implicitt/lib/Eval.ml

59 lines
2.1 KiB
OCaml
Raw Normal View History

2022-08-25 20:29:55 +02:00
module V = Value
module T = Term
2022-08-30 16:12:47 +02:00
let rec index (env : V.env) (i : int) =
match env with
| [] -> failwith "Can't happen"
| x :: xs -> if i < 1 then x else index xs (i-1)
2022-08-25 20:29:55 +02:00
2022-08-30 16:12:47 +02:00
let rec eval (env : V.env) (tr : T.term) =
match tr with
| Var (Ix i) -> index env i
| Type -> V.Type
| T0 -> V.T0
| Ind0 (B b, t) -> begin
match eval env t with
| Stuck (s , T0) -> V.Stuck (V.Ind0 (V.C (env, b), s), V.T0)
| _ -> failwith "eval Ind0 impossible error"
end
| T1 -> V.T1
| T1tr -> V.T1vl
| TNat -> V.TNat
| Zero -> V.Zero
| Suc n -> V.Suc (eval env n)
| IndN (B b, tz, B B ts, n) -> indN env b (eval env tz) ts (eval env n)
| TBool -> V.TBool
| True -> V.True
| False -> V.False
| IndB (B b, t, f, bo) -> begin
match eval env bo with
| True -> eval env t
| False -> eval env f
| Stuck (s, TBool) -> V.Stuck (V.IndB (V.C (env, b), eval env t, eval env f, s), V.TBool)
| _ -> failwith "eval IndB impossible error"
end
| Pi (dom, B cod) -> V.Pi (eval env dom, V.C (env, cod))
| Lam (B scope) -> V.Lam (C (env, scope))
| App (f, x) -> app (eval env f) (eval env x)
| Sg (ty, B tr) -> V.Sg (eval env ty, V.C (env, tr))
| Pair (x, y) -> V.Pair (eval env x, eval env y)
| Fst tr -> fst (eval env tr)
| Snd tr -> snd (eval env tr)
(* B b, B B ts *)
and indN (env : V.env) (b : T.term) (tz : V.value) (ts : T.term) (n : V.value) =
match n with
| Zero -> tz
| Suc m -> eval (indN env b tz ts m :: m :: env) ts
| Stuck (s, TNat) -> V.Stuck (V.IndN (V.C (env, b), tz, V.C2 (env, ts), s), V.TNat)
| _ -> failwith "eval IndN impossible error"
and app (f : V.value) (x : V.value) =
failwith "todo"
and fst (p : V.value) =
failwith "todo"
and snd (p : V.value) =
failwith "todo"