diff options
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/REPL/Run.hs')
| -rw-r--r-- | lambda-calcul/haskell/src/Minilang/REPL/Run.hs | 60 |
1 files changed, 30 insertions, 30 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs index a4b50f4..c90ecde 100644 --- a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs +++ b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs @@ -10,11 +10,12 @@ import Control.Monad.Catch import Data.Text hiding (replicate) import qualified Data.Text as Text import Debug.Trace (trace) +import Minilang.Lambda (loadProgram) import Minilang.Lambda.DeBruijn (eval, fromDeBruijn, toDeBruijn) +import Minilang.Lambda.Eval (newEnv) import Minilang.Lambda.Infer (infer, newContext) import Minilang.Lambda.Parser (desugar, parse) import Minilang.REPL.Types -import Minilang.Lambda.Eval (newEnv) -- | Run a REPL session runREPL :: @@ -49,41 +50,40 @@ handleCommand :: (MonadCatch m, MonadREPL m) => Command -> m () -handleCommand ClearEnv = getEnv >>= \e -> setEnv (e{env = newEnv, context = newContext}) +handleCommand ClearEnv = getEnv >>= \e -> setEnv (e {env = newEnv, context = newContext}) handleCommand DumpEnv = - getEnv >>= \REPLEnv{..} -> - output (CurrentEnv env context) + getEnv >>= \REPLEnv {..} -> + output (CurrentEnv env context) handleCommand (Load (File file)) = do - t <- load file - case t of - Left err -> output (Msg $ pack $ show err) - Right prog -> loadProgramInEnv prog + t <- load file + case t of + Left err -> output (Msg $ pack $ show err) + Right prog -> loadProgramInEnv prog handleCommand (Load (Data prog)) = loadProgramInEnv prog -handleCommand (Set (StepTypeChecker st)) = getEnv >>= \e -> setEnv (e{stepTypeCheck = st}) -handleCommand (Set (DebugParser st)) = getEnv >>= \e -> setEnv (e{debugParser = st}) +handleCommand (Set (StepTypeChecker st)) = getEnv >>= \e -> setEnv (e {stepTypeCheck = st}) +handleCommand (Set (DebugParser st)) = getEnv >>= \e -> setEnv (e {debugParser = st}) handleCommand Help = - output (Msg helpText) + output (Msg helpText) loadProgramInEnv :: (MonadCatch m, MonadREPL m) => Text -> m () -loadProgramInEnv prog = undefined -- do --- repl@REPLEnv{rho = ρ, gamma = γ, debugParser} <- getEnv --- case runParser program (ParserState debugParser) "" (unpack prog) of --- Left err -> output (Msg $ pack $ show err) --- Right e -> --- ( do --- (ρ', γ') <- loadProgram e ρ γ --- setEnv (repl{rho = ρ', gamma = γ'}) --- output (Msg makeMessage) --- ) --- `catch` \(TypingError err) -> output (Msg err) --- where --- makeMessage = --- "Loaded \"" --- <> ( if Text.length prog > 15 --- then Text.take 15 prog <> "..." --- else prog --- ) --- <> "\"" +loadProgramInEnv prog = do + repl@REPLEnv {env, context} <- getEnv + case parse prog of + Left err -> output (Msg $ pack $ show err) + Right e -> do + case loadProgram e env context of + Left typeError -> output (Msg $ pack $ show typeError) + Right (term, typ, env', context') -> do + setEnv (repl {env = env', context = context'}) + output (Evaluated term typ) + where + makeMessage = + "Loaded \"" + <> ( if Text.length prog > 15 + then Text.take 15 prog <> "..." + else prog + ) + <> "\"" |
