diff options
Diffstat (limited to 'Sil/Parse.icl')
| -rw-r--r-- | Sil/Parse.icl | 45 |
1 files changed, 39 insertions, 6 deletions
diff --git a/Sil/Parse.icl b/Sil/Parse.icl index 925423c..ec25c1f 100644 --- a/Sil/Parse.icl +++ b/Sil/Parse.icl @@ -36,6 +36,12 @@ where toString TComma = "," toString TSemicolon = ";" toString TAssign = ":=" + toString TTilde = "~" + toString TPlus = "+" + toString TMinus = "-" + toString TStar = "*" + toString TSlash = "/" + toString TPercent = "%" toString (TLit l) = toString l toString TIf = "if" toString TWhile = "while" @@ -67,6 +73,12 @@ where tks ['}':r] t = tks r [TBraceClose:t] tks [',':r] t = tks r [TComma :t] tks [';':r] t = tks r [TSemicolon :t] + tks ['~':r] t = tks r [TTilde :t] + tks ['+':r] t = tks r [TPlus :t] + tks ['-':r] t = tks r [TMinus :t] + 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 ['w':'h':'i':'l':'e' :s:r] t | isSpace s = tks r [TWhile :t] @@ -131,12 +143,6 @@ where declaration :: Parser Token Statement declaration = liftM2 Declaration name (item TAssign *> application) - application :: Parser Token Application - application - = liftM2 App name (item TParenOpen *> seplist TComma application <* item TParenClose) - <|> liftM Literal literal - <|> liftM Name name - return :: Parser Token Statement return = liftM Return (item TReturn *> optional application) @@ -144,6 +150,33 @@ where machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode where isMachineCode (TMachineCode _) = True; isMachineCode _ = False +application :: Parser Token Application +application + = leftAssoc + ( op TPlus Add + <|> op TMinus Sub + ) + $ leftAssoc + ( op TStar Mul + <|> op TSlash Div + <|> op TPercent Rem + ) + $ noInfix +where + op :: Token Op2 -> Parser Token Op2 + op token operator = item token *> pure operator + + 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 + + noInfix :: Parser Token Application + noInfix + = liftM2 App name (item TParenOpen *> seplist TComma application <* item TParenClose) + <|> liftM (BuiltinApp Neg) (item TTilde *> noInfix) + <|> liftM Literal literal + <|> liftM Name name + name :: Parser Token Name name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name" where |