University of Virginia, Department of Computer Science
CS200: Computer Science, Spring 2003

Notes: Wednesday 25 March 2003

Meta-Circular Evaluator
(define (meval expr env)
   ((self-evaluating? expr) expr)
   ((quoted? expr)          (text-of-quotation expr))
   ((definition? expr)      (define-variable! 
                              (definition-variable expr)
                              (meval (definition-value expr) env) env))
   ((lambda? expr)          (make-procedure (lambda-parameters expr) (lambda-body expr) env))
   ((application? expr)     (mapply (meval (application-operator expr) env) 
                                    (map (lambda (subexpr) (meval subexpr env))
                                         (application-operands expr))))
   ((variable? expr)        (environment-lookup-name expr env)) ;; Must be last 
   (else (error "Unrecognized expression: " expr))))

(define (mapply procedure operands)  
   ((primitive-procedure? procedure) (apply-primitive procedure operands))
   ((compound-procedure? procedure)  (apply-compound procedure operands))
   (else (error "Unknown applicator: " procedure))))

(define (apply-primitive procedure operands)
  ;;; Uses the underlying Scheme apply
  (apply (primitive-procedure-procedure procedure) operands))

(define (apply-compound procedure operands)
   (procedure-body procedure)
   (extend-environment (procedure-parameters procedure)
                       (procedure-environment procedure))))

(define (meval-sequence seq env)
  ;;; Evaluate to the value of the last expression in the sequence 
  (get-last (map (lambda (expr) (meval expr env)) seq)))
;;; Environments

(define the-empty-environment '())

(define (make-new-environment frame env) (cons frame env))
(define (make-empty-frame) (list))

(define (first-frame env) (car env))
(define (enclosing-environment env) (cdr env))

(define (extend-environment names values env)
   (map (lambda (name value) (cons name value)) names values)

(define (environment-lookup-name name env)
  (if (null? env) (error "No binding for" name)
      (if (frame-contains? name (first-frame env))
          (frame-lookup-name name (first-frame env))
          (environment-lookup-name name (enclosing-environment env)))))

(define (bind-variable name value env)
  (add-binding-to-frame! name value (first-frame env)))

(define (add-binding-to-frame! name value frame)
  (car frame) ;; ! frame cannot be null or append! doesn't work
  (append! frame (list (cons name value)))) ; Note why we use append! not append 

(define (frame-contains? name frame)
   (lambda (var result) (if (eq? (car var) name) #t result))

(define (frame-lookup-name name frame)
  (if (null? frame) (error "Name not found in frame:" name)
      (if (eq? (car (car frame)) name) 
          (cdr (car frame))
          (frame-lookup-name name (cdr frame)))))

(define (define-variable! var value env)
  ;;; We always add the new definition at the beginning of the frame.  That way,
  ;;; frame-lookup-name will find the new definition first if it is redefined.
  (set-car! env (cons (cons var value) (car env))))

;;; Mini-scheme can add, multiply and subtract using the underlying Scheme primitives:

(define the-global-environment
    ;; Some popular constants
    (cons 'true #t)
    (cons 'false #f)
    (cons 'null null)
    ;; Primitive procedures
    (cons '+ (make-primitive-procedure +))
    (cons '* (make-primitive-procedure *))
    (cons '- (make-primitive-procedure -))
    ;;; ... some more in PS7's
;;; We represent different entities using tagged lists.

(define (tagged-list? expr tag)
  (if (pair? expr) (eq? (car expr) tag) #f))

(define (self-evaluating? expr)
  (or (number? expr) (string? expr) (primitive-procedure? expr)))

(define (variable? expr) (symbol? expr))

(define (quoted? expr) (tagged-list? expr `quote))
(define (text-of-quotation expr) (cadr expr))

(define (definition? expr) (tagged-list? expr 'define))
(define (definition-variable expr) (cadr expr))
(define (definition-value expr) (caddr expr))

(define (lambda? expr) (tagged-list? expr 'lambda))
(define (make-lambda params body) (list 'lambda params body))
(define (lambda-parameters expr) (cadr expr))
(define (lambda-body expr) (cddr expr))

(define (and? expr) (tagged-list? expr 'and))
(define (make-and operands) (list 'and operands))
(define (and-operands expr) (cdr expr))

(define (make-procedure parameters body environment)
  (list 'procedure parameters body environment))

(define (compound-procedure? expr) (tagged-list? expr 'procedure))
(define (procedure-parameters procedure) (cadr procedure))
(define (procedure-body procedure) (caddr procedure))
(define (procedure-environment procedure) (cadddr procedure))

(define (application? expr) (pair? expr))
(define (application-operator expr) (car expr))
(define (application-operands expr) (cdr expr))

(define (primitive-procedure? expr)
  (tagged-list? expr 'primitive-procedure))

(define (make-primitive-procedure expr)
  (list 'primitive-procedure expr))
(define (primitive-procedure-procedure procedure) (cadr procedure))
CS 200

CS 200: Computer Science
Department of Computer Science
University of Virginia

Circle Fractal by Ramsey Arnaoot and Qi Wang
Using these Materials