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
|
{-# LANGUAGE OverloadedStrings #-}
module Language.SimpleShell.Parser
( Parser
, lexeme
, 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 (Parsec)
import qualified Text.Megaparsec as MP (parseTest)
import Text.Megaparsec.Char (space1)
import qualified Text.Megaparsec.Char.Lexer as L
( lexeme
, space
, skipLineComment
, skipBlockComment
)
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
}
sc :: Parser ()
sc = L.space
space1
(L.skipLineComment "//")
(L.skipBlockComment "/*" "*/")
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
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 = MP.parseTest (runReaderT p initContext)
|
