Moving to a more nuanced naming scheme. What happens next will amaze you!
This commit is contained in:
parent
11e1ed7cf4
commit
2bc6312415
192
racket/chap1.rkt
192
racket/chap1.rkt
|
@ -1,192 +0,0 @@
|
||||||
; Lisp In Small Pieces, chapter 1 Simple Lambda Calculus interpreter
|
|
||||||
; with global environment, simple lexical closures enforced by singly
|
|
||||||
; linked lists.
|
|
||||||
|
|
||||||
; This covers only severals exercise: I added 'exit as an exit value;
|
|
||||||
; I fixed the definition of '<', and then applied the exercise out of
|
|
||||||
; the book.
|
|
||||||
|
|
||||||
; Any of the exercises that needed call/cc I've avoided for the simple
|
|
||||||
; reason that I started this to learn lisp, I'm a raw beginner, and
|
|
||||||
; call/cc is definitely advance estorics.
|
|
||||||
|
|
||||||
; 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 gets 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))))))))
|
|
||||||
|
|
||||||
; Sometimes, you do have to define something before you use it. Lesson
|
|
||||||
; learned.
|
|
||||||
|
|
||||||
(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)
|
|
||||||
|
|
||||||
(define-syntax defpredicate
|
|
||||||
(syntax-rules ()
|
|
||||||
((_ name native arity)
|
|
||||||
(defprimitive name (lambda args (or (apply native args) the-false-value)) arity))))
|
|
||||||
|
|
||||||
(defprimitive cons cons 2)
|
|
||||||
(defprimitive car car 1)
|
|
||||||
(defprimitive set-cdr! set-mcdr! 2)
|
|
||||||
(defprimitive + + 2)
|
|
||||||
(defprimitive - - 2)
|
|
||||||
(defprimitive * * 2)
|
|
||||||
(defpredicate lt < 2)
|
|
||||||
(defpredicate 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 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))))
|
|
||||||
|
|
||||||
; Already we're starting to get some scope here. Note that
|
|
||||||
; make-function provides the environment, not the invoke. This makes
|
|
||||||
; this a lexically scoped interpreter.
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
; 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 mcdar (syntax-rules () ((_ e) (mcdr (mcar e)))))
|
|
||||||
|
|
||||||
; Iterate through the environment, find an ID, return its associated
|
|
||||||
; value.
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
; Core 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))
|
|
||||||
|
|
||||||
; (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1))))))
|
|
|
@ -1,10 +0,0 @@
|
||||||
(define (find-symbol id tree)
|
|
||||||
(call/cc
|
|
||||||
(lambda (exit)
|
|
||||||
(define (find tree)
|
|
||||||
(if (pair? tree)
|
|
||||||
(or (find (car tree)) (find (cdr tree)))
|
|
||||||
(if (eq? tree id) (exit #t) #f)))
|
|
||||||
(find tree))))
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue