top.errors doesn't need to be an IORef
This commit is contained in:
@@ -43,8 +43,7 @@ instance Show TopContext where
|
|||||||
emptyTop : ∀ io. {{Monad io}} {{HasIO io}} -> io TopContext
|
emptyTop : ∀ io. {{Monad io}} {{HasIO io}} -> io TopContext
|
||||||
emptyTop = do
|
emptyTop = do
|
||||||
let mcctx = MC emptyMap Nil 0 CheckAll
|
let mcctx = MC emptyMap Nil 0 CheckAll
|
||||||
errs <- newIORef $ the (List Error) Nil
|
pure $ MkTop emptyMap Nil emptyMap Nil emptyMap mcctx 0 Nil emptyMap
|
||||||
pure $ MkTop emptyMap Nil emptyMap Nil emptyMap mcctx 0 errs emptyMap
|
|
||||||
|
|
||||||
|
|
||||||
setFlag : QName → FC → EFlag → M Unit
|
setFlag : QName → FC → EFlag → M Unit
|
||||||
@@ -91,4 +90,4 @@ addHint qn = do
|
|||||||
addError : Error -> M Unit
|
addError : Error -> M Unit
|
||||||
addError err = do
|
addError err = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
modifyIORef top.errors (_::_ err)
|
modifyTop [ errors $= _::_ err ]
|
||||||
|
|||||||
@@ -433,7 +433,7 @@ record TopContext where
|
|||||||
|
|
||||||
-- Global values
|
-- Global values
|
||||||
verbose : Int -- command line flag
|
verbose : Int -- command line flag
|
||||||
errors : IORef (List Error)
|
errors : List Error
|
||||||
ops : Operators
|
ops : Operators
|
||||||
|
|
||||||
-- we'll use this for typechecking, but need to keep a TopContext around too.
|
-- we'll use this for typechecking, but need to keep a TopContext around too.
|
||||||
|
|||||||
@@ -165,19 +165,15 @@ processModule importFC base stk qn@(QN ns nm) = do
|
|||||||
top <- getTop
|
top <- getTop
|
||||||
|
|
||||||
let mod = MkModCtx csum top.defs top.metaCtx top.ops
|
let mod = MkModCtx csum top.defs top.metaCtx top.ops
|
||||||
errors <- liftIO {M} $ readIORef top.errors
|
if stk /= Nil && length' top.errors == 0
|
||||||
if stk /= Nil && length' errors == 0
|
|
||||||
then dumpModule qn src mod
|
then dumpModule qn src mod
|
||||||
else pure MkUnit
|
else pure MkUnit
|
||||||
|
|
||||||
let modules = updateMap modns mod top.modules
|
let modules = updateMap modns mod top.modules
|
||||||
modifyTop [modules := modules]
|
modifyTop [modules := modules]
|
||||||
|
|
||||||
(Nil) <- liftIO {M} $ readIORef top.errors
|
let (Nil) = top.errors
|
||||||
| errors => do
|
| errors => exitFailure "Compile failed"
|
||||||
-- we're now showing errors when they occur, so they're next to debug messages
|
|
||||||
-- traverse (putStrLn ∘ showError src) errors
|
|
||||||
exitFailure "Compile failed"
|
|
||||||
logMetas $ reverse $ listValues top.metaCtx.metas
|
logMetas $ reverse $ listValues top.metaCtx.metas
|
||||||
pure src
|
pure src
|
||||||
where
|
where
|
||||||
@@ -199,7 +195,7 @@ showErrors : String -> String -> M Unit
|
|||||||
showErrors fn src = do
|
showErrors fn src = do
|
||||||
top <- getTop
|
top <- getTop
|
||||||
-- TODO {M} needed to sort out scrutinee
|
-- TODO {M} needed to sort out scrutinee
|
||||||
(Nil) <- liftIO {M} $ readIORef top.errors
|
let (Nil) = top.errors
|
||||||
| errors => do
|
| errors => do
|
||||||
traverse (putStrLn ∘ showError src) errors
|
traverse (putStrLn ∘ showError src) errors
|
||||||
exitFailure "Compile failed"
|
exitFailure "Compile failed"
|
||||||
|
|||||||
Reference in New Issue
Block a user