(load "record.ss")

;;; Expression records

(define-record num (val))
(define-record varref (var))
(define-record lambda (formals body))
(define-record app (operator operands))
(define-record if (test then else))
(define-record let (vars exps body))
(define-record letrecproc (vars formalss exps body))
(define-record begin (exps))
(define-record set! (var exp))
(define-record call/cc (exp))

;;; Recordifier (aka Parser)

(define recordify
  (lambda (exp)
    (cond
      ((number? exp) (make-num exp))
      ((symbol? exp) (make-varref exp))
      ((atom? exp) (error 'recordify "illegal expression ~s" exp))
      (else
	(case (car exp)
	  ((lambda)
	   (make-lambda (cadr exp) (recordify (caddr exp))))
	  ((if)
	   (make-if (recordify (cadr exp)) (recordify (caddr exp))
	     (recordify (cadddr exp))))
	  ((let)
	   (let ((vars (map car (cadr exp))) (exps (map cadr (cadr exp))))
	     (let ((exps (map recordify exps)))
	       (make-let vars exps (recordify (caddr exp))))))
	  ((letrecproc)
	   (let ((decls (cadr exp)))
	     (make-letrecproc (map car decls)
	       (map cadr decls)
	       (map (lambda (decl) (recordify (caddr decl))) decls)
	       (recordify (caddr exp)))))
	  ((begin) (make-begin (map recordify (cdr exp))))
	  ((set!) (make-set! (cadr exp) (recordify (caddr exp))))
	  ((call/cc) (make-call/cc (recordify (cadr exp))))
	  (else
	    (make-app (recordify (car exp)) (map recordify (cdr exp)))))))))

;;; Value records

(define-record closure (formals body env))

;;; Environment ADT

(define create-empty-env (lambda () '()))

(define extend-env
  (lambda (vars vals env)
    (append (map cons vars (map make-cell vals)) env)))

(define apply-env
  (lambda (env var)
    (cond
      ((assq var env) => cdr)
      (else (error 'apply-env "variable ~s is undefined" var)))))

;;; Cell ADT

(define make-cell (lambda (x) (vector x)))
(define cell-ref (lambda (c) (vector-ref c 0)))
(define cell-set! (lambda (c v) (vector-set! c 0 v)))

;;; Initial environment

(define null (lambda (x) (if (null? x) 1 0)))
(define zero (lambda (x) (if (zero? x) 1 0)))
(define equal (lambda (x y) (if (= x y) 1 0)))
(define less (lambda (x y) (if (< x y) 1 0)))
(define greater (lambda (x y) (if (> x y) 1 0)))
  
(define init-env
  (extend-env
    '(equal zero less greater emptylist)
    (list equal zero less greater '())
    (extend-env
      '(+ - * add1 sub1 cons car cdr list null)
      (list + - * add1 sub1 cons car cdr list null)
      (create-empty-env))))