blob: be78beb68118ecfb6f567bf4f5d38aec0b373475 (
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
|
module Language.SimpleShell.Parser
( Parser
, lookupVar
, lookupFun
, initContext
, parseTest'
)
where
import Language.SimpleShell.AST.Expr (FunName, VarName)
import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig)
import Control.Monad.Reader (ask, ReaderT, runReaderT)
import Data.Map (Map)
import qualified Data.Map as Map (empty, lookup)
import Data.Text (Text, unpack)
import Data.Void (Void)
import Text.Megaparsec
type Parser = ReaderT Context (Parsec Void Text)
data Context = Context
{ ctxVars :: Map VarName SimpleType
, ctxFuns :: Map FunName FunSig
}
initContext :: Context
initContext = Context
{ ctxVars = Map.empty
, ctxFuns = Map.empty
}
lookupVar :: VarName -> Parser SimpleType
lookupVar varname = do
mt <- Map.lookup varname . ctxVars <$> ask
case mt of
Just t -> return t
Nothing -> fail $ "Undeclared variable $" ++ unpack varname
lookupFun :: FunName -> Parser FunSig
lookupFun fname = do
msig <- Map.lookup fname . ctxFuns <$> ask
case msig of
Just sig -> return sig
Nothing -> fail $ "Undefined function " ++ unpack fname
parseTest' :: Show a => Parser a -> Text -> IO ()
parseTest' p = parseTest (runReaderT p initContext)
|
