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
|
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Minilang.REPL.Run where
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 qualified Minilang.Lambda.Infer as Infer
import Minilang.Lambda.Parser (desugar, parse)
import Minilang.Lambda.Unify (Type (TyVar))
import Minilang.REPL.Types
-- | Run a REPL session
runREPL ::
(MonadCatch m, MonadREPL m) => m ()
runREPL = go
where
go = do
prompt
raw <- input
case raw of
EOF -> output Bye
In txt -> handleUserInput txt >> go
Com cmd -> handleCommand cmd >> go
handleUserInput ::
(MonadCatch m, MonadREPL m) =>
Text ->
m ()
handleUserInput txt = do
REPLEnv {language} <- getEnv
case parse txt of
Left err -> output (Msg $ pack $ show err)
Right expr -> do
let term = desugar expr
v = fromDeBruijn $ eval (toDeBruijn term)
case language of
Typed ->
case infer term of
Left typeError -> output (Msg $ Infer.render typeError)
Right typ -> do
let
output (Evaluated v typ)
Untyped ->
output (Evaluated v (TyVar "<?>"))
handleCommand ::
(MonadCatch m, MonadREPL m) =>
Command ->
m ()
handleCommand ClearEnv = getEnv >>= \e -> setEnv (e {env = newEnv, context = newContext})
handleCommand DumpEnv =
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
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 (SelectLanguage lang)) = getEnv >>= \e -> setEnv (e {language = lang})
handleCommand Help =
output (Msg helpText)
loadProgramInEnv ::
(MonadCatch m, MonadREPL m) =>
Text ->
m ()
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
)
<> "\""
|
