on master help sign in
Merge remote-tracking branch 'upstream/master' into unifier-context

Conflicts: src/Idris/ElabTerm.hs

commit60f74272cacda005beb53c871dfad1d79fbd2e10 authorDavid Raymond Christiansen <david@davidchristiansen.dk> dateSat 22 Mar 2014, 10:00 (13 years ago) parent82c94b30fc0cdc
9 files changed+161−82
libs/effects/Effects.idr+52−26 libs/prelude/Builtins.idr+14−5 libs/prelude/Decidable/Equality.idr+10−8 libs/prelude/Prelude.idr+20−2 libs/prelude/Prelude/Bool.idr+2 src/IRTS/Compiler.hs+1−1 src/Idris/Coverage.hs+4−4 src/Idris/ElabDecls.hs+4−2 src/Idris/ElabTerm.hs+54−34
libs/effects/Effects.idr+52−26
@@ -4,35 +4,57 @@ import Language.Reflection
44import Control.Catchable
55import Effect.Default
66
7−%access public
8−
9−---- Effects
7+--- Effectful computations are described as algebraic data types that
8+--- explain how an effect is interpreted in some underlying context.
109
10+%access public
11+-- ----------------------------------------------------------------- [ Effects ]
12+||| The Effect type describes effectful computations.
13+|||
14+||| This type is parameterised by:
15+||| + The input resource.
16+||| + The return type of the computation.
17+||| + The computation to run on the resource.
1118Effect : Type
1219Effect = (x : Type) -> Type -> (x -> Type) -> Type
1320
21+||| The `EFFECT` Data type describes how to promote the Effect
22+||| description into a concrete effect.
1423%error_reverse
1524data EFFECT : Type where
1625 MkEff : Type -> Effect -> EFFECT
1726
27+||| Handler classes describe how an effect `e` is translated to the
28+||| underlying computation context `m` for execution.
1829class Handler (e : Effect) (m : Type -> Type) where
19− handle : res -> (eff : e t res resk) ->
20− ((x : t) -> resk x -> m a) -> m a
21−
22−-- Get the resource type (handy at the REPL to find out about an effect)
30+ ||| How to handle the effect.
31+ |||
32+ ||| @ r The resource being handled.
33+ ||| @ eff The effect to be applied.
34+ ||| @ ctxt The context in which to handle the effect.
35+ handle : (r : res) -> (eff : e t res resk) ->
36+ (ctxt : ((x : t) -> resk x -> m a)) -> m a
37+
38+||| Get the resource type (handy at the REPL to find out about an effect)
2339resourceType : EFFECT -> Type
2440resourceType (MkEff t e) = t
2541
42+-- --------------------------------------------------------- [ Syntactic Sugar ]
43+
2644-- A bit of syntactic sugar ('syntax' is not very flexible so we only go
2745-- up to a small number of parameters...)
2846
47+-- No state transition
2948syntax "{" [inst] "}" [eff] = eff inst (\result => inst)
49+
50+-- The state transition is dependent on a result `b`, a bound variable.
3051syntax "{" [inst] "==>" "{" {b} "}" [outst] "}" [eff]
3152 = eff inst (\b => outst)
32−syntax "{" [inst] "==>" [outst] "}" [eff] = eff inst (\result => outst)
3353
34−---- Properties and proof construction
54+--- A simple state transition
55+syntax "{" [inst] "==>" [outst] "}" [eff] = eff inst (\result => outst)
3556
57+-- --------------------------------------- [ Properties and Proof Construction ]
3658using (xs : List a, ys : List a)
3759 data SubList : List a -> List a -> Type where
3860 SubNil : SubList {a} [] []
@@ -53,7 +75,7 @@ data EffElem : Effect -> Type ->
5375 Here : EffElem x a (MkEff a x :: xs)
5476 There : EffElem x a xs -> EffElem x a (y :: xs)
5577
56−-- make an environment corresponding to a sub-list
78+||| make an environment corresponding to a sub-list
5779dropEnv : Env m ys -> SubList xs ys -> Env m xs
5880dropEnv [] SubNil = []
5981dropEnv (v :: vs) (Keep rest) = v :: dropEnv vs rest
@@ -67,7 +89,7 @@ updateWith [] [] SubNil = []
6789updateWith (y :: ys) [] SubNil = y :: ys
6890updateWith [] (x :: xs) (Keep rest) = []
6991
70−-- put things back, replacing old with new in the sub-environment
92+||| Put things back, replacing old with new in the sub-environment
7193rebuildEnv : Env m ys' -> (prf : SubList ys xs) ->
7294 Env m xs -> Env m (updateWith ys' xs prf)
7395rebuildEnv [] SubNil env = env
@@ -75,8 +97,7 @@ rebuildEnv (x :: xs) (Keep rest) (y :: env) = x :: rebuildEnv xs rest env
7597rebuildEnv xs (Drop rest) (y :: env) = y :: rebuildEnv xs rest env
7698rebuildEnv (x :: xs) SubNil [] = x :: xs
7799
78−---- The Effect EDSL itself ----
79−
100+-- -------------------------------------------------- [ The Effect EDSL itself ]
80101-- some proof automation
81102
82103%reflection
@@ -131,11 +152,6 @@ updateResTy : (val : t) ->
131152updateResTy {b} val (MkEff a e :: xs) Here n = (MkEff (b val) e) :: xs
132153updateResTy val (x :: xs) (There p) n = x :: updateResTy val xs p n
133154
134−-- updateResTyImm : (xs : List EFFECT) -> EffElem e a xs -> Type ->
135−-- List EFFECT
136−-- updateResTyImm (MkEff a e :: xs) Here b = (MkEff b e) :: xs
137−-- updateResTyImm (x :: xs) (There p) b = x :: updateResTyImm xs p b
138−
139155infix 5 :::, :-, :=
140156
141157data LRes : lbl -> Type -> Type where
@@ -157,11 +173,17 @@ relabel : (l : ty) -> Env m xs -> Env m (map (\x => l ::: x) xs)
157173relabel {xs = []} l [] = []
158174relabel {xs = (MkEff a e :: xs)} l (v :: vs) = (l := v) :: relabel l vs
159175
160−-- the language of Effects
161−
162−data Eff : (m : Type -> Type) ->
163− (x : Type) ->
164− List EFFECT -> (x -> List EFFECT) -> Type where
176+-- ------------------------------------------------- [ The Language of Effects ]
177+||| Definition of an Effect.
178+|||
179+||| @ m The computation context
180+||| @ x The return type of the result.
181+||| @ es The list of allowed side-effects.
182+||| @ ce Function to compute a new list of allowed side-effects.
183+data Eff : (m : Type -> Type)
184+ -> (x : Type)
185+ -> (es : List EFFECT)
186+ -> (ce : x -> List EFFECT) -> Type where
165187 value : a -> Eff m a xs (\v => xs)
166188 with_val : (val : a) -> Eff m () xs (\v => xs' val) ->
167189 Eff m a xs xs'
@@ -192,7 +214,7 @@ data Eff : (m : Type -> Type) ->
192214return : a -> Eff m a xs (\v => xs)
193215return x = value x
194216
195−-- for idiom brackets
217+-- ------------------------------------------------------ [ for idiom brackets ]
196218
197219infixl 2 <$>
198220
@@ -207,7 +229,7 @@ syntax pureM [val] = with_val val (pure ())
207229 arg <- v
208230 return (fn arg)
209231
210−-- an interpreter
232+-- ---------------------------------------------------------- [ an interpreter ]
211233
212234private
213235execEff : Env m xs -> (p : EffElem e res xs) ->
@@ -276,6 +298,9 @@ new : Handler e m =>
276298 Eff m a xs (\v => xs')
277299new {r} e = newInit r e
278300
301+-- --------------------------------------------------------- [ Running Effects ]
302+
303+||| Run an effectful program
279304run : Applicative m => {default MkDefaultEnv env : Env m xs} -> Eff m a xs xs' -> m a
280305run {env} prog = eff env prog (\r, env => pure r)
281306
@@ -295,7 +320,7 @@ runEnv : Applicative m => Env m xs -> Eff m a xs xs' ->
295320 m (x : a ** Env m (xs' x))
296321runEnv env prog = eff env prog (\r, env => pure (r ** env))
297322
298−-- some higher order things
323+-- ----------------------------------------------- [ some higher order things ]
299324
300325mapE : Applicative m => (a -> {xs} Eff m b) -> List a -> {xs} Eff m (List b)
301326mapE f [] = pure []
@@ -314,3 +339,4 @@ when : Applicative m => Bool -> ({xs} Eff m ()) -> {xs} Eff m ()
314339when True e = e
315340when False e = pure ()
316341
342+-- --------------------------------------------------------------------- [ EOF ]
libs/prelude/Builtins.idr+14−5
@@ -43,14 +43,23 @@ lazy x = x -- compiled specially
4343force : a -> a
4444force x = x -- compiled specially
4545
46−data Lazy : Type -> Type where
47− Delay : (val : a) -> Lazy a
46+data LazyType = LazyCodata | LazyEval
4847
49−Force : Lazy a -> a
48+data Lazy' : LazyType -> Type -> Type where
49+ Delay : {t, a : _} -> (val : a) -> Lazy' t a
50+
51+Force : {t, a : _} -> Lazy' t a -> a
5052Force (Delay x) = x
5153
52−par : Lazy a -> a
53−par (Delay x) = x -- compiled specially
54+Lazy : Type -> Type
55+Lazy t = Lazy' LazyEval t
56+
57+Inf : Type -> Type
58+Inf t = Lazy' LazyCodata t
59+
60+par : Lazy a -> a -- Doesn't actually do anything yet. Maybe a 'Par a' type
61+ -- is better in any case?
62+par (Delay x) = x
5463
5564malloc : Int -> a -> a
5665malloc size x = x -- compiled specially
libs/prelude/Decidable/Equality.idr+10−8
@@ -12,6 +12,7 @@ import Prelude.Maybe
1212-- Utility lemmas
1313--------------------------------------------------------------------------------
1414
15+||| The negation of equality is symmetric (follows from symmetry of equality)
1516total negEqSym : {a : t} -> {b : t} -> (a = b -> _|_) -> (b = a -> _|_)
1617negEqSym p h = p (sym h)
1718
@@ -20,7 +21,9 @@ negEqSym p h = p (sym h)
2021-- Decidable equality
2122--------------------------------------------------------------------------------
2223
24+||| Decision procedures for propositional equality
2325class DecEq t where
26+ ||| Decide whether two elements of `t` are propositionally equal
2427 total decEq : (x1 : t) -> (x2 : t) -> Dec (x1 = x2)
2528
2629--------------------------------------------------------------------------------
@@ -33,7 +36,6 @@ instance DecEq () where
3336--------------------------------------------------------------------------------
3437-- Booleans
3538--------------------------------------------------------------------------------
36−
3739total trueNotFalse : True = False -> _|_
3840trueNotFalse refl impossible
3941
@@ -122,13 +124,13 @@ lemma_fst_neq_snd_eq : {x : a, x' : b, y : c, y' : d} ->
122124lemma_fst_neq_snd_eq p_x_not_x' refl refl = p_x_not_x' refl
123125
124126instance (DecEq a, DecEq b) => DecEq (a, b) where
125− decEq (a, b) (a', b') with (decEq a a')
126− decEq (a, b) (a, b') | (Yes refl) with (decEq b b')
127− decEq (a, b) (a, b) | (Yes refl) | (Yes refl) = Yes refl
128− decEq (a, b) (a, b') | (Yes refl) | (No p) = No (\eq => lemma_snd_neq refl p eq)
129− decEq (a, b) (a', b') | (No p) with (decEq b b')
130− decEq (a, b) (a', b) | (No p) | (Yes refl) = No (\eq => lemma_fst_neq_snd_eq p refl eq)
131− decEq (a, b) (a', b') | (No p) | (No p') = No (\eq => lemma_both_neq p p' eq)
127+ decEq (a, b) (a', b') with (decEq a a')
128+ decEq (a, b) (a, b') | (Yes refl) with (decEq b b')
129+ decEq (a, b) (a, b) | (Yes refl) | (Yes refl) = Yes refl
130+ decEq (a, b) (a, b') | (Yes refl) | (No p) = No (\eq => lemma_snd_neq refl p eq)
131+ decEq (a, b) (a', b') | (No p) with (decEq b b')
132+ decEq (a, b) (a', b) | (No p) | (Yes refl) = No (\eq => lemma_fst_neq_snd_eq p refl eq)
133+ decEq (a, b) (a', b') | (No p) | (No p') = No (\eq => lemma_both_neq p p' eq)
132134
133135
134136--------------------------------------------------------------------------------
libs/prelude/Prelude.idr+20−2
@@ -439,26 +439,32 @@ uniformB64x2 x = prim__mkB64x2 x x
439439
440440---- some basic io
441441
442+||| Output a string to stdout without a trailing newline
442443partial
443444putStr : String -> IO ()
444445putStr x = mkForeign (FFun "putStr" [FString] FUnit) x
445446
447+||| Output a string to stdout with a trailing newline
446448partial
447449putStrLn : String -> IO ()
448450putStrLn x = putStr (x ++ "\n")
449451
452+||| Output something showable to stdout, with a trailing newline
450453partial
451454print : Show a => a -> IO ()
452455print x = putStrLn (show x)
453456
457+||| Read one line of input from stdin
454458partial
455459getLine : IO String
456460getLine = prim_fread prim__stdin
457461
462+||| Write a single character to stdout
458463partial
459464putChar : Char -> IO ()
460465putChar c = mkForeign (FFun "putchar" [FInt] FUnit) (cast c)
461466
467+||| Read a single character from stdin
462468partial
463469getChar : IO Char
464470getChar = map cast $ mkForeign (FFun "getchar" [] FInt)
@@ -468,21 +474,30 @@ getChar = map cast $ mkForeign (FFun "getchar" [] FInt)
468474abstract
469475data File = FHandle Ptr
470476
477+||| Standard input
471478partial stdin : File
472479stdin = FHandle prim__stdin
473480
481+||| Call the RTS's file opening function
474482do_fopen : String -> String -> IO Ptr
475483do_fopen f m
476484 = mkForeign (FFun "fileOpen" [FString, FString] FPtr) f m
477485
478−fopen : String -> String -> IO File
486+||| Open a file
487+||| @ f the filename
488+||| @ m the mode as a String (`"r"`, `"w"`, or `"r+"`)
489+fopen : (f : String) -> (m : String) -> IO File
479490fopen f m = do h <- do_fopen f m
480491 return (FHandle h)
481492
493+||| Modes for opening files
482494data Mode = Read | Write | ReadWrite
483495
496+||| Open a file
497+||| @ f the filename
498+||| @ m the mode
484499partial
485−openFile : String -> Mode -> IO File
500+openFile : (f : String) -> (m : Mode) -> IO File
486501openFile f m = fopen f (modeStr m) where
487502 modeStr Read = "r"
488503 modeStr Write = "w"
@@ -567,15 +582,18 @@ nullPtr : Ptr -> IO Bool
567582nullPtr p = do ok <- mkForeign (FFun "isNull" [FPtr] FInt) p
568583 return (ok /= 0)
569584
585+||| Check if a supposed string was actually a null pointer
570586partial
571587nullStr : String -> IO Bool
572588nullStr p = do ok <- mkForeign (FFun "isNull" [FString] FInt) p
573589 return (ok /= 0)
574590
591+||| Pointer equality
575592eqPtr : Ptr -> Ptr -> IO Bool
576593eqPtr x y = do eq <- mkForeign (FFun "idris_eqPtr" [FPtr, FPtr] FInt) x y
577594 return (eq /= 0)
578595
596+||| Check whether a file handle is actually a null pointer
579597partial
580598validFile : File -> IO Bool
581599validFile (FHandle h) = do x <- nullPtr h
libs/prelude/Prelude/Bool.idr+2
@@ -1,5 +1,7 @@
11module Prelude.Bool
22
3+import Builtins
4+
35||| Boolean Data Type
46data Bool = False | True
57
src/IRTS/Compiler.hs+1−1
@@ -193,7 +193,7 @@ instance ToIR (TT Name) where
193193 l == txt "Delay"
194194 = do arg' <- ir' env arg
195195 return $ LLazyExp arg'
196− | (P _ (UN l) _, [_, arg]) <- unApply tm,
196+ | (P _ (UN l) _, [_, _, arg]) <- unApply tm,
197197 l == txt "Force"
198198 = do arg' <- ir' env arg
199199 return $ LForce arg'
src/Idris/Coverage.hs+4−4
@@ -402,12 +402,12 @@ buildSCG (_, n) = do
402402 x -> error $ "buildSCG: " ++ show (n, x)
403403
404404delazy t@(App f a)
405− | (P _ (UN l) _, [_, arg]) <- unApply t,
405+ | (P _ (UN l) _, [_, _, arg]) <- unApply t,
406406 l == txt "Force" = delazy arg
407− | (P _ (UN l) _, [_, arg]) <- unApply t,
407+ | (P _ (UN l) _, [_, _, arg]) <- unApply t,
408408 l == txt "Delay" = delazy arg
409− | (P _ (UN l) _, [arg]) <- unApply t,
410− l == txt "Lazy" = delazy arg
409+ | (P _ (UN l) _, [_, arg]) <- unApply t,
410+ l == txt "Lazy'" = delazy arg
411411delazy (App f a) = App (delazy f) (delazy a)
412412delazy (Bind n b sc) = Bind n (fmap delazy b) (delazy sc)
413413delazy t = t
src/Idris/ElabDecls.hs+4−2
@@ -254,7 +254,7 @@ elabData info syn doc argDocs fc opts (PDatadecl n t_in dcons)
254254 let metainf = DataMI params
255255 addIBC (IBCMetaInformation n metainf)
256256 -- TMP HACK! Make this a data option
257− when (n /= sUN "Lazy") $ collapseCons n cons
257+ when (n /= sUN "Lazy'") $ collapseCons n cons
258258 updateContext (addDatatype (Data n ttag cty cons))
259259 updateContext (setMetaInformation n metainf)
260260 mapM_ (checkPositive n) cons
@@ -874,7 +874,9 @@ elabCon info syn tn codata (doc, argDocs, n, t_in, fc, forcenames)
874874
875875 mkLazy (PPi pl n ty sc)
876876 = let ty' = if getTyName ty
877− then PApp fc (PRef fc (sUN "Lazy")) [pexp ty]
877+ then PApp fc (PRef fc (sUN "Lazy'"))
878+ [pexp (PRef fc (sUN "LazyCodata")),
879+ pexp ty]
878880 else ty in
879881 PPi pl n ty' (mkLazy sc)
880882 mkLazy t = t
src/Idris/ElabTerm.hs+54−34
@@ -20,7 +20,7 @@ import Control.Monad
2020import Control.Monad.State.Strict
2121import Data.List
2222import qualified Data.Map as M
23−import Data.Maybe (mapMaybe)
23+import Data.Maybe (mapMaybe, fromMaybe)
2424import qualified Data.Set as S
2525import qualified Data.Text as T
2626
@@ -173,25 +173,27 @@ elab ist info pattern opts fn tm
173173 -- ++ "\n-----------\n") $
174174 --trace ("ELAB " ++ show t') $
175175 let fc = fileFC "Force"
176− handleError forceErr
176+ env <- get_env
177+ handleError (forceErr env)
177178 (elab' ina t')
178179 (elab' ina (PApp fc (PRef fc (sUN "Force"))
179− [pimp (sUN "a") Placeholder True,
180+ [pimp (sUN "t") Placeholder True,
181+ pimp (sUN "a") Placeholder True,
180182 pexp ct])) True
181183
182− forceErr (CantUnify _ t t' _ _ _)
183− | (P _ (UN ht) _, _) <- unApply t,
184− ht == txt "Lazy" = True
185− forceErr (CantUnify _ t t' _ _ _)
186− | (P _ (UN ht) _, _) <- unApply t',
187− ht == txt "Lazy" = True
188− forceErr (InfiniteUnify _ t _)
189− | (P _ (UN ht) _, _) <- unApply t,
190− ht == txt "Lazy" = True
191− forceErr (Elaborating _ _ t) = forceErr t
192− forceErr (ElaboratingArg _ _ _ t) = forceErr t
193− forceErr (At _ t) = forceErr t
194− forceErr t = False
184+ forceErr env (CantUnify _ t t' _ _ _)
185+ | (P _ (UN ht) _, _) <- unApply (normalise (tt_ctxt ist) env t),
186+ ht == txt "Lazy'" = True
187+ forceErr env (CantUnify _ t t' _ _ _)
188+ | (P _ (UN ht) _, _) <- unApply (normalise (tt_ctxt ist) env t'),
189+ ht == txt "Lazy'" = True
190+ forceErr env (InfiniteUnify _ t _)
191+ | (P _ (UN ht) _, _) <- unApply (normalise (tt_ctxt ist) env t),
192+ ht == txt "Lazy'" = True
193+ forceErr env (Elaborating _ _ t) = forceErr env t
194+ forceErr env (ElaboratingArg _ _ _ t) = forceErr env t
195+ forceErr env (At _ t) = forceErr env t
196+ forceErr env t = False
195197
196198 local f = do e <- get_env
197199 return (f `elem` map fst e)
@@ -688,13 +690,14 @@ elab ist info pattern opts fn tm
688690 let (tyh, _) = unApply (normalise (tt_ctxt ist) env ty)
689691 let tries = if pattern then [t, mkDelay t] else [mkDelay t, t]
690692 case tyh of
691− P _ (UN l) _ | l == txt "Lazy"
693+ P _ (UN l) _ | l == txt "Lazy'"
692694 -> return (PAlternative False tries)
693695 _ -> return t
694696 where
695697 mkDelay (PAlternative b xs) = PAlternative b (map mkDelay xs)
696698 mkDelay t = let fc = fileFC "Delay" in
697− addImpl ist (PApp fc (PRef fc (sUN "Delay")) [pexp t])
699+ addImpl ist (PApp fc (PRef fc (sUN "Delay"))
700+ [pexp t])
698701
699702 insertCoerce ina t =
700703 do ty <- goal
@@ -724,10 +727,7 @@ elab ist info pattern opts fn tm
724727 -> Bool -- ^ under a 'force'
725728 -> [(Bool, PTerm)] -- ^ (Laziness, argument)
726729 -> ElabD ()
727− elabArgs ist ina failed fc retry f [] force _
728−-- | retry = let (ns, ts) = unzip (reverse failed) in
729−-- elabArgs ina [] False ns ts
730− | otherwise = return ()
730+ elabArgs ist ina failed fc retry f [] force _ = return ()
731731 elabArgs ist ina failed fc r f (n:ns) force ((_, Placeholder) : args)
732732 = elabArgs ist ina failed fc r f ns force args
733733 elabArgs ist ina failed fc r f ((argName, holeName):ns) force ((lazy, t) : args)
@@ -738,18 +738,30 @@ elab ist info pattern opts fn tm
738738 | otherwise = elabArg argName holeName t
739739 where elabArg argName holeName t =
740740 do now_elaborating fc f argName
741− hs <- get_holes
742− tm <- get_term
743− -- No coercing under an explicit Force (or it can Force/Delay
744− -- recursively!)
745− let elab = if force then elab' else elabE
746− failed' <- -- trace (show (n, t, hs, tm)) $
747− -- traceWhen (not (null cs)) (show ty ++ "\n" ++ showImp True t) $
748− case holeName `elem` hs of
749− True -> do focus holeName; elab ina t; return failed
750− False -> return failed
751− done_elaborating_arg f argName
752− elabArgs ist ina failed fc r f ns force args
741+ wrapErr f argName $ do
742+ hs <- get_holes
743+ tm <- get_term
744+ -- No coercing under an explicit Force (or it can Force/Delay
745+ -- recursively!)
746+ let elab = if force then elab' else elabE
747+ failed' <- -- trace (show (n, t, hs, tm)) $
748+ -- traceWhen (not (null cs)) (show ty ++ "\n" ++ showImp True t) $
749+ case holeName `elem` hs of
750+ True -> do focus holeName; elab ina t; return failed
751+ False -> return failed
752+ done_elaborating_arg f argName
753+ elabArgs ist ina failed fc r f ns force args
754+ wrapErr f argName action =
755+ do elabState <- get
756+ while <- elaborating_app
757+ let while' = map (\(x, y, z)-> (y, z)) while
758+ (result, newState) <- case runStateT action elabState of
759+ OK (res, newState) -> return (res, newState)
760+ Error e -> do done_elaborating_arg f argName
761+ lift (tfail (elaboratingArgErr while' e))
762+ put newState
763+ return result
764+
753765
754766-- | Perform error reflection for function applicaitons with specific error handlers
755767reflectFunctionErrors :: IState -> Name -> Name -> ElabD a -> ElabD a
@@ -1628,6 +1640,14 @@ reflectErr (LoadingFailed str err) =
16281640 raw_apply (Var $ reflErrName "LoadingFailed") [RConstant (Str str)]
16291641reflectErr x = raw_apply (Var (sNS (sUN "Msg") ["Errors", "Reflection", "Language"])) [RConstant . Str $ "Default reflection: " ++ show x]
16301642
1643+elaboratingArgErr :: [(Name, Name)] -> Err -> Err
1644+elaboratingArgErr [] err = err
1645+elaboratingArgErr ((f,x):during) err = fromMaybe err (rewrite err)
1646+ where rewrite (ElaboratingArg _ _ _ _) = Nothing
1647+ rewrite (ProofSearchFail e) = fmap ProofSearchFail (rewrite e)
1648+ rewrite (At fc e) = fmap (At fc) (rewrite e)
1649+ rewrite err = Just (ElaboratingArg f x during err)
1650+
16311651
16321652withErrorReflection :: Idris a -> Idris a
16331653withErrorReflection x = idrisCatch x (\ e -> handle e >>= ierror)