mirror of
https://github.com/anoma/juvix.git
synced 2024-12-15 18:13:56 +03:00
efb7f2abd0
Filepaths within a Loc must now be absolute or an error is thrown when
mkLoc is called. This Loc is used when displaying errors.
This commit uses imaginary absolute file paths in the Core repl and Asm
commands in the cases (parsing a single expression for example).
Before this fix, the `core {repl, read, eval}` and `asm` commands would
crash if it encountered an error when invoked with a relative path, or
in the case of a repl when parsing a single expression.
115 lines
3.9 KiB
Haskell
115 lines
3.9 KiB
Haskell
module Commands.Dev.Core.Repl where
|
|
|
|
import Commands.Base
|
|
import Commands.Dev.Core.Repl.Options
|
|
import Commands.Extra.Paths
|
|
import Evaluator
|
|
import Juvix.Compiler.Core.Data.InfoTable qualified as Core
|
|
import Juvix.Compiler.Core.Extra.Base qualified as Core
|
|
import Juvix.Compiler.Core.Info qualified as Info
|
|
import Juvix.Compiler.Core.Info.NoDisplayInfo qualified as Info
|
|
import Juvix.Compiler.Core.Language qualified as Core
|
|
import Juvix.Compiler.Core.Pretty qualified as Core
|
|
import Juvix.Compiler.Core.Translation.FromSource qualified as Core
|
|
|
|
runCommand :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Sem r ()
|
|
runCommand opts = do
|
|
showReplWelcome
|
|
runRepl opts Core.emptyInfoTable
|
|
|
|
parseText :: Core.InfoTable -> Text -> Either Core.ParserError (Core.InfoTable, Maybe Core.Node)
|
|
parseText = Core.runParser replPath
|
|
|
|
runRepl :: forall r. (Members '[Embed IO, App] r) => CoreReplOptions -> Core.InfoTable -> Sem r ()
|
|
runRepl opts tab = do
|
|
embed (putStr "> ")
|
|
embed (hFlush stdout)
|
|
done <- embed isEOF
|
|
unless done $ do
|
|
s <- embed getLine
|
|
case fromText (strip s) of
|
|
":q" -> return ()
|
|
":h" -> do
|
|
embed showReplHelp
|
|
runRepl opts tab
|
|
':' : 'p' : ' ' : s' ->
|
|
case parseText tab (fromString s') of
|
|
Left err -> do
|
|
printJuvixError (JuvixError err)
|
|
runRepl opts tab
|
|
Right (tab', Just node) -> do
|
|
renderStdOut (Core.ppOut opts node)
|
|
embed (putStrLn "")
|
|
runRepl opts tab'
|
|
Right (tab', Nothing) ->
|
|
runRepl opts tab'
|
|
':' : 'e' : ' ' : s' ->
|
|
case parseText tab (fromString s') of
|
|
Left err -> do
|
|
printJuvixError (JuvixError err)
|
|
runRepl opts tab
|
|
Right (tab', Just node) ->
|
|
replEval True tab' node
|
|
Right (tab', Nothing) ->
|
|
runRepl opts tab'
|
|
':' : 'l' : ' ' : f -> do
|
|
s' <- embed (readFile f)
|
|
sf <- someBaseToAbs' (someFile f)
|
|
case Core.runParser sf Core.emptyInfoTable s' of
|
|
Left err -> do
|
|
printJuvixError (JuvixError err)
|
|
runRepl opts tab
|
|
Right (tab', mnode) -> case mnode of
|
|
Nothing -> runRepl opts tab'
|
|
Just node -> replEval False tab' node
|
|
":r" ->
|
|
runRepl opts Core.emptyInfoTable
|
|
_ ->
|
|
case parseText tab s of
|
|
Left err -> do
|
|
printJuvixError (JuvixError err)
|
|
runRepl opts tab
|
|
Right (tab', Just node) ->
|
|
replEval False tab' node
|
|
Right (tab', Nothing) ->
|
|
runRepl opts tab'
|
|
where
|
|
replEval :: Bool -> Core.InfoTable -> Core.Node -> Sem r ()
|
|
replEval noIO tab' node = do
|
|
r <- doEval noIO defaultLoc tab' node
|
|
case r of
|
|
Left err -> do
|
|
printJuvixError (JuvixError err)
|
|
runRepl opts tab'
|
|
Right node'
|
|
| Info.member Info.kNoDisplayInfo (Core.getInfo node') -> runRepl opts tab'
|
|
| otherwise -> do
|
|
renderStdOut (Core.ppOut opts node')
|
|
embed (putStrLn "")
|
|
runRepl opts tab'
|
|
where
|
|
defaultLoc = singletonInterval (mkInitialLoc replPath)
|
|
|
|
showReplWelcome :: (Members '[Embed IO, App] r) => Sem r ()
|
|
showReplWelcome = embed $ do
|
|
putStrLn "JuvixCore REPL"
|
|
putStrLn ""
|
|
putStrLn "Type \":h\" for help."
|
|
putStrLn ""
|
|
|
|
showReplHelp :: IO ()
|
|
showReplHelp = do
|
|
putStrLn ""
|
|
putStrLn "JuvixCore REPL"
|
|
putStrLn ""
|
|
putStrLn "Type in a JuvixCore program to evaluate."
|
|
putStrLn ""
|
|
putStrLn "Available commands:"
|
|
putStrLn ":p expr Pretty print \"expr\"."
|
|
putStrLn ":e expr Evaluate \"expr\" without interpreting IO actions."
|
|
putStrLn ":l file Load and evaluate \"file\". Resets REPL state."
|
|
putStrLn ":r Reset REPL state."
|
|
putStrLn ":q Quit."
|
|
putStrLn ":h Display this help message."
|
|
putStrLn ""
|