#lang racket
(require redex)

(define-language L
  (M N ::= (λ (X) M) (M N) X c (op M ...))
  (X Y ::= variable-not-otherwise-mentioned)
  (c ::= b integer)
  (b ::= tt ff)
  (op ::= ∧ ∨ ¬ +)

  (C ::= (λ (X) C) (C N) (M C) (op M ... C M ...) hole)
  (V ::= (λ (X) M) c X)
  (R ::= (V V) (op V ...))
  (E ::= (E M) (V E) (op V ... E M ...) hole)
  #:binding-forms
  (λ (X) M #:refers-to X))
(default-language L)

(define-metafunction L
  δ : op V ... -> V or ⊥
  [(δ ∧ tt b) b]
  [(δ ∧ ff b) ff]
  [(δ ¬ tt) ff]
  [(δ ¬ ff) tt]
  [(δ ∨ tt b) tt]
  [(δ ∨ ff b) b]
  [(δ + integer ...) ,(apply + (term (integer ...)))]
  [(δ op V ...) ⊥])

(define-judgment-form L
  #:mode (R I O)
  #:contract (R M N)

  [(where V_answer (δ op V ...))
   ----------------------------- "δ"
   (R (op V ...) V_answer)]

  [------------------------------------ "βv"
   (R ((λ (X) M) V) (substitute M X V))])
  
(test-judgment-holds
 (R ((λ (X) X) Y)
    Y))

(test-judgment-holds
 (R (+ 1 2 -3) 0))

(test-equal (judgment-holds (R (λ (X) (X X)) M) M)
            '())

(define-judgment-form L
  #:mode (->R I O)
  #:contract (->R M N)

  [(R M N)
   --------- "R"
   (->R (in-hole C M)
        (in-hole C N))])

(test-judgment-holds
 (->R (((λ (x) z) q)
       ((λ (x) q) z))
      (((λ (x) z) q) q)))

(test-judgment-holds
 (->R (((λ (x) z) q)
       ((λ (x) q) z))
      (z ((λ (x) q) z))))

(test-judgment-holds
 (->R (λ (w) ((λ (x) x) w))
      (λ (X) X)))

(define-judgment-form L
  #:mode (->>R I O)
  #:contract (->>R M N)

  [----------- "reflexive"
   (->>R M M)]

  [(->R M_1 M_2) (->>R M_2 M_3)
   ---------------------------- "transitive"
   (->>R M_1 M_3)])

(test-judgment-holds
 (->>R (((λ (x) z) q)
        ((λ (x) q) z))
       (z q)))

(define-judgment-form L
  #:mode (decomposes I O O)

  [---------------------------
   (decomposes (in-hole E R) E R)])

(redex-check
 L
 M
 (let ([decomps (judgment-holds (decomposes M C R) (C R))])
   (cond
     [(null? decomps) (redex-match L V (term M))]
     [(null? (cdr decomps)) #t]
     [else #f])))


(test-results)