From: Ramakrishnan Muthukrishnan Date: Sun, 13 Nov 2011 15:56:07 +0000 (+0530) Subject: changes to evaluator taking the exercise solutions into account X-Git-Url: https://git.rkrishnan.org/%5B/%5D%20/quickstart.html?a=commitdiff_plain;h=bcae2fe9a2c2a782a8757deb8f3d83db32590dbb;p=sicp.git changes to evaluator taking the exercise solutions into account --- diff --git a/src/sicp/metacircular.rkt b/src/sicp/metacircular.rkt index 24ef7e0..bae6128 100644 --- a/src/sicp/metacircular.rkt +++ b/src/sicp/metacircular.rkt @@ -184,4 +184,86 @@ clauses)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) - (expand-clauses rest)))))) \ No newline at end of file + (expand-clauses rest)))))) + +;; true and false +(define (true? x) + (not (eq? x false))) + +(define (false? x) + (eq? x false)) + +;; procedures +(define (make-procedure parameters body env) + (list 'procedure parameters body env)) + +(define (compound-procedure? p) + (tagged-list? p 'procedure)) + +(define (procedure-parameters p) (cadr p)) +(define (procedure-body p) (caddr p)) +(define (procedure-env p) (cadddr p)) + +;; operations on environment +(define (enclosing-environment env) (cdr env)) +(define (first-frame env) (car env)) +(define the-empty-environment '()) + +;; frame operations +(define (make-frame variables values) + (cons variables values)) + +(define (frame-variables frame) (car frame)) +(define (frame-values frame) (cdr frame)) +(define (add-bindings-to-frame! var val frame) + (set-car! frame (cons var (frame-variables frame))) + (set-cdr! frame (cons val (frame-values frame)))) + +(define (extend-environment vars vals base-env) + (if (= (length vars) (length vals)) + (cons (make-frame vars vals) base-env) + (if (< (length vars) (length vals)) + (error "Too many args supplied" vars vals) + (error "Too many args supplied" vars vals)))) + +(define (lookup-variable-value var env) + (define (env-loop env) + (define (scan vars vals) + (cond [(null? vars) + (env-loop (enclosing-environment env))] + [(eq? var (car vars)) + (car vals)] + [else (scan (cdr vars) (cdr vals))])) + (if (eq? env the-empty-environment) + (error "unbound variable" var) + (let ([frame (first-frame env)]) + (scan (frame-variables frame) + (frame-values frame))))) + (env-loop env)) + +(define (set-variable-value! var val env) + (define (env-loop env) + (define (scan vars vals) + (cond [(null? vars) + (env-loop (enclosing-environment env))] + [(eq? var (car vars)) + (set-car! vals val)] + [else (scan (cdr vars) (cdr vals))])) + (if (eq? env the-empty-environment) + (error "unbound variable" var) + (let ([frame (first-frame env)]) + (scan (frame-variables frame) + (frame-values frame))))) + (env-loop env)) + +(define (define-variable! var val env) + (let ([frame (first-frame env)]) + (define (scan vars vals) + (cond [(null? vars) + (add-bindings-to-frame! var val frame)] + [(eq? var (car vars)) + (set-car! vals val)] + [else (scan (cdr vars) (cdr vals))])) + (scan (frame-variables frame) + (frame-values frame)))) +