eval-dd.scm

(declare (usual-integrations))

(load "syn-dd.scm")
(load "table.scm")

(define (install-eval-function)
  (define eval-table (make-table))
  (define (operator exp)
    (car exp))
  (define (eval-if exp env)
    (if (true? (eval (if-predicate exp) env))
      (eval (if-consequent exp) env)
      (eval (if-alternative exp) env)))

  (define (eval-sequence exps env)
    (cond ((last-exp? exps)
           (eval (first-exp exps) env))
          (else
            (eval (first-exps exps) env)
            (eval-sequence (rest-exps) env))))

  (define (eval-assignment exp env)
    (set-variable-value! (assignment-variable exp)
                       (eval (assignment-value exp) env)
                       env)
    'ok)

  (define (eval-definition exp env)
    (define-variable! (definition-variable exp)
                      (eval (definition-value exp) env)
                      env)
    'ok)
  
    (define (list-of-values exps env)
    (if (no-operands? exps)
      '()
      (cons (eval (first-operand exps env))
            (list-of-values (rest-operands exps) env))))

  (insert! 'quote text-of-quotation eval-table)

  (insert! 'set! eval-assignment eval-table)

  (insert! 'define eval-definition eval-table)

  (insert! 'if eval-if eval-table)

  (insert! 'lambda
           (lambda (exp env)
             (make-procedure (lambda-parameters exp)
                             (lambda-body exp)
                             env))
           eval-table)

  (insert! 'begin
           (lambda (exp env)
             (eval-sequence 
               (begin-actions exp)
               env)))

  (insert 'cond
          (lambda (exp env)
            (eval (cond->if exp) env)))

  (insert! 'application
           (lambda (exp env)
           (apply (eval (operator exp) env)
                  (list-of-values (operands exp) env))))

  (define (eval exp env)
    (cond ((self-evaluating? exp) exp)
          ((variable? exp) (lookup-variable exp env))
          (else 
            (let (eval-fun (lookup (operator exp) table))
              (if eval-fun
                (eval-fun exp env)
                (((lookup 'application eval-table) exp env)))))))
  'ok)