53 lines
1.3 KiB
OCaml
53 lines
1.3 KiB
OCaml
module M = Metaenv
|
|
module C = Common
|
|
module V = Value
|
|
module E = Eval
|
|
module T = Term
|
|
|
|
module Lvl =
|
|
struct
|
|
type t = V.lvl
|
|
let compare (V.Lvl i1) (V.Lvl i2) = Stdlib.compare i1 i2
|
|
end
|
|
|
|
module LvlMap = Map.Make(Lvl)
|
|
|
|
type pren =
|
|
{ dom : int;
|
|
cod : int;
|
|
ren : V.lvl LvlMap.t;
|
|
}
|
|
|
|
exception InvertError
|
|
|
|
let rec invert (len : int) (spine : V.spine) =
|
|
match spine with
|
|
| [] -> { dom = 0;
|
|
cod = len;
|
|
ren = LvlMap.empty
|
|
}
|
|
| (tr, _, _) :: xs ->
|
|
match invert len xs with
|
|
| { dom = dom; ren = ren; _ } ->
|
|
match E.force tr with
|
|
| V.Stuck (V.Var l, _) -> { dom = dom+1;
|
|
cod = len;
|
|
ren = LvlMap.add l (V.Lvl dom) ren;
|
|
}
|
|
| _ -> raise InvertError
|
|
|
|
and rename (_ : C.meta) (_ : pren) (_ : V.value) = failwith "TODO: rename"
|
|
|
|
(* use only explicit lambdas when solving metas *)
|
|
and lams (len : int) (t : T.term) =
|
|
if len == 0
|
|
then t
|
|
else T.Lam (C.Exp, T.B (lams (len-1) t))
|
|
|
|
and solve (len : int) (m : C.meta) (sp : V.spine) (rhs : V.value) =
|
|
let pren = invert len sp in
|
|
let rhs' = rename m pren rhs in
|
|
let solu = E.eval [] (lams pren.dom rhs') in
|
|
let mety = M.getMetaType m in
|
|
M.modMetaEntry (M.MvMap.add m (M.Solved (solu, mety)))
|