remove default from `FromParser.fromParserPure` and `Main.step`

This commit is contained in:
rhiannon morris 2024-04-07 03:20:39 +02:00
parent 7a0bc73d25
commit 11b0ab6a25
3 changed files with 11 additions and 13 deletions

View File

@ -34,9 +34,8 @@ Step : Type -> Type -> Type
Step a b = OpenFile -> a -> Eff Compile b
private
step : {default CErr console : ConsoleChannel} ->
Phase -> OutFile -> Step a b -> a -> Eff CompileStop b
step phase file act x = do
step : ConsoleChannel -> Phase -> OutFile -> Step a b -> a -> Eff CompileStop b
step console phase file act x = do
opts <- askAt OPTS
res <- withOutFile console file fromError $ \h => lift $ act h x
when (opts.until == Just phase) stopHere
@ -99,11 +98,11 @@ processFile : String -> Eff Compile ()
processFile file = withEarlyStop $ pipeline !(askAt OPTS) file where
pipeline : Options -> String -> Eff CompileStop ()
pipeline opts =
step Parse opts.dump.parse Main.parse >=>
step Check opts.dump.check Main.check >=>
step Erase opts.dump.erase Main.erase >=>
step Scheme opts.dump.scheme Main.scheme >=>
step End opts.outFile Main.output {console = COut}
step CErr Parse opts.dump.parse Main.parse >=>
step CErr Check opts.dump.check Main.check >=>
step CErr Erase opts.dump.erase Main.erase >=>
step CErr Scheme opts.dump.scheme Main.scheme >=>
step COut End opts.outFile Main.output
export covering

View File

@ -49,10 +49,9 @@ record PureParserResult a where
logLevels : LevelStack
export
fromParserPure : {default [<] ns : Mods} ->
NameSuf -> Definitions -> LevelStack ->
fromParserPure : Mods -> NameSuf -> Definitions -> LevelStack ->
Eff FromParserPure a -> Either Error (PureParserResult a)
fromParserPure suf defs lvls act = runSTErr $ do
fromParserPure ns suf defs lvls act = runSTErr $ do
suf <- newSTRef' suf
defs <- newSTRef' defs
log <- newSTRef' [<]
@ -376,7 +375,7 @@ export covering
expectFail : Loc -> Eff FromParserPure a -> Eff FromParserPure Error
expectFail loc act = do
gen <- getAt GEN; defs <- getAt DEFS; ns <- getAt NS; lvl <- curLevels
case fromParserPure {ns} gen defs (singleton lvl) act of
case fromParserPure ns gen defs (singleton lvl) act of
Left err => pure err
Right _ => throw $ ExpectedFail loc

View File

@ -68,7 +68,7 @@ parameters {c : Bool} {auto _ : Show b}
runFromParser : {default empty defs : Definitions} ->
Eff FromParserPure a -> Either FromParser.Error a
runFromParser = map val . fromParserPure 0 defs initStack
runFromParser = map val . fromParserPure [<] 0 defs initStack
export
tests : Test