Finding simple autos after elab

src/Lib/Elab.idr

@@ -97,7 +97,7 @@ parameters (ctx: Context)
         if elem k acc
           then do
             debug "\{show k} \{show acc}"
-
+            -- when does this happen?
             error fc "non-linear pattern: \{show sp}"
           else go xs (k :: acc)
       go (xs :< v) _ = error emptyFC "non-variable in pattern \{show v}"
@@ -137,8 +137,8 @@ parameters (ctx: Context)
   -- REVIEW can I get better names in here?
   lams (S k) tm = Lam emptyFC "arg_\{show k}" (lams k tm)
 
-
+  export
-  solve : Nat -> Nat -> SnocList Val -> Val  -> M  ()
+  solve : (lvl : Nat) -> (k : Nat) -> SnocList Val -> Val -> M  ()
   solve l m sp t = do
     debug "solve \{show m} lvl \{show l} sp \{show sp} is \{show t}"
     meta@(Unsolved metaFC ix ctx ty _) <- lookupMeta m

src/Lib/ProcessDecl.idr

@@ -2,6 +2,7 @@ module Lib.ProcessDecl
 
 import Data.IORef
 import Data.String
+import Data.Vect
 
 import Lib.Elab
 import Lib.Parser
@@ -11,6 +12,29 @@ import Lib.Eval
 import Lib.Types
 import Lib.Util
 
+
+-- This is a crude first pass
+-- TODO consider ctx
+findMatches : Val -> List TopEntry -> M (List Tm)
+findMatches ty [] = pure []
+findMatches ty ((MkEntry name type def@(Fn t)) :: xs) = do
+  top <- get
+  let ctx = mkCtx top.metas (getFC ty)
+  -- FIXME we're restoring state, but the INFO logs have already been emitted
+  -- Also redo this whole thing to run during elab, recheck constraints, etc.
+  mc <- readIORef top.metas
+  catchError {e=Error} (do
+      -- TODO sort out the FC here
+      let fc = getFC ty
+      tm <- check (mkCtx  top.metas fc) (RVar fc name) ty
+      debug "Found \{pprint [] tm} for \{show ty}"
+      (tm ::) <$> findMatches ty xs)
+    (\ _ => do
+      writeIORef top.metas mc
+      debug "No match \{show ty} \{pprint [] type}"
+      findMatches ty xs)
+findMatches ty (y :: xs) = findMatches ty xs
+
 getArity : Tm -> Nat
 getArity (Pi x str icit t u) = S (getArity u)
 -- Ref or App (of type constructor) are valid
@@ -28,6 +52,13 @@ collectDecl ((Def fc nm cl) :: rest@(Def _ nm' cl' :: xs)) =
   else (Def fc nm cl :: collectDecl rest)
 collectDecl (x :: xs) = x :: collectDecl xs
 
+-- Makes the arg for `solve` when we solve an auto
+makeSpine : Nat -> Vect k BD -> SnocList Val
+makeSpine k [] = [<]
+makeSpine (S k) (Defined :: xs) = makeSpine k xs
+makeSpine (S k) (Bound :: xs) = makeSpine k xs :< VVar emptyFC k [<]
+makeSpine 0 xs = ?fixme
+
 export
 processDecl : Decl -> M ()
 
@@ -80,21 +111,35 @@ processDecl (Def fc nm clauses) = do
   clauses' <- traverse (makeClause top) clauses
   tm <- buildTree (mkCtx top.metas fc) (MkProb clauses' vty)
   putStrLn "Ok \{pprint [] tm}"
+
+  mc <- readIORef top.metas
+  let mlen = length mc.metas `minus` mstart
+  for_ (take mlen mc.metas) $ \case
+    (Unsolved fc k ctx ty AutoSolve) => do
+      debug "auto solving \{show k} : \{show ty}"
+      -- we want the context here too.
+      [tm] <- findMatches ty top.defs
+        | res => error fc "Failed to solve \{show ty}, matches: \{show $ map (pprint []) res}"
+      val <- eval ctx.env CBN tm
+      let sp = makeSpine ctx.lvl ctx.bds
+      solve ctx ctx.lvl k sp val
+      pure ()
+    _ => pure ()
+
   tm' <- zonk top 0 [] tm
   putStrLn "NF \{pprint[] tm'}"
+
   mc <- readIORef top.metas
-
+  -- for_ (take mlen mc.metas) $ \case
-  -- Maybe here we try search?
+  for_ (mc.metas) $ \case
-
-  for_ (drop mstart mc.metas) $ \case
     (Solved k x) => pure ()
     (Unsolved (l,c) k ctx ty User) => do
-      -- TODO print here
+      -- TODO print here instead of during Elab
       pure ()
     (Unsolved (l,c) k ctx ty kind) => do
       tm <- quote ctx.lvl !(forceMeta ty)
       -- Now that we're collecting errors, maybe we simply check at the end
-      addError $ E (l,c) "Unsolved meta \{show k} type \{pprint (names ctx) tm}"
+      addError $ E (l,c) "Unsolved meta \{show k} \{show kind} type \{pprint (names ctx) tm}"
   debug "Add def \{nm} \{pprint [] tm'} : \{pprint [] ty}"
   modify $ setDef nm ty (Fn tm')
 

tests/black/Auto.newt

@@ -0,0 +1,27 @@
+module Auto
+
+ptype String
+ptype Int
+
+pfunc i2s : Int -> String := "(i) => ''+i"
+pfunc _++_ : String -> String -> String := "(a,b) => a + b"
+
+infixl 4 _++_
+
+-- We need sugar and marking as class/instance on all of this
+
+data Show : U -> U where
+  MkShow : { A : U } -> ((show : A) -> String) -> Show A
+
+-- FIXME - we'd like to inline this, so `show _ {{showInt}} a` ends up as `i2s a`
+show : {A : U} {{myshow : Show A}} -> A -> String
+show {_} {{MkShow foo}} a = foo a
+
+showInt : Show Int
+showInt = MkShow i2s
+
+ptype World
+pfunc log : {A : U} -> A -> World := "(_, a) => console.log(a)"
+
+main : Int -> World
+main _ = log ("answer: " ++ show 42)