sicp-ex-4.12



<< Previous exercise (4.11) | Index | Next exercise (4.13) >>


meteorgan

  
  
  
 ;; this solution is based on exercise 4.11, that's to say i used different 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 few arguments supplied" vars vals) 
                         (error "Too many arguments supplied" vars vals)))) 
  
 ;; look up a variable in a frame 
 (define (lookup-binding-in-frame var frame) 
         (cond ((null? frame) (cons false '())) 
                   ((eq? (car (car frame)) var) 
                    (cons true (cdr (car frame)))) 
                   (else (lookup-binding-in-frame var (cdr frame))))) 
  
 ;; in frame, set var to val 
 (define (set-binding-in-frame var val frame) 
         (cond ((null? frame) false) 
                   ((eq? (car (car frame)) var) 
                    (set-cdr! (car frame) val) 
                    true) 
                   (else (set-binding-in-frame var val (cdr frame))))) 
  
 (define (lookup-variable-value var env) 
         (if (eq? env the-empty-environment) 
                 (error "Unbound variable" var)) 
                 (let ((result (lookup-binding-in-frame var (first-frame env)))) 
                         (if (car result) 
                                 (cdr result) 
                                 (lookup-variable-value var (enclosing-environment env))))) 
  
 (define (set-variable-value! var val env) 
         (if (eq? env the-empty-environment) 
                 (error "Unbound variable -- SET" var) 
                 (if (set-binding-in-frame var val (first-frame env)) 
                         true 
                         (set-variable-value! var val (enclosing-environment  env))))) 
  
 (define (define-variable! var val env) 
         (let ((frame (first-frame env))) 
                 (if (set-binding-in-frame var val frame) 
                         true 
                         (set-car! env (cons (cons var val) frame))))) 
  
  
  
 (define (env-loop env base match) 
   (let ((frame (first-frame env))) 
     (define (scan vars vals) 
       (cond ((null? vars) 
              base) 
             ((eq? var (car vars)) 
              match)                  
             (else (scan (cdr vars) (cdr vals))))) 
     (scan (frame-variables frame) 
           (frame-values frame)))) 
  
 (define (lookup-variable-value var env) 
   (env-loop env 
             (env-loop (enclosing-environment env)) 
             (car vals))) 
  
 (define (set-variable-value! var val env) 
   (env-loop env 
             (env-loop (enclosing-environment env)) 
             (set-car! vals val))) 
  
 (define (define-variable! var val env) 
   (env-loop env 
             (add-binding-to-frame! var val frame) 
             (set-car! vals val))) 
  
  
  

  
 ;; general procedure 
 (define (env-loop match-proc end-frame end-env env) 
   (define (scan vars vals current-frame current-env) 
     (cond ((null? vars) 
            (end-frame current-frame current-env)) 
           ((eq? var (car vars)) 
            (match-proc vars vals current-frame current-env)) 
           (else 
            (scan (cdr vars) (cdr vals) current-frame current-env)))) 
   (if (eq? env the-empty-environment) 
       (end-env) 
       (let ((frame (first-frame env))) 
         (scan (frame-variables frame) 
               (frame-values frame) 
               frame env)))) 
  
 ;; lookup-variable-value 
 (define (lookup-variable-value var env) 
   (define (match-proc vars vals cur-frame cur-env) (car vals)) 
   (define (end-env) (error "Unbound variable" var)) 
   (define (end-frame cur-frame cur-env)                       ;; !!! 
     (env-loop match-proc end-frame end-env (enclosing-environment cur-env))) 
    (env-loop match-proc end-frame end-env env)) 
  
 ;; set-variable-value! 
 (define (set-variable-value! var val env) 
   (define (match-proc vars vals cur-frame cur-env) (set-car! vals val)) 
   (define (end-env) (error "Unbound variable" var)) 
   (define (end-frame cur-frame cur-env)                       ;; !!! 
     (env-loop match-proc end-frame end-env (enclosing-environment cur-env))) 
   (env-loop match-proc end-frame end-env env)) 
  
 ;; define-variable! 
 (define (define-variable! var val env) 
   (define (match-proc vars vals cur-frame cur-env) (set-car! vals val)) 
   (define (end-env) (error "Unbound variable" var)) 
   (define (end-frame cur-frame cur-env)                       ;; !!! 
     (add-binding-to-frame! var val cur-frame)) 
   (env-loop match-proc end-frame end-env env)) 
  
  

I don't think SophiaG's solution is correct, since you can't just pass 'text' to be evaluated later

  
 (define (scan-frame var frame no-vars-callback found-callback) 
   (define (scan variables values) 
     (cond ((null? variables) 
            (no-vars-callback)) 
           ((eq? var (car variables)) 
            (found-callback variables values)) 
           (else (scan (cdr variables) (cdr values))))) 
   (scan (frame-variables frame) (frame-values frame))) 
  
 (define (search-env var env success-callback) 
   (define no-found-callback 
     ; search the next environment 
     (search-env var (enclosing-environment env) success-callback)) 
   (if (eq? env the-empty-environment) 
       (error "Unbound variable" var) 
       (scan-frame var (first-frame env) no-found-callback success-callback))) 
  
 (define (lookup-variable-value var env) 
   (search-env var env (lambda (vars vals) (car vals)))) 
  
 (define (set-variable-value! var val env) 
   (search-env var env (lambda (vars vals) (set-car! vals val)))) 
  
 (define (define-variable! var val env) 
   (scan-frame 
     var 
     (first-frame env) 
     (lambda () (add-binding-to-frame! var val frame) 
     (lambda (vars vals) (set-car! vals val)))))