bab6c7b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add error handlers to IBC files

commitbab6c7b10db17dd824ad500ef732c35643f1166c authorDavid Raymond Christiansen <david@davidchristiansen.dk> dateThu 23 Jan 2014, 16:12 (13 years ago) parent887b6e2

4 files changed+29−6

compare with master

unifiedsplit

src/Idris/AbsSyntaxTree.hs+2 src/Idris/ElabDecls.hs+1 src/Idris/IBC.hs+24−5 src/Idris/Parser.hs+2−1

src/Idris/AbsSyntaxTree.hs+2

@@ -193,6 +193,8 @@ data IBCWrite = IBCFix FixDecl

193193 | IBCDef Name -- i.e. main context

194194 | IBCNameHint (Name, Name)

195195 | IBCLineApp FilePath Int PTerm

196+ | IBCErrorHandler Name

197+ | IBCFunctionErrorHandler Name Name Name

196198 deriving Show

197199

198200-- | The initial state for the compiler

src/Idris/ElabDecls.hs+1

@@ -126,6 +126,7 @@ elabType' norm info syn doc fc opts n ty' = {- let ty' = piBind (params info) ty

126126 if tyIsHandler nty'

127127 then do i <- getIState

128128 putIState $ i { idris_errorhandlers = idris_errorhandlers i ++ [n] }

129+ addIBC (IBCErrorHandler n)

129130 else ifail $ "The type " ++ show nty' ++ " is invalid for an error handler"

130131 else ifail "Error handlers can only be defined when the ErrorReflection language extension is enabled."

131132 when corec $ do setAccessibility n Frozen

src/Idris/IBC.hs+24−5

@@ -26,7 +26,7 @@ import Util.Zlib (decompressEither)

2626

2727

2828ibcVersion :: Word8

29−ibcVersion = 54

29+ibcVersion = 55

3030

3131data IBCFile = IBCFile { ver :: Word8,

3232 sourcefile :: FilePath,

@@ -57,7 +57,9 @@ data IBCFile = IBCFile { ver :: Word8,

5757 ibc_coercions :: [Name],

5858 ibc_lineapps :: [(FilePath, Int, PTerm)],

5959 ibc_namehints :: [(Name, Name)],

60− ibc_metainformation :: [(Name, MetaInformation)]

60+ ibc_metainformation :: [(Name, MetaInformation)],

61+ ibc_errorhandlers :: [Name],

62+ ibc_function_errorhandlers :: [(Name, Name, Name)] -- fn, arg, handler

6163 }

6264 deriving Show

6365{-!

@@ -65,7 +67,7 @@ deriving instance Binary IBCFile

6567!-}

6668

6769initIBC :: IBCFile

68−initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

70+initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

6971

7072loadIBC :: FilePath -> Idris ()

7173loadIBC fp = do iLOG $ "Loading ibc " ++ fp

@@ -213,6 +215,9 @@ ibc i (IBCLineApp fp l t) f

213215ibc i (IBCNameHint (n, ty)) f

214216 = return f { ibc_namehints = (n, ty) : ibc_namehints f }

215217ibc i (IBCMetaInformation n m) f = return f { ibc_metainformation = (n,m) : ibc_metainformation f }

218+ibc i (IBCErrorHandler n) f = return f { ibc_errorhandlers = n : ibc_errorhandlers f }

219+ibc i (IBCFunctionErrorHandler fn a n) f =

220+ return f { ibc_function_errorhandlers = (fn, a, n) : ibc_function_errorhandlers f }

216221

217222process :: IBCFile -> FilePath -> Idris ()

218223process i fn

@@ -250,6 +255,8 @@ process i fn

250255 pLineApps (ibc_lineapps i)

251256 pNameHints (ibc_namehints i)

252257 pMetaInformation (ibc_metainformation i)

258+ pErrorHandlers (ibc_errorhandlers i)

259+ pFunctionErrorHandlers (ibc_function_errorhandlers i)

253260

254261timestampOlder :: FilePath -> FilePath -> IO ()

255262timestampOlder src ibc = do srct <- getModificationTime src

@@ -428,6 +435,14 @@ pMetaInformation ds = mapM_ (\ (n, m) ->

428435 putIState (i { tt_ctxt = setMetaInformation n m (tt_ctxt i) }))

429436 ds

430437

438+pErrorHandlers :: [Name] -> Idris ()

439+pErrorHandlers ns = do i <- getIState

440+ putIState $ i { idris_errorhandlers = idris_errorhandlers i ++ ns }

441+

442+pFunctionErrorHandlers :: [(Name, Name, Name)] -> Idris ()

443+pFunctionErrorHandlers [] = return ()

444+pFunctionErrorHandlers ((fn, arg, handler):ns) = do addFunctionErrorHandlers fn arg [handler]

445+ pFunctionErrorHandlers ns

431446----- Generated by 'derive'

432447

433448instance Binary SizeChange where

@@ -1012,7 +1027,7 @@ instance Binary MetaInformation where

10121027 return (DataMI x1)

10131028

10141029instance Binary IBCFile where

1015− put x@(IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30)

1030+ put x@(IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 x32)

10161031 = {-# SCC "putIBCFile" #-}

10171032 do put x1

10181033 put x2

@@ -1044,6 +1059,8 @@ instance Binary IBCFile where

10441059 put x28

10451060 put x29

10461061 put x30

1062+ put x31

1063+ put x32

10471064 get

10481065 = do x1 <- get

10491066 if x1 == ibcVersion then

@@ -1076,7 +1093,9 @@ instance Binary IBCFile where

10761093 x28 <- get

10771094 x29 <- get

10781095 x30 <- get

1079− return (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30)

1096+ x31 <- get

1097+ x32 <- get

1098+ return (IBCFile x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 x32)

10801099 else return (initIBC { ver = x1 })

10811100

10821101instance Binary DataOpt where

src/Idris/Parser.hs+2−1

@@ -880,7 +880,8 @@ directive syn = do try (lchar '%' *> reserved "lib"); cgn <- codegen_; lib <- st

880880 ns <- sepBy1 name (lchar ',')

881881 return [PDirective (do fn' <- disambiguate fn

882882 ns' <- mapM disambiguate ns

883− addFunctionErrorHandlers fn' arg ns')]

883+ addFunctionErrorHandlers fn' arg ns'

884+ mapM_ (addIBC . IBCFunctionErrorHandler fn' arg) ns')]

884885 <|> do try (lchar '%' *> reserved "language"); ext <- pLangExt;

885886 return [PDirective (addLangExt ext)]

886887 <?> "directive"