Chapter 4: Metalinguistic Abstraction

  - metalinguistic abstraction :: establishing new languages
  - evaluator :: a procedure that is applied to a language expression
                 in order to execute its instructions


    The evaluator, 
                   which determines the meaning of expressions in a
           programming language, 
                                 is just another program.

* 4.1 The Metacircular Evaluator

we are going to implement lisp -- in lisp

  - metacircular :: an evaluator that is written in the same language
                    it evaluates to

we implement the evaluation model, having two parts:
  1. to eval a combination, evaluate the subexpressions of the
     combinataion and then apply the value of the operator
     subexpression to the values of the operand subexpressions
  2. to apply a compound proc to its args, eval the proc in a new
     env. create the new env by extending the env of the proc with the
     formal paramaters bound to the proc's args

** 4.1.1 the core of the evaluator
*** eval
eval takes args expression and environment

it executes case analysis on expression type

#+BEGIN_SRC scheme
  (define (eval exp env)
    (cond ((self-evaluating? exp) exp)
	  ((variable? exp) (lookup-variable-value exp env))
	  ((quoted? exp) (text-of-quotation exp))
	  ((assignment? exp) (eval-assignment exp env))
	  ((if? exp) (eval-if exp env))
	  ((lambda? exp)
	   (make-procedure (lambda-parameters exp)
			   (lambda-body exp)
			   env))
	  ((begin? exp)
	   (eval-sequence (begin-actions exp) env))
	  ((cond? exp) (eval (cond->if exp) env))
	  ((application? exp)
	   (apply (eval (operator exp) env)
		  (list-of-values (operands exp) env)))
	  (else
	   (error "Unknown expression type -- EVAL" exp))))
#+END_SRC


*** apply

apply takes args proc and args

#+BEGIN_SRC scheme
  (define (apply procedure arguments)
    (cond ((primitive-procedure? procedure)
	   (apply-primitive-procedure procedure arguments))
	  ((compound-procedure? procedure)
	   (eval-sequence
	    (procedure-body procedure)
	    (extend-environment
	     (procedure-parameters procedure)
	     arguments
	     (procedure-environment procedure))))
	  (else
	   (error
	    "Unknown procedure type -- APPLY" procedure))))
#+END_SRC

*** procedure arguments

#+BEGIN_SRC scheme
  (define (list-of-values exps env)
    (if (no-operands? exps)
	'()
	(cons (eval (first-operand exps) env)
	      (list-of-values (rest-operands exps) env))))
#+END_SRC

*** conditionals

#+BEGIN_SRC scheme
  (define (eval-if exp env)
    (if (true? (eval (if-predicate exp) env))
	(eval (if-consequent exp) env)
	(eval (if-alternative exp) env)))
#+END_SRC

*** sequences

#+BEGIN_SRC scheme
  (define (eval-sequence exps env)
    (cond ((last-exp? exps) (eval (first-exp exps) env))
	  (else (eval (first-exp exps) env)
		(eval-sequence (rest-exps exps) env))))
#+END_SRC

*** assignments and definitions

#+BEGIN_SRC scheme
  (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)
#+END_SRC

** 4.1.2 representing expressions

#+BEGIN_SRC scheme
  (define (self-evaluating? exp)
    (cond ((number? exp) true)
	  ((string? exp) true)
	  (else false)))

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

  (define (quoted? exp)
    (tagged-list? exp 'quote))
  (define (text-of-quotation exp)
    (cadr exp))

  (define (tagged-list? exp tag)
    (if (pair? exp)
	(eq? (car exp) tag)
	false))

  (define (assignment? exp)
    (tagged-list? exp 'set!))
  (define (assignment-variable exp) (cadr exp))
  (define (assignment-value exp) (caddr exp))

  (define (definition? exp)
    (tagged-list? exp 'define))
  (define (definition-variable exp)
    (if (symbol? (cadr exp))
	(cadr exp)
	(caadr exp)))
  (define (definition-value exp)
    (if (symbol? (cadr exp))
	(cadr exp)
	(make-lambda (cdadr exp)   ;; formal params
		     (cddr exp)))) ;; body

  (define (lambda? exp)
    (tagged-list? exp 'lambda))
  (define (lambda-paramaters exp)
    (cadr exp))
  (define (lambda-body exp)
    (cddr exp))
  (define (make-lambda parameters body)
    (cons 'lambda (cons parameters body)))

  (define (if? exp) (tagged-list? exp 'if))
  (define (if-predicate exp) (cadr exp))
  (define (if-consequent exp) (caddr exp))
  (define (if-alternative exp)
    (if (not (null? (cdddr exp)))
	(cadddr exp)
	'false))
  (define (make-if predicate consequent alternative)
    (list 'if predicate consequent alternative))

  (define (begin? exp) (tagged-list? exp 'begin))
  (define (begin-actions exp) (cdr exp))
  (define (last-exp? seq) (null? (cdr seq)))
  (define (first-exp seq) (car seq))
  (define (rest-exps seq) (cdr seq))
  (define (sequence->exp seq)
    (cond ((null? seq) seq)
	  ((last-exp? seq) (first-exp seq))
	  (else (make-begin seq))))
  (define (make-begin seq) (cons 'begin seq))

  (define (application? exp) (pair? exp))
  (define (operator exp) (car exp))
  (define (operands exp) (cdr exp))
  (define (no-operands? ops) (null? ops))
  (define (first-operand ops) (car ops))
  (define (rest-operands ops) (cdr ops))

  ;; DERIVED EXPRESSIONS

  (define (cond? exp) (tagged-list? exp 'cond))
  (define (cond-clauses exp) (cdr exp))
  (define (cond-else-clause? clause)
    (eq? (cond-predicate clause) 'else))
  (define (cond-predicate clause) (car clause))
  (define (cond-actions clause) (cdr clause))
  (define (cond->if exp)
    (expand-clauses (cond-clauses exp)))
  (define (expand-clauses clauses)
    (if (null? clauses)
	'false		; no else clause
	(let ((first (car clauses))
	      (rest (cdr clauses)))
	  (if (cond-else-clause? first)
	      (if (null? rest)
		  (sequence->exp (cond-actions first))
		  (error "ELSE clause isn't last -- COND->IF"
			 clauses))
	      (make-if (cond-predicate first)
		       (sequence-exp (cond-actions first))
		       (expand-clauses rest))))))
#+END_SRC

** 4.1.3 evaluator data structure

#+BEGIN_SRC scheme
  (define (true? x) (not (eq? x false)))
  (define (false? x) (eq? x false))

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

  (define (enclosing-environment env) (cdr env))
  (define (first-frame env) (car env))
  (define the-empty-environment '())

  (define (make-frame variables values)
    (cons variables values))
  (define (frame-variables frame) (car frame))
  (define (frame-values frame) (cdr frame))
  (define (add-binding-to-frame! var val frame)
    (set-car! frame (cons var (car frame)))
    (set-car! frame (cons val (cdr frame))))

  (define (extend-environment vars vals base-env)
    (if (= (length vars) (length vals))
	(cons (make-frame vars vals) base-env)
	(if (< (length vars) (length vals))
	    (error "Too many args supplied" vars vals)
	    (error "Too few args supplied" vars vals))))
  (define (lookup-variable-value var env)
    (define (env-loop env)
      (define (scan vars vals)
	(cond ((null? vars)
	       (env-loop (enclosing-environment env)))
	      ((eq? var (car vars))
	       (car vals))
	      (else (scan (cdr vars) (cdr vals)))))
      (if (eq? env the-empty-environment)
	  (error "Unbound var" var)
	  (let ((frame (first-frame env)))
	    (scan (frame-variables frame)
		  (frame-values frame)))))
    (env-loop env))
  (define (set-variable-value! var val env)
    (define (env-loop env)
      (define (scan vars vals)
	(cond ((null? vars)
	       (env-loop (enclosing-environment env)))
	      ((eq? var (car vars))
	       (set-car! vals val))
	      (else (scan (cdr vars) (cdr vals)))))
      (if (eq? env the-empty-environment)
	  (error "Unbound var -- SET!" var)
	  (let ((frame (first-frame env)))
	    (scan (frame-variables frame)
		  (frame-values frame)))))
    (env-loop env))
  (define (define-variable! var val env)
    (let ((frame (first-frame env)))
      (define (scan vars vals)
	(cond ((null? vars)
	       (add-binding-to-frame! var val frame))
	      ((eq? var (car vars))
	       (set-car! vals val))
	      (else (scan (cdr vars) (cdr vals)))))
      (scan (frame-variables frame)
	    (frame-values frame))))
#+END_SRC

** 4.1.4 running the evaluator as a program

#+BEGIN_SRC scheme
  (define (setup-environment)
    (let ((initial-env
	   (extend-environment (primitive-procedure-names)
			       (primitive-procedure-objects)
			       the-empty-environment)))
      (define-variable! 'true true initial-env)
      (define-variable! 'false false initial-env)
      initial-env))
  (define the-global-environment (setup-environment))
#+END_SRC

#+BEGIN_SRC scheme
  (define (primitive-procedure? proc)
    (tagged-list? proc 'primitive))
  (define (primitive-implementation proc) (cadr proc))
  (define primitive-procedures
    (list (list 'car car)
	  (list 'cdr cdr)
	  (list 'cons cons)
	  (list 'null? null?)
	  ;; etc
	  ))
  (define (primitive-procedure-names)
    (map car
	 primitive-procedures))
  (define (primitive-procedure-objects)
    (map (lambda (proc) (list 'primitive (cadr proc)))
	 primitive-procedures))
  (define (apply-primitive-procedure proc args)
    (apply-in-underlying-scheme
     (primitive-implementation proc) args))
#+END_SRC

the repl:
#+BEGIN_SRC scheme
  (define input-prompt ";;; M-Eval input: ")
  (define output-prompt ";;; M-Eval value: ")

  (define (driver-loop)
    (prompt-for-input input-prompt)
    (let ((input (read)))
      (let ((output (eval input the-global-environment)))
	(announce-output output-prompt)
	(user-print output)))
    (driver-loop))
  (define (prompt-for-input string)
    (newline) (newline) (display string) (newline))
  (define (announce-output string)
    (newline) (display string) (newline))
  (define (user-print objects)
    (if (compound-procedure? object)
	(display (list 'compound-procedure
		       (procedure-parameters object)
		       (procedure-body object)
		       '<procedure-env>))
	(display object)))
#+END_SRC
** 4.1.5 data as programs
programs are descriptions of abstract (possibly infinite) machines

consider,
#+BEGIN_SRC scheme
  (define (factorial n)
    (if (= 1 n)
	1
	(* (factorial (- n 1) n))))
#+END_SRC
it is a description of a program but also simply a list

it is data that can be executed by feeding it to the evaluator 

the evaluator is a special machine that takes as input the description
of a machine and will configure itself to emulate the machine
described. it is a /universal machine/

** 4.1.6 internal definitions
consider a program with internal definitions:
#+BEGIN_SRC scheme
  (define (f x)
    (define (even? n)
      (if (= n 0)
	  true
	  (odd? (- n 1))))
    (define (odd? n)
      (if (= n 1)
	  false
	  (even? (- n 1))))
    ;; ...
    )	
#+END_SRC

even? and odd? need to be defined for the whole scope of f, not just
the scope that follows the definition. our interpreter is sequential,
but this works bc they wont be called until they are all defined

best is to evaluate all the definitions simultaneously, before any of
them are used.
** 4.1.7 separating syntactic analysis from execution
an interesting technique to optimize evaluation by separating out the
analyzing from the execution. see text for details.