lisp

solutions to Lisp in Small Pieces
Log | Files | Refs | Feed

commit d5ad2fc850fe945ac5a0c0f7f104a6e997656ba8
parent 1b115198dff57473b0bfec7c5037ccde96760218
Author: Jenny Doe <tng@soykaf.me>
Date:   Mon,  7 Jan 2019 22:13:33 +0100

Solved 1-4

Diffstat:
Achapter1/s.environment_1-4.scm | 14++++++++++++++
Achapter1/s.procedures_1-4.scm | 14++++++++++++++
2 files changed, 28 insertions(+), 0 deletions(-)

diff --git a/chapter1/s.environment_1-4.scm b/chapter1/s.environment_1-4.scm @@ -0,0 +1,14 @@ +(define not-found-value (cons "not found" "not found")) + +(define (lookup name env) + (let ((x (car (getprop 'apval name (list not-found-value))))) + (if (eq? not-found-value x) + (error 'lookup "No such binding" name) + x))) + +(define (update! name new-value env) + (begin + (lookup name env) ; we don't care about the value + (putprop 'apval name + (cons new-value + (cdr (getprop 'apval name)))))) diff --git a/chapter1/s.procedures_1-4.scm b/chapter1/s.procedures_1-4.scm @@ -0,0 +1,14 @@ +(define (make-function bound-names body env) + (lambda (values current.env) + (let ((old-bindings + (map (lambda (bound-name value) + (let ((old (getprop 'apval bound-name '()))) + (putprop 'apval bound-name (cons value old)) + bound-name)) + bound-names values))) + (begin + (let ((res (eprogn (list body) current.env))) + (for-each (lambda (x) + (putprop 'apval x (cdr (getprop 'apval x)))) + old-bindings) + res)))))