blob: 7ca0c8565a41506e9c7d702530af705f6ab16ef5 (
plain)
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
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module Minilang.REPL.Pure where
import Control.Exception (throw)
import Control.Monad.Catch
import Control.Monad.Catch.Pure (CatchT (..))
import Control.Monad.State
import Data.Text hiding (replicate)
import Minilang.Lambda.Parser (pretty, resugar)
import qualified Minilang.Lambda.Unify as Type
import Minilang.REPL.Types
data PureEnv = PureEnv
{ inputText :: [Text],
outputText :: [Text],
pureREPL :: REPLEnv
}
newtype PureREPL a = PureREPL {runPure :: CatchT (State PureEnv) a}
deriving (Functor, Applicative, Monad, MonadState PureEnv, MonadCatch)
instance MonadREPL PureREPL where
input = do
ins <- gets inputText
case ins of
[] -> pure EOF
(t : ts) -> modify (\e -> e {inputText = ts}) >> pure (interpret t)
output t = modify $ \e -> e {outputText = render t : outputText e}
prompt = pure ()
getEnv = gets pureREPL
setEnv e' = modify $ \e -> e {pureREPL = e'}
load f = pure $ Left $ REPLError $ "cannot load file " <> f <> " in Pure interpreter"
render :: Out -> Text
render = \case
Msg t -> t
Evaluated ast _term typ -> pretty ast <> " : " <> Type.pretty typ
Bye -> "Bye!"
other -> pack (show other)
instance MonadThrow PureREPL where
throwM = throw
|
