diff options
Diffstat (limited to 'Sil/Parse.icl')
| -rw-r--r-- | Sil/Parse.icl | 42 |
1 files changed, 33 insertions, 9 deletions
diff --git a/Sil/Parse.icl b/Sil/Parse.icl index ec25c1f..092d3da 100644 --- a/Sil/Parse.icl +++ b/Sil/Parse.icl @@ -67,6 +67,10 @@ tokenise cs = reverse <$> tks cs [] where tks :: [Char] [Token] -> MaybeError ParseError [Token] tks [] t = pure t + tks [':':'=':r] t = tks r [TAssign :t] + tks ['=':'=':r] t = tks r [TDoubleEquals :t] + tks ['|':'|':r] t = tks r [TDoubleBar :t] + tks ['&':'&':r] t = tks r [TDoubleAmpersand:t] tks ['(':r] t = tks r [TParenOpen :t] tks [')':r] t = tks r [TParenClose:t] tks ['{':r] t = tks r [TBraceOpen :t] @@ -79,8 +83,8 @@ where tks ['*':r] t = tks r [TStar :t] tks ['/':r] t = tks r [TSlash :t] tks ['%':r] t = tks r [TPercent :t] - tks [':':'=':r] t = tks r [TAssign :t] tks ['i':'f' :s:r] t | isSpace s = tks r [TIf :t] + tks ['e':'l':'s':'e' :s:r] t | isSpace s = tks r [TElse :t] tks ['w':'h':'i':'l':'e' :s:r] t | isSpace s = tks r [TWhile :t] tks ['r':'e':'t':'u':'r':'n':s:r] t | isSpace s = tks r [TReturn:t] tks ['T':'r':'u':'e' :s:r] t | isSpace s = tks r [TLit $ BLit True :t] @@ -137,8 +141,8 @@ statement :: Parser Token Statement statement = ((declaration <|> liftM Application application <|> return -/* <|> if` - <|> while*/) <* item TSemicolon) <|> machinecode + <|> if` + /*<|> while*/) <* item TSemicolon) <|> machinecode where declaration :: Parser Token Statement declaration = liftM2 Declaration name (item TAssign *> application) @@ -150,22 +154,36 @@ where machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode where isMachineCode (TMachineCode _) = True; isMachineCode _ = False + if` :: Parser Token Statement + if` = item TIf *> + parenthised application >>= \cond -> + braced codeblock >>= \iftrue -> + optional (item TElse *> braced codeblock) >>= \iffalse -> + pure $ If cond iftrue iffalse + application :: Parser Token Application application - = leftAssoc - ( op TPlus Add - <|> op TMinus Sub + = rightAssoc (op TDoubleBar LogOr) + $ rightAssoc (op TDoubleAmpersand LogAnd) + $ rightAssoc (op TDoubleEquals Equals) + $ leftAssoc + ( op TPlus Add + <|> op TMinus Sub ) $ leftAssoc - ( op TStar Mul - <|> op TSlash Div - <|> op TPercent Rem + ( op TStar Mul + <|> op TSlash Div + <|> op TPercent Rem ) $ noInfix where op :: Token Op2 -> Parser Token Op2 op token operator = item token *> pure operator + rightAssoc :: (Parser Token Op2) (Parser Token Application) -> Parser Token Application + rightAssoc opp appp = appp >>= \e1 -> optional (opp >>= \op -> rightAssoc opp appp >>= \e -> pure (op,e)) + >>= pure o maybe e1 (\(op,e2) -> BuiltinApp2 e1 op e2) + leftAssoc :: (Parser Token Op2) (Parser Token Application) -> Parser Token Application leftAssoc opp appp = appp >>= \e1 -> many (opp >>= \op -> appp >>= \e -> pure (op,e)) >>= foldM (\e (op,e2) -> pure $ BuiltinApp2 e op e2) e1 @@ -202,3 +220,9 @@ where isLit :: Token -> Bool isLit (TLit _) = True isLit _ = False + +parenthised :: (Parser Token a) -> Parser Token a +parenthised p = item TParenOpen *> p <* item TParenClose + +braced :: (Parser Token a) -> Parser Token a +braced p = item TBraceOpen *> p <* item TBraceClose |