(load "lab2x.ss") ; lab 2, w/ parse extended to allow multi-argument
                  ;  lambda expressions and applications, which parse
                  ;  into nested one-argument lambdas and apps,
                  ;  using the idea of "currying"

;; pure lambda calculus versions of cons, car, cdr, etc.
(define lcons '(lambda (a d) (lambda (o) (o a d))))
(define lcar '(lambda (p) (p (lambda (a d) a))))
(define lcdr '(lambda (p) (p (lambda (a d) d))))
(define ltrue '(lambda (t e) t))
(define lfalse '(lambda (t e) e))
(define lif '(lambda (c t e) (c t e)))
(define lempty-list `(lambda (o) ,ltrue))
(define lnull? `(lambda (p) (p (lambda (a d) ,lfalse))))

;; the Y combinator, for recursion
(define w '(lambda (x) (f (x x))))
(define y `(lambda (f) (,w ,w)))

;; the reverse-onto procedure (rev l acc) => l reversed onto acc
(define reverse-onto-maker 
  `(lambda (reverse-onto)
     (lambda (l acc)
       (,lif (,lnull? l)
        acc
        (reverse-onto (,lcdr l)
                      (,lcons (,lcar l) acc))))))

(define reverse-onto `(,y ,reverse-onto-maker))

;; Now test w/ lambda-calculus versions of the scheme expressions:
;;   (cons 'three (cons 'two (cons 'one '())))
;;   (reverse-onto (cons 'one (cons 'two (cons 'three '())))
;;                 '())
;; These should be the same.

(reduce*-leftmost `(,lcons three 
                    (,lcons two (,lcons one ,lempty-list)))
                  1000)

(reduce*-leftmost 
 `(,reverse-onto (,lcons one 
                  (,lcons two (,lcons three ,lempty-list)))
   ,lempty-list)
 1000)