rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

remove default from FromParser.fromParserPure and Main.step

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

15
exe/Main.idr
View file

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

7
lib/Quox/Parser/FromParser.idr
View file

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

2
tests/Tests/FromPTerm.idr
View file

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