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
105
106
107
108
109
|
{-# 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 Minilang.Lambda (evalInEnvWith, loadProgram)
import Minilang.Lambda.Eval (newEnv)
import Minilang.Lambda.Infer (extendContext, infer, newContext)
import qualified Minilang.Lambda.Infer as Infer
import Minilang.Lambda.Parser (AST (..), parse, parseProgram, resugar)
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
repl@REPLEnv{language, evaluator, env, context} <- getEnv
case parse txt of
Left err -> output (Msg $ pack $ show err)
Right (Def ident body) -> do
let v = evalInEnvWith evaluator env body
case language of
Typed ->
case infer v of
Left typeError -> output (Msg $ Infer.render typeError)
Right typ -> do
setEnv $
repl
{ env = (ident, v) : env
, context = extendContext ident typ context
}
output (Defined ident (Just typ))
Untyped -> do
setEnv $ repl{env = (ident, v) : env}
output (Defined ident Nothing)
Right expr -> do
let v = evalInEnvWith evaluator env expr
ast = resugar v
case language of
Typed ->
case infer v of
Left typeError -> output (Msg $ Infer.render typeError)
Right typ -> do
let
output (Evaluated ast v (Just typ))
Untyped ->
output (Evaluated ast v Nothing)
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 language)
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})
>> output (Msg $ "Language set to " <> pack (show lang))
handleCommand (Set (SelectEvaluator ev)) =
getEnv >>= \e ->
setEnv (e{evaluator = ev})
>> output (Msg $ "Evaluator set to " <> pack (show ev))
handleCommand Help =
output (Msg helpText)
loadProgramInEnv ::
(MonadCatch m, MonadREPL m) =>
Text ->
m ()
loadProgramInEnv prog = do
repl@REPLEnv{env, context, language, evaluator} <- getEnv
case parseProgram prog of
Left err -> output (Msg $ pack $ show err)
Right exprs -> do
case loadProgram evaluator language env context exprs of
Left typeError -> output (Msg $ pack $ show typeError)
Right (results, env', context') -> do
setEnv (repl{env = env', context = context'})
mapM_ (\(term, typ) -> output (Evaluated (resugar term) term typ)) results
|
