Page Numbers: Yes X: 306 Y: 1.0" First Page: 1
Margins: Top: 1.0" Bottom: 1.0"
Heading:

LECTURE NOTES #12LISP: LANGUAGE AND LITERATUREMay 22, 1984
————————————————————————————————————————————

Examples for Lecture #12 — Meta-circular Processors

Filed as:[phylum]<3-lisp>course>notes>Lecture-11.notes
User.cm:[phylum]<BrianSmith>system>user.classic
Last edited:May 22, 1984 1:21 PM

————————————————————————————————————————————

(define NORMALIZE
(lambda [struc env]
(cond [(normal struc) struc]
[(atom struc) (binding struc env)]
[(rail struc) (normalize-rail struc env)]
[(pair struc) (reduce (pproc struc) (pargs struc) env)])))

(define REDUCE
(lambda [proc args env]
(let [[proc-nf (normalize proc env)]]
(dispatch (closure-type proc-nf)
[simple (let [[args-nf (normalize args env)]]
(if (primitive proc-nf)
(reduce-primitive-simple proc-nf args-nf)
(expand-closure proc-nf args-nf)))]
[special (if (primitive proc-nf)
(reduce-primitive-special
(extract-simple-closure proc-nf)
args
env)
(expand-closure (extract-simple-closure proc-nf) ↑args))]
[macro (normalize ↑(expand-closure (extract-simple-closure proc-nf)
’[(,proc-nf . ,↑args)])
env))]))))

(define NORMALIZE-RAIL
(lambda [rail env]
(if (empty rail)
(rcons)
(cons (normalize (1st rail) env)
(normalize-rail (rest rail) env)))))

(define EXPAND-CLOSURE
(lambda [proc-nf args-nf]
(normalize (body proc-nf)
(bind (pattern proc-nf)
args-nf
(environment proc-nf)))))

(define READ-NORMALIZE-PRINT
(lambda [env stream]
(begin (prompt&reply (normalise (prompt&read stream) env)
stream)
(read-normalize-print env stream))))



(define NORMAL
(lambda [struct]
(cond [(or (pair struct) (atom struct)) $false]
[(or (handle struct)
(charat struct) (numeral struct)
(stringer struct) (closure struct)
(boolean struct) (streamer struct)
(environment-designator struct))
$true]
[(rail struct) (every normal struct)])))

(define REDUCE-PRIMITIVE-SPECIAL
(lambda [closure args env]
(select ↑closure
[↑if (if (= ’$T (normalize (first args) env))
(normalize (second args) env)
(normalize (third args) env)))]
[↑set (rebind (first args)
(normalize (second args) env)
env)]
[↑lambda (ccons ↑env
(first args)
(second args))])))

————————————————————————————————————————————————

(define NEW-BIND
(lambda [pattern args env]
(cond [(atom pattern) (bind pattern args env)]
[(null pattern) (if (null args)
env
(error "wrong-number-of-arguments" pattern))]
[$t (new-bind (first pattern)
(first args)
(new-bind (rest pattern)
(rest args)
env))])))

————————————————————————————————————————————————

(define DYNAMIC-REDUCE
(lambda [proc args env]
(let [[proc-nf (normalize proc env)]]
(dispatch (closure-type proc-nf)
[simple (let [[args-nf (normalize args env)]]
(if (primitive proc-nf)
(reduce-primitive-simple proc-nf args-nf)
(expand-closure proc-nf args-nf env)))]
[special (if (primitive proc-nf)
(reduce-primitive-special (extract-simple-closure proc-nf)
↑args
env)
(expand-closure proc-nf ↑args env))]
[macro (normalize ↑(expand-closure (extract-simple-closure proc-nf)
’[(,proc-nf . ,↑args)]
env)
env))]))))

(define DYNAMIC-EXPAND-CLOSURE
(lambda [proc-nf args-nf env]
(normalize (body proc-nf)
(bind (pattern proc-nf)
args-nf ; Note that no environments need be
env)))) ; stored within the closure.

————————————————————————————————————————————————