Notes: Wednesday 27 March 2002

Schedule

• Wednesday, 27 March: Read SICP, Chapter 4 (you may skip 4.1.6 and 4.1.7 and 4.4-end).
• Before 3 April: GEB, Aria with Diverse Variations and Chapter XIII: BlooP and FlooP and GlooP.
• Friday, 5 April: Problem Set 7

Meta-Circular Evaluator

;;; Core of the evaluator - eval and apply
;;;
;;; We have named them "meval" and "mapply" to avoid any confusion with
;;; the built-in Scheme eval and apply.

(define (meval expr env)
  (cond
   ((self-evaluating? expr) expr)
   ((variable? expr)        (environment-lookup-name expr env))
   ((lambda? expr)          (make-procedure (lambda-parameters expr) (lambda-body expr) env))
   ((definition? expr)      (define-variable! 
			      (definition-variable expr)
			      (meval (definition-value expr) env) env))
   ((application? expr)     (mapply (meval (application-operator expr) env) 
				    (map (lambda (subexpr) (meval subexpr env))
					 (application-operands expr))))
   (else                    (error "Unknown expression: " exp))))

(define (mapply procedure operands)  
  (cond 
   ((primitive-procedure? procedure) 
    (apply-primitive procedure operands))
   ((compound-procedure? procedure) 
    (meval-sequence (procedure-body procedure)
		    (extend-environment (procedure-parameters procedure) operands
					(procedure-environment procedure))))
   (else (error "Unknown applicator: " procedure))))

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

(define (meval-sequence seq env)
  (if (= (length seq) 1)
      (meval (car seq) env)
      (begin (meval (car seq) env)
	     (meval-sequence (cdr seq) env))))

(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)))
  'ok)

;;;
;;; Environments and Frames
;;;

(define (make-new-environment frame env) (cons frame env))
(define (first-frame env) (car env))
(define (enclosing-environment env) (cdr env))
(define (make-empty-frame) (list))

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

(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)
  (insertlg (lambda (var result) (if (eq? (car var) name) #t result))
	    frame #f))
	    
(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)))))

;;;
;;; Abstractions
;;;

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

(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))

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

(define (variable? expr) (symbol? 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 (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 (definition? expr) (tagged-list? expr 'define))
(define (definition-variable expr) (cadr expr))
(define (definition-value expr) (caddr expr))

(define the-empty-environment '())

(define the-global-environment
  (make-new-environment
   (list
    (cons '+ (make-primitive-procedure +))
    (cons '* (make-primitive-procedure *))
    (cons '- (make-primitive-procedure -))
    )
   the-empty-environment))

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

David Evans evans@virginia.edu Using these Materials