(require (lib "defmacro.ss"))

(define (compose l)
  (if (pair? l)
      (lambda (x) ((compose (cdr l)) ((car l) x)))
      (lambda (x) x)))

(define (match? pattern term)
  (cond
   ((and (pair? pattern) (pair? term))
    (let ((a (match? (car pattern)
                     (car term)))
          (b (match? (cdr pattern)
                     (cdr term))))
      (and a
           b
           (append a b))))
   ((variable? pattern)
    (list (cons pattern term)))
   ((and (symbol? pattern) (symbol? term))
    (and (eq? pattern term)
         '()))
   ((and (eq? pattern '()) (eq? term '()))
    '())
   (#t
    #f)))

(define (variable? v)
  (and (symbol? v)
       (char-lower-case? (string-ref (symbol->string v) 0))))

(define-macro (lam pat body)
  
  (define (vars pattern)
    (cond
     ((pair? pattern)
      (append (vars (car pattern))
              (vars (cdr pattern))))
     ((variable? pattern)
      (list pattern))
     (#t
      '())))
  
  (define (variable? v)
    (and (symbol? v)
         (char-lower-case? (string-ref (symbol->string v) 0))))
  
  `(lambda (x)
     (let ((match (match? ',pat x)))
       (if match
           (let ,(map (lambda (p)
                        `(,p (cdr (assoc (quote ,p) match))))
                      (vars pat))
             (begin ,body))
           x))))


(letrec ((is-even? (compose (list (lam (Z) 'True)
                                  (lam (S n) (not- (list (is-even? n)))))))
         (not- (compose (list (lam (True) 'False)
                              (lam (False) 'True)))))
  (display (is-even? '(S (S (S (S (Z))))))) ; => True
  (display (is-even? '(S (S (S (S (S (Z))))))))  ) ; => False

; is_even =     Z -> True 
;          . S(n) -> not(is_even(n))
; not = True -> False
;     . False -> True
;     . other -> Fail(TypeError, "`not' undefined for: ", other)
;
; puts(is_even(5))
;
; ...
; not = Maybe -> Maybe . not
; not = Fuzzy(n) -> Fuzzy(1 - n) . not
;
; App(Variable, [Arguments])
; Atom
; Tuple(Tag, [Arguments])
; Variable
; BinOp(Tag, A, B)
; Def(Variable, Value, Body)  ~>  App(Lambda(Variable@Pattern, Body), [Value])
; Lambda(Pattern, Body)
;
; Natural: Z, S(Z)
; Whole:   N(S(Z))
; Ratio:   R(W, W)
;
; Char:    Char(Z)
; String:  Cons(Z, String) | Nil