on master help sign in
Allow functions to be declared as error handlers
8f95300David Christiansen
src/Idris/AbsSyntaxTree.hs+6−2
@@ -131,7 +131,8 @@ data IState = IState {
131 idris_outputmode :: OutputMode,
131 idris_outputmode :: OutputMode,
132 idris_colourRepl :: Bool,
132 idris_colourRepl :: Bool,
133 idris_colourTheme :: ColourTheme,
133 idris_colourTheme :: ColourTheme,
134− idris_outh :: Handle
134+ idris_outh :: Handle,
135+ idris_errorhandlers :: [Name]
135 }
136 }
136
137
137data SizeChange = Smaller | Same | Bigger | Unknown
138data SizeChange = Smaller | Same | Bigger | Unknown
@@ -189,13 +190,15 @@ data IBCWrite = IBCFix FixDecl
189 | IBCLineApp FilePath Int PTerm
190 | IBCLineApp FilePath Int PTerm
190 deriving Show
191 deriving Show
191
192
193+-- | The initial state for the compiler
194+idrisInit :: IState
192idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext
195idrisInit = IState initContext [] [] emptyContext emptyContext emptyContext
193 emptyContext emptyContext emptyContext emptyContext
196 emptyContext emptyContext emptyContext emptyContext
194 emptyContext emptyContext emptyContext emptyContext
197 emptyContext emptyContext emptyContext emptyContext
195 emptyContext
198 emptyContext
196 [] [] defaultOpts 6 [] [] [] [] [] [] [] [] [] [] [] []
199 [] [] defaultOpts 6 [] [] [] [] [] [] [] [] [] [] [] []
197 [] Nothing Nothing [] [] [] Hidden False [] Nothing [] [] RawOutput
200 [] Nothing Nothing [] [] [] Hidden False [] Nothing [] [] RawOutput
198− True defaultTheme stdout
201+ True defaultTheme stdout []
199
202
200-- | The monad for the main REPL - reading and processing files and updating
203-- | The monad for the main REPL - reading and processing files and updating
201-- global state (hence the IO inner monad).
204-- global state (hence the IO inner monad).
@@ -380,6 +383,7 @@ data FnOpt = Inlinable -- always evaluate when simplifying
380 -- a function argument, and further evaluation resutls
383 -- a function argument, and further evaluation resutls
381 | Implicit -- implicit coercion
384 | Implicit -- implicit coercion
382 | CExport String -- export, with a C name
385 | CExport String -- export, with a C name
386+ | ErrorHandler -- ^^ an error handler for use with the ErrorReflection extension
383 | Reflection -- a reflecting function, compile-time only
387 | Reflection -- a reflecting function, compile-time only
384 | Specialise [(Name, Maybe Int)] -- specialise it, freeze these names
388 | Specialise [(Name, Maybe Int)] -- specialise it, freeze these names
385 deriving (Show, Eq)
389 deriving (Show, Eq)
src/Idris/ElabDecls.hs+6
@@ -112,6 +112,12 @@ elabType' norm info syn doc fc opts n ty' = {- let ty' = piBind (params info) ty
112 addIBC (IBCFlags n opts')
112 addIBC (IBCFlags n opts')
113 when (Implicit `elem` opts) $ do addCoercion n
113 when (Implicit `elem` opts) $ do addCoercion n
114 addIBC (IBCCoercion n)
114 addIBC (IBCCoercion n)
115+ -- If the function is declared as an error handler and the language
116+ -- extension is enabled, then add it to the list of error handlers.
117+ when (ErrorReflection `elem` idris_language_extensions i && ErrorHandler `elem` opts) $
118+ -- TODO: Check that the declared type is the correct type for an error handler:
119+ -- handler : List (TTName, TT) -> Err -> ErrorReport
120+ putIState $ i { idris_errorhandlers = n : idris_errorhandlers i }
115 when corec $ do setAccessibility n Frozen
121 when corec $ do setAccessibility n Frozen
116 addIBC (IBCAccess n Frozen)
122 addIBC (IBCAccess n Frozen)
117 return usety
123 return usety
src/Idris/Parser.hs+3
@@ -309,6 +309,7 @@ FnOpts ::= 'total'
309 | 'partial'
309 | 'partial'
310 | 'implicit'
310 | 'implicit'
311 | '%' 'assert_total'
311 | '%' 'assert_total'
312+ | '%' 'error_handler'
312 | '%' 'reflection'
313 | '%' 'reflection'
313 | '%' 'specialise' '[' NameTimesList? ']'
314 | '%' 'specialise' '[' NameTimesList? ']'
314 ;
315 ;
@@ -330,6 +331,8 @@ fnOpts opts
330 fnOpts (CExport c : opts)
331 fnOpts (CExport c : opts)
331 <|> do try (lchar '%' *> reserved "assert_total");
332 <|> do try (lchar '%' *> reserved "assert_total");
332 fnOpts (AssertTotal : opts)
333 fnOpts (AssertTotal : opts)
334+ <|> do try (lchar '%' *> reserved "error_handler");
335+ fnOpts (ErrorHandler : opts)
333 <|> do try (lchar '%' *> reserved "reflection");
336 <|> do try (lchar '%' *> reserved "reflection");
334 fnOpts (Reflection : opts)
337 fnOpts (Reflection : opts)
335 <|> do lchar '%'; reserved "specialise";
338 <|> do lchar '%'; reserved "specialise";