on master help sign in
Merge branch 'master' of github.com:edwinb/Idris-dev
commitf31c76a9a2517811bff724992bc819e1a096ca93 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateTue 12 Feb 2013, 15:28 (14 years ago) parenta6c36d31eed9c2
13 files changed+407−237
src/Core/ProofShell.hs+21−17 src/IRTS/Compiler.hs+3−3 src/Idris/AbsSyntax.hs+92−92 src/Idris/AbsSyntaxTree.hs+1−1 src/Idris/Completion.hs+143 src/Idris/Coverage.hs+9−9 src/Idris/ElabDecls.hs+39−39 src/Idris/Error.hs+3−3 src/Idris/Parser.hs+12−11 src/Idris/Prover.hs+30−13 src/Idris/REPL.hs+51−46 src/Idris/UnusedArgs.hs+2−2 src/Main.hs+1−1
src/Core/ProofShell.hs+21−17
@@ -11,6 +11,8 @@ import Core.Elaborate
1111import Control.Monad.State
1212import System.Console.Haskeline
1313
14+import Idris.AbsSyntaxTree (Idris)
15+
1416import Util.Pretty
1517
1618data ShellState = ShellState
@@ -55,21 +57,23 @@ processCommand (Tac e) state
5557 err -> (state, show err)
5658 | otherwise = (state, "No proof in progress")
5759
58−runShell :: ShellState -> InputT IO ShellState
59−runShell st = do (prompt, parser) <-
60− maybe (return ("TT# ", parseCommand))
61− (\st -> do outputStrLn . render . pretty $ st
62− return (show (thname st) ++ "# ", parseTactic))
63− (prf st)
64− x <- getInputLine prompt
65− cmd <- case x of
66− Nothing -> return $ Right Quit
67− Just input -> return (parser input)
68− case cmd of
69− Left err -> do outputStrLn (show err)
70− runShell st
71− Right cmd -> do let (st', r) = processCommand cmd st
72− outputStrLn r
73− if (not (exitNow st')) then runShell st'
74− else return st'
60+runShell :: ShellState -> Idris ShellState
61+runShell st = runInputT defaultSettings $ runShell' st
62+ where
63+ runShell' st = do (prompt, parser) <-
64+ maybe (return ("TT# ", parseCommand))
65+ (\st -> do outputStrLn . render . pretty $ st
66+ return (show (thname st) ++ "# ", parseTactic))
67+ (prf st)
68+ x <- getInputLine prompt
69+ cmd <- case x of
70+ Nothing -> return $ Right Quit
71+ Just input -> return (parser input)
72+ case cmd of
73+ Left err -> do outputStrLn (show err)
74+ runShell' st
75+ Right cmd -> do let (st', r) = processCommand cmd st
76+ outputStrLn r
77+ if (not (exitNow st')) then runShell' st'
78+ else return st'
7579
src/IRTS/Compiler.hs+3−3
@@ -73,7 +73,7 @@ compile target f tm
7373 Bytecode -> liftIO $ dumpBC c f
7474 ToJavaScript -> liftIO $ codegenJavaScript c f outty
7575 Error e -> fail $ show e
76− where checkMVs = do i <- get
76+ where checkMVs = do i <- getIState
7777 case idris_metavars i \\ primDefs of
7878 [] -> return ()
7979 ms -> fail $ "There are undefined metavariables: " ++ show ms
@@ -91,7 +91,7 @@ irMain tm = do i <- ir tm
9191
9292allNames :: [Name] -> Name -> Idris [Name]
9393allNames ns n | n `elem` ns = return []
94−allNames ns n = do i <- get
94+allNames ns n = do i <- getIState
9595 case lookupCtxt Nothing n (idris_callgraph i) of
9696 [ns'] -> do more <- mapM (allNames (n:ns)) (map fst (calls ns'))
9797 return (nub (n : concat more))
@@ -193,7 +193,7 @@ instance ToIR (TT Name) where
193193 | (P (DCon t a) n _, args) <- unApply tm
194194 = irCon env t a n args
195195 | (P _ n _, args) <- unApply tm
196− = do i <- get
196+ = do i <- getIState
197197 args' <- mapM (ir' env) args
198198 case getPrim i n args' of
199199 Just tm -> return tm
src/Idris/AbsSyntax.hs+92−92
@@ -26,57 +26,57 @@ import Util.Pretty
2626
2727
2828getContext :: Idris Context
29−getContext = do i <- get; return (tt_ctxt i)
29+getContext = do i <- getIState; return (tt_ctxt i)
3030
3131getObjectFiles :: Idris [FilePath]
32−getObjectFiles = do i <- get; return (idris_objs i)
32+getObjectFiles = do i <- getIState; return (idris_objs i)
3333
3434addObjectFile :: FilePath -> Idris ()
35−addObjectFile f = do i <- get; put (i { idris_objs = f : idris_objs i })
35+addObjectFile f = do i <- getIState; putIState $ i { idris_objs = f : idris_objs i }
3636
3737getLibs :: Idris [String]
38−getLibs = do i <- get; return (idris_libs i)
38+getLibs = do i <- getIState; return (idris_libs i)
3939
4040addLib :: String -> Idris ()
41−addLib f = do i <- get; put (i { idris_libs = f : idris_libs i })
41+addLib f = do i <- getIState; putIState $ i { idris_libs = f : idris_libs i }
4242
4343addHdr :: String -> Idris ()
44−addHdr f = do i <- get; put (i { idris_hdrs = f : idris_hdrs i })
44+addHdr f = do i <- getIState; putIState $ i { idris_hdrs = f : idris_hdrs i }
4545
4646totcheck :: (FC, Name) -> Idris ()
47−totcheck n = do i <- get; put (i { idris_totcheck = idris_totcheck i ++ [n] })
47+totcheck n = do i <- getIState; putIState $ i { idris_totcheck = idris_totcheck i ++ [n] }
4848
4949setFlags :: Name -> [FnOpt] -> Idris ()
50−setFlags n fs = do i <- get; put (i { idris_flags = addDef n fs (idris_flags i) })
50+setFlags n fs = do i <- getIState; putIState $ i { idris_flags = addDef n fs (idris_flags i) }
5151
5252setAccessibility :: Name -> Accessibility -> Idris ()
5353setAccessibility n a
54− = do i <- get
54+ = do i <- getIState
5555 let ctxt = setAccess n a (tt_ctxt i)
56− put (i { tt_ctxt = ctxt })
56+ putIState $ i { tt_ctxt = ctxt }
5757
5858setTotality :: Name -> Totality -> Idris ()
5959setTotality n a
60− = do i <- get
60+ = do i <- getIState
6161 let ctxt = setTotal n a (tt_ctxt i)
62− put (i { tt_ctxt = ctxt })
62+ putIState $ i { tt_ctxt = ctxt }
6363
6464getTotality :: Name -> Idris Totality
6565getTotality n
66− = do i <- get
66+ = do i <- getIState
6767 case lookupTotal n (tt_ctxt i) of
6868 [t] -> return t
6969 _ -> return (Total [])
7070
7171addToCG :: Name -> CGInfo -> Idris ()
7272addToCG n cg
73− = do i <- get
74− put (i { idris_callgraph = addDef n cg (idris_callgraph i) })
73+ = do i <- getIState
74+ putIState $ i { idris_callgraph = addDef n cg (idris_callgraph i) }
7575
7676addDocStr :: Name -> String -> Idris ()
7777addDocStr n doc
78− = do i <- get
79− put (i { idris_docstrings = addDef n doc (idris_docstrings i) })
78+ = do i <- getIState
79+ putIState $ i { idris_docstrings = addDef n doc (idris_docstrings i) }
8080
8181addToCalledG :: Name -> [Name] -> Idris ()
8282addToCalledG n ns = return () -- TODO
@@ -87,13 +87,13 @@ addToCalledG n ns = return () -- TODO
8787
8888addInstance :: Bool -> Name -> Name -> Idris ()
8989addInstance int n i
90− = do ist <- get
90+ = do ist <- getIState
9191 case lookupCtxt Nothing n (idris_classes ist) of
9292 [CI a b c d ins] ->
9393 do let cs = addDef n (CI a b c d (addI i ins)) (idris_classes ist)
94− put (ist { idris_classes = cs })
94+ putIState $ ist { idris_classes = cs }
9595 _ -> do let cs = addDef n (CI (MN 0 "none") [] [] [] [i]) (idris_classes ist)
96− put (ist { idris_classes = cs })
96+ putIState $ ist { idris_classes = cs }
9797 where addI i ins | int = i : ins
9898 | chaser n = ins ++ [i]
9999 | otherwise = insI i ins
@@ -107,45 +107,45 @@ addInstance int n i
107107
108108addClass :: Name -> ClassInfo -> Idris ()
109109addClass n i
110− = do ist <- get
110+ = do ist <- getIState
111111 let i' = case lookupCtxt Nothing n (idris_classes ist) of
112112 [c] -> c { class_instances = class_instances i }
113113 _ -> i
114− put (ist { idris_classes = addDef n i' (idris_classes ist) })
114+ putIState $ ist { idris_classes = addDef n i' (idris_classes ist) }
115115
116116addIBC :: IBCWrite -> Idris ()
117117addIBC ibc@(IBCDef n)
118− = do i <- get
118+ = do i <- getIState
119119 when (notDef (ibc_write i)) $
120− put (i { ibc_write = ibc : ibc_write i })
120+ putIState $ i { ibc_write = ibc : ibc_write i }
121121 where notDef [] = True
122122 notDef (IBCDef n': is) | n == n' = False
123123 notDef (_ : is) = notDef is
124−addIBC ibc = do i <- get; put (i { ibc_write = ibc : ibc_write i })
124+addIBC ibc = do i <- getIState; putIState $ i { ibc_write = ibc : ibc_write i }
125125
126126clearIBC :: Idris ()
127−clearIBC = do i <- get; put (i { ibc_write = [] })
127+clearIBC = do i <- getIState; putIState $ i { ibc_write = [] }
128128
129129getHdrs :: Idris [String]
130−getHdrs = do i <- get; return (idris_hdrs i)
130+getHdrs = do i <- getIState; return (idris_hdrs i)
131131
132132setErrLine :: Int -> Idris ()
133−setErrLine x = do i <- get;
133+setErrLine x = do i <- getIState;
134134 case (errLine i) of
135− Nothing -> put (i { errLine = Just x })
135+ Nothing -> putIState $ i { errLine = Just x }
136136 Just _ -> return ()
137137
138138clearErr :: Idris ()
139−clearErr = do i <- get
140− put (i { errLine = Nothing })
139+clearErr = do i <- getIState
140+ putIState $ i { errLine = Nothing }
141141
142142getSO :: Idris (Maybe String)
143−getSO = do i <- get
143+getSO = do i <- getIState
144144 return (compiled_so i)
145145
146146setSO :: Maybe String -> Idris ()
147−setSO s = do i <- get
148− put (i { compiled_so = s })
147+setSO s = do i <- getIState
148+ putIState $ (i { compiled_so = s })
149149
150150getIState :: Idris IState
151151getIState = get
@@ -154,9 +154,9 @@ putIState :: IState -> Idris ()
154154putIState = put
155155
156156getName :: Idris Int
157−getName = do i <- get;
157+getName = do i <- getIState;
158158 let idx = idris_name i;
159− put (i { idris_name = idx + 1 })
159+ putIState $ (i { idris_name = idx + 1 })
160160 return idx
161161
162162checkUndefined :: FC -> Name -> Idris ()
@@ -175,24 +175,24 @@ isUndefined fc n
175175 _ -> return True
176176
177177setContext :: Context -> Idris ()
178−setContext ctxt = do i <- get; put (i { tt_ctxt = ctxt } )
178+setContext ctxt = do i <- getIState; putIState $ (i { tt_ctxt = ctxt } )
179179
180180updateContext :: (Context -> Context) -> Idris ()
181−updateContext f = do i <- get; put (i { tt_ctxt = f (tt_ctxt i) } )
181+updateContext f = do i <- getIState; putIState $ (i { tt_ctxt = f (tt_ctxt i) } )
182182
183183addConstraints :: FC -> (Int, [UConstraint]) -> Idris ()
184184addConstraints fc (v, cs)
185− = do i <- get
185+ = do i <- getIState
186186 let ctxt = tt_ctxt i
187187 let ctxt' = ctxt { uconstraints = cs ++ uconstraints ctxt,
188188 next_tvar = v }
189189 let ics = zip cs (repeat fc) ++ idris_constraints i
190− put (i { tt_ctxt = ctxt', idris_constraints = ics })
190+ putIState $ i { tt_ctxt = ctxt', idris_constraints = ics }
191191
192192addDeferred :: [(Name, Type)] -> Idris ()
193193addDeferred ns = do mapM_ (\(n, t) -> updateContext (addTyDecl n (tidyNames [] t))) ns
194− i <- get
195− put (i { idris_metavars = map fst ns ++ idris_metavars i })
194+ i <- getIState
195+ putIState $ i { idris_metavars = map fst ns ++ idris_metavars i }
196196 where tidyNames used (Bind (MN i x) b sc)
197197 = let n' = uniqueName (UN x) used in
198198 Bind n' b $ tidyNames (n':used) sc
@@ -202,8 +202,8 @@ addDeferred ns = do mapM_ (\(n, t) -> updateContext (addTyDecl n (tidyNames [] t
202202 tidyNames used b = b
203203
204204solveDeferred :: Name -> Idris ()
205−solveDeferred n = do i <- get
206− put (i { idris_metavars = idris_metavars i \\ [n] })
205+solveDeferred n = do i <- getIState
206+ putIState $ i { idris_metavars = idris_metavars i \\ [n] }
207207
208208iputStrLn :: String -> Idris ()
209209iputStrLn = liftIO . putStrLn
@@ -212,164 +212,164 @@ iWarn :: FC -> String -> Idris ()
212212iWarn fc err = liftIO $ putStrLn (show fc ++ ":" ++ err)
213213
214214setLogLevel :: Int -> Idris ()
215−setLogLevel l = do i <- get
215+setLogLevel l = do i <- getIState
216216 let opts = idris_options i
217217 let opt' = opts { opt_logLevel = l }
218− put (i { idris_options = opt' } )
218+ putIState $ i { idris_options = opt' }
219219
220220setCmdLine :: [Opt] -> Idris ()
221−setCmdLine opts = do i <- get
221+setCmdLine opts = do i <- getIState
222222 let iopts = idris_options i
223− put (i { idris_options = iopts { opt_cmdline = opts } })
223+ putIState $ i { idris_options = iopts { opt_cmdline = opts } }
224224
225225getDumpDefun :: Idris (Maybe FilePath)
226−getDumpDefun = do i <- get
226+getDumpDefun = do i <- getIState
227227 return $ findC (opt_cmdline (idris_options i))
228228 where findC [] = Nothing
229229 findC (DumpDefun x : _) = Just x
230230 findC (_ : xs) = findC xs
231231
232232getDumpCases :: Idris (Maybe FilePath)
233−getDumpCases = do i <- get
233+getDumpCases = do i <- getIState
234234 return $ findC (opt_cmdline (idris_options i))
235235 where findC [] = Nothing
236236 findC (DumpCases x : _) = Just x
237237 findC (_ : xs) = findC xs
238238
239239logLevel :: Idris Int
240−logLevel = do i <- get
240+logLevel = do i <- getIState
241241 return (opt_logLevel (idris_options i))
242242
243243setErrContext :: Bool -> Idris ()
244−setErrContext t = do i <- get
244+setErrContext t = do i <- getIState
245245 let opts = idris_options i
246246 let opt' = opts { opt_errContext = t }
247− put (i { idris_options = opt' })
247+ putIState $ i { idris_options = opt' }
248248
249249errContext :: Idris Bool
250−errContext = do i <- get
250+errContext = do i <- getIState
251251 return (opt_errContext (idris_options i))
252252
253253useREPL :: Idris Bool
254−useREPL = do i <- get
254+useREPL = do i <- getIState
255255 return (opt_repl (idris_options i))
256256
257257setREPL :: Bool -> Idris ()
258−setREPL t = do i <- get
258+setREPL t = do i <- getIState
259259 let opts = idris_options i
260260 let opt' = opts { opt_repl = t }
261− put (i { idris_options = opt' })
261+ putIState $ i { idris_options = opt' }
262262
263263setTarget :: Target -> Idris ()
264−setTarget t = do i <- get
264+setTarget t = do i <- getIState
265265 let opts = idris_options i
266266 let opt' = opts { opt_target = t }
267− put (i { idris_options = opt' })
267+ putIState $ i { idris_options = opt' }
268268
269269target :: Idris Target
270−target = do i <- get
270+target = do i <- getIState
271271 return (opt_target (idris_options i))
272272
273273setOutputTy :: OutputType -> Idris ()
274−setOutputTy t = do i <- get
274+setOutputTy t = do i <- getIState
275275 let opts = idris_options i
276276 let opt' = opts { opt_outputTy = t }
277− put (i { idris_options = opt' })
277+ putIState $ i { idris_options = opt' }
278278
279279outputTy :: Idris OutputType
280−outputTy = do i <- get
280+outputTy = do i <- getIState
281281 return $ opt_outputTy $ idris_options i
282282
283283verbose :: Idris Bool
284−verbose = do i <- get
284+verbose = do i <- getIState
285285 return (opt_verbose (idris_options i))
286286
287287setVerbose :: Bool -> Idris ()
288−setVerbose t = do i <- get
288+setVerbose t = do i <- getIState
289289 let opts = idris_options i
290290 let opt' = opts { opt_verbose = t }
291− put (i { idris_options = opt' })
291+ putIState $ i { idris_options = opt' }
292292
293293typeInType :: Idris Bool
294−typeInType = do i <- get
294+typeInType = do i <- getIState
295295 return (opt_typeintype (idris_options i))
296296
297297setTypeInType :: Bool -> Idris ()
298−setTypeInType t = do i <- get
298+setTypeInType t = do i <- getIState
299299 let opts = idris_options i
300300 let opt' = opts { opt_typeintype = t }
301− put (i { idris_options = opt' })
301+ putIState $ i { idris_options = opt' }
302302
303303coverage :: Idris Bool
304−coverage = do i <- get
304+coverage = do i <- getIState
305305 return (opt_coverage (idris_options i))
306306
307307setCoverage :: Bool -> Idris ()
308−setCoverage t = do i <- get
308+setCoverage t = do i <- getIState
309309 let opts = idris_options i
310310 let opt' = opts { opt_coverage = t }
311− put (i { idris_options = opt' })
311+ putIState $ i { idris_options = opt' }
312312
313313setIBCSubDir :: FilePath -> Idris ()
314−setIBCSubDir fp = do i <- get
314+setIBCSubDir fp = do i <- getIState
315315 let opts = idris_options i
316316 let opt' = opts { opt_ibcsubdir = fp }
317− put (i { idris_options = opt' })
317+ putIState $ i { idris_options = opt' }
318318
319319valIBCSubDir :: IState -> Idris FilePath
320320valIBCSubDir i = return (opt_ibcsubdir (idris_options i))
321321
322322addImportDir :: FilePath -> Idris ()
323−addImportDir fp = do i <- get
323+addImportDir fp = do i <- getIState
324324 let opts = idris_options i
325325 let opt' = opts { opt_importdirs = fp : opt_importdirs opts }
326− put (i { idris_options = opt' })
326+ putIState $ i { idris_options = opt' }
327327
328328setImportDirs :: [FilePath] -> Idris ()
329−setImportDirs fps = do i <- get
329+setImportDirs fps = do i <- getIState
330330 let opts = idris_options i
331331 let opt' = opts { opt_importdirs = fps }
332− put (i { idris_options = opt' })
332+ putIState $ i { idris_options = opt' }
333333
334334allImportDirs :: IState -> Idris [FilePath]
335335allImportDirs i = do let optdirs = opt_importdirs (idris_options i)
336336 return ("." : optdirs)
337337
338338impShow :: Idris Bool
339−impShow = do i <- get
339+impShow = do i <- getIState
340340 return (opt_showimp (idris_options i))
341341
342342setImpShow :: Bool -> Idris ()
343−setImpShow t = do i <- get
343+setImpShow t = do i <- getIState
344344 let opts = idris_options i
345345 let opt' = opts { opt_showimp = t }
346− put (i { idris_options = opt' })
346+ putIState $ i { idris_options = opt' }
347347
348348logLvl :: Int -> String -> Idris ()
349−logLvl l str = do i <- get
349+logLvl l str = do i <- getIState
350350 let lvl = opt_logLevel (idris_options i)
351351 when (lvl >= l)
352352 $ do liftIO (putStrLn str)
353− put (i { idris_log = idris_log i ++ str ++ "\n" } )
353+ putIState $ i { idris_log = idris_log i ++ str ++ "\n" }
354354
355355cmdOptType :: Opt -> Idris Bool
356−cmdOptType x = do i <- get
356+cmdOptType x = do i <- getIState
357357 return $ x `elem` opt_cmdline (idris_options i)
358358
359359iLOG :: String -> Idris ()
360360iLOG = logLvl 1
361361
362362noErrors :: Idris Bool
363−noErrors = do i <- get
363+noErrors = do i <- getIState
364364 case errLine i of
365365 Nothing -> return True
366366 _ -> return False
367367
368368setTypeCase :: Bool -> Idris ()
369−setTypeCase t = do i <- get
369+setTypeCase t = do i <- getIState
370370 let opts = idris_options i
371371 let opt' = opts { opt_typecase = t }
372− put (i { idris_options = opt' })
372+ putIState $ i { idris_options = opt' }
373373
374374
375375-- For inferring types of things
@@ -634,8 +634,8 @@ addStatics n tm ptm =
634634 let statics' = nub $ map fst statics ++
635635 filter (\x -> not (elem x dnames)) stnames
636636 let stpos = staticList statics' tm
637− i <- get
638− put (i { idris_statics = addDef n stpos (idris_statics i) })
637+ i <- getIState
638+ putIState $ i { idris_statics = addDef n stpos (idris_statics i) }
639639 addIBC (IBCStatic n)
640640 where
641641 initStatics (Bind n (Pi ty) sc) (PPi p _ _ s)
@@ -659,14 +659,14 @@ implicit syn n ptm = implicit' syn [] n ptm
659659
660660implicit' :: SyntaxInfo -> [Name] -> Name -> PTerm -> Idris PTerm
661661implicit' syn ignore n ptm
662− = do i <- get
662+ = do i <- getIState
663663 let (tm', impdata) = implicitise syn ignore i ptm
664664-- let (tm'', spos) = findStatics i tm'
665− put (i { idris_implicits = addDef n impdata (idris_implicits i) })
665+ putIState $ i { idris_implicits = addDef n impdata (idris_implicits i) }
666666 addIBC (IBCImp n)
667667 logLvl 5 ("Implicit " ++ show n ++ " " ++ show impdata)
668668-- i <- get
669−-- put (i { idris_statics = addDef n spos (idris_statics i) })
669+-- putIState $ i { idris_statics = addDef n spos (idris_statics i) }
670670 return tm'
671671
672672implicitise :: SyntaxInfo -> [Name] -> IState -> PTerm -> (PTerm, [PArg])
src/Idris/AbsSyntaxTree.hs+1−1
@@ -136,7 +136,7 @@ idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext
136136
137137-- The monad for the main REPL - reading and processing files and updating
138138-- global state (hence the IO inner monad).
139−type Idris = StateT IState (InputT IO)
139+type Idris = StateT IState IO
140140
141141-- Commands in the REPL
142142
src/Idris/Completion.hsnew file+143
@@ -0,0 +1,143 @@
1+module Idris.Completion (replCompletion, proverCompletion) where
2+
3+import Core.Evaluate (ctxtAlist)
4+import Core.TT
5+
6+import Idris.AbsSyntaxTree
7+
8+import Control.Monad.State.Strict
9+
10+import Data.List
11+import Data.Maybe
12+
13+import System.Console.Haskeline
14+
15+-- TODO: add specific classes of identifiers to complete, fx metavariables
16+-- | A specification of the arguments that REPL commands can take
17+data CmdArg = ExprArg -- ^ The command takes an expression
18+ | NameArg -- ^ The command takes a name
19+ | FileArg -- ^ The command takes a file
20+ | ModuleArg -- ^ The command takes a module name
21+ | OptionArg -- ^ The command takes an option
22+
23+-- | Information about how to complete the various commands
24+cmdArgs :: [(String, CmdArg)]
25+cmdArgs = [ (":t", ExprArg)
26+ , (":miss", NameArg)
27+ , (":missing", NameArg)
28+ , (":i", NameArg)
29+ , (":info", NameArg)
30+ , (":total", NameArg)
31+ , (":l", FileArg)
32+ , (":load", FileArg)
33+ , (":m", ModuleArg) -- NOTE: Argumentless form is a different command
34+ , (":p", NameArg)
35+ , (":prove", NameArg)
36+ , (":a", NameArg)
37+ , (":addproof", NameArg)
38+ , (":rmproof", NameArg)
39+ , (":showproof", NameArg)
40+ , (":c", FileArg)
41+ , (":compile", FileArg)
42+ , (":js", FileArg)
43+ , (":javascript", FileArg)
44+ , (":set", OptionArg)
45+ , (":unset", OptionArg)
46+ ]
47+commands = map fst cmdArgs
48+
49+-- | A specification of the arguments that tactics can take
50+data TacticArg = NameTArg -- ^ Names: n1, n2, n3, ... n
51+ | ExprTArg
52+ | AltsTArg
53+
54+-- | A list of available tactics and their argument requirements
55+tacticArgs :: [(String, Maybe TacticArg)]
56+tacticArgs = [ ("intro", Nothing)
57+ , ("intros", Nothing)
58+ , ("refine", Just ExprTArg)
59+ , ("rewrite", Just ExprTArg)
60+ , ("let", Nothing) -- FIXME syntax for let
61+ , ("focus", Just ExprTArg)
62+ , ("exact", Just ExprTArg)
63+ , ("reflect", Just ExprTArg)
64+ , ("try", Just AltsTArg)
65+ ] ++ map (\x -> (x, Nothing)) [
66+ "intro", "intros", "compute", "trivial", "solve", "attack",
67+ "state", "term", "undo", "qed", "abandon", ":q"
68+ ]
69+tactics = map fst tacticArgs
70+
71+-- | Convert a name into a string usable for completion. Filters out names
72+-- that users probably don't want to see.
73+nameString :: Name -> Maybe String
74+nameString (UN ('@':_)) = Nothing
75+nameString (UN ('#':_)) = Nothing
76+nameString (UN n) = Just n
77+nameString (NS n _) = nameString n
78+nameString _ = Nothing
79+
80+-- FIXME: Respect module imports
81+-- | Get the user-visible names from the current interpreter state.
82+names :: Idris[String]
83+names = do i <- get
84+ let ctxt = tt_ctxt i
85+ return $ nub $ mapMaybe (nameString . fst) $ ctxtAlist ctxt
86+
87+
88+modules :: Idris [String]
89+modules = do i <- get
90+ return $ map show $ imported i
91+
92+
93+
94+completeWith :: [String] -> String -> [Completion]
95+completeWith ns n = if uniqueExists
96+ then [simpleCompletion n]
97+ else map simpleCompletion prefixMatches
98+ where prefixMatches = filter (isPrefixOf n) ns
99+ uniqueExists = n `elem` prefixMatches
100+
101+completeName :: [String] -> String -> Idris [Completion]
102+completeName extra n = do ns <- names
103+ return $ completeWith (extra ++ ns) n
104+
105+completeExpr :: [String] -> CompletionFunc Idris
106+completeExpr extra = completeWord Nothing " \t" (completeName extra)
107+
108+completeOption :: CompletionFunc Idris
109+completeOption = completeWord Nothing " \t" completeOpt
110+ where completeOpt = return . (completeWith ["errorcontext", "showimplicits"])
111+
112+isWhitespace :: Char -> Bool
113+isWhitespace = (flip elem) " \t\n"
114+
115+-- | Get the completion function for a particular command
116+completeCmd :: String -> CompletionFunc Idris
117+completeCmd cmd (prev, next) = fromMaybe completeCmdName $ fmap completeArg $ lookup cmd cmdArgs
118+ where completeArg FileArg = completeFilename (prev, next)
119+ completeArg NameArg = completeExpr [] (prev, next) -- FIXME only complete one name
120+ completeArg OptionArg = completeOption (prev, next)
121+ completeArg ModuleArg = noCompletion (prev, next) -- FIXME do later
122+ completeArg ExprArg = completeExpr [] (prev, next)
123+ completeCmdName = return $ ("", completeWith commands cmd)
124+
125+replCompletion :: CompletionFunc Idris
126+replCompletion (prev, next) = case firstWord of
127+ ':':cmdName -> completeCmd (':':cmdName) (prev, next)
128+ _ -> completeExpr [] (prev, next)
129+ where firstWord = fst $ break isWhitespace $ dropWhile isWhitespace $ reverse prev
130+
131+
132+completeTactic :: [String] -> String -> CompletionFunc Idris
133+completeTactic as tac (prev, next) = fromMaybe completeTacName $ fmap completeArg $ lookup tac tacticArgs
134+ where completeTacName = return $ ("", completeWith tactics tac)
135+ completeArg Nothing = noCompletion (prev, next)
136+ completeArg (Just NameTArg) = noCompletion (prev, next) -- this is for binding new names!
137+ completeArg (Just ExprTArg) = completeExpr as (prev, next)
138+ completeArg (Just AltsTArg) = noCompletion (prev, next) -- TODO
139+
140+
141+proverCompletion :: [String] -> CompletionFunc Idris
142+proverCompletion assumptions (prev, next) = completeTactic assumptions firstWord (prev, next)
143+ where firstWord = fst $ break isWhitespace $ dropWhile isWhitespace $ reverse prev
src/Idris/Coverage.hs+9−9
@@ -33,23 +33,23 @@ genMissing fn args sc
3333-- covering...)
3434
3535mkPatTm :: PTerm -> Idris Term
36−mkPatTm t = do i <- get
36+mkPatTm t = do i <- getIState
3737 let timp = addImpl' True [] [] i t
3838 evalStateT (toTT timp) 0
3939 where
40− toTT (PRef _ n) = do i <- lift $ get
40+ toTT (PRef _ n) = do i <- lift getIState
4141 case lookupDef Nothing n (tt_ctxt i) of
4242 [TyDecl nt _] -> return $ P nt n Erased
4343 _ -> return $ P Ref n Erased
4444 toTT (PApp _ t args) = do t' <- toTT t
4545 args' <- mapM (toTT . getTm) args
4646 return $ mkApp t' args'
47− toTT _ = do v <- get
47+ toTT _ = do v <- get
4848 put (v + 1)
4949 return (P Bound (MN v "imp") Erased)
5050
5151mkPTerm :: Name -> [TT Name] -> Idris PTerm
52−mkPTerm f args = do i <- get
52+mkPTerm f args = do i <- getIState
5353 let fapp = mkApp (P Bound f Erased) (map eraseName args)
5454 return $ delab i fapp
5555 where eraseName (App f a) = App (eraseName f) (eraseName a)
@@ -90,7 +90,7 @@ dropDefault (c : cs) = c : dropDefault cs
9090dropDefault [] = []
9191
9292expandTree :: SC -> Idris SC
93−expandTree (Case n alts) = do i <- get
93+expandTree (Case n alts) = do i <- getIState
9494 as <- expandAlts i (dropDefault alts)
9595 (getDefault alts)
9696 alts' <- mapM expandTreeA as
@@ -307,7 +307,7 @@ calcProd i fc n pats = do patsprod <- mapM prodRec pats
307307calcTotality :: [Name] -> FC -> Name -> [([Name], Term, Term)]
308308 -> Idris Totality
309309calcTotality path fc n pats
310− = do i <- get
310+ = do i <- getIState
311311 let opts = case lookupCtxt Nothing n (idris_flags i) of
312312 [fs] -> fs
313313 _ -> []
@@ -370,7 +370,7 @@ checkTotality path fc n
370370 totalityError t = tclift $ tfail (At fc (Msg (show n ++ " is " ++ show t)))
371371
372372 warnPartial n t
373− = do i <- get
373+ = do i <- getIState
374374 case lookupDef Nothing n (tt_ctxt i) of
375375 [x] -> do
376376 iputStrLn $ show fc ++ ":Warning - " ++ show n ++ " is " ++ show t
@@ -399,7 +399,7 @@ checkDeclTotality (fc, n)
399399
400400buildSCG :: (FC, Name) -> Idris ()
401401buildSCG (_, n) = do
402− ist <- get
402+ ist <- getIState
403403 case lookupCtxt Nothing n (idris_callgraph ist) of
404404 [cg] -> case lookupDef Nothing n (tt_ctxt ist) of
405405 [CaseOp _ _ _ _ _ args sc _ _] ->
@@ -495,7 +495,7 @@ buildSCG' ist sc args = -- trace ("Building SCG for " ++ show sc) $
495495
496496checkSizeChange :: Name -> Idris Totality
497497checkSizeChange n = do
498− ist <- get
498+ ist <- getIState
499499 case lookupCtxt Nothing n (idris_callgraph ist) of
500500 [cg] -> do let ms = mkMultiPaths ist [] (scg cg)
501501 logLvl 5 ("Multipath for " ++ show n ++ ":\n" ++
src/Idris/ElabDecls.hs+39−39
@@ -44,7 +44,7 @@ elabType info syn doc fc opts n ty' = {- let ty' = piBind (params info) ty_in
4444 n = liftname info n_in in -}
4545 do checkUndefined fc n
4646 ctxt <- getContext
47− i <- get
47+ i <- getIState
4848 logLvl 3 $ show n ++ " pre-type " ++ showImp True ty'
4949 ty' <- implicit syn n ty'
5050 let ty = addImpl i ty'
@@ -91,7 +91,7 @@ elabPostulate info syn doc fc opts n ty
9191 fty <- case lookupTy Nothing n ctxt of
9292 [] -> tclift $ tfail $ (At fc (NoTypeDecl n)) -- can't happen!
9393 [ty] -> return ty
94− ist <- get
94+ ist <- getIState
9595 let (ap, _) = unApply (getRetTy fty)
9696 logLvl 5 $ "Checking collapsibility of " ++ show (ap, fty)
9797 let postOK = case ap of
@@ -110,7 +110,7 @@ elabData info syn doc fc codata (PLaterdecl n t_in)
110110 = do iLOG (show (fc, doc))
111111 checkUndefined fc n
112112 ctxt <- getContext
113− i <- get
113+ i <- getIState
114114 t_in <- implicit syn n t_in
115115 let t = addImpl i t_in
116116 ((t', defer, is), log) <- tclift $ elaborate ctxt n (TType (UVal 0)) []
@@ -126,7 +126,7 @@ elabData info syn doc fc codata (PDatadecl n t_in dcons)
126126 = do iLOG (show fc)
127127 undef <- isUndefined fc n
128128 ctxt <- getContext
129− i <- get
129+ i <- getIState
130130 t_in <- implicit syn n t_in
131131 let t = addImpl i t_in
132132 ((t', defer, is), log) <- tclift $ elaborate ctxt n (TType (UVal 0)) []
@@ -140,11 +140,11 @@ elabData info syn doc fc codata (PDatadecl n t_in dcons)
140140 when undef $ updateContext (addTyDecl n cty)
141141 cons <- mapM (elabCon info syn n codata) dcons
142142 ttag <- getName
143− i <- get
143+ i <- getIState
144144 let as = map (const Nothing) (getArgTys cty)
145145 let params = findParams (zip as (repeat True)) (map snd cons)
146146 logLvl 2 $ "Parameters : " ++ show params
147− put (i { idris_datatypes = addDef n (TI (map fst cons) codata params)
147+ putIState (i { idris_datatypes = addDef n (TI (map fst cons) codata params)
148148 (idris_datatypes i) })
149149 addIBC (IBCDef n)
150150 addIBC (IBCData n)
@@ -188,7 +188,7 @@ elabRecord :: ElabInfo -> SyntaxInfo -> String -> FC -> Name ->
188188elabRecord info syn doc fc tyn ty cdoc cn cty
189189 = do elabData info syn doc fc False (PDatadecl tyn ty [(cdoc, cn, cty, fc)])
190190 cty' <- implicit syn cn cty
191− i <- get
191+ i <- getIState
192192 cty <- case lookupTy Nothing cn (tt_ctxt i) of
193193 [t] -> return (delab i t)
194194 _ -> fail "Something went inexplicably wrong"
@@ -213,13 +213,13 @@ elabRecord info syn doc fc tyn ty cdoc cn cty
213213 isNonImp _ = Nothing
214214
215215 tryElabDecl info (fn, ty, val)
216− = do i <- get
216+ = do i <- getIState
217217 idrisCatch (do elabDecl' EAll info ty
218218 elabDecl' EAll info val)
219219 (\v -> do iputStrLn $ show fc ++
220220 ":Warning - can't generate setter for " ++
221221 show fn ++ " (" ++ show ty ++ ")"
222− put i)
222+ putIState i)
223223
224224 getImplB k (PPi (Imp l s _) n Placeholder sc)
225225 = getImplB k sc
@@ -297,7 +297,7 @@ elabCon :: ElabInfo -> SyntaxInfo -> Name -> Bool ->
297297elabCon info syn tn codata (doc, n, t_in, fc)
298298 = do checkUndefined fc n
299299 ctxt <- getContext
300− i <- get
300+ i <- getIState
301301 t_in <- implicit syn n (if codata then mkLazy t_in else t_in)
302302 let t = addImpl i t_in
303303 logLvl 2 $ show fc ++ ":Constructor " ++ show n ++ " : " ++ showImp True t
@@ -343,7 +343,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
343343 (zip [0..] cs)
344344 -- if the return type of 'ty' is collapsible, the optimised version should
345345 -- just do nothing
346− ist <- get
346+ ist <- getIState
347347 let (ap, _) = unApply (getRetTy fty)
348348 logLvl 5 $ "Checking collapsibility of " ++ show (ap, fty)
349349 -- FIXME: Really ought to only do this for total functions!
@@ -354,17 +354,17 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
354354 _ -> False
355355 _ -> False
356356 solveDeferred n
357− ist <- get
357+ ist <- getIState
358358 when doNothing $
359359 case lookupCtxt Nothing n (idris_optimisation ist) of
360360 [oi] -> do let opts = addDef n (oi { collapsible = True })
361361 (idris_optimisation ist)
362− put (ist { idris_optimisation = opts })
362+ putIState (ist { idris_optimisation = opts })
363363 _ -> do let opts = addDef n (Optimise True [] [])
364364 (idris_optimisation ist)
365− put (ist { idris_optimisation = opts })
365+ putIState (ist { idris_optimisation = opts })
366366 addIBC (IBCOpt n)
367− ist <- get
367+ ist <- getIState
368368 let pats = pats_in
369369 -- logLvl 3 (showSep "\n" (map (\ (l,r) ->
370370 -- show l ++ " = " ++
@@ -401,7 +401,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
401401 pdef' <- applyOpts optpdef
402402 logLvl 2 $ "Optimised patterns"
403403 logLvl 5 $ show pdef'
404− ist <- get
404+ ist <- getIState
405405 -- let wf = wellFounded ist n sc
406406 let tot = if pcover || AssertTotal `elem` opts
407407 then Unchecked -- finish checking later
@@ -425,8 +425,8 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
425425 logLvl 3 (show tree)
426426 logLvl 3 $ "Optimised: " ++ show tree'
427427 ctxt <- getContext
428− ist <- get
429− put (ist { idris_patdefs = addDef n pdef' (idris_patdefs ist) })
428+ ist <- getIState
429+ putIState (ist { idris_patdefs = addDef n pdef' (idris_patdefs ist) })
430430 case lookupTy (namespace info) n ctxt of
431431 [ty] -> do updateContext (addCasedef n (inlinable opts)
432432 tcase knowncovering
@@ -437,7 +437,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
437437 setTotality n tot
438438 totcheck (fc, n)
439439 when (tot /= Unchecked) $ addIBC (IBCTotal n tot)
440− i <- get
440+ i <- getIState
441441 case lookupDef Nothing n (tt_ctxt i) of
442442 (CaseOp _ _ _ _ _ scargs sc scargs' sc' : _) ->
443443 do let calls = findCalls sc' scargs'
@@ -485,7 +485,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
485485elabVal :: ElabInfo -> Bool -> PTerm -> Idris (Term, Type)
486486elabVal info aspat tm_in
487487 = do ctxt <- getContext
488− i <- get
488+ i <- getIState
489489 let tm = addImpl i tm_in
490490 logLvl 10 (showImp True tm)
491491 -- try:
@@ -510,7 +510,7 @@ elabVal info aspat tm_in
510510checkPossible :: ElabInfo -> FC -> Bool -> Name -> PTerm -> Idris Bool
511511checkPossible info fc tcgen fname lhs_in
512512 = do ctxt <- getContext
513− i <- get
513+ i <- getIState
514514 let lhs = addImpl i lhs_in
515515 -- if the LHS type checks, it is possible
516516 case elaborate ctxt (MN 0 "patLHS") infP []
@@ -537,7 +537,7 @@ elabClause info tcgen (cnum, PClause fc fname lhs_in withs rhs_in whereblock)
537537 = do ctxt <- getContext
538538 -- Build the LHS as an "Infer", and pull out its type and
539539 -- pattern bindings
540− i <- get
540+ i <- getIState
541541 -- get the parameters first, to pass through to any where block
542542 let fn_ty = case lookupTy Nothing fname (tt_ctxt i) of
543543 [t] -> t
@@ -575,7 +575,7 @@ elabClause info tcgen (cnum, PClause fc fname lhs_in withs rhs_in whereblock)
575575 logLvl 5 $ "Where block:\n " ++ show wbefore ++ "\n" ++ show wafter
576576 mapM_ (elabDecl' EAll info) wbefore
577577 -- Now build the RHS, using the type of the LHS as the goal.
578− i <- get -- new implicits from where block
578+ i <- getIState -- new implicits from where block
579579 logLvl 5 (showImp True (expandParams decorate newargs defs (defs \\ decls) rhs_in))
580580 let rhs = addImplBoundInf i (map fst newargs) (defs \\ decls)
581581 (expandParams decorate newargs defs (defs \\ decls) rhs_in)
@@ -609,7 +609,7 @@ elabClause info tcgen (cnum, PClause fc fname lhs_in withs rhs_in whereblock)
609609 case converts ctxt [] clhsty crhsty of
610610 OK _ -> return ()
611611 Error e -> ierror (At fc (CantUnify False clhsty crhsty e [] 0))
612− i <- get
612+ i <- getIState
613613 checkInferred fc (delab' i crhs True) rhs
614614 return $ Right (clhs, crhs)
615615 where
@@ -678,7 +678,7 @@ elabClause info tcgen (_, PWith fc fname lhs_in withs wval_in withblock)
678678 = do ctxt <- getContext
679679 -- Build the LHS as an "Infer", and pull out its type and
680680 -- pattern bindings
681− i <- get
681+ i <- getIState
682682 let lhs = addImpl i lhs_in
683683 logLvl 5 ("LHS: " ++ showImp True lhs)
684684 ((lhs', dlhs, []), _) <-
@@ -731,7 +731,7 @@ elabClause info tcgen (_, PWith fc fname lhs_in withs wval_in withblock)
731731 logLvl 3 ("New function type " ++ show wtype)
732732 let wname = MN windex (show fname)
733733 let imps = getImps wtype -- add to implicits context
734− put (i { idris_implicits = addDef wname imps (idris_implicits i) })
734+ putIState (i { idris_implicits = addDef wname imps (idris_implicits i) })
735735 addIBC (IBCDef wname)
736736 def' <- checkDef fc [(wname, wtype)]
737737 addDeferred def'
@@ -751,7 +751,7 @@ elabClause info tcgen (_, PWith fc fname lhs_in withs wval_in withblock)
751751 (map (pexp . (PRef fc) . fst) bargs_post))
752752 logLvl 5 ("New RHS " ++ showImp True rhs)
753753 ctxt <- getContext -- New context with block added
754− i <- get
754+ i <- getIState
755755 ((rhs', defer, is), _) <-
756756 tclift $ elaborate ctxt (MN 0 "wpatRHS") clhsty []
757757 (do pbinds lhs_tm
@@ -776,7 +776,7 @@ elabClause info tcgen (_, PWith fc fname lhs_in withs wval_in withblock)
776776 mkAuxC wname lhs ns ns' d = return $ d
777777
778778 mkAux wname toplhs ns ns' (PClause fc n tm_in (w:ws) rhs wheres)
779− = do i <- get
779+ = do i <- getIState
780780 let tm = addImpl i tm_in
781781 logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++
782782 showImp True toplhs)
@@ -787,7 +787,7 @@ elabClause info tcgen (_, PWith fc fname lhs_in withs wval_in withblock)
787787 lhs <- updateLHS n wname mvars ns ns' (fullApp tm) w
788788 return $ PClause fc wname lhs ws rhs wheres
789789 mkAux wname toplhs ns ns' (PWith fc n tm_in (w:ws) wval withs)
790− = do i <- get
790+ = do i <- getIState
791791 let tm = addImpl i tm_in
792792 logLvl 2 ("Matching " ++ showImp True tm ++ " against " ++
793793 showImp True toplhs)
@@ -864,7 +864,7 @@ elabClass info syn doc fc constraints tn ps ds
864864 mapM_ (elabDecl EAll info) (concat fns)
865865 -- add the default definitions
866866 mapM_ (elabDecl EAll info) (concat (map (snd.snd) defs))
867− i <- get
867+ i <- getIState
868868 addIBC (IBCClass tn)
869869 where
870870 nodoc (n, (_, o, t)) = (n, (o, t))
@@ -918,7 +918,7 @@ elabClass info syn doc fc constraints tn ps ds
918918 let ty = PPi constraint (MN 0 "pc") c con
919919 iLOG (showImp True ty)
920920 iLOG (showImp True lhs ++ " = " ++ showImp True rhs)
921− i <- get
921+ i <- getIState
922922 let conn = case con of
923923 PRef _ n -> n
924924 PApp _ (PRef _ n) _ -> n
@@ -982,7 +982,7 @@ elabInstance :: ElabInfo -> SyntaxInfo ->
982982 Maybe Name -> -- explicit name
983983 [PDecl] -> Idris ()
984984elabInstance info syn fc cs n ps t expn ds
985− = do i <- get
985+ = do i <- getIState
986986 (n, ci) <- case lookupCtxtName (namespace info) n (idris_classes i) of
987987 [c] -> return c
988988 _ -> fail $ show fc ++ ":" ++ show n ++ " is not a type class"
@@ -1137,7 +1137,7 @@ elabInstance info syn fc cs n ps t expn ds
11371137 let ty = PPi constraint (MN 0 "pc") c con
11381138 iLOG (showImp True ty)
11391139 iLOG (showImp True lhs ++ " = " ++ showImp True rhs)
1140− i <- get
1140+ i <- getIState
11411141 let conn = case con of
11421142 PRef _ n -> n
11431143 PApp _ (PRef _ n) _ -> n
@@ -1214,7 +1214,7 @@ elabDecl' what info (PData doc s f co d)
12141214elabDecl' what info d@(PClauses f o n ps)
12151215 | what /= ETypes
12161216 = do iLOG $ "Elaborating clause " ++ show n
1217− i <- get -- get the type options too
1217+ i <- getIState -- get the type options too
12181218 let o' = case lookupCtxt Nothing n (idris_flags i) of
12191219 [fs] -> fs
12201220 [] -> []
@@ -1223,7 +1223,7 @@ elabDecl' what info (PMutual f ps)
12231223 = do mapM_ (elabDecl ETypes info) ps
12241224 mapM_ (elabDecl EDefns info) ps
12251225elabDecl' what info (PParams f ns ps)
1226− = do i <- get
1226+ = do i <- getIState
12271227 iLOG $ "Expanding params block with " ++ show ns ++ " decls " ++
12281228 show (concatMap tldeclared ps)
12291229 let nblock = pblock i
@@ -1256,8 +1256,8 @@ elabDecl' what info (PRecord doc s f tyn ty cdoc cn cty)
12561256 = do iLOG $ "Elaborating record " ++ show tyn
12571257 elabRecord info s doc f tyn ty cdoc cn cty
12581258elabDecl' _ info (PDSL n dsl)
1259− = do i <- get
1260− put (i { idris_dsls = addDef n dsl (idris_dsls i) })
1259+ = do i <- getIState
1260+ putIState (i { idris_dsls = addDef n dsl (idris_dsls i) })
12611261 addIBC (IBCDSL n)
12621262elabDecl' what info (PDirective i)
12631263 | what /= EDefns = i
@@ -1279,7 +1279,7 @@ checkInferred fc inf user =
12791279 do logLvl 6 $ "Checked to\n" ++ showImp True inf ++ "\n\nFROM\n\n" ++
12801280 showImp True user
12811281 logLvl 10 $ "Checking match"
1282− i <- get
1282+ i <- getIState
12831283 tclift $ case matchClause' True i user inf of
12841284 Right vs -> return ()
12851285 Left (x, y) -> tfail $ At fc
@@ -1293,7 +1293,7 @@ checkInferred fc inf user =
12931293
12941294inferredDiff :: FC -> PTerm -> PTerm -> Idris Bool
12951295inferredDiff fc inf user =
1296− do i <- get
1296+ do i <- getIState
12971297 logLvl 6 $ "Checked to\n" ++ showImp True inf ++ "\n" ++
12981298 showImp True user
12991299 tclift $ case matchClause' True i user inf of
src/Idris/Error.hs+3−3
@@ -20,7 +20,7 @@ import Data.Typeable
2020iucheck :: Idris ()
2121iucheck = do tit <- typeInType
2222 when (not tit) $
23− do ist <- get
23+ do ist <- getIState
2424 idrisCatch (tclift $ ucheck (idris_constraints ist))
2525 (\e -> do let msg = show e
2626 setErrLine (getErrLine msg)
@@ -46,13 +46,13 @@ ifail :: String -> Idris ()
4646ifail str = throwIO (IErr str)
4747
4848ierror :: Err -> Idris ()
49−ierror err = do i <- get
49+ierror err = do i <- getIState
5050 throwIO (IErr $ pshow i err)
5151
5252tclift :: TC a -> Idris a
5353tclift tc = case tc of
5454 OK v -> return v
55− Error err -> do i <- get
55+ Error err -> do i <- getIState
5656 case err of
5757 At (FC f l) e -> setErrLine l
5858 _ -> return ()
src/Idris/Parser.hs+12−11
@@ -63,12 +63,13 @@ fixErrorMsg msg fixes = msg ++ ", possible fixes:\n" ++ (concat $ intersperse "\
6363loadModule :: FilePath -> Idris String
6464loadModule f
6565 = idrisCatch (do i <- getIState
66+ let file = takeWhile (/= ' ') f
6667 ibcsd <- valIBCSubDir i
6768 ids <- allImportDirs i
68− fp <- liftIO $ findImport ids ibcsd f
69− if f `elem` imported i
70− then iLOG $ "Already read " ++ f
71− else do putIState (i { imported = f : imported i })
69+ fp <- liftIO $ findImport ids ibcsd file
70+ if file `elem` imported i
71+ then iLOG $ "Already read " ++ file
72+ else do putIState (i { imported = file : imported i })
7273 case fp of
7374 IDR fn -> loadSource False fn
7475 LIDR fn -> loadSource True fn
@@ -78,7 +79,7 @@ loadModule f
7879 case src of
7980 IDR sfn -> loadSource False sfn
8081 LIDR sfn -> loadSource True sfn)
81− let (dir, fh) = splitFileName f
82+ let (dir, fh) = splitFileName file
8283 return (dropExtension fh))
8384 (\e -> do let msg = show e
8485 setErrLine (getErrLine msg)
@@ -110,7 +111,7 @@ loadSource lidr f
110111 v <- verbose
111112 when v $ iputStrLn $ "Type checking " ++ f
112113 elabDecls toplevel ds
113− i <- get
114+ i <- getIState
114115 -- simplify every definition do give the totality checker
115116 -- a better chance
116117 mapM_ (\n -> do logLvl 5 $ "Simplifying " ++ show n
@@ -118,7 +119,7 @@ loadSource lidr f
118119 (map snd (idris_totcheck i))
119120 -- build size change graph from simplified definitions
120121 iLOG "Totality checking"
121− i <- get
122+ i <- getIState
122123 mapM_ buildSCG (idris_totcheck i)
123124 mapM_ checkDeclTotality (idris_totcheck i)
124125 iLOG ("Finished " ++ f)
@@ -162,7 +163,7 @@ parseTac i = runParser (do t <- pTactic defaultSyntax
162163
163164parseImports :: FilePath -> String -> Idris ([String], [String], String, SourcePos)
164165parseImports fname input
165− = do i <- get
166+ = do i <- getIState
166167 case runParser (do whiteSpace
167168 mname <- pHeader
168169 ps <- many pImport
@@ -170,7 +171,7 @@ parseImports fname input
170171 pos <- getPosition
171172 return ((mname, ps, rest, pos), i)) i fname input of
172173 Left err -> fail (show err)
173− Right (x, i) -> do put i
174+ Right (x, i) -> do putIState i
174175 return x
175176
176177pHeader :: IParser [String]
@@ -275,7 +276,7 @@ pImport = do reserved "import"; f <- identifier; option ';' (lchar ';')
275276parseProg :: SyntaxInfo -> FilePath -> String -> SourcePos ->
276277 Idris [PDecl]
277278parseProg syn fname input pos
278− = do i <- get
279+ = do i <- getIState
279280 case runParser (do setPosition pos
280281 whiteSpace
281282 ps <- many (pDecl syn)
@@ -284,7 +285,7 @@ parseProg syn fname input pos
284285 return (concat ps, i')) i fname input of
285286 Left err -> do iputStrLn (show err)
286287 return []
287− Right (x, i) -> do put i
288+ Right (x, i) -> do putIState i
288289 return (collect x)
289290
290291-- Collect PClauses with the same function name
src/Idris/Prover.hs+30−13
@@ -13,8 +13,10 @@ import Idris.ElabTerm
1313import Idris.Parser
1414import Idris.Error
1515import Idris.DataOpts
16+import Idris.Completion
1617
1718import System.Console.Haskeline
19+import System.Console.Haskeline.History
1820import Control.Monad.State
1921
2022import Util.Pretty
@@ -22,7 +24,7 @@ import Util.Pretty
2224prover :: Bool -> Name -> Idris ()
2325prover lit x =
2426 do ctxt <- getContext
25− i <- get
27+ i <- getIState
2628 case lookupTy Nothing x ctxt of
2729 [t] -> if elem x (idris_metavars i)
2830 then prove ctxt lit x t
@@ -37,15 +39,23 @@ showProof lit n ps
3739 where bird = if lit then "> " else ""
3840 break = "\n" ++ bird
3941
42+proverSettings :: ElabState [PDecl] -> Settings Idris
43+proverSettings e = setComplete (proverCompletion assumptionNames) defaultSettings
44+ where assumptionNames = case envAtFocus (proof e) of
45+ OK env -> names env
46+ names [] = []
47+ names ((MN _ _, _) : bs) = names bs
48+ names ((n, _) : bs) = show n : names bs
49+
4050prove :: Context -> Bool -> Name -> Type -> Idris ()
4151prove ctxt lit n ty
42− = do let ps = initElaborator n ctxt ty
43− (tm, prf) <- ploop True ("-" ++ show n) [] (ES (ps, []) "" Nothing)
52+ = do let ps = initElaborator n ctxt ty
53+ (tm, prf) <- ploop True ("-" ++ show n) [] (ES (ps, []) "" Nothing) Nothing
4454 iLOG $ "Adding " ++ show tm
4555 iputStrLn $ showProof lit n prf
46− i <- get
56+ i <- getIState
4757 let proofs = proof_list i
48− put (i { proof_list = (n, prf) : proofs })
58+ putIState (i { proof_list = (n, prf) : proofs })
4959 let tree = simpleCase False True CompileTime (FC "proof" 0) [([], P Ref n ty, tm)]
5060 logLvl 3 (show tree)
5161 (ptm, pty) <- recheckC (FC "proof" 0) [] tm
@@ -58,7 +68,7 @@ prove ctxt lit n ty
5868elabStep :: ElabState [PDecl] -> ElabD a -> Idris (a, ElabState [PDecl])
5969elabStep st e = do case runStateT e st of
6070 OK (a, st') -> return (a, st')
61− Error a -> do i <- get
71+ Error a -> do i <- getIState
6272 fail (pshow i a)
6373
6474dumpState :: IState -> ProofState -> IO ()
@@ -108,18 +118,25 @@ lifte :: ElabState [PDecl] -> ElabD a -> Idris a
108118lifte st e = do (v, _) <- elabStep st e
109119 return v
110120
111−ploop :: Bool -> String -> [String] -> ElabState [PDecl] -> Idris (Term, [String])
112−ploop d prompt prf e
113− = do i <- get
121+ploop :: Bool -> String -> [String] -> ElabState [PDecl] -> Maybe History -> Idris (Term, [String])
122+ploop d prompt prf e h
123+ = do i <- getIState
114124 when d $ liftIO $ dumpState i (proof e)
115− x <- lift $ getInputLine (prompt ++ "> ")
125+ (x, h') <- runInputT (proverSettings e) $
126+ -- Manually track the history so that we can use the proof state
127+ do _ <- case h of
128+ Just history -> putHistory history
129+ Nothing -> return ()
130+ l <- getInputLine (prompt ++ "> ")
131+ h' <- getHistory
132+ return (l, Just h')
116133 (cmd, step) <- case x of
117134 Nothing -> fail "Abandoned"
118135 Just input -> do return (parseTac i input, input)
119136 case cmd of
120137 Right Abandon -> fail "Abandoned"
121138 _ -> return ()
122− (d, st, done, prf') <- idrisCatch
139+ (d, st, done, prf') <- idrisCatch
123140 (case cmd of
124141 Left err -> do iputStrLn (show err)
125142 return (False, e, False, prf)
@@ -140,7 +157,7 @@ ploop d prompt prf e
140157 return (True, st, False, prf ++ [step]))
141158 (\err -> do iputStrLn (show err)
142159 return (False, e, False, prf))
143− if done then do (tm, _) <- elabStep st get_term
160+ if done then do (tm, _) <- elabStep st get_term
144161 return (tm, prf')
145− else ploop d prompt prf' st
162+ else ploop d prompt prf' st h'
146163
src/Idris/REPL.hs+51−46
@@ -16,6 +16,7 @@ import Idris.Primitives
1616import Idris.Coverage
1717import Idris.UnusedArgs
1818import Idris.Docs
19+import Idris.Completion
1920
2021import Paths_idris
2122import Util.System
@@ -49,23 +50,23 @@ import Data.List
4950import Data.Char
5051import Data.Version
5152
52−repl :: IState -> [FilePath] -> Idris ()
53+repl :: IState -> [FilePath] -> InputT Idris ()
5354repl orig mods
5455 = H.catch
5556 (do let prompt = mkPrompt mods
56− x <- lift $ getInputLine (prompt ++ "> ")
57+ x <- getInputLine (prompt ++ "> ")
5758 case x of
58− Nothing -> do iputStrLn "Bye bye"
59+ Nothing -> do lift $ iputStrLn "Bye bye"
5960 return ()
6061 Just input -> H.catch
61− (do ms <- processInput input orig mods
62+ (do ms <- lift $ processInput input orig mods
6263 case ms of
6364 Just mods -> repl orig mods
6465 Nothing -> return ())
6566 ctrlC)
6667 ctrlC
67− where ctrlC :: SomeException -> Idris ()
68− ctrlC e = do iputStrLn (show e)
68+ where ctrlC :: SomeException -> InputT Idris ()
69+ ctrlC e = do lift $ iputStrLn (show e)
6970 repl orig mods
7071
7172mkPrompt [] = "Idris"
@@ -78,7 +79,7 @@ lit f = case splitExtension f of
7879
7980processInput :: String -> IState -> [FilePath] -> Idris (Maybe [FilePath])
8081processInput cmd orig inputs
81− = do i <- get
82+ = do i <- getIState
8283 let fn = case inputs of
8384 (f:_) -> f
8485 _ -> ""
@@ -86,12 +87,12 @@ processInput cmd orig inputs
8687 Left err -> do liftIO $ print err
8788 return (Just inputs)
8889 Right Reload ->
89− do put (orig { idris_options = idris_options i })
90+ do putIState (orig { idris_options = idris_options i })
9091 clearErr
9192 mods <- mapM loadModule inputs
9293 return (Just inputs)
9394 Right (Load f) ->
94− do put (orig { idris_options = idris_options i })
95+ do putIState (orig { idris_options = idris_options i })
9596 clearErr
9697 mod <- loadModule f
9798 return (Just [f])
@@ -111,7 +112,7 @@ processInput cmd orig inputs
111112
112113resolveProof :: Name -> Idris Name
113114resolveProof n'
114− = do i <- get
115+ = do i <- getIState
115116 ctxt <- getContext
116117 n <- case lookupNames Nothing n' ctxt of
117118 [x] -> return x
@@ -121,15 +122,15 @@ resolveProof n'
121122
122123removeProof :: Name -> Idris ()
123124removeProof n =
124− do i <- get
125+ do i <- getIState
125126 let proofs = proof_list i
126127 let ps = filter ((/= n) . fst) proofs
127− put $ i { proof_list = ps }
128+ putIState $ i { proof_list = ps }
128129
129130edit :: FilePath -> IState -> Idris ()
130131edit "" orig = iputStrLn "Nothing to edit"
131132edit f orig
132− = do i <- get
133+ = do i <- getIState
133134 env <- liftIO $ getEnvironment
134135 let editor = getEditor env
135136 let line = case errLine i of
@@ -138,7 +139,7 @@ edit f orig
138139 let cmd = editor ++ line ++ f
139140 liftIO $ system cmd
140141 clearErr
141− put (orig { idris_options = idris_options i })
142+ putIState (orig { idris_options = idris_options i })
142143 loadModule f
143144 iucheck
144145 return ()
@@ -149,7 +150,7 @@ edit f orig
149150
150151proofs :: IState -> Idris ()
151152proofs orig
152− = do i <- get
153+ = do i <- getIState
153154 let ps = proof_list i
154155 case ps of
155156 [] -> iputStrLn "No proofs available"
@@ -166,7 +167,7 @@ process fn Help = iputStrLn displayHelp
166167process fn (Eval t)
167168 = do (tm, ty) <- elabVal toplevel False t
168169 ctxt <- getContext
169− ist <- get
170+ ist <- getIState
170171 let tm' = normaliseAll ctxt [] tm
171172 let ty' = normaliseAll ctxt [] ty
172173 logLvl 3 $ "Raw: " ++ show (tm', ty')
@@ -186,7 +187,7 @@ process fn (ExecVal t)
186187 where fc = FC "(input)" 0
187188process fn (Check (PRef _ n))
188189 = do ctxt <- getContext
189− ist <- get
190+ ist <- getIState
190191 imp <- impShow
191192 case lookupTy Nothing n ctxt of
192193 ts@(_:_) -> mapM_ (\t -> iputStrLn $ show n ++ " : " ++
@@ -194,20 +195,20 @@ process fn (Check (PRef _ n))
194195 [] -> iputStrLn $ "No such variable " ++ show n
195196process fn (Check t) = do (tm, ty) <- elabVal toplevel False t
196197 ctxt <- getContext
197− ist <- get
198+ ist <- getIState
198199 imp <- impShow
199200 let ty' = normaliseC ctxt [] ty
200201 iputStrLn (showImp imp (delab ist tm) ++ " : " ++
201202 showImp imp (delab ist ty))
202203
203−process fn (DocStr n) = do i <- get
204+process fn (DocStr n) = do i <- getIState
204205 case lookupCtxtName Nothing n (idris_docstrings i) of
205206 [] -> iputStrLn $ "No documentation for " ++ show n
206207 ns -> mapM_ showDoc ns
207208 where showDoc (n, d)
208209 = do doc <- getDocs n
209210 iputStrLn $ show doc
210−process fn Universes = do i <- get
211+process fn Universes = do i <- getIState
211212 let cs = idris_constraints i
212213-- iputStrLn $ showSep "\n" (map show cs)
213214 liftIO $ print (map fst cs)
@@ -216,7 +217,7 @@ process fn Universes = do i <- get
216217 case ucheck cs of
217218 Error e -> iputStrLn $ pshow i e
218219 OK _ -> iputStrLn "Universes OK"
219−process fn (Defn n) = do i <- get
220+process fn (Defn n) = do i <- getIState
220221 iputStrLn "Compiled patterns:\n"
221222 liftIO $ print (lookupDef Nothing n (tt_ctxt i))
222223 case lookupCtxt Nothing n (idris_patdefs i) of
@@ -230,12 +231,12 @@ process fn (Defn n) = do i <- get
230231 = do liftIO $ putStr $ showImp True (delab i lhs)
231232 liftIO $ putStr " = "
232233 liftIO $ putStrLn $ showImp True (delab i rhs)
233−process fn (TotCheck n) = do i <- get
234+process fn (TotCheck n) = do i <- getIState
234235 case lookupTotal n (tt_ctxt i) of
235236 [t] -> iputStrLn (showTotal t i)
236237 _ -> return ()
237238process fn (DebugInfo n)
238− = do i <- get
239+ = do i <- getIState
239240 let oi = lookupCtxtName Nothing n (idris_optimisation i)
240241 when (not (null oi)) $ iputStrLn (show oi)
241242 let si = lookupCtxt Nothing n (idris_statics i)
@@ -247,25 +248,25 @@ process fn (DebugInfo n)
247248 do print (head d)
248249 let cg = lookupCtxtName Nothing n (idris_callgraph i)
249250 findUnusedArgs (map fst cg)
250− i <- get
251+ i <- getIState
251252 let cg' = lookupCtxtName Nothing n (idris_callgraph i)
252253 sc <- checkSizeChange n
253254 iputStrLn $ "Size change: " ++ show sc
254255 when (not (null cg')) $ do iputStrLn "Call graph:\n"
255256 iputStrLn (show cg')
256−process fn (Info n) = do i <- get
257+process fn (Info n) = do i <- getIState
257258 case lookupCtxt Nothing n (idris_classes i) of
258259 [c] -> classInfo c
259260 _ -> iputStrLn "Not a class"
260261process fn (Search t) = iputStrLn "Not implemented"
261262process fn (Spec t) = do (tm, ty) <- elabVal toplevel False t
262263 ctxt <- getContext
263− ist <- get
264+ ist <- getIState
264265 let tm' = simplify ctxt True [] {- (idris_statics ist) -} tm
265266 iputStrLn (show (delab ist tm'))
266267
267268process fn (RmProof n')
268− = do i <- get
269+ = do i <- getIState
269270 n <- resolveProof n'
270271 let proofs = proof_list i
271272 case lookup n proofs of
@@ -276,15 +277,15 @@ process fn (RmProof n')
276277 where
277278 insertMetavar :: Name -> Idris ()
278279 insertMetavar n =
279− do i <- get
280+ do i <- getIState
280281 let ms = idris_metavars i
281− put $ i { idris_metavars = n : ms }
282+ putIState $ i { idris_metavars = n : ms }
282283
283284process fn (AddProof prf)
284285 = do let fb = fn ++ "~"
285286 liftIO $ copyFile fn fb -- make a backup in case something goes wrong!
286287 prog <- liftIO $ readFile fb
287− i <- get
288+ i <- getIState
288289 let proofs = proof_list i
289290 n' <- case prf of
290291 Nothing -> case proofs of
@@ -301,7 +302,7 @@ process fn (AddProof prf)
301302 where ls = (lines prog)
302303
303304process fn (ShowProof n')
304− = do i <- get
305+ = do i <- getIState
305306 n <- resolveProof n'
306307 let proofs = proof_list i
307308 case lookup n proofs of
@@ -310,26 +311,26 @@ process fn (ShowProof n')
310311
311312process fn (Prove n')
312313 = do ctxt <- getContext
313− ist <- get
314+ ist <- getIState
314315 n <- case lookupNames Nothing n' ctxt of
315316 [x] -> return x
316317 [] -> return n'
317318 ns -> fail $ pshow ist (CantResolveAlts (map show ns))
318319 prover (lit fn) n
319320 -- recheck totality
320− i <- get
321+ i <- getIState
321322 totcheck (FC "(input)" 0, n)
322323 mapM_ (\ (f,n) -> setTotality n Unchecked) (idris_totcheck i)
323324 mapM_ checkDeclTotality (idris_totcheck i)
324325
325326process fn (HNF t) = do (tm, ty) <- elabVal toplevel False t
326327 ctxt <- getContext
327− ist <- get
328+ ist <- getIState
328329 let tm' = hnf ctxt [] tm
329330 iputStrLn (show (delab ist tm'))
330−process fn TTShell = do ist <- get
331+process fn TTShell = do ist <- getIState
331332 let shst = initState (tt_ctxt ist)
332− shst' <- lift $ runShell shst
333+ runShell shst
333334 return ()
334335process fn Execute = do (m, _) <- elabVal toplevel False
335336 (PApp fc
@@ -361,7 +362,7 @@ process fn (Pattelab t)
361362 = do (tm, ty) <- elabVal toplevel True t
362363 iputStrLn $ show tm ++ "\n\n : " ++ show ty
363364
364−process fn (Missing n) = do i <- get
365+process fn (Missing n) = do i <- getIState
365366 case lookupDef Nothing n (tt_ctxt i) of
366367 [CaseOp _ _ _ _ _ args t _ _]
367368 -> do tms <- genMissing n args t
@@ -369,7 +370,7 @@ process fn (Missing n) = do i <- get
369370 [] -> iputStrLn $ show n ++ " undefined"
370371 _ -> iputStrLn $ "Ambiguous name"
371372process fn Metavars
372− = do ist <- get
373+ = do ist <- getIState
373374 let mvs = idris_metavars ist \\ primDefs
374375 case mvs of
375376 [] -> iputStrLn "No global metavariables to solve"
@@ -396,7 +397,7 @@ dumpMethod :: (Name, (FnOpts, PTerm)) -> Idris ()
396397dumpMethod (n, (_, t)) = iputStrLn $ show n ++ " : " ++ show t
397398
398399dumpInstance :: Name -> Idris ()
399−dumpInstance n = do i <- get
400+dumpInstance n = do i <- getIState
400401 ctxt <- getContext
401402 imp <- impShow
402403 case lookupTy Nothing n ctxt of
@@ -489,12 +490,16 @@ help =
489490 ([":q",":quit"], "", "Exit the Idris system")
490491 ]
491492
493+
494+replSettings :: Settings Idris
495+replSettings = setComplete replCompletion defaultSettings
496+
492497-- invoke as if from command line
493498idris :: [Opt] -> IO IState
494−idris opts = runInputT defaultSettings $ execStateT (idrisMain opts) idrisInit
499+idris opts = execStateT (idrisMain opts) idrisInit
495500
496501idrisMain :: [Opt] -> Idris ()
497−idrisMain opts =
502+idrisMain opts =
498503 do let inputs = opt getFile opts
499504 let runrepl = not (NoREPL `elem` opts)
500505 let output = opt getOutput opts
@@ -510,8 +515,8 @@ idrisMain opts =
510515 let tgt = case opt getTarget opts of
511516 [] -> ViaC
512517 xs -> last xs
513− when (DefaultTotal `elem` opts) $ do i <- get
514− put (i { default_total = True })
518+ when (DefaultTotal `elem` opts) $ do i <- getIState
519+ putIState (i { default_total = True })
515520 setREPL runrepl
516521 setVerbose runrepl
517522 setCmdLine opts
@@ -536,8 +541,8 @@ idrisMain opts =
536541 elabPrims
537542 when (not (NoPrelude `elem` opts)) $ do x <- loadModule "Prelude"
538543 return ()
539− when runrepl $ iputStrLn banner
540− ist <- get
544+ when runrepl $ iputStrLn banner
545+ ist <- getIState
541546 mods <- mapM loadModule inputs
542547 ok <- noErrors
543548 when ok $ case output of
@@ -546,7 +551,7 @@ idrisMain opts =
546551 when ok $ case newoutput of
547552 [] -> return ()
548553 (o:_) -> process "" (NewCompile o)
549− when runrepl $ repl ist inputs
554+ when runrepl $ runInputT replSettings $ repl ist inputs
550555 ok <- noErrors
551556 when (not ok) $ liftIO (exitWith (ExitFailure 1))
552557 where
src/Idris/UnusedArgs.hs+2−2
@@ -14,7 +14,7 @@ findUnusedArgs ns = mapM_ traceUnused ns
1414
1515traceUnused :: Name -> Idris ()
1616traceUnused n
17− = do i <- get
17+ = do i <- getIState
1818 case lookupCtxt Nothing n (idris_callgraph i) of
1919 [CGInfo args calls scg usedns _] ->
2020 do let argpos = zip args [0..]
@@ -38,7 +38,7 @@ used path g j
3838 | (g, j) `elem` path = return False -- cycle, never used on the way
3939 | otherwise
4040 = do logLvl 5 $ (show ((g, j) : path))
41− i <- get
41+ i <- getIState
4242 case lookupCtxt Nothing g (idris_callgraph i) of
4343 [CGInfo args calls scg usedns unused] ->
4444 if (j >= length args)
src/Main.hs+1−1
@@ -39,7 +39,7 @@ import Paths_idris
3939
4040main = do xs <- getArgs
4141 let opts = parseArgs xs
42− runInputT defaultSettings $ execStateT (runIdris opts) idrisInit
42+ execStateT (runIdris opts) idrisInit
4343
4444runIdris :: [Opt] -> Idris ()
4545runIdris opts = do