Chapter one. It actually works.
This commit is contained in:
commit
d7f8dddb91
|
|
@ -0,0 +1,8 @@
|
|||
*#
|
||||
.#*
|
||||
*~
|
||||
*.orig
|
||||
npm-debug.log
|
||||
node_modules/*
|
||||
tmp/
|
||||
test/
|
||||
|
|
@ -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))
|
||||
Loading…
Reference in New Issue