56 lines
1.8 KiB
OCaml
56 lines
1.8 KiB
OCaml
module P = AbsImplicitt
|
|
module T = Core.Term
|
|
|
|
open List
|
|
|
|
open T
|
|
|
|
exception UnboundVar
|
|
|
|
let rec lookup (k : P.id) (env : P.id list) =
|
|
match env with
|
|
| [] -> raise UnboundVar
|
|
| x :: xs -> if k == x then 0 else 1 + lookup k xs
|
|
|
|
let rec proc (e : P.id list) (ex : P.exp) =
|
|
match ex with
|
|
| ExpPiE (name, dom, cod) -> Pi (Exp, proc e dom, B (proc (name :: e) cod))
|
|
| ExpPiI (name, dom, cod) -> Pi (Imp, proc e dom, B (proc (name :: e) cod))
|
|
| ExpSig (name, ty, fib) -> Sg (proc e ty, B (proc (name :: e) fib))
|
|
| ExpLet (name, tr, ty, sc) -> Let (proc e tr, proc e ty, B (proc (name :: e) sc))
|
|
| ExpLam ([], _) -> failwith "impossible empty lambda"
|
|
| ExpLam (bs, sc) -> unwrapLambda e bs sc
|
|
| ExpAppI (e1, e2) -> App (Imp, proc e e1, proc e e2)
|
|
| ExpAppE (e1, e2) -> App (Exp, proc e e1, proc e e2)
|
|
| ExpVar i -> Var (Ix (lookup i e)) (* todo: definitions, elimination *)
|
|
| ExpT0 -> T0
|
|
| ExpT1 -> T1
|
|
| ExpT1tr -> T1tr
|
|
| ExpTNat -> TNat
|
|
| ExpZero -> Zero
|
|
| ExpSuc e1 -> Suc (proc e e1)
|
|
| ExpTBool -> TBool
|
|
| ExpTrue -> True
|
|
| ExpFalse -> False
|
|
| ExpPair (e1, e2) -> Pair (proc e e1, proc e e2)
|
|
| ExpFst e1 -> Fst (proc e e1)
|
|
| ExpSnd e1 -> Snd (proc e e1)
|
|
| ExpHole -> InsMeta (C.Mv (C.getCMV ()), length e)
|
|
| ExpInd0 (i1, e1, e2) -> Ind0 (B (proc (i1 :: e) e1), proc e e2)
|
|
| ExpIndN (i1, e1, e2, i2, i3, e3, e4) ->
|
|
IndN (B (proc (i1 :: e) e1)
|
|
, proc e e2
|
|
, B (B (proc (i3 :: i2 :: e) e3))
|
|
, proc e e4)
|
|
| ExpIndB (i1, e1, e2, e3, e4) ->
|
|
IndB (B (proc (i1 :: e) e1)
|
|
, proc e e2
|
|
, proc e e3
|
|
, proc e e4)
|
|
|
|
and unwrapLambda (e : P.id list) (bs : P.bD list) (sc : P.exp) =
|
|
match bs with
|
|
| [] -> proc e sc
|
|
| BE n :: bs -> Lam (Exp, B (unwrapLambda (n :: e) bs sc))
|
|
| BI n :: bs -> Lam (Imp, B (unwrapLambda (n :: e) bs sc))
|