Page Numbers: Yes X: 306 Y: 1.0" First Page: 1
Margins: Top: 1.0" Bottom: 1.3"
Heading:
LECTURE #11 SLIDES LISP: LANGUAGE AND LITERATUREMay 17, 1984
——————————————————————————————————
Slides for Lecture #11 — Quotation and Structural Abstraction
Filed as:[phylum]<3-lisp>course>notes>Lecture-11.slides
User.cm:[phylum]<BrianSmith>system>user.classic+4
Last edited:May 17, 1984 1:55 PM
——————————————————————————————————
(internalize "2")
1= ’2
1> (internalize "(+ x y)")
1= ’(+ x y)
1> (internalize " (first ; this is a comment
;;;
;;; and some more
;;;
x)")
1= ’(first x)
(define INCREMENT
(mlambda [call]
(pcons ’+ (rcons ’1 (pargs call)))))
(lambda [call]
(pcons ’+ (rcons ’1 (pargs call))))
((lambda [call]
(pcons ’+ (rcons ’1 (pargs call))))
’(increment x))
(pcons ’+ (rcons ’1 (pargs ’(increment x))))
(pcons ’+ (rcons ’1 ’[x]))
(pcons ’+ ’[1 x]))
’(+ 1 x)
(define INCREMENT
(mlambda [call]
(pcons ’+ (rcons ’1 (pargs call)))))
(if* (= 1 2)
then (+ 10 (factorial ... ))
else [( ... )])
(define IF*
(mlambda [call]
(pcons ’if
(rcons (first (pargs call))
(third (pargs call))
(fifth (pargs call))))))
Perhaps clearer:
(define IF*
(mlambda [call]
(let [[premise (first (pargs call))]
[c1 (third (pargs call))]
[c2 (fifth (pargs call))]]
(pcons ’if (rcons premise c1 c2))))))
(if* e1 then e2 else e3) W> (if e1 e2 e3)
1> (define CAREFUL-DIVISION
(lambda [dividend divisor]
(if* (= divisor 0)
then "can’t divide by zero"
else (/ dividend divisor))))
1= ’careful-division
1> (careful-division 12 3)
1= 4
1> (careful-division 12 0)
1= "can’t divide by zero"
(define IF*
(mlambda [call]
(let [[premise (first (pargs call))]
[noise-1 (second (pargs call))]
[c1 (third (pargs call))]
[noise-2 (fourth (pargs call))]
[c2 (fifth (pargs call))]]
(if (and (= noise-1 ’then)
(= noise-1 ’else))
(pcons ’if
(rcons premise c1 c2))
(error "Malformed IF*" call)))))
(define ARG
(lambda [n pair]
(nth n (pargs pair))))
(define IF*
(mlambda [call]
(pcons ’if (rcons (arg 1 call)
(arg 3 call)
(arg 5 call)))))
Would really like:
(define IF*
(mlambda [call]
’(if (arg 1 call) (arg 3 call) (arg 5 call))))
(define IF*
(mlambda [call]
’(if ,(arg 1 call)
,(arg 3 call)
,(arg 5 call))))
’(/ ,x (if (= ,y 0)
1
,y))
(pcons ’/
(rcons x
(pcons ’if
(rcons (pcons ’=
(rcons y ’0))
’1
y))))
More examples:
1> (set X ’(= 2 3))
1= ’(= 2 3)
1> ’(if X A B)
1= ’(if X
A
B)
1> ’(if ,X A B)
1= ’(if (+ 2 3)
A
B)
(define OBJECT
(letrec [[define-message
(lambda [name]
’(define ,name
(lambda args
(((first args) ,↑name) . (rest args)))))]]
(mlambda [call]
(letseq [[state-vars (arg 1 call)]
[inited-vars (arg 2 call)]
[pairs (tail 2 (pargs call))]
[fun-names (map (lambda [pair] (acons)) pairs)]]
’(begin
,(map (lambda [pair]
(define-message (first pair)))
pairs)
(lambda ,state-vars
(let ,inited-vars
(letrec ,(map (lambda [pair fun-name]
’[,fun-name ,(second pair)])
pairs
fun-names)
(lambda [message]
(cond . ,(map (lambda [pair fun-name]
’[(= message ,↑(first pair))
,fun-name])
pairs
fun-names)))))))))))
Converts
(object [<init-var-1> ... <init-var-k>]
[[<var-1> <init-1>] ... [<var-n> <init-n>]]
[<mess1> <fun1>]
[<mess2> <fun2>]
...
[<messj> <funj>])
into
(begin [(define-message <mess1>)
(define-message <mess2>)
...
(define-message <messj>)]
(lambda [init-var-1 ... init-var-k]
(let [[<var-1> <init-1>]
...
[<var-n> <init-n>]]
(letrec [<new-name-1> <fun1>]
...
[<new-name-j> <funj>]]
(lambda [message]
(cond [(= message ’<mess1>) <new-name-1>]
[(= message ’<mess2>) <new-name-2>]
...
[(= message ’<messj>) <new-name-j>]))))))
(object [balance] []
[WITHDRAW (lambda [amount]
(if (< balance amount)
(error "Insufficient funds")
(begin (set balance (- balance amount))
balance)))]
[DEPOSIT (lambda [amount]
(begin (set balance (+ balance amount))
balance))])
into
(begin [(define-message WITHDRAW)
(define-message DEPOSIT)]
(lambda [balance]
(let []
(letrec [[{atom 1} (lambda [amount]
(if (< balance amount)
(error "Insufficient funds")
(begin (set balance (- balance amount))
balance)))]
[{atom 2} (lambda [amount]
(begin (set balance (+ balance amount))
balance))]]
(lambda [message]
(cond [(= message ’withdraw) {atom 1}]
[(= message ’deposit) {atom 2}]))))))
1> (normalize ’(+ 1 2) global)
1= ’3
1> (normalize ’[2 3 4] global)
1= ’[2 3 4]
1> (set x 3)
1= 3
1> ’[1 2 x]
1= ’[1 2 x]
1> (normalize ’[1 2 x] global)
1= ’[1 2 3]
1> (let [[x ’4]]
(normalize x global))
1= ’4
1> (let [[x ’4]]
(normalize ’[1 2 x] global))
1= ’[1 2 3]
1> (let [[x ’4]]
(normalize ’[1 2 ,x] global))
1= ’[1 2 4]
(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 proc-nf ↑args))]
[macro (normalize
↑(expand-closure (extract-simple-closure 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))))