; brussell 6.001 Tutorial 11, Spring 2004

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

; topics:

; Static Analysis, Register Machines

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

; Deadlines:

; PSET10 due Tuesday, 5/4 at midnight
; LECT22 due Wednesday, 5/5 at 9am
; LECT23 due Friday, 5/7 at 9am
; Proj6 due Friday, 5/7 at 6pm

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

; Static Analysis

(let* ((a 1)
       (b a)
       (c b))
  body)

; Useful procedures

(define (let*-vars exp)
  (map car (cadr exp)))
(define (let*-vals exp)
  (map cadr (cadr exp)))
(define (let*-body exp)
  (cddr exp))

(define (analyze-sequence exps)
  (define (sequentially p1 p2)
    (lambda (env) (p1 env) (p2 env)))
  (define (loop first-proc rest-procs)
    (if (null? rest-procs)
	first-proc
      (loop (sequentially first-proc (car rest-procs))
	    (cdr rest-procs))))
  (let ((procs (map analyze exps)))
    (if (null? procs)
	(error "Empty sequence -- ANALYZE"))
    (loop (car procs) (cdr procs))))

; Analyze let*

(define (analyze-let* exp)
  (let ((vars (let*-vars exp))
	(pvals (map analyze (let*-vals exp)))
	(pbody (analyze-sequence (let*-body exp))))
    (define (loop vars pvals pbody)
      (if (null? vars)
	  (lambda (env) pbody)
	(let ((rest (loop (cdr vars) (cdr pvals) pbody)))
	  (lambda (env)
	    (rest (extend-environment (list (car vars))
				      (list ((car pvals) env))
				      env))))))
    (loop vars pvals pbody)))

(lambda (env)
  (lambda (extend-environment (list (car vars))
			      (list ((car pvals) env))
			      env)
    (lambda (...)
      ...
      (lambda (...)
	(pbody env)))))

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

Example recursive subroutines 

Questions to ask: What is necessary information to have 
in the contract?  What is the contract?

Optimizing with tail calls (show difference between tail
recursion and regular recursion)

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

list-ref
 (test (op =) (reg k) (const 0))
 (branch (label list-ref-done))
 (assign k (op -) (reg k) (const 1))
 (assign lst (op cdr) (reg lst))
 (goto (label list-ref))
list-ref-done
 (assign val (op car) (reg lst))
 (goto (reg continue))

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

(expt x n)

expt
 (assign val (const 1))
expt-top
 (test (op =) (reg n) (const 1))
 (branch (label expt-done))
 (assign val (op *) (reg val) (reg x))
 (assign n (op -) (reg n) (const 1))
 (goto (label expt-top))
expt-done
 (goto (reg continue))

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

(define (prime? p)
  (define (helper n)
    (cond ((> n (sqrt p)) #t)
	  ((divisible? p n) #f)
	  (else (helper (+ n 1)))))
  (helper 2))

; Inputs: p,continue
; Outputs: val
; Overwrites: t1,n
; Stack: unchanged
prime?
 (assign n (const 2))
helper
 (assign t1 (op sqrt) (reg p))
 (test (op >) (reg n) (reg t1))
 (branch (label b-case1))
 (test (op divisible?) (reg p) (reg n))
 (branch (label b-case2))
 (assign n (op +) (reg n) (const 1))
 (goto (label helper))
b-case1
 (assign val #t)
 (goto (reg continue))
b-case2
 (assign val #f)
 (goto (reg continue))

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

; Iterative version of num-primes

(define (num-primes num)
  (define (helper i c)
    (cond ((> i num) c)
	  ((prime? i) (helper (+ i 1) (+ c 1)))
	  (else (helper (+ i 1) c))))
  (helper 1 0))

num-primes
 (assign i (const 1))
 (assign c (const 0))
helper
 (test (op >) (reg i) (reg n))
 (branch (label b-case1))
 (assign p (reg i))
 (save continue)
 (assign continue (label after-prime))
 (goto (label prime?))
after-prime
 (restore continue)
 (assign i (op +) (reg i) (const 1))
 (test (op eq?) (reg val) (const #f))
 (branch (label after-bcase2))
 (assign c (op +) (reg c) (const 1))
after-bcase2
 (goto (label helper))
b-case1
 (assign val (reg c))
 (goto (reg continue))

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

(define (num-primes n)
  (define (helper i)
    (cond ((> i n) 0)
	  ((prime? i) (+ 1 (helper (+ i 1))))
	  (else (helper (+ i 1)))))
  (helper 1))

; Inputs: n,continue
; Outputs: val
; Overwrites: i
; Stack: unchanged
num-primes
 (assign i (const 1))
helper
 (test (op >) (reg i) (reg n))
 (branch (label b-case))
 (assign i (op +) (reg i) (const 1))
 (test (op prime?) (reg i))
 (branch (label p-case1))
 (goto (label helper))
b-case
 (assign val (const 0))
 (goto (reg continue))
p-case1
 (save continue)
 (assign continue (label p-case2))
 (goto (label helper))
p-case2
 (restore continue)
 (assign val (op +) (reg val) (const 1))
 (goto (reg continue))

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

(define (map f lst)
  (if (null? lst)
      nil
    (cons (f (car lst))
	  (map f (cdr lst)))))

; Inputs: f,lst,continue
; Outputs: newlst
; Overwrites: t1
; Stack: unchanged
map
 (test (op null?) (reg lst))
 (branch (label b-case))
r-case
 (save continue)
 (save lst)
 (assign lst (op cdr) (reg lst))
 (assign continue (label r-case-done))
 (goto (label map))
r-case-done
 (restore lst)
 (restore continue)
 (assign t1 (op car) (reg lst))
 (assign t1 (op f) (reg t1)) ; Have to obey contract for f
 (assign newlst (op cons) (reg t1) (reg newlst))
 (goto (reg continue))
b-case
 (assign newlst (const nil))
 (goto (reg continue))

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

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

; Inputs: pred,lst,continue
; Outputs: newlst
; Overwrites: t,lst
; Stack: unchanged
filter
 (test (op null?) (reg lst))
 (branch (label b-case))
 (assign t (op car) (reg lst))
 (test (op pred) (reg t))
 (branch (label r-case-1))
r-case-2
 (assign lst (op cdr) (reg lst))
 (goto (label filter))
b-case
 (assign newlst (const nil))
 (goto (reg continue))
r-case-1
 (save continue)
 (save t)
 (assign lst (op cdr) (reg lst))
 (assign continue (label r-case-1-done))
 (goto (label filter))
r-case-1-done
 (restore t)
 (restore continue)
 (assign newlst (op cons) (reg t) (reg newlst))
 (goto (reg continue))

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

(define (fold-right f init lst)
  (if (null? lst) init
    (f (car lst) (fold-right f init (cdr lst)))))

; Inputs: op,init,lst,continue
; Outputs: val
; Overwrites: t
; Stack: unchanged
fold-right
 (test (op null?) (reg lst))
 (branch (label b-case))
r-case
 (save continue)
 (save lst)
 (assign lst (op cdr) (reg lst))
 (assign continue (label r-case-done))
 (goto (label fold-right))
 (restore lst)
 (restore continue)
 (assign t (op car) (reg lst))
 (assign val (op f) (reg t) (reg val))
 (goto (reg continue))
b-case
 (assign val (reg init))
 (goto (reg continue))

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

(define (fibbad n)
  (if (< n 2) n
    (+ (fibbad (- n 1)) (fibbad (- n 2)))))

; Inputs: n,continue
; Outputs: val
; Overwrites: n,t1,t2
; Stack: unchanged
fibbad
 (test (op <) (reg n) (const 2))
 (branch (label b-case))
 (assign t1 (op -) (reg n) (const 2))
 (save continue)
 (save t1)
 (assign n (op -) (reg n) (const 1))
 (assign continue (label r-case1))
 (goto (label fibbad))
r-case1
 (restore n) ; Restore into n the contents of (- n 2)
 (assign t2 (reg val))
 (save t2)
 (assign continue (label r-case2))
 (goto (label fibbad))
r-case2
 (restore t2)
 (restore continue)
 (assign val (op +) (reg t2) (reg val))
 (goto (reg continue))
b-case
 (assign val (reg n))
 (goto (reg continue))

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

(define (fibgood n)
  (define (helper current prev count)
    (if (= count 1) current
      (helper (+ prev current) current (- count 1))))
  (helper 1 0 n))

; Inputs: n,continue
; Outputs: val
; Overwrites: current,prev,count
; Stack: unchanged
fibgood
 (assign current (const 1))
 (assign prev (const 0))
 (assign count (reg n))
helper
 (test (op =) (reg count) (const 1))
 (branch (label b-case))
 (assign current (op +) (reg prev) (reg current))
 (assign prev (reg current))
 (assign count (op -) (reg count) (const 1))
 (goto (label helper))
b-case
 (assign val (reg current))
 (goto (reg continue))

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

; Universal Machines

; Diagonalization: Show that the reals are uncountable
; Construct a real number between 0 and 1 that is different 
; from all other reals.

; Use diagonalization to show the proof that the halting 
; problem is undecidable
; Assume that the predicate halt? exists, which takes as input
; a procedure and an argument and returns #t if the procedure 
; halts and #f if it does not.
(define D 
  (lambda (M)
    (if (halt? M M)
	(loop-forever)
      'halt)))
(define (loop-forever) (loop-forever))

(D D)

; Two outputs: loop-forever if D halts on input D
; OR halt if D does not halt on input D.
; So, D halts on M iff M loops forever on M.

; Learn more about Turing machines in 6.840

; Perhaps discuss current complexity issues

; P versus NP problem.

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

; Simple incrementer
(controller
 (assign sum (const 0))
 (assign sum (op +) (reg sum) (const 1))
 (assign sum (op +) (reg sum) (const 1)))

; GCD
(controller
 test-b
 (test (op =) (const 0) (reg b))
 (branch (label gcd-done))
 (assign t (op rem) (reg a) (reg b))
 (assign a (reg b))
 (assign b (reg t))
 (goto (label test-b))
 gcd-done)

; Increment, using subroutines
; Contract:
; Input: sum, continue
; Output: sum
; Writes: none
(controller
 (assign sum (const 0))
 (assign continue (label after-call-1))
 (goto (label increment))
 after-call-1
 (assign continue (label after-call-2))
 (goto (label increment))
 after-call-2
 (goto (label done))
 increment
 (assign sum (op +) (reg sum) (const 1))
 (goto (reg continue))
 done)

; Optimizing tail calls
; i.e. when there is no work after the call except (goto (reg continue))
setup
(assign sum (const 15))
(save continue)
(assign continue (label after-call))
(goto (label increment))
after-call
(restore continue)
(goto (reg continue))

; Optimized version
setup
(assign sum (const 15))
(goto (label increment))

; Factorial
(controller
 (assign continue (label halt))
 fact
 (test (op =) (reg n) (const 1))
 (branch (label b-case))
 (save continue)
 (save n)
 (assign n (op -) (reg n) (const 1))
 (assign continue (label r-done))
 (goto (label fact))
 r-done
 (restore n)
 (restore continue)
 (assign val (op *) (reg val) (reg n))
 (goto (reg continue))
 b-case
 (assign val (const 1))
 (goto (reg continue))
 halt)

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

; Done in project 6

(define (append a b)
  (if (null? a) b
    (cons (car a)
	  (append (cdr a) b))))

; Inputs: a,b,continue
; Outputs: b
; Overwrites: t
; Stack: unchanged
append
 (test (op null?) (reg a))
 (branch (label b-case))
r-case
 (save continue)
 (save a)
 (assign a (op cdr) (reg a))
 (assign continue (label r-case-done))
 (goto (label append))
r-case-done
 (restore a)
 (restore continue)
 (assign t (op car) (reg a))
 (assign b (op cons) (reg t) (reg b))
 (goto (reg continue))
b-case
 (goto (reg continue))