1 module M0ld
.Parser
(parseM0ld
) where
2 import Text
.ParserCombinators
.Parsec
hiding (label
)
3 import qualified Data
.Map
as Map
7 first
<- choice
[letter
, char
'_
']
8 rest
<- many
$ choice
[alphaNum
, char
'_
', char
'!']
9 return $ [first
] ++ rest
14 , char
'#' >> many
(noneOf
"\n") >> newline
18 opt_ws
= option
[()] ws
25 symbol x
= tok
$ string x
27 parenthesized
= between
(symbol
"(") (symbol
")")
29 inBraces
= between
(symbol
"{") (symbol
"}")
31 register
= char
'$' >> identifier
34 id <- tok
$ identifier
39 l
<- option
[] (try label
)
40 body
<- choice
$ map try [label
,call2
,call
,decl
,goto
,br
]
45 (char
'ยข
') <|
> (char
'?
')
50 return $ IntegerConstant
$ read digits
52 content
<- between
(char
'"') (char '"') quotedChar
53 return $ StringConstant
$ concat content
66 -- implicit_decl :: GenParser Char ImplicitDecls [Char]
70 case (Map
.lookup c decls
) of
74 let new
= "___implicit_register___"++(show $ Map
.size decls
)
75 updateState
$ Map
.insert c new
79 value = tok
$ choice
[register
,implicit_decl
]
85 defaultValue
<- option None
$ symbol
"=" >> constant
86 return [Decl x defaultValue
]
88 branch
= inBraces
$ do
91 label
<- tok identifier
102 return [Br cond iftrue iffalse
]
111 inline_decl
<- option
False (symbol
"my" >> return True)
117 arguments
<- parenthesized
$ sepBy
(tok argument
) (symbol
",")
118 let pos
= [ x | Pos x
<- arguments
]
119 named
= [x |
(Named k v
) <- arguments
, x
<- [k
,v
]]
120 decl
= if inline_decl
then [Decl target None
] else []
121 call
= [Call target identifier
(Capture invocant pos named
)]
122 return $ decl
++ call
130 capture
<- parenthesized
$ symbol
"|" >> value
131 return [Call2 target responder identifier capture
]
136 v
<- parenthesized
value
142 terminator
= opt_ws
>> ((symbol
";" >> return ()) <|
> eof
)
145 stmts
<- tok
$ endBy stmt terminator
147 constants
<- getState
148 return (concat $ stmts
,constants
)
151 savedState
<- getState
155 stmts
<- inBraces
$ tok
$ endBy stmt terminator
156 constants
<- getState
158 return $ SubMold
$ (implicitDecls constants
) ++ (concat stmts
)
159 type ImplicitDecls
= Map
.Map Value
[Char]
161 implicitDecls
= map (\(constant,reg
) -> Decl reg
constant) . Map
.toList
164 case (runParser top
(Map
.empty :: ImplicitDecls
) "" code
) of
165 Left err
-> error $ show err
166 Right
(stmts
,constants
) -> (implicitDecls constants
) ++ stmts