did some work on renaming / meta solutions

lib/Core/Convert.ml

@@ -5,7 +5,7 @@ module M = Metaenv
 exception Unequal (* todo, better exception *)
 
 let rec conv_tp (len : int) (v1 : V.value) (v2 : V.value) =
-  match v1, v2 with
+  match E.force v1, E.force v2 with
   | Type,                Type                    -> ()
   | T0,                  T0                      -> ()
   | T1,                  T1                      -> ()
@@ -23,8 +23,10 @@ let rec conv_tp (len : int) (v1 : V.value) (v2 : V.value) =
   | Stuck (s1, Type), Stuck (s2, Type)           -> conv_stuck len s1 s2
   | _ -> raise Unequal
 
-and conv_tr (len : int) (ty : V.value) (v1 : V.value) (v2 : V.value) =
-  match ty with
+and conv_tr (len : int) (ty : V.value) (v1' : V.value) (v2' : V.value) =
+  let v1 = E.force v1'
+  and v2 = E.force v2' in
+  match E.force ty with
   | Type               -> conv_tp len v1 v2
   | T1                 -> () (* unit η-law, this still requires evaluation :/ *)
   | T0                 -> () (* might be nice, why not? *)
@@ -45,6 +47,7 @@ and conv_tr (len : int) (ty : V.value) (v1 : V.value) (v2 : V.value) =
       | _ -> raise Unequal
       end
 
+(* does not need to force as things are forced in subsequent calls *)
 and conv_sp (len : int) (sp1 : V.spine) (sp2 : V.spine) =
   match sp1, sp2 with
   | (x1, i1, t1) :: xs1 , (x2, i2, t2) :: xs2 ->
@@ -55,6 +58,7 @@ and conv_sp (len : int) (sp1 : V.spine) (sp2 : V.spine) =
   | [] , [] -> ()
   | _ -> raise Unequal
 
+(* does not force as it is called by functions which do force *)
 and conv_stuck (len : int) (s1 : V.stuck) (s2 : V.stuck) =
   match s1, s2 with
   | Var (Lvl i),       Var (Lvl j)       -> if i == j then () else raise Unequal

lib/Core/Eval.ml

@@ -8,8 +8,8 @@ open List
 let rec eval (env : V.env) (tr : T.term) =
   match tr with
   | Var  (Ix i)               -> nth env i
-  | Meta (Mv i)               -> V.Stuck (V.Meta (Mv i), M.getMetaType i)
-  | InsMeta (Mv i, c)         -> appEnv (V.Stuck (V.Meta (Mv i), M.getMetaType i)) c env
+  | Meta m                    -> V.Stuck (V.Meta m, M.getMetaType m)
+  | InsMeta (m, c)            -> appEnv (V.Stuck (V.Meta m, M.getMetaType m)) c env
   | Type                      -> V.Type
   | T0                        -> V.T0
   | Ind0 (B b, t)             -> ind0 env b (eval env t)

lib/Core/Metaenv.ml

@@ -1,23 +1,33 @@
 module C = Common
 module V = Value
 
-open List
+module Mv =
+  struct
+    type t = C.meta
+    let compare (C.Mv i1) (C.Mv i2) = Stdlib.compare i1 i2
+  end
+
+module MvMap = Map.Make(Mv)
 
 type mentry
   = Unsolved of V.value (* type *)
   | Solved of (V.value * V.value) (* solution : type *)
 
-let metaEntries : mentry list ref = ref []
+let metaEntries : mentry MvMap.t ref = ref MvMap.empty
 
-let getMetaEntry (i : int) =
-  nth (! metaEntries) i
+let getMetaEntry (m : C.meta) =
+  MvMap.find m !metaEntries
 
-let getMetaType (i : int) =
-  match getMetaEntry i with
+let modMetaEntry (f : mentry MvMap.t -> mentry MvMap.t) =
+  metaEntries.contents <- f !metaEntries
+
+(* TODO: if not found then insert new meta for the type somehow *)
+let getMetaType (m : C.meta) =
+  match getMetaEntry m with
   | Unsolved ty -> ty
   | Solved (_, ty) -> ty
 
-let resolveMeta (Mv i : C.meta) =
-  match getMetaEntry i with
-  | Unsolved ty -> V.Stuck (V.Meta (Mv i), ty)
+let resolveMeta (m : C.meta) =
+  match getMetaEntry m with
+  | Unsolved ty -> V.Stuck (V.Meta m, ty)
   | Solved (tr, _) -> tr

lib/Core/Renaming.ml

@@ -0,0 +1,52 @@
+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)))