(define-module (environment)
               #: export (lookup-variable-value
                           setup-environment
                           set-variable-value!
                           define-variable!
                           extend-env))

(add-to-load-path ".")
(use-modules (prelude/primitives))

;;; env
(define (enclosing-env environ) (cdr environ))
(define (first-frame environ) (car environ))
(define the-empty-env '())
(define (empty-env? environ) (eq? environ the-empty-env))

;; frames
(define (make-frame variables values)
  (cons variables values))
(define frame-variables car)
(define frame-values cdr)
(define (add-binding-to-frame! var val frame)
  (begin
    (set-car! frame (cons var (frame-variables frame)))
    (set-cdr! frame (cons val (frame-values frame)))))
(define (extend-env vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) base-env)
      (error "Too few or too many arguments supplied" vars vals)))

;;; variable lookup
(define (lookup-variable-value var env)
  (cond
    [(empty-env? env) (error "Unbound variable" var)]
    [else
      (let ([f (first-frame env)])
        (let scan ([variables (frame-variables f)]
                   [values (frame-values f)])
          (cond
            [(null? variables)
             (lookup-variable-value var
                                    (enclosing-env env))]
            [(eq? var (car variables)) (car values)]
            [else (scan (cdr variables) (cdr values))])))]))

;;; environment modification
(define (set-variable-value! var val env)
  (cond
    [(empty-env? env) (error "Unbound variable" var)]
    [else
      (let ([f (first-frame env)])
        (let scan ([variables (frame-variables f)]
                   [values (frame-values f)])
          (cond
            [(null? variables) (set-variable-value! 
                                 var
                                 val
                                 (enclosing-env env))]
            [(eq? var (car variables)) (set-car! values val)]
            [else (scan (cdr variables) (cdr values))])))]))

(define (define-variable! var val env)
  (let ([f (first-frame env)])
    (define (scan vars vals)
      (cond
        [(null? vars) (add-binding-to-frame! var val f)]
        [(eq? var (car vars)) (set-car! vals val)]
        [else (scan (cdr vars) (cdr vals))]))
    (scan (frame-variables f)
          (frame-values f))))

(define (setup-environment)
  (let ([initial-env (extend-env
                       (primitive-names)
                       (primitive-objs)
                       the-empty-env)])
    (define-variable! 'true #t initial-env)
    (define-variable! 'false #f initial-env)
    initial-env))