;;; top-level loader file for stacks examples

(printf "top.s Fri May 28 13:02:27 1993~%")

(load "parse-utils.s")
(load "syntax.s")
(load "stacks.s")

;;; Tests

;;; Top level

(define run
  (lambda (string)
    (eval-exp (scan&parse string) (make-init-env) (make-init-cont))))

(define debug-points '())

(define pgm1 "1")

(define pgm2 "(+ 40 50)")

(define pgm3 
  "letrec (fact x) = if (zero? x) then 1 else (* x (fact (sub1 x)))
  in (fact 6)")

(define pgm4
  "letrec (diff x y) = (- x y) in (diff 6 4)") ; test argument order

(define pgm5
  "letrec (app f x) = (f x)
          (foo x) = (add1 x)
    in (app foo 17)")

(define pgm6                            ; test passing procedures down
                                        ; can't pass them up
  "letrec (foo f x) = letrec (bar y) = (f x y)
                      in (bar 3)
          in (foo - 7)")

(define test3
  (lambda (n)
    (run (format
           "letrec (fact x) = if (zero? x) then 1 else (* x (fact (sub1 x)))
              in (fact ~s)"
           n))))

(define test
  (lambda (filename)
    (load filename)
    (test1)))

(define test1
  (lambda ()
    (let ((answers (list (run pgm1)
                         (run pgm2)
                         (run pgm3)
                         (run pgm4)
                         (run pgm5)
                         (run pgm6)
                         (test3 4))))
      (printf "~s~%" answers)
      (equal? answers '(1 90 720 2 18 4 24)))))

; > (load "top.s")
; top.s Fri May 28 11:11:27 1993
; syntax.s Fri May 28 11:11:46 1993
; stacks.s Fri May 28 10:59:47 1993
; > (test "interp1.s")
; interp1.s Fri May 28 11:16:52 1993
; (1 90 720 2 18 24)