mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-19 17:21:59 +03:00
just putzing around still but I managed to get some looking up to work just by filtering the list of all global defs.
This commit is contained in:
parent
35a50480f4
commit
9bbbe927f0
@ -31,6 +31,8 @@ log' lvl msg
|
|||||||
then coreLift $ putStrLn $ "LOG " ++ show lvl ++ ": " ++ msg
|
then coreLift $ putStrLn $ "LOG " ++ show lvl ++ ": " ++ msg
|
||||||
else pure ()
|
else pure ()
|
||||||
|
|
||||||
|
||| Log a message with the given log level. Use increasingly
|
||||||
|
||| high log level numbers for more granular logging.
|
||||||
export
|
export
|
||||||
log : {auto c : Ref Ctxt Defs} ->
|
log : {auto c : Ref Ctxt Defs} ->
|
||||||
String -> Nat -> Lazy String -> Core ()
|
String -> Nat -> Lazy String -> Core ()
|
||||||
|
@ -607,7 +607,6 @@ loadMainFile f
|
|||||||
[] => pure (FileLoaded f)
|
[] => pure (FileLoaded f)
|
||||||
_ => pure (ErrorsBuildingFile f errs)
|
_ => pure (ErrorsBuildingFile f errs)
|
||||||
|
|
||||||
|
|
||||||
||| Process a single `REPLCmd`
|
||| Process a single `REPLCmd`
|
||||||
|||
|
|||
|
||||||
||| Returns `REPLResult` for display by the higher level shell which
|
||| Returns `REPLResult` for display by the higher level shell which
|
||||||
@ -714,35 +713,84 @@ process (Exec ctm)
|
|||||||
= execExp ctm
|
= execExp ctm
|
||||||
process Help
|
process Help
|
||||||
= pure RequestedHelp
|
= pure RequestedHelp
|
||||||
process (ProofSearch (PType fc))
|
process (ProofSearch searchTerm@(PPi fc rc piInfo _ argTy retTy))
|
||||||
= do let ty = gType fc
|
= do log "repl.ps" 2 $ "piInfo " ++ (show piInfo) ++ " argTy " ++ (show argTy) ++ " retTy " ++ (show retTy)
|
||||||
logGlue "repl.ps" 2 "tst" [] ty
|
defs <- get Ctxt
|
||||||
pure Done
|
let context = gamma defs
|
||||||
process (ProofSearch pterm)
|
allDefs <- map catMaybes $ traverse (flip lookupCtxtExact context) $ !(allNames context)
|
||||||
= do ttimp <- desugar AnyExpr [] pterm
|
log "repl.ps" 2 $ "Defs: " ++ (show $ length allDefs)
|
||||||
logRaw "repl.ps" 2 "tst" ttimp
|
|
||||||
log "repl.ps" 2 (show (getFn ttimp))
|
ttimpSearchTerm <- desugar AnyExpr [] searchTerm
|
||||||
let ty = gType (getFC ttimp)
|
|
||||||
logGlue "repl.ps" 2 "gType" [] ty
|
|
||||||
let n = (UN "[input]")
|
let n = (UN "[input]")
|
||||||
inidx <- resolveName n
|
inidx <- resolveName n
|
||||||
-- (tm1, gl1) <- check top (initElabInfo InType) (MkNested []) [] ttimp Nothing
|
(tm, _) <- elabTerm inidx InType [] (MkNested [])
|
||||||
-- logTermNF "repl.ps" 2 "tst" [] tm1
|
[] ttimpSearchTerm Nothing
|
||||||
|
logTermNF "repl.ps" 2 "tm" [] tm
|
||||||
|
|
||||||
|
let filteredDefs = (flip filter) allDefs (\def => def.type == tm)
|
||||||
|
log "repl.ps" 2 $ "filtered count: " ++ (show $ length filteredDefs)
|
||||||
|
|
||||||
|
doc <- traverse (getDocsFor replFC) $ (.fullname) <$> filteredDefs
|
||||||
|
pure $ Printed $ vsep $ pretty <$> (intersperse "\n" $ join doc)
|
||||||
|
process (ProofSearch pterm)
|
||||||
|
= do log "repl.ps" 2 (show pterm)
|
||||||
|
ttimp <- desugar AnyExpr [] pterm
|
||||||
|
logRaw "repl.ps" 2 "ttimp from desugar" ttimp
|
||||||
|
log "repl.ps" 2 (show (getFn ttimp))
|
||||||
|
-- let ty = gType (getFC ttimp)
|
||||||
|
-- logGlue "repl.ps" 2 "gType" [] ty
|
||||||
|
let n = (UN "[input]")
|
||||||
|
inidx <- resolveName n
|
||||||
|
newRef EST (initEState 0 [])
|
||||||
|
(tm1, gl1) <- checkImp top (initElabInfo InType) (MkNested []) [] ttimp Nothing
|
||||||
|
logTermNF "repl.ps" 2 "checkImp generated type" [] tm1
|
||||||
-- logGlue "repl.ps" 2 "tst" [] gl1
|
-- logGlue "repl.ps" 2 "tst" [] gl1
|
||||||
(tm, gl) <- elabTerm inidx InType [] (MkNested [])
|
(tm, gl) <- elabTerm inidx InType [] (MkNested [])
|
||||||
[] ttimp Nothing
|
[] ttimp Nothing
|
||||||
logTermNF "repl.ps" 2 "tst" [] tm
|
logTermNF "repl.ps" 2 "tm" [] tm
|
||||||
logGlue "repl.ps" 2 "tst" [] gl
|
-- logGlue "repl.ps" 2 "glue term" [] gl
|
||||||
|
|
||||||
addNameType replFC n [] tm
|
-- addNameType replFC n [] tm
|
||||||
searchResults <- exprSearchN replFC 3 n []
|
-- searchResults <- exprSearchN replFC 3 n []
|
||||||
pure $ log $ show searchResults
|
-- pure $ log $ show searchResults
|
||||||
|
|
||||||
tm' <- search replFC top False 1000 n tm []
|
ty <- checkTerm inidx InType [] (MkNested []) []
|
||||||
|
(IBindHere replFC (PI erased) ttimp)
|
||||||
|
(gType replFC)
|
||||||
|
logTerm "repl.ps" 2 "check term result" ty
|
||||||
|
logTermNF "repl.ps" 2 ("Type of " ++ show n) [] (abstractFullEnvType replFC [] ty)
|
||||||
|
|
||||||
|
|
||||||
|
log "repl.pl" 2 ""
|
||||||
|
log "repl.ps" 2 "--- AutoSearch ------"
|
||||||
|
|
||||||
|
tm' <- search replFC top False 1000 n ty [] -- ty or tm?
|
||||||
defs <- get Ctxt
|
defs <- get Ctxt
|
||||||
fnms <- toFullNames !(normaliseAll defs [] tm')
|
fnms <- toFullNames !(normaliseAll defs [] tm')
|
||||||
itm <- resugar [] fnms
|
itm <- resugar [] fnms
|
||||||
logTermNF "repl.ps" 2 "tst" [] fnms
|
logTermNF "repl.ps" 2 "full names from tm'" [] fnms
|
||||||
|
|
||||||
|
log "repl.pl" 2 ""
|
||||||
|
log "repl.ps" 2 "--- Editing Search ------"
|
||||||
|
|
||||||
|
searchty <- normalise defs [] ty -- ty or tm?
|
||||||
|
logTerm "repl.ps" 2 "Normalised type" searchty
|
||||||
|
arity <- getArity defs [] ty -- ty or tm?
|
||||||
|
log "repl.ps" 2 $ "arity : " ++ (show arity)
|
||||||
|
let results = searchType replFC top (initSearchOpts True 1000) [] ty 0 searchty -- replaced arity with 0 -- ty or tm?
|
||||||
|
Just ((resTm, exprDefs), results2) <- nextResult results
|
||||||
|
| Nothing => pure Done
|
||||||
|
logTerm "repl.ps" 2 "1st search result" resTm
|
||||||
|
|
||||||
|
Just ((resTm2, exprDefs2), results3) <- nextResult results2
|
||||||
|
| Nothing => pure Done
|
||||||
|
logTerm "repl.ps" 2 "2nd search result" resTm2
|
||||||
|
|
||||||
|
Just ((resTm3, exprDefs3), results4) <- nextResult results3
|
||||||
|
| Nothing => pure Done
|
||||||
|
logTerm "repl.ps" 2 "3rd search result" resTm3
|
||||||
|
|
||||||
pure $ ProofFound $ itm
|
pure $ ProofFound $ itm
|
||||||
|
|
||||||
process (Missing n)
|
process (Missing n)
|
||||||
|
@ -710,6 +710,7 @@ tryIntermediateRec fc rig opts env ty topty (Just rd)
|
|||||||
pure True
|
pure True
|
||||||
isSingleCon _ _ = pure False
|
isSingleCon _ _ = pure False
|
||||||
|
|
||||||
|
export
|
||||||
searchType : {vars : _} ->
|
searchType : {vars : _} ->
|
||||||
{auto c : Ref Ctxt Defs} ->
|
{auto c : Ref Ctxt Defs} ->
|
||||||
{auto m : Ref MD Metadata} ->
|
{auto m : Ref MD Metadata} ->
|
||||||
|
Loading…
Reference in New Issue
Block a user