(use srfi-1)
(require-library low-level-macros)
(import low-level-macros macro-helpers)
(import-for-syntax (only low-level-macros macro-rules with-gensyms))


; lazy does it!
(define (force e)
	(e #t))

; curried, if.
(define (cif2 p)
	(lambda (a) (lambda (b) (if p (force a) (force b)))))

; Thunk you!
(define-syntax cif
	(macro-rules ()
		((_ p a b) (with-gensyms (d1 d2) `(((cif2 ,p) (lambda (d1) ,a)) (lambda (d2) ,b))))))

; Ye olde, stryct y-combinator:
(define Y
  (lambda (le)
	  ((lambda (mk) (mk mk))
		   (lambda (foo) (le (lambda (x) ((foo foo) x)))))))

; Mogensen-Scott Encoding
; as in ftp://ftp.diku.dk/diku/semantics/papers/D-128.ps.Z
(define-syntax mogensen
 (macro-rules ()
	((_ (lambda vars body)) (with-gensyms (a b c) `(lambda (a b c) (c (lambda ,vars (mogensen ,body))))))
	((_ (x y)) (with-gensyms (a b c) `(lambda (a b c)  (b (mogensen ,x) (mogensen ,y)))))
	((_ x)  (with-gensyms (a b c) `(lambda (a b c) (a ,x))))))

(set! E
  (Y (lambda (e)
       (lambda (mm)
         (mm (lambda (x) x)
             (lambda (m n) ((e m) (e n)))
             (lambda (m) (lambda (v) (e (m v)))))))))

(define (1- x) (- x 1))
(define (0? x) (= 0 x))
(define (curry* a) (lambda (b) (* a b)))

; canonical faculty example!
(print (E (mogensen
            ((Y (lambda (f)
                  (lambda (n) (cif (0? n) 1 ((curry* n) (f (1- n)))))))
             4))))