1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC "-fno-warn-orphans" #-}
module Minilang.REPL where
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.Environment (lookupEnv)
import Text.Read (readMaybe)
import System.Console.Haskeline
( defaultBehavior,
defaultSettings,
historyFile,
runInputTBehavior,
setComplete,
)
import System.IO (Handle, stderr)
-- | Read the evaluator selection from the @MINILANG_EVAL@ environment variable.
-- Returns 'DeBruijn' when the variable is absent or unrecognised.
evaluatorFromEnv :: IO Evaluator
evaluatorFromEnv =
lookupEnv "MINILANG_EVAL" >>= \case
Nothing -> pure DeBruijn
Just raw -> case readMaybe raw of
Just ev -> pure ev
Nothing -> do
Text.hPutStrLn stderr $
"Warning: unknown MINILANG_EVAL value " <> Text.pack (show raw)
<> ", falling back to DeBruijn"
pure DeBruijn
-- | Build the initial 'REPLEnv' using the given 'Evaluator'.
replEnvWith :: Evaluator -> REPLEnv
replEnvWith ev = initialREPL { evaluator = ev }
-- * Haskeline REPL
withTerminal :: Evaluator -> IO ()
withTerminal ev =
runInputTBehavior defaultBehavior settings $
evalStateT (runHaskeline runREPL) (replEnvWith ev)
where
settings = setComplete completion $ defaultSettings {historyFile = Just "~/.minilang.history"}
-- * Other REPLs
-- | Pure IO REPL
-- Used for testing purposes
withHandles ::
Handle -> Handle -> IO ()
withHandles hin hout =
evalStateT (runConsole runREPL) (IOEnv hin hout initialREPL)
-- | Simple IO REPL, used to evaluate programs from stdin or file loading
withIO :: Evaluator -> Handle -> Handle -> IO ()
withIO ev hin hout = do
programText <- parseProgram <$> Text.hGetContents hin
case programText of
Left err -> Text.hPutStrLn hout (Text.pack (show err))
Right prog -> case loadProgram ev Untyped newEnv newContext prog 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) -- TODO: handle types <> " : " <> Unify.pretty typ
-- * Pure REPL
withInput ::
[Text] -> [Text]
withInput stream =
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
withInputs initEnv stream =
execState (runCatchT (runPurer runREPL)) (PurerEnv stream [] initEnv)
runProgram :: PurerREPL a -> PurerEnv
runProgram prog =
execState (runCatchT (runPurer prog)) (PurerEnv [] [] initialREPL)
|
