DataMuseum.dk

top - download

    Length: 4324 (0x10e4)
    Types: TextFile
    Names: »ecevsyn.scm«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/gnu-31mar87/scheme/psets/ecevsyn.scm« 

TextFile

;;;-*-SCHEME-*-
;;;These are the definitions of the representations of expressions and
;;;environments used by the explicit-control evaluator.  These are
;;;essentially the same as the ones used by the meta-circualr
;;;evaluator, with a few additions (e.g., no-argument procedures).


(define (self-evaluating? exp) (number? exp))

(define (quoted? exp)
  (if (atom? exp)
      nil
      (eq? (car exp) 'quote)))

(define (text-of-quotation exp) (cadr exp))

(define (variable? exp) (symbol? exp))

(define (assignment? exp)
  (if (atom? exp)
      nil
      (eq? (car exp) 'set!)))

(define (assignment-variable exp) (cadr exp))

(define (assignment-value exp) (caddr exp))

(define (definition? exp)
  (if (atom? exp)
      nil
      (eq? (car exp) 'define)))

(define (definition-variable exp)
  (cond ((variable? (cadr exp))
         (cadr exp))
        (else
         (caadr exp))))

(define (definition-value exp) 
  (cond ((variable? (cadr exp))
         (caddr exp))           
        (else
         (cons 'lambda
               (cons (cdadr exp)
                     (cddr exp))))))

(define (lambda? exp)
  (if (atom? exp)
      nil
      (eq? (car exp) 'lambda)))

(define (conditional? exp)
  (if (atom? exp)
      nil
      (eq? (car exp) 'cond)))

(define (clauses exp) (cdr exp))

(define (no-clauses? clauses) (null? clauses))

(define (first-clause clauses) (car clauses))

(define (rest-clauses clauses) (cdr clauses))

(define (predicate clause) (car clause))

(define (action-sequence clause) (cdr clause))

(define (true? x) (not (null? x)))

(define (else-clause? clause)
  (eq? (predicate clause) 'else))

(define (last-exp? seq) (eq? (cdr seq) nil))

(define (first-exp seq) (car seq))

(define (rest-exps seq) (cdr seq))

(define (no-args? exp)
  (if (atom? exp)
      nil
      (null? (cdr exp))))

(define (application? exp)
  (if (atom? exp)
      nil
      (not (null? (cdr exp)))))

(define (operator app) (car app))

(define (operands app) (cdr app))

(define (no-operands? args) (eq? args nil))

(define (last-operand? args)
  (null? (cdr args)))

(define (first-operand args) (car args))

(define (rest-operands args) (cdr args))

(define (make-procedure lambda-exp env)
  (list 'procedure lambda-exp env))

(define (compound-procedure? proc)
  (if (atom? proc)
      nil
      (eq? (car proc) 'procedure)))

(define (parameters proc) (cadr (cadr proc)))

(define (procedure-body proc) (cddr (cadr proc)))

(define (procedure-environment proc) (caddr proc))

;;; representing environments

(define (make-binding variable value)
  (cons variable value))

(define (binding-variable binding)
  (car binding))

(define (binding-value binding)
  (cdr binding))

(define (set-binding-value! binding value)
  (set-cdr! binding value))


(define (binding-in-frame var frame)
  (assq var frame))


(define (make-frame variables values)
  (cond ((and (null? variables) (null? values)) '())
        ((null? variables)
         (error "Too many values supplied" values))
        ((null? values)
         (error "Too few values supplied" variables))
        (else
         (cons (make-binding (car variables)
                             (car values))
               (make-frame (cdr variables)
                           (cdr values))))))
(define (first-frame env) (car env))

(define (rest-frames env) (cdr env))

(define (adjoin-frame frame env) (cons frame env))

(define (set-first-frame! env new-frame)
  (set-car! env new-frame))

(define (binding-in-env var env)
  (if (null? env)
      nil
      (let ((b (binding-in-frame var
                                 (first-frame env))))
        (if (not (null? b))
            b
            (binding-in-env var (rest-frames env))))))

(define (lookup-variable-value var env)
  (let ((b (binding-in-env var env)))
    (if (null? b)
        (error "Unbound variable" var)
        (binding-value b))))

(define (extend-environment variables values base-env)
  (adjoin-frame (make-frame variables values) base-env))

(define (set-variable-value! var val env)
  (let ((b (binding-in-env var env)))
    (if (null? b)
        (error "Unbound variable" var)
        (set-binding-value! b val))))

(define (define-variable! var val env)
  (set-first-frame! env
                    (cons (make-binding var val)
                          (first-frame env))))