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
|
module Language.SimpleShell.Parser.Module
( moduleP0
, modulePF
)
where
import Language.SimpleShell.AST.Module (Module(..), ModuleElement(..))
import Language.SimpleShell.AST.Name (FunName, ProcedureName)
import Language.SimpleShell.AST.SimpleType (FunSig, ProcedureSig)
import Language.SimpleShell.Parser.Common.Root (RootParser)
import Language.SimpleShell.Parser.Function (functionP0, functionP)
import Control.Monad (void)
import Control.Monad.Reader (ReaderT, runReaderT, withReaderT)
import Control.Monad.State (StateT, execStateT, gets, modify)
import Control.Monad.Trans.Class (lift)
import Data.Map (Map)
import qualified Data.Map as Map (empty, lookup, insert)
import Data.Text (unpack)
import Text.Megaparsec (many)
type ModuleParser0 = StateT ModuleContext RootParser
type ModuleParser = ReaderT ModuleContext RootParser
moduleP0 :: RootParser ModuleContext
moduleP0 = execStateT moduleMP0 initModuleContext
modulePF :: ModuleContext -> RootParser Module
modulePF = runReaderT moduleMP
data ModuleContext
= ModuleContext
{ ctxFuns :: Map FunName FunSig
, ctxProcedures :: Map ProcedureName ProcedureSig
}
deriving (Show)
initModuleContext :: ModuleContext
initModuleContext = ModuleContext Map.empty Map.empty
addFun :: FunName -> FunSig -> ModuleParser0 ()
addFun fname sig = do
funs <- gets ctxFuns
case Map.lookup fname funs of
Just _ -> fail $ "Function `" ++ unpack fname ++ "` already defined."
Nothing -> modify (\ctx -> ctx { ctxFuns = Map.insert fname sig funs })
moduleMP0 :: ModuleParser0 ()
moduleMP0 = void $ many (lift functionP0 >>= uncurry addFun)
moduleMP :: ModuleParser Module
moduleMP = Module <$> many elementP
where
elementP :: ModuleParser ModuleElement
elementP = FunctionElement <$> withReaderT ctxFuns functionP
|
