Initial work on metas

src/Lib/Check.idr

@@ -4,14 +4,16 @@ import Control.Monad.Error.Interface
 import Control.Monad.Identity
 import Lib.Parser.Impl
 import Lib.Prettier
+import Data.List
 import Data.Vect
 import Data.String
 import Lib.TT
 import Lib.TopContext
 import Syntax
 
-
+-- renaming
-
+-- dom gamma ren
+data PRen = PR Nat Nat (List Nat)
 
 -- IORef for metas needs IO
 parameters {0 m : Type -> Type} {auto _ : HasIO m} {auto _ : MonadError Error m} (top : TopContext)
@@ -26,6 +28,80 @@ parameters {0 m : Type -> Type} {auto _ : HasIO m} {auto _ : MonadError Error m}
   -- unify l (VPi str icit x y) u = ?unify_rhs_5
   -- unify l VU u = ?unify_rhs_6
 
+  forceMeta : Val -> Val
+  -- TODO - need to look up metas
+  forceMeta x = x
+
+  -- return renaming, the position is the new VVar
+  invert : Nat -> List Val -> m (List Nat)
+  invert lvl sp = go sp []
+    where
+      go : List Val -> List Nat -> m (List Nat)
+      go [] acc = pure acc
+      go ((VVar k []) :: xs) acc = do
+        if elem k acc 
+          then throwError $ E (0,0) "non-linear pattern"
+          else go xs (k :: acc)
+      go _ _ = throwError $ E (0,0) "non-variable in pattern"
+  
+  -- we have to "lift" the renaming when we go under a lambda
+  -- I think that essentially means our domain ix are one bigger, since we're looking at lvl
+  -- in the codomain, so maybe we can just keep that value
+  rename : Nat ->  List Nat -> Nat -> Val -> m Tm
+  rename meta ren lvl v = go ren lvl v
+    where
+      go : List Nat -> Nat -> Val -> m Tm
+      goSpine : List Nat -> Nat -> Tm -> List Val -> m Tm
+      goSpine ren lvl tm [] = pure tm
+      goSpine ren lvl tm (x :: xs) = do
+        xtm <- go ren lvl x
+        goSpine ren lvl (App tm xtm) xs
+
+      go ren lvl (VVar k sp) = case findIndex (== k) ren of
+        Nothing => throwError $ E (0,0) "scope/skolem thinger"
+        Just x => goSpine ren lvl (Bnd $ cast x) sp
+      go ren lvl (VRef nm sp) = goSpine ren lvl (Ref nm Nothing) sp
+      go ren lvl (VMeta ix sp) = if ix == meta
+        then throwError $ E (0,0) "meta occurs check"
+        else goSpine ren lvl (Meta ix) sp
+      go ren lvl (VLam n icit t) = pure (Lam n icit !(go (lvl :: ren) (S lvl) (t $$ VVar lvl [])))
+      go ren lvl (VPi n icit ty tm) = pure (Pi n icit !(go ren lvl ty) !(go (lvl :: ren) (S lvl) (tm $$ VVar lvl [])))
+      go ren lvl VU = pure U
+
+  -- lams : Nat -> Tm -> Tm
+  -- lams 0 tm = tm
+  -- lams (S k) tm = Lam 
+
+  solve : Nat -> Nat -> List Val -> Val -> m ()
+  solve l m sp t = do
+    ren <- invert l sp
+    tm <- rename m ren l t
+    printLn "solution to \{show m} is \{show tm}"
+
+    pure ()
+
+  unify : (l : Nat) -> Val -> Val -> m ()
+
+  unifySpine : Nat -> Bool -> List Val -> List Val -> m ()
+  unifySpine l False _ _ = throwError $ E (0,0) "unify failed"
+  unifySpine l True [] [] = pure ()
+  unifySpine l True (x :: xs) (y :: ys) = unify l x y >> unifySpine l True xs ys
+  unifySpine l True _ _ = throwError $ E (0,0) "meta spine length mismatch"
+
+  unify l t u = case (forceMeta t, forceMeta u) of
+    (VLam _ _ t,  VLam _ _ t'  ) => unify (l + 1) (t $$ VVar l []) (t' $$ VVar l [])
+    (t,           VLam _ _ t'  ) => unify (l + 1) (t `vapp` VVar l []) (t' $$ VVar l [])
+    (VLam _ _ t,  t'           ) => unify (l + 1) (t $$ VVar l []) (t' `vapp` VVar l [])
+    (VPi _ _ a b, VPi _ _ a' b') => unify l a a' >> unify (S l) (b $$ VVar l []) (b' $$ VVar l [])
+    (VVar k sp,   VVar k' sp'  ) => unifySpine l (k == k') sp sp'
+    (VRef n sp,   VRef n' sp'  ) => unifySpine l (n == n') sp sp'
+    (VMeta i sp,  VMeta i' sp' ) => unifySpine l (i == i') sp sp'
+
+    (t,           VMeta i' sp') => solve l i' sp' t
+    (VMeta i sp, t'           ) => solve l i sp t'
+    (VU, VU) => pure ()
+    _ => throwError $ E (0,0) "unify failed"
+
 
   export
   infer : Context -> Raw -> m (Tm, Val)
@@ -40,20 +116,15 @@ parameters {0 m : Type -> Type} {auto _ : HasIO m} {auto _ : MonadError Error m}
                       let ctx' = extend ctx nm a
                       tm' <- check ctx' tm (b $$ var)
                       pure $ Lam nm icit tm'
-                    
-                    -- So it gets stuck for `List a`, not a pi type, and we want the
-                    -- (This is not a data constructor, but a church encoding)
-                    -- List reduces now and we're stuck for `Nat`.
-
                     other => error [(DS "Expected pi type, got \{show $ quote 0 ty}")]
   check ctx tm ty = do
     (tm', ty') <- infer ctx tm
     -- This is where the conversion check / pattern unification go
-    -- unify ctx.lvl ty' ty
+    unify ctx.lvl ty' ty
-    if quote 0 ty /= quote 0 ty' then
+    -- if quote 0 ty /= quote 0 ty' then
-        error [DS "type mismatch got", DD (quote 0 ty'), DS "expected", DD (quote 0 ty)]
+    --     error [DS "type mismatch got", DD (quote 0 ty'), DS "expected", DD (quote 0 ty)]
-      else pure tm'
+    --   else pure tm'
-
+    pure tm'
   infer ctx (RVar nm) = go 0 ctx.types
     where
       go : Nat -> Vect n (String, Val) -> m (Tm, Val)

src/Lib/TT.idr

@@ -7,7 +7,6 @@ module Lib.TT
 -- For SourcePos
 import Lib.Parser.Impl
 import Lib.Prettier
-import Lib.Metas
 
 import Control.Monad.Error.Interface
 
@@ -189,9 +188,6 @@ export
 nf : Env -> Tm -> Tm
 nf env t = quote (length env) (eval env CBN t)
 
-public export
-conv : (lvl : Nat) -> Val -> Val -> Bool
-
 
 {-
 smalltt
@@ -221,9 +217,9 @@ Can I get val back? Do we need to quote? What happens if we don't?
 
 -}
 
-
+-- FIXME remove List BD
 public export
-data MetaEntry = Unsolved Nat (List BD) | Solved Nat Tm (List BD)
+data MetaEntry = Unsolved Nat (List BD) | Solved Nat Val
 
 public export
 record MetaContext where
@@ -298,6 +294,11 @@ freshMeta ctx = do
   applyBDs k t (Bound :: xs) = applyBDs (S k) (App t (Bnd k)) xs
   applyBDs k t (Defined :: xs) = applyBDs (S k) t xs
 
+-- solveMeta : HasIO m => Context -> m Tm
+-- solveMeta ctx = do
+--   mc <- readIORef ctx.metas
+  
+
 -- we need more of topcontext later - Maybe switch it up so we're not passing
 -- around top
 export