bab6c7b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Add error handlers to IBC files

bab6c7bDavid Raymond Christiansen13 years ago

src/Idris/AbsSyntaxTree.hs+2

compare with master

unifiedsplit

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

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

194 | IBCNameHint (Name, Name)

195 | IBCLineApp FilePath Int PTerm

196+ | IBCErrorHandler Name

197+ | IBCFunctionErrorHandler Name Name Name

196 deriving Show

198 deriving Show

197

199

198-- | The initial state for the compiler

200-- | 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

126 if tyIsHandler nty'

127 then do i <- getIState

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

129+ addIBC (IBCErrorHandler n)

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

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

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

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

131 when corec $ do setAccessibility n Frozen

132 when corec $ do setAccessibility n Frozen

src/Idris/IBC.hs+24−5

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

28ibcVersion :: Word8

29−ibcVersion = 54

29+ibcVersion = 55

31data IBCFile = IBCFile { ver :: Word8,

32 sourcefile :: FilePath,

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

57 ibc_coercions :: [Name],

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

59 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

61 }

63 }

62 deriving Show

64 deriving Show

63{-!

65{-!

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

65!-}

67!-}

67initIBC :: IBCFile

69initIBC :: IBCFile

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

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

70loadIBC :: FilePath -> Idris ()

72loadIBC :: FilePath -> Idris ()

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

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

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

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

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

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

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

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

217ibc 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 }

216

221

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

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

218process i fn

223process i fn

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

250 pLineApps (ibc_lineapps i)

255 pLineApps (ibc_lineapps i)

251 pNameHints (ibc_namehints i)

256 pNameHints (ibc_namehints i)

252 pMetaInformation (ibc_metainformation i)

257 pMetaInformation (ibc_metainformation i)

258+ pErrorHandlers (ibc_errorhandlers i)

259+ pFunctionErrorHandlers (ibc_function_errorhandlers i)

253

260

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

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

255timestampOlder src ibc = do srct <- getModificationTime src

262timestampOlder src ibc = do srct <- getModificationTime src

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

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

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

429 ds

436 ds

430

437

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

431----- Generated by 'derive'

446----- Generated by 'derive'

432

447

433instance Binary SizeChange where

448instance Binary SizeChange where

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

1012 return (DataMI x1)

1027 return (DataMI x1)

1013

1028

1014instance Binary IBCFile where

1029instance 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)

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

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

1017 do put x1

1032 do put x1

1018 put x2

1033 put x2

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

1044 put x28

1059 put x28

1045 put x29

1060 put x29

1046 put x30

1061 put x30

1062+ put x31

1063+ put x32

1047 get

1064 get

1048 = do x1 <- get

1065 = do x1 <- get

1049 if x1 == ibcVersion then

1066 if x1 == ibcVersion then

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

1076 x28 <- get

1093 x28 <- get

1077 x29 <- get

1094 x29 <- get

1078 x30 <- get

1095 x30 <- get

1096+ x31 <- get

1097+ x32 <- 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)

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)

1080 else return (initIBC { ver = x1 })

1099 else return (initIBC { ver = x1 })

1081

1100

1082instance Binary DataOpt where

1101instance Binary DataOpt where

src/Idris/Parser.hs+2−1

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

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

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

882 ns' <- mapM disambiguate ns

883− addFunctionErrorHandlers fn' arg ns')]

883+ addFunctionErrorHandlers fn' arg ns'

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

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

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

885 return [PDirective (addLangExt ext)]

886 return [PDirective (addLangExt ext)]

886 <?> "directive"

887 <?> "directive"