From d7f8dddb9150cdd7ccd90ebc7072cce077494dd0 Mon Sep 17 00:00:00 2001 From: "Elf M. Sternberg" Date: Wed, 15 Apr 2015 15:50:53 -0700 Subject: [PATCH] Chapter one. It actually works. --- .gitignore | 8 +++ chap1.rkt | 184 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 192 insertions(+) create mode 100644 .gitignore create mode 100644 chap1.rkt diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25bbd9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +*# +.#* +*~ +*.orig +npm-debug.log +node_modules/* +tmp/ +test/ diff --git a/chap1.rkt b/chap1.rkt new file mode 100644 index 0000000..be4fa23 --- /dev/null +++ b/chap1.rkt @@ -0,0 +1,184 @@ +; Lisp In Small Pieces, chapter 1 Simple Lambda Calculus interpreter +; with global environment, simple lexical closures enforced by singly +; linked lists. + +; This covers only one exercise: I added 'exit as an exit value. + +; Needed for 'wrong-syntax', which is Racket's version of the "wrong" +; exception tosser. + +(require racket/syntax) + +; LISP requires a mutatable environment, so using mcons/mpair for +; that. + +(require scheme/mpair) + +; Weird; racket needs this as a patch. I would have expected it as +; present in the default list of functions! + +(define (atom? x) + (and (not (null? x)) + (not (pair? x)))) + +(define env_init '()) + +(define env_global env_init) + +; So, this macro places *into the current scope* (i.e. no building of +; a new scope that get's reaped upon exit) the names of variables and +; potential initial values. + +(define-syntax definitial + (syntax-rules () + ((definitial name) + (begin (set! env_global (mcons (mcons 'name 'void) env_global)) 'name)) + ((definitial name value) + (begin (set! env_global (mcons (mcons 'name value) env_global)) 'name)))) + +; Oh! This macro (same scope thing again) associates named things with +; values in the target environment (the host language), along with +; arity checking. (which it doesn't do for 'if', for example) + +(define-syntax defprimitive + (syntax-rules () + ((defprimitive name value arity) + (definitial name + (lambda (values) + (if (= arity (length values)) + (apply value values) + (wrong-syntax #'here "Incorrect arity ~s" (list 'name values)))))))) + +(define the-false-value (cons "false" "boolean")) + +(definitial t #t) +(definitial f the-false-value) +(definitial nil '()) +(definitial foo) +(definitial bar) +(definitial fib) +(definitial fact) + +(defprimitive cons cons 2) +(defprimitive car car 1) +(defprimitive set-cdr! set-mcdr! 2) +(defprimitive + + 2) +(defprimitive < < 2) +(defprimitive eq? eq? 2) + +; This function extends the environment so that *at this moment of +; extension* the conslist head points to the old environment, then +; when it's done it points to the new environment. What's really +; interesting is that the conslist head points to the last object +; initialized, not the first. + +(define (extend env variables values) + (cond ((pair? variables) + (if (pair? values) + (mcons (mcons (car variables) (car values)) + (extend env (cdr variables) (cdr values))) + (wrong-syntax #'here "Too few values"))) + ((null? variables) + (if (null? values) + env + (wrong-syntax #'here "Too many values"))) + ((symbol? variables) (mcons (mcons variables values) env)))) + +; This is interesting. Already we're starting to get some scope here. +; Note that make function provides the environment, not the invoke. +; But we're still only passing the empty init environment. + +; Now a different order, one in which closures aren't present, makes +; the code fragile. So: + +(define (make-function variables body env) + (lambda (values) + (eprogn body (extend env variables values)))) + +; if it's a function, invoke it. Wow. Much complex. Very interpret. + +(define (invoke fn args) + (if (procedure? fn) + (fn args) + (wrong-syntax #'here "Not an function ~s" fn))) + +; The text points out that the global environment is being +; pushed/popped as needed and rebuilt with every function call. In +; this case, the defining envirnoment is no longer being used at all, +; only the current one. This would make this a dynamically scope +; language, no? + +; Iterate through the exps, return the value of the last one. + +(define (eprogn exps env) + (if (pair? exps) + (if (pair? (cdr exps)) + (begin (evaluate (car exps) env) + (eprogn (cdr exps) env)) + (evaluate (car exps) env)) + '())) + +; Iterate through the exps, return a list of the values of the +; evaluated expressions + +(define (evlis exps env) + (if (pair? exps) + (cons (evaluate (car exps) env) + (evlis (cdr exps) env)) + '())) + +; silly patch because of the mutatable lists + +(define-syntax mcaar (syntax-rules () ((_ e) (mcar (mcar e))))) +(define-syntax mcadr (syntax-rules () ((_ e) (mcdr (mcar e))))) + +; Iterate through the environment, find an ID, return its associated +; value. This is a completely global, resettable environment; we're +; talking BASIC here. + +(define (lookup id env) + (if (mpair? env) + (if (eq? (mcaar env) id) + (mcdar env) + (lookup id (mcdr env))) + (wrong-syntax #'here "No such binding ~s" id))) + +; Iterate through the environment, find an ID, and change its value to +; the new value. Again, purely global environment. Really starting +; to grok how the environment "stack" empowers modern runtimes. + +(define (update! id env value) + (if (mpair? env) + (if (eq? (mcaar env) id) + (begin (set-mcdr! (mcar env) value) value) + (update! id (mcdr env) value)) + (wrong-syntax #'here "No such binding ~s" id))) + +; Different evaluation rules. + +(define (evaluate exp env) + (if (atom? exp) + (cond + ((symbol? exp) (lookup exp env)) + ((or (number? exp) (string? exp) (char? exp) (boolean? exp) (vector? exp)) exp) + (else (wrong-syntax #'here "Cannot evaluate"))) + (case (car exp) + ((quote) (cadr exp)) + ; Note: No checks that the statement even vaguely resembles the rules. + ((if) (if (not (eq? (evaluate (cadr exp) env) the-false-value)) + (evaluate (caddr exp) env) + (evaluate (cadddr exp) env))) + ((begin) (eprogn (cdr exp) env)) + ((set!) (update! (cadr exp) env (evaluate (caddr exp) env))) + ((lambda) (make-function (cadr exp) (cddr exp) env)) + (else (invoke (evaluate (car exp) env) (evlis (cdr exp) env)))))) + +; Run it. Note that the function toplevel is self-referential. + +(define (chapter1-scheme) + (define (toplevel) + (let ((result (evaluate (read) env_global))) + (if (not (eq? result 'exit)) + (begin (display result) (toplevel)) + #f))) + (toplevel))