Answer till 4.27
parent
95c18225a5
commit
1d0227f445
10
README.md
10
README.md
|
@ -10,7 +10,7 @@ You can use the Scheme implementation by the MIT to run these scripts. In Arch,
|
|||
execute `pacman -S mit-scheme` to install it. Then run the scripts via
|
||||
`mit-scheme --quiet < script.scm`.
|
||||
|
||||
**This is currently (2020/12/16) work in progress.**
|
||||
**This is currently (2021/01/25) work in progress.**
|
||||
|
||||
|
||||
# Chapter 1
|
||||
|
@ -64,8 +64,14 @@ this brought up cool memories. I wish I still had that presentation.
|
|||
|
||||
Finally, SICP introduces the evaluation model for stateless functions and
|
||||
concludes with some exercises that require second-order procedures: procedures
|
||||
that take other procedures as arguments.
|
||||
that take other procedures as arguments.
|
||||
|
||||
|
||||
# Chapter 2
|
||||
|
||||
![Corner Split](misc/corner-split-3.png)
|
||||
|
||||
|
||||
# Chapter 3
|
||||
|
||||
|
||||
|
|
170
ex-4_25-xx.scm
170
ex-4_25-xx.scm
|
@ -1,7 +1,171 @@
|
|||
(load "util.scm")
|
||||
; (load "misc/evaluator.scm")
|
||||
(load "misc/evaluator.scm")
|
||||
|
||||
(display "\nex-4.25\n")
|
||||
(display "\nex-4.25 - factorial-unless\n")
|
||||
|
||||
(display "\nex-4.26\n")
|
||||
(eval '(define (unless condition usual-value exceptional-value)
|
||||
(if condition exceptional-value usual-value)) the-global-environment)
|
||||
|
||||
(eval '(define (factorial n)
|
||||
(unless (= n 1)
|
||||
(* n (factorial (- n 1)))
|
||||
1)) the-global-environment)
|
||||
|
||||
; This implementation of factorial is not going to terminate in regular
|
||||
; applicative-order Scheme because the recursive calls to factorial result in
|
||||
; an endless-loop. The definition would work in a normal-order language.
|
||||
|
||||
; (factorial 5)
|
||||
|
||||
(display "[answered]\n")
|
||||
|
||||
|
||||
(display "\nex-4.26 - special-form-unless\n")
|
||||
|
||||
(define (unless-condition exp) (cadr exp))
|
||||
(define (unless-usual exp) (caddr exp))
|
||||
(define (unless-exceptional exp) (cadddr exp))
|
||||
|
||||
(define (unless->combination exp)
|
||||
(make-if (unless-condition exp)
|
||||
(unless-exceptional exp)
|
||||
(unless-usual exp)))
|
||||
|
||||
(assert (eval '(factorial 3) the-global-environment) 6)
|
||||
|
||||
(display "\nexample - lazy-evaluation\n")
|
||||
|
||||
(define (eval exp env)
|
||||
(cond ((self-evaluating? exp) exp)
|
||||
((variable? exp) (lookup-variable-value exp env))
|
||||
((quoted? exp) (text-of-quotation exp))
|
||||
((assignment? exp) (eval-assignment exp env))
|
||||
((definition? exp) (eval-definition exp env))
|
||||
((if? exp) (eval-if exp env))
|
||||
((lambda? exp)
|
||||
(make-procedure (lambda-parameters exp)
|
||||
(lambda-body exp)
|
||||
env))
|
||||
((begin? exp)
|
||||
(eval-sequence (begin-actions exp) env))
|
||||
((cond? exp) (eval (cond->if exp) env))
|
||||
((application? exp)
|
||||
(apply (actual-value (operator exp) env)
|
||||
(operands exp)
|
||||
env))
|
||||
(else
|
||||
(error "Unknown expression type -- EVAL" exp))))
|
||||
|
||||
(define (actual-value exp env)
|
||||
(force-it (eval exp env)))
|
||||
|
||||
(define (apply procedure arguments env)
|
||||
(cond ((primitive-procedure? procedure)
|
||||
(apply-primitive-procedure
|
||||
procedure
|
||||
(list-of-arg-values arguments env))) ; changed
|
||||
((compound-procedure? procedure)
|
||||
(eval-sequence
|
||||
(procedure-body procedure)
|
||||
(extend-environment
|
||||
(procedure-parameters procedure)
|
||||
(list-of-delayed-args arguments env) ; changed
|
||||
(procedure-environment procedure))))
|
||||
(else
|
||||
(error
|
||||
"Unknown procedure type -- APPLY" procedure))))
|
||||
|
||||
(define (list-of-arg-values exps env)
|
||||
(if (no-operands? exps)
|
||||
'()
|
||||
(cons (actual-value (first-operand exps) env)
|
||||
(list-of-arg-values (rest-operands exps)
|
||||
env))))
|
||||
(define (list-of-delayed-args exps env)
|
||||
(if (no-operands? exps)
|
||||
'()
|
||||
(cons (delay-it (first-operand exps) env)
|
||||
(list-of-delayed-args (rest-operands exps)
|
||||
env))))
|
||||
|
||||
(define (eval-if exp env)
|
||||
(if (true? (actual-value (if-predicate exp) env))
|
||||
(eval (if-consequent exp) env)
|
||||
(eval (if-alternative exp) env)))
|
||||
|
||||
(define (force-it obj)
|
||||
(if (thunk? obj)
|
||||
(actual-value (thunk-exp obj) (thunk-env obj))
|
||||
obj))
|
||||
|
||||
(define (delay-it exp env)
|
||||
(list 'thunk exp env))
|
||||
|
||||
(define (thunk? obj)
|
||||
(tagged-list? obj 'thunk))
|
||||
|
||||
(define (thunk-exp thunk) (cadr thunk))
|
||||
|
||||
(define (thunk-env thunk) (caddr thunk))
|
||||
|
||||
(define (evaluated-thunk? obj)
|
||||
(tagged-list? obj 'evaluated-thunk))
|
||||
|
||||
(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))
|
||||
|
||||
(define (force-it obj)
|
||||
(cond ((thunk? obj)
|
||||
(let ((result (actual-value
|
||||
(thunk-exp obj)
|
||||
(thunk-env obj))))
|
||||
(set-car! obj 'evaluated-thunk)
|
||||
(set-car! (cdr obj) result) ; replace exp with its value
|
||||
(set-cdr! (cdr obj) '()) ; forget unneeded env
|
||||
result))
|
||||
((evaluated-thunk? obj)
|
||||
(thunk-value obj))
|
||||
(else obj)))
|
||||
|
||||
(define the-global-environment (setup-environment))
|
||||
|
||||
(eval '(define (assert a b)
|
||||
(cond ((equal? a b) (display "[ok]"))
|
||||
(else
|
||||
(display "[error] ")
|
||||
(display a)
|
||||
(display " != ")
|
||||
(display b)))
|
||||
(newline)) the-global-environment)
|
||||
|
||||
(eval '(define (unless condition usual-value exceptional-value)
|
||||
(if condition exceptional-value usual-value)) the-global-environment)
|
||||
|
||||
(eval '(define (factorial n)
|
||||
(unless (= n 1)
|
||||
(* n (factorial (- n 1)))
|
||||
1)) the-global-environment)
|
||||
|
||||
(eval '(assert (factorial 5) 120) the-global-environment)
|
||||
|
||||
(display "\nex-4.27 - lazy-evaluator\n")
|
||||
|
||||
(eval '(define count 0) the-global-environment)
|
||||
(eval '(define (id x) (set! count (+ count 1)) x) the-global-environment))
|
||||
(eval '(define w (id (id 10))) the-global-environment)
|
||||
|
||||
; I expected count to be 0 here, but it is 1 in reality. I think when
|
||||
; list-of-delayed-args is called in the first call of id the count gets
|
||||
; incremented the first time. Hence, the value is 1.
|
||||
(assert (eval 'count the-global-environment) 1)
|
||||
|
||||
; w is thunk and cannot be displayed. By getting the actual value it will show
|
||||
; 10 as expected.
|
||||
(assert (actual-value 'w the-global-environment) 10)
|
||||
|
||||
; After w is fully evaluated count is 2 as expected.
|
||||
(assert (eval 'count the-global-environment) 2) ; count is 2
|
||||
|
||||
(display "\nex-4.28\n")
|
||||
|
||||
(display "\nex-4.29\n")
|
||||
|
||||
|
|
Binary file not shown.
After Width: | Height: | Size: 52 KiB |
|
@ -4,6 +4,7 @@
|
|||
((quoted? exp) (text-of-quotation exp))
|
||||
((assignment? exp) (eval-assignment exp env))
|
||||
((definition? exp) (eval-definition exp env))
|
||||
((unless? exp) (eval (unless->combination exp) env))
|
||||
((if? exp) (eval-if exp env))
|
||||
((lambda? exp)
|
||||
(make-procedure (lambda-parameters exp)
|
||||
|
@ -108,6 +109,7 @@
|
|||
(define (make-lambda parameters body)
|
||||
(cons 'lambda (cons parameters body)))
|
||||
|
||||
(define (unless? exp) (tagged-list? exp 'unless))
|
||||
(define (if? exp) (tagged-list? exp 'if))
|
||||
(define (if-predicate exp) (cadr exp))
|
||||
(define (if-consequent exp) (caddr exp))
|
||||
|
@ -244,8 +246,12 @@
|
|||
(list 'cons cons)
|
||||
(list 'null? null?)
|
||||
(list 'display display)
|
||||
(list 'equal? equal?)
|
||||
(list 'newline newline)
|
||||
(list '= =)
|
||||
(list '+ +)
|
||||
(list '* *)
|
||||
(list '/ /)
|
||||
(list '- -)
|
||||
(list '< <)
|
||||
;;<more primitives>
|
||||
|
@ -299,6 +305,12 @@
|
|||
'<procedure-env>))
|
||||
(display object)))
|
||||
|
||||
(define (eval-verbose exp env)
|
||||
(let ((output (eval exp env)))
|
||||
(user-print output) (newline)
|
||||
output))
|
||||
|
||||
|
||||
(define the-global-environment (setup-environment))
|
||||
|
||||
;(driver-loop)
|
||||
|
|
Loading…
Reference in New Issue