; brussell 6.001 Tutorial 10, Spring 2004
; Heavily borrowed from benmv

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; topics:

; Interpretation, Meta-circular evaluator, Lazy evaluation, 
; Streams

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Deadlines:

; PSET9 due Tuesday, 4/27 at midnight
; LECT20 due Wednesday, 4/28 at 9am
; LECT21 due Friday, 4/30 at 9am
; Proj5 due Friday, 4/30 at 6pm

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Interpretation

; Stages of interpretation:

; Lexical analyzer: converts string to symbols
; Parser: converts symbols to parse trees
; Evaluator: Converts trees to values
; Printer: Converts value to printed representation

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Example 1: Evaluation of case special form

(case* expr
       ((val val ...) consequent)
       ((val val  ...) consequent)
       ...     
       (else* alternate))

; Case* evaluates expr and compares its value (using eqv?) against 
; each of the listed values (which are not evaluated).  When a match 
; is found, the corresponding consequent expression is evaluated and 
; returned as the result of the case*.  If no matches are found, the 
; alternate expression is evaluated and returned instead.  You can 
; assume the else* clause is required if you want.

(define (m-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))
	((definition? exp) (eval-definition exp env))
	((if? exp) (eval-if exp env))
	...
	((case? exp) (eval-case exp env))
	...
	((application? exp)
	 (m-apply (m-eval (operator exp) env)
		  (list-of-values (operands exp) env)))
	(else (error "Unknown expression type"))))

(define (case? exp)
  (tagged-list? exp 'case*))

(define (eval-case exp env)
  (let ((target-value (m-eval (second exp) env)))
    (eval-case-clauses target-value (cddr exp) env)))

(define (eval-case-clauses target-value clauses env)
  (if (null? clauses)
      'undefined
    (let ((clause (car clauses)))
      (cond ((else-clause? clause) (m-eval (second clause) env))
	    ((value-found? target-value (first clause))
	     (m-eval (second clause) env))
	    (else (eval-case-clauses target-value
				     (cdr clauses) env))))))

(define (else-clause? clause)
  (tagged-list? clause 'else*))

(define (value-found? target values)
  (not (null? (memq target values))))

; (memv object lst) returns the first pair of lst whose car
; is object.  Uses eqv? for comparison.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; case -> cond

(define (m-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))
	((definition? exp) (eval-definition exp env))
	((if? exp) (eval-if exp env))
	...
	((case? exp) (m-eval (case->cond exp) env))
	...
	((application? exp)
	 (m-apply (m-eval (operator exp) env)
		  (list-of-values (operands exp) env)))
	(else (error "Unknown expression type"))))

(define (case->cond exp)
  (let* ((expr (cadr exp))
	 (xclauses (map (lambda (x)
			  (if (eq? (car x) 'else*)
			      (cons 'else* (cdr x))
			    (cons (list 'memq* expr
					(list 'quote* (car x)))
				  (cdr x))))
			(cddr exp))))
    (cons 'cond* xclauses)))

; More efficient way to do this, assuming **val** is not defined
(define (case->cond exp)
  (let* ((expr (cadr exp))
	 (xclauses (map (lambda (x)
			  (if (eq? (car x) 'else*)
			      (cons 'else* (cdr x))
			    (cons (list 'memq* '**val**
					(list 'quote* (car x)))
				  (cdr x))))
			(cddr exp))))
    (list 'let*
	  (list (list '**val** expr))
	  (cons 'cond* xclauses))))

; Using quasiquote:

(define case-expr second)
(define case-clauses cddr)

(define (case->cond exp)
  (let* ((expr (case-expr exp))
	 (xclauses (map (lambda (x)
			  (if (eq? (car x) 'else)
			      `(else ,@(cdr x))
			      `((memq ,expr ',(car x)) ,@(cdr x))))
			(case-clauses exp))))
    `(cond ,@xclauses)))

(define (case->cond exp)
  (let* ((expr (case-expr exp))
	 (xclauses (map (lambda (x)
			  (if (eq? (car x) 'else)
			      `(else ,@(cdr x))
			      `((memq **val** ',(car x)) ,@(cdr x))))
			(case-clauses exp))))
    `(let ((**val** ,expr))
       (cond ,@xclauses))))

(define (filter pred lst)
  (cond ((null? lst)
	 '())
	((pred (car lst))
	 (cons (car lst) (filter pred (cdr lst))))
	(else (filter pred (cdr lst)))))

(define (case->cond exp)
  (let ((xclauses (map (lambda (x)
			 `(list ',(car x) (lambda () ,@(cdr x))))
		       (filter (lambda (x) (not (eq? (car x) 'else)))
			       (case-clauses exp))))
	(else-expr (filter (lambda (x) (eq? x 'else))
			   (case-clauses exp))))
    `(let* ((ops (list ,@xclauses))
	    (lookup (association-procedure 
		     (lambda (key test) (memq test key)) car))
	    (val (lookup ,(case-expr exp) ops)))
       (if val
	   ((cadr val))
	   ,(if else-expr
		(car else-expr)
		''unspecified)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Applicative versus normal (lazy) order

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Streams
; Show trick of find two streams to add together to get
; the resulting stream.

; Draw picture
(define (cons-stream x (lazy-memo y))
  (cons x y))

(define stream-car car)
(define stream-cdr cdr)

; Review with ones and ints.
(define ones (cons-stream 1 ones))
(define ints (cons-stream 1 (add-streams ones ints)))

; Exercise ???: Write map2stream.
(define (map2stream op s1 s2)
  (cons-stream (op (stream-car s1) (stream-car s2))
	       (map2stream op (stream-cdr s1) (stream-cdr s2))))

; Exercise ???: Write add-streams, mul-streams, div-streams.
(define (add-streams s1 s2)
  (map2stream + s1 s2))

; Exercise ???: Write scale-stream.
(define (scale-stream x s)
  (cons-stream (* x (stream-car s))
	       (scale-stream x (stream-cdr s))))

; Exercise ???: Stream of factorials.
(define facts (cons-stream 1 (mul-streams ints facts)))

; Exercise ???: Stream of fibs.
(define fibs
  (cons-stream 1
	       (cons-stream 1
			    (add-streams fibs
					 (stream-cdr fibs)))))

; Sequence of the sum of the integers from 1 to N
(define int-sum
  (cons-stream 1 (add-streams (stream-cdr ints) int-sum)))

; Sequence of even and odd numbers
(define evens
  (cons-stream 0 (add-streams evens
			      (scale-stream 2 ones))))
(define odds
  (cons-stream 1 (add-streams odds
			      (scale-stream 2 ones))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Example ???: Evaluation of for-each.  This needs to be 
; completed.  Perhaps use for final exam review.

(for-each* proc list list ...)

(define (m-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))
	((definition? exp) (eval-definition exp env))
	((if? exp) (eval-if exp env))
	...
	((for-each? exp) (eval-for-each exp env))
	...
	((application? exp)
	 (m-apply (m-eval (operator exp) env)
		  (list-of-values (operands exp) env)))
	(else (error "Unknown expression type"))))

(define (for-each? exp)
  (tagged-list? exp 'for-each*))
(define (eval-for-each exp env)
  (let ((proc (cadr exp))
	(exps (cddr exp)))
    ...))
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Misc. procedures

(define (stream-interval a b)
  (if (> a b)
      'the-empty-stream
    (cons-stream a (stream-interval (+ a 1) b))))

(define (stream-filter pred str)
  (if (pred (stream-car str))
      (cons-stream (stream-car str)
		   (stream-filter pred
				  (stream-cdr str)))
    (stream-filter pred 
		   (stream-cdr str))))

(define (sieve str)
  (cons-stream
   (stream-car str)
   (sieve (stream-filter
	   (lambda (x)
	     (not (divisible? (stream-car str))))
	   (stream-cdr str)))))

(define primes 
  (sieve (stream-cdr ints)))