(* 15-317 Constructive Logic
 * A bidirectional type checker for proof terms
 * Spring 2023
 * Live-coded, Feb 2, 2023
 *)

datatype prop =
         And of prop * prop
       | Imp of prop * prop
       | Or of prop * prop
       | True
       | False
       | Var of string

fun Not A = Imp(A,False)

datatype term =
         Pair of term * term (* <M,N> *)
       | Fst of term         (* fst M *)
       | Snd of term         (* snd M *)
       | Lam of term -> term (* \x. M *)
       | App of term * term  (* M N *)
       | Inl of term         (* inl M *)
       | Inr of term         (* inr M *)
       | Case of term * (term -> term) * (term -> term) (* case (M, u.N, w.P) *)
       | Unit                (* <> *)
       | Abort of term       (* abort M *)
       | Hyp of prop         (* _ : A *)

(* check : term -> prop -> bool *)
(* synth : term -> prop option *)
fun check (Pair(M,N)) (And(A,B)) = check M A andalso check N B
  | check (Lam(F)) (Imp(A,B)) = check (F (Hyp A)) B
  | check (Inl(M)) (Or(A,B)) = check M A
  | check (Inr(M)) (Or(A,B)) = check M B
  | check (Case(M,F,G)) C =
    (case synth M
      of SOME(Or(A,B)) => check (F (Hyp A)) C andalso check (G (Hyp B)) C
       | _ => false)
  | check (Abort(M)) C =
    (case synth M
      of SOME(False) => true
       | _ => false)
  | check (Unit) (True) = true
  | check M (Var(P)) =
    (case synth M
      of SOME(Var(P')) => P' = P
       | _ => false)
  | check M A = false

and synth (Hyp(A)) = SOME(A)
  | synth (Fst(M)) =
    (case synth M
      of SOME(And(A,B)) => SOME(A)
       | _ => NONE)
  | synth (Snd(M)) =
    (case synth M
      of SOME(And(A,B)) => SOME(B)
       | _ => NONE)
  | synth (App(M,N)) =
    (case synth M
      of SOME(Imp(A,B)) => if check N A
                           then SOME(B)
                           else NONE
       | _ => NONE)
  | synth M = NONE

fun assert true = ()
  | assert false = raise Fail "assert"
fun deny true = raise Fail "deny"
  | deny false = ()

val A = Var("A")
val B = Var("B")
val C = Var("C")

val () = assert (check (Pair(Unit,Unit)) (And(True,True)))
val () = deny (check Unit (And(True,True)))
val () = assert (check (Lam(fn x => x)) (Imp(A,A)))
val () = deny (check (Lam(fn x => x)) (Imp(A,B)))
val () = assert (check (Lam(fn x => Fst(x))) (Imp(And(A,B),A)))
val () = assert (check (Lam(fn x => Lam(fn y => x))) (Imp(A,Imp(B,A))))
val () = assert (check (Lam(fn x => Case(x, fn u => Inr u, fn w => Inl w)))
                       (Imp(Or(A,B),Or(B,A))))
val () = deny (check (Lam(fn x => Case(x, fn u => Inr u, fn w => Inl w)))
                     (Imp(Or(A,B),Or(A,B))))
val () = assert (check (Lam(fn x => Abort(App(Snd(x),Fst(x))))) (Not(And(A,Not(A)))))
val () = deny (check (Lam(fn x => Abort(App(Fst(x),Snd(x))))) (Not(And(A,Not(A)))))