exa/prlg
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

there's outputStrLn

Browse source
This commit is contained in:
Mirek Kratochvil 2022-11-15 20:31:02 +01:00
parent e074e454d5
commit fdf96f5a77
1 changed files with 10 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
app/Frontend.hs
View file

@ -33,16 +33,16 @@ interpret = (>> return True) . lex
where where
lex input = do lex input = do
case MP.parse P.lexPrlg "-" input of case MP.parse P.lexPrlg "-" input of
Left bundle -> liftIO $ putStr (MP.errorBundlePretty bundle) Left bundle -> lift . outputStr $ MP.errorBundlePretty bundle
Right toks -> parse toks Right toks -> parse toks
parse toks = do parse toks = do
case MP.parse P.parsePrlg "-" toks of case MP.parse P.parsePrlg "-" toks of
Left bundle -> liftIO $ putStr (MP.errorBundlePretty bundle) Left bundle -> lift . outputStr $ MP.errorBundlePretty bundle
Right asts -> traverse_ shunt asts Right asts -> traverse_ shunt asts
shunt ast = do shunt ast = do
o <- gets ops o <- gets ops
case P.shuntPrlg o ast of case P.shuntPrlg o ast of
Left err -> liftIO $ putStrLn $ "expression parsing: " ++ err Left err -> lift . outputStrLn $ "expression parsing: " ++ err
Right prlg -> intern prlg Right prlg -> intern prlg
intern prlgs = do intern prlgs = do
prlgi <- withStrTable $ \st -> C.internPrlg st prlgs prlgi <- withStrTable $ \st -> C.internPrlg st prlgs
@ -58,14 +58,13 @@ interpret = (>> return True) . lex
execute code execute code
execute code = do execute code = do
res <- I.prove code res <- I.prove code
case res of lift . outputStrLn $
Left err -> liftIO $ putStrLn err case res of
Right res -> Left err -> err
liftIO $ Right res ->
putStrLn $ if res
if res then "yes."
then "yes." else "no proof."
else "no proof."
interpreterStart :: PrlgEnv () interpreterStart :: PrlgEnv ()
interpreterStart = do interpreterStart = do