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

LECTURE #9 SLIDES LISP: LANGUAGE AND LITERATUREMay 10, 1984
——————————————————————————————————

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

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

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



(define OBJECT-NAME
(object [state-var1 ... state-vark]
[METHOD-NAME1 procedure1]
[METHOD-NAME2 procedure2]
...
[METHOD-NAMEn proceduren]))



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

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 CELL
(object [contents]
[UPDATE (lambda [new-contents]
(set contents new-contents))]
[CONTENTS (lambda [] 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 FAMILY
(object [mother father kids]
[MOTHER (lambda [] mother)]
[FATHER (lambda [] father)]
[KIDS (lambda [] kids)]
[NEW-KID (lambda [kid] (set kids (cons kid kids)))]))

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 COUNT
(let [[n 0]]
(lambda []
(begin (set n (+ n 1))
n))))

(define ONE
(lambda []
(let [[n 0]]
(begin (set n (+ n 1))
n)))



(define ACCOUNT
(object [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 MAKE-ACCOUNT
(lambda [balance]
(letrec [[PRIVATE-WITHDRAW-FUN
(lambda [amount]
(if (< balance amount)
"Insufficient funds"
(begin (set balance (- balance amount))
balance)))]
[PRIVATE-DEPOSIT-FUN
(lambda [amount]
(set balance (+ balance amount)))]
[PRIVATE-CURRENT-BALANCE-FUN
(lambda [] balance)]]
(lambda [message]
(cond [(= message ’withdraw) private-withdraw-fun]
[(= message ’deposit) private-deposit-fun]
[(= message ’current-balance)
private-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 OBJECT-NAME
(object [state-var1 ... state-vark]
[METHOD-NAME1 procedure1]
[METHOD-NAME2 procedure2]
...
[METHOD-NAMEn proceduren]))

(begin
(define METHOD-NAME1
(lambda args
(((first args) ’method-name1) . (rest args))))
...
(define METHOD-NAMEn
(lambda args
(((first args) ’method-namen) . (rest args))))]
(lambda [state-var1 ... state-vark]
(letrec [[private-name1 procedure1]
...
[private-namen proceduren]]
(lambda [message]
(cond [(= message ’method-name1) private-name1]
...
[(= message ’method-namen) private-namen]
[$T (error "unrecognized message" ↑message)])))))



(define M-CONS
(object [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 EMPTY-M-RAIL
(object []
[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> (define M-LIST; Should be more convenient to use.
(lambda args
(if (null args)
(empty-m-rail)
(m-cons (first args)
(m-list . (rest args))))))
1= ’m-list

1> (set M1 (m-list 10 20 30))
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-list 10 20 30))
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)]
[(string arg) (substring 2 (string-length arg) 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> (length! (m-cons "a" "b"))
1= 2



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



(define ACCOUNT-=
(lambda [a1 a2]
(= ↑a1 ↑a1)))