Skip to content
This repository
tree: 2a9dba2f9e
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 97 lines (82 sloc) 2.974 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
;; Example 4.12

;; environment

;; environment is the list of frames
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())

;; frame is the two lists: list of variables and list of values
(define (make-frame variables values)
  (cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
  (set-car! frame (cons var (car frame))) ;; mutable append (frame = x + frame)
  (set-cdr! frame (cons val (cdr frame))))

;; create new frame(vars, vals) and ptr to base env
(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 arguments supplied" vars vals)
          (error "Too few arguments supplied" vars vals))))

;; kind of abstraction, lol
(define (scan-helper vars vals env eqVar onEq)
  (cond ((null? vars)
         (env-loop (enclosing-environment env)))
        ((eq? eqVar (car vars))
         (onEq vars vals))
        (else (scan-helper (cdr vars) (cdr vals) env eqVar onEq))))

(define (lookup-variable-value var env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan-helper (frame-variables frame)
                       (frame-values frame)
                       env
                       var
                       (lambda (vr vl) (car vl))))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan-helper (frame-variables frame)
                       (frame-values frame)
                       env
                       var
                       (lambda (vr vl) (set-car! vl val))))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-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))))

;; Test

(define variables '(x y z))
(define vals '(42 24 -5))
(define frame (make-frame variables vals))
(define env (list frame))

(display "Original frame :\n")
frame

(add-binding-to-frame! 'q 100 frame)
(display "After adding (q:100) :\n")
frame

(display "Lookup added vars :\n")
(lookup-variable-value 'x env)
(lookup-variable-value 'y env)
(lookup-variable-value 'z env)
(lookup-variable-value 'q env)

(display "Setting some vars to new vals :\n")
(set-variable-value! 'x 2 env)
(set-variable-value! 'q 1 env)
frame

(display "Definition (t:2) :\n")
(define-variable! 't 2 env)
frame
Something went wrong with that request. Please try again.