(include-book "m1/m1-lemmas")
(in-package "M1")

(defun ! (n)
  (if (zp n) 1 (* n (! (- n 1)))))

(defun fib (n)
  (if (zp n)
      0
      (if (equal n 1)
          1
          (+ (fib (- n 1)) (fib (- n 2))))))

; When the Feb 8 class began, I had pre-loaded the forms above.

(defconst *pi*
       '((ICONST 0)
         (ICONST 1)
         (IADD)
         (GOTO -2)))

(defun test (k)
       (top
        (stack
         (run (repeat 'tick k)
              (make-state 0
                          nil
                          nil
                          *pi*)))))

(test 1)
(test 4)
(test 7)
(test 10)
(test 13) 

(defun magic-schedule (n)
       (if (equal n 0)
           (repeat 'tick 1)
           (repeat 'tick (+ 1 (* 3 n)))))

(defun magically-compute-factorial (n)
       (top
        (stack
         (run (magic-schedule (! n))
              (make-state 0
                          nil
                          nil
                          *pi*)))))

(magically-compute-factorial 0)
(magically-compute-factorial 1)
(magically-compute-factorial 2)
(magically-compute-factorial 3)
(magically-compute-factorial 4)
(magically-compute-factorial 5)
(magically-compute-factorial 6)

(defun magically-compute-fib (n)
       (top
        (stack
         (run (magic-schedule (fib n))
              (make-state 0
                          nil
                          nil
                          *pi*)))))

(magically-compute-fib 0)
(magically-compute-fib 1)
(magically-compute-fib 2)
(magically-compute-fib 3)
(magically-compute-fib 4)
(magically-compute-fib 5)
(magically-compute-fib 6)
(magically-compute-fib 7)

(quote (end of demo 1))

(defun g (x y a)
      (if (zp x)
          a
          (g (- x 1) y (+ y a))))

(defconst *g-program*
       '((ICONST 0)   ; 0
         (ISTORE 2)   ; 1  a = 0;
         (ILOAD 0)    ; 2  [loop:]
         (IFEQ 10)    ; 3  if x=0 then go to end;
         (ILOAD 0)    ; 4
         (ICONST 1)   ; 5
         (ISUB)       ; 6
         (ISTORE 0)   ; 7  x = x-1;
         (ILOAD 1)    ; 8
         (ILOAD 2)    ; 9
         (IADD)       ;10
         (ISTORE 2)   ;11  a = y+a;
         (GOTO -10)   ;12  go to loop
         (ILOAD 2)    ;13  [end:]
         (HALT))      ;14 ``return'' a
    )

(defun g-loop-sched (x)
      (if (zp x)
          (repeat 'tick 3)
          (ap (repeat 'tick 11)
              (g-loop-sched (- x 1)))))

(defun g-sched (x)
      (ap (repeat 'tick 2)
          (g-loop-sched x)))

(defun test-g-program (x y)
      (top
       (stack
        (run (g-sched x)
             (make-state 0 (list x y) nil *g-program*)))))    

(test-g-program 4 5)

(test-g-program 40 50)

(quote (end of demo 2))