4.1 the metacircular evaluator

4/1/jord/lecture.org

@@ -191,3 +191,82 @@ curry's paradoxical combinator Y:
 :       = (F ((λ (x) (F (x x))) (λ (x) (F (x x)))))
 
 : (y F) = (F (y F))
+* Lecture 7B: Metacircular Evaluator, Pt 2
+https://youtu.be/QVEOq5k6Xi0
+
+gjs: "what we did was a lot of fun but will it be useful for
+      anything?"
+
+he says they are, for messing with new language ideas that can be
+quickly tested
+
+lets start by adding a simple feature to a lisp
+
+but first, gjs needs to tell us a thing or two about "features"
+
+many languages have a crisis of "creeping featurism", where far too
+many things are implemented
+
+there's also "feeping creaturism", where things barely work and the
+language barely works because it requires too many resources
+  (i think... his example seems a little dated)
+
+one useful feature is for things like + and * to be able to take any
+arbitrary number of arguments
+
+we need to think first of a notation and then a way to interpret that
+notation. 
+
+: (λ (x . y)
+:   (map (λ (u) (* x u))
+:         y))
+
+: (x . y)
+is a representation of a cons'd pair
+
+: (λ x x) ;; = list
+this one takes all args together
+
+how do we do this? easy. modify the metacircular evaluator.
+
+--> break
+
+now, for a more substantial variation
+
+*dynamic variable binding*
+
+Variation 2: a famous "bug"
+  - dynamic binding :: a free var in a procedure has its value defined
+       in the chain of callers, rather than where the procedure is
+       defined
+the most important problem with this technique is a modularity crisis
+
+changing a name can change the behavior of a program in catastrophic
+ways
+
+--> break
+
+in algol 60, args could be passed by name or value. if by name, the
+arg would be delayed
+
+we can add the feature, delayed parameters (by-name params)
+
+like if we would like to add special forms like cond
+
+#+BEGIN_SRC scheme
+  (define (unless p c a)		;; reverse if (like ruby!)
+    (cond ((not y) c)
+	  (else a)))
+
+  (unless (= 1 0) 2 (/ 1 0))
+  ;; => (cond ((not (= 1 0)) 2)
+  ;;	    (else (/ 1 0)))
+
+  ;; this  errors. what we would like is to say something special
+  ;; about c and a. that they are delayed.
+
+  ;; here we will build a kludge
+  (define (unless p (name c) (name a))
+    (cond ((not p) c)
+	  (else a)))
+#+END_SRC

4/1/jord/notes.org

@@ -0,0 +1,394 @@
+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.