blob: d9dbbbe8ee12199b30031e3e1d289f6c431ea426 (
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
50
51
52
53
54
55
|
{-# 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 <> renderType typ
Defined ident typ -> ident <> renderType typ
Bye -> "Bye!"
other -> pack (show other)
renderType :: Maybe Type.Type -> Text
renderType typ = case typ of
Nothing -> ""
Just t -> " : " <> Type.pretty t
instance MonadThrow PureREPL where
throwM = throw
|
