2023-01-26 21:13:51 +01:00
|
|
|
module P = AbsImplicitt
|
2023-01-26 19:17:23 +01:00
|
|
|
module R = RawSyntax
|
|
|
|
|
|
|
|
|
|
open R
|
2023-01-26 21:13:51 +01:00
|
|
|
|
|
|
|
|
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, proc (name :: e) cod)
|
|
|
|
|
| ExpPiI (name, dom, cod) -> Pi (Imp, proc e dom, proc (name :: e) cod)
|
|
|
|
|
| ExpSig (name, ty, fib) -> Sg (proc e ty, proc (name :: e) fib)
|
|
|
|
|
| ExpLet (name, tr, ty, sc) -> Let (proc e tr, proc e ty, 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 -> failwith "hole not implemented"
|
|
|
|
|
|
|
|
|
|
and unwrapLambda (e : P.id list) (bs : P.bD list) (sc : P.exp) =
|
|
|
|
|
match bs with
|
|
|
|
|
| [] -> proc e sc
|
|
|
|
|
| BE n :: bs -> Lam (Exp, unwrapLambda (n :: e) bs sc)
|
|
|
|
|
| BI n :: bs -> Lam (Imp, unwrapLambda (n :: e) bs sc)
|
