summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src/Minilang/REPL.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/REPL.hs')
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL.hs58
1 files changed, 41 insertions, 17 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/REPL.hs b/lambda-calcul/haskell/src/Minilang/REPL.hs
index a5ffce1..ae25822 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL.hs
@@ -1,59 +1,83 @@
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC "-fno-warn-orphans" #-}
module Minilang.REPL where
-import Control.Monad.Catch.Pure (CatchT (..))
+import Control.Monad.Catch.Pure (CatchT (..), SomeException)
import Control.Monad.State
import Data.Text hiding (replicate)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+import Minilang.Lambda (loadProgram)
+import Minilang.Lambda.Eval (Term, newEnv)
+import Minilang.Lambda.Infer (newContext)
+import Minilang.Lambda.Parser (parseProgram, pretty, resugar)
+import Minilang.Lambda.Unify (Type)
+import qualified Minilang.Lambda.Unify as Unify
import Minilang.REPL.Haskeline
import Minilang.REPL.IO
import Minilang.REPL.Pure
import Minilang.REPL.Purer
import Minilang.REPL.Run
import Minilang.REPL.Types
-import System.Console.Haskeline (
- defaultBehavior,
+import System.Console.Haskeline
+ ( defaultBehavior,
defaultSettings,
historyFile,
runInputTBehavior,
setComplete,
- )
+ )
import System.IO (Handle)
-- * Haskeline REPL
withTerminal :: IO ()
withTerminal =
- runInputTBehavior defaultBehavior settings $ evalStateT (runHaskeline runREPL) initialREPL
+ runInputTBehavior defaultBehavior settings $ evalStateT (runHaskeline runREPL) initialREPL
where
- settings = setComplete completion $ defaultSettings{historyFile = Just "~/.minilang.history"}
+ settings = setComplete completion $ defaultSettings {historyFile = Just "~/.minilang.history"}
-- * Other REPLs
-{- | Pure IO REPL
- Used for testing purposes
--}
-
--- |
+-- | Pure IO REPL
+-- Used for testing purposes
withHandles ::
- Handle -> Handle -> IO ()
+ Handle -> Handle -> IO ()
withHandles hin hout =
- evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL)
+ evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL)
+
+-- | Simple IO REPL, used to evaluate programs from stdin or file loading
+withIO :: Handle -> Handle -> IO ()
+withIO hin hout = do
+ input <- parseProgram <$> Text.hGetContents hin
+ case input of
+ Left err -> Text.hPutStrLn hout (Text.pack (show err))
+ Right inputs -> case loadProgram Untyped newEnv newContext inputs of
+ Right (results, _, _) -> mapM_ (Text.hPutStrLn hout . render) results
+ Left err -> Text.hPutStrLn hout (Text.pack $ show err)
+ where
+ render :: (Term, Type) -> Text
+ render (term, typ) = pretty (resugar term) <> " : " <> Unify.pretty typ
-- * Pure REPL
withInput ::
- [Text] -> [Text]
+ [Text] -> [Text]
withInput stream =
- outputText $ execState (runCatchT (runPure runREPL)) (PureEnv stream [] initialREPL)
+ outputText $ execState (runCatchT (runPure runREPL)) (PureEnv stream [] initialREPL)
+
-- * Purer REPL
-- This useful for rehydrating and environment from a sequence of inputs
withInputs ::
- REPLEnv -> [In] -> PurerEnv
+ REPLEnv -> [In] -> PurerEnv
withInputs initEnv stream =
- execState (runCatchT (runPurer runREPL)) (PurerEnv stream [] initEnv)
+ execState (runCatchT (runPurer runREPL)) (PurerEnv stream [] initEnv)
+
+runProgram :: PurerREPL a -> PurerEnv
+runProgram prog =
+ execState (runCatchT (runPurer prog)) (PurerEnv [] [] initialREPL)