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

LECTURE #8 SLIDES LISP: LANGUAGE AND LITERATUREMay 8, 1984
——————————————————————————————————

Slides for Lecture 8 — State, Polymorphism, and Message-Passing

Filed as:[phylum]<3-lisp>course>notes>Lecture-08.slides
User.cm:[phylum]<BrianSmith>system>user.classic+4
Last edited:May 8, 1984 1:41 PM

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



(let [[balance 0]]
(define WITHDRAW
(lambda [amount]
(if (< balance amount)
"Insufficient funds"
(begin (set balance (- balance amount))
balance))))
(define DEPOSIT
(lambda [amount]
(set balance (+ balance amount))))
(define CURRENT-BALANCE
(lambda [] balance)))

1> (current-balance)
1= 100
1> (deposit 23)
1= 123
1> (withdraw 40)
1= 83
1> (withdraw 100)
1= "Insufficient funds"



(define MAKE-ACCOUNT
(lambda [balance]
(define WITHDRAW
(lambda [amount]
(if (< balance amount)
"Insufficient funds"
(begin (set balance (- balance amount))
balance))))
(define DEPOSIT
(lambda [amount]
(set balance (+ balance amount))))
(define CURRENT-BALANCE
(lambda [] balance)))))



(define MAKE-ACCOUNT
(lambda [balance]
(letrec [[WITHDRAW-FUN
(lambda [amount]
(if (< balance amount)
"Insufficient funds"
(begin (set balance (- balance amount))
balance)))]
[DEPOSIT-FUN
(lambda [amount]
(set balance (+ balance amount)))]
[CURRENT-BALANCE-FUN
(lambda [] balance)]]
(lambda [message]
(cond [(= message ’withdraw) withdraw-fun]
[(= message ’deposit) deposit-fun]
[(= message ’current-balance) current-balance-fun]
[$T (error "unknown message" message)])))))

1> (set A1 (make-account 100))
1= {simple closure ... }
1> ((A1 ’deposit) 2000)
1= 2100
1> ((A1 ’withdraw) 40)
1= 2060
1> ((A1 ’current-balance))
1= 2060



(define WITHDRAW
(lambda [account amount]
((account ’withdraw) amount)))

(define DEPOSIT
(lambda [account amount]
((account ’deposit) amount)))

(define CURRENT-BALANCE
(lambda [account]
((account ’current-balance)))



(define CELL
(lambda [contents]
(letrec [[UPDATE-FUN (lambda [new-contents]
(set contents new-contents))]
[CONTENTS-FUN (lambda [] contents)]]
(lambda [message]
(cond [(= message ’contents) contents-fun]
[(= message ’update) update-fun]
[$T (error "unknown message" message)])))))

(define UPDATE
(lambda [cell new-contents]
((cell ’update) new-contents)))

(define CONTENTS
(lambda [cell]
((cell ’contents))))

1> (set C1 (cell "This is a string"))
1= "This is a string"

1> (set C2 (cell 200))
1= 200

1> (contents C1)
1= "This is a string"

1> (update C1 factorial)
1= {factorial closure}

1> ((contents C1) 6)
1= 120

1> (+ 3 (contents C2))
1= 203



(define MAKE-ACCOUNT
(lambda [balance]
(let [[account (cell balance)]]
(letrec [[WITHDRAW-FUN
(lambda [amount]
(if (< (contents account) amount)
"Insufficient funds"
(update account
(- (contents account) amount))))]
[DEPOSIT-FUN
(lambda [amount]
(update account (+ (contents account) amount)))]
[CURRENT-BALANCE-FUN
(lambda [] (contents account))]]
(lambda [message]
(cond [(= message ’withdraw) withdraw-fun]
[(= message ’deposit) deposit-fun]
[(= message ’current-balance) current-balance-fun]
[$T (error "unknown message" message)]))))))

(define WITHDRAW
(lambda [account amount]
((account ’withdraw) amount)))

(define DEPOSIT
(lambda [account amount]
((account ’deposit) amount)))

(define CURRENT-BALANCE
(lambda [account]
((account ’current-balance)))



(define DEFINE-MESSAGE
(lambda [message]
(define <message>; ???
(lambda args
(((first args) message) . (rest args))))

i.e., DEFINE-MESSAGE should convert

(define-message WITHDRAW)

to:

(define WITHDRAW
(lambda args
(((first args) ’withdraw) . (rest args))))

which is equivalent to:

(define WITHDRAW
(lambda [account amount]
((account ’withdraw) amount)))



(define CELL
(lambda [contents]
(letrec [[UPDATE-FUN (lambda [new-contents]
(set contents new-contents))]
[CONTENTS-FUN (lambda [] contents)]]
(lambda [message]
(cond [(= message ’contents) contents-fun]
[(= message ’update) update-fun]
[$T (error "unknown message" message)])))))

(define-message UPDATE)

(define-message CONTENTS)



(define-object CELL
(lambda [contents]
[UPDATE (lambda [new-contents]
(set contents new-contents))]
[CONTENTS (lambda [] contents)]))

and:

(define-object MAKE-ACCOUNT
(lambda [balance]
[WITHDRAW (lambda [amount]
(if (< balance amount)
"Insufficient funds"
(set balance (- balance amount))))]
[DEPOSIT (lambda [amount]
(set balance (+ balance amount))]
[CURRENT-BALANCE (lambda [] balance)]))



(define-object FAMILY
(lambda [mother father kids]
[MOTHER (lambda [] mother)]
[FATHER (lambda [] father)]
[KIDS (lambda [] kids)]
[NEW-KID (lambda [kid] (set kids (append kids [kid])))]))

1> (set LeVesques (family "HECTOR" "PAT" []))
1= {simple closure ... }
1> (father LeVesques)
1= "Hector"
1> (mother LeVesques)
1= "Pat"
1> (new-kid LeVesques "Michele")
1= [Michele]
1> (new-kid LeVesques "Rene")
1= ["Michele" "Rene"]
1> (kids LeVesques)
1= ["Michele" "Rene"]



(define-object M-CONS
(lambda [element tail]
[M-RAIL (lambda [] $true)]
[M-FIRST (lambda [] element)]
[M-REST (lambda [] tail)]
[NEW-FIRST (lambda [new-element] (set element new-element))]
[NEW-REST (lambda [new-tail] (set tail new-tail))]
[M-NULL (lambda [] $false)]
[M-LENGTH (lambda [] (+ 1 (m-length tail)))]))

(define-object EMPTY-M-RAIL
(lambda []
[M-RAIL (lambda [] $true)]
[M-FIRST (lambda [] (error "empty m-rail" ’?))]
[M-REST (lambda [] (error "empty m-rail" ’?))]
[NEW-FIRST (lambda [new-element] (error "empty m-rail" ’?))]
[NEW-REST (lambda [new-tail] (error "empty m-rail" ’?))]
[M-NULL (lambda [] $true)]
[M-LENGTH (lambda [] 0)]))



1> (set M1
(m-cons 10
(m-cons 20
(m-cons 30
(empty-m-rail)))))
1= {simple closure ... }
1> (m-first M1)
1= 10
1> (m-length M1)
1= 3
1> (m-rest M1)
1= {simple closure ... }; Not too useful
1> (new-first M1 "Hi there")
1= "Hi there"
1> (m-length M1)
1= 3
1> (m-first M1)
1= "Hi there"
1> (new-rest M1 (empty-m-rail))
1= {simple closure ... }
1> (m-length M1)
1= 1



(define-object M-CONS
(lambda [element tail]
[M-RAIL (lambda [] $true)]
[M-FIRST (lambda [] element)]
[M-REST (lambda [] tail)]
[NEW-FIRST (lambda [new-element] (set element new-element))]
[NEW-REST (lambda [new-tail] (set tail new-tail))]
[M-NULL (lambda [] $false)]
[M-LENGTH (lambda [] (+ 1 (m-length tail)))]
[M-EXTERNALIZE
(lambda []
(let [[rs (m-externalize tail)]]
(string-append
"<"
(externalize ↑element)
(if (m-null tail) "" " ")
(substring 2 (string-length rs) rs))))]))

(define-object EMPTY-M-RAIL
(lambda []
[M-RAIL (lambda [] $true)]
[M-FIRST (lambda [] (error "empty m-rail" ’?))]
[M-REST (lambda [] (error "empty m-rail" ’?))]
[NEW-FIRST (lambda [new-element] (error "empty m-rail" ’?))]
[NEW-REST (lambda [new-tail] (error "empty m-rail" ’?))]
[M-NULL (lambda [] $true)]
[M-LENGTH (lambda [] 0)]
[M-EXTERNALIZE (lambda [] "<>")]))



1> (set M1
(m-cons 10
(m-cons 20
(m-cons 30
(empty-m-rail)))))
1= {simple closure ... }
1> (m-externalize m1)
1= "<10 20 30>"
1> (begin (new-first M1 (factorial 6))
(m-externalize m1))
1= "<120 20 30>"
1> (new-rest M1 (m-empty-rail))
1= {simple closure ... }
1> (m-externalize M1)
1= "<120>"



(define REST!
(lambda [arg]
(cond [(rail arg) (rest arg)]
[(sequence arg) (rest arg)]
[(m-rail arg) (m-rest arg)]
[$T (error "type error for rest" ↑arg)])))

1> (length! "This is a test")
1= 14
1> (length! [10 20 30])
1= 3



1> (set F1 (family "Tully" "Cleopatra" []))
1= {simple closure}
1> (set F1 (family "Cicero" "Cleopatra" []))
1= {simple closure}
1> (= f1 f2)
Error: Equality not defined over functions