Statement parsing

1 files changed, 29 insertions, 9 deletions

diff --git a/src/SPL/Parse.hs b/src/SPL/Parse.hs
index c05b755..4331ccb 100644
--- a/src/SPL/Parse.hs
+++ b/src/SPL/Parse.hs
@@ -3,12 +3,13 @@
 module SPL.Parse (parse)
 where
 
-import Text.Parsec (sepBy)
-import qualified Text.Parsec as P
-
 import Control.Applicative
+import Control.Monad
 import Data.Functor
 
+import Text.Parsec (sepBy, (<?>))
+import qualified Text.Parsec as P
+
 import SPL.Syntax hiding (TInt,TBool,TChar,TArrow)
 import qualified SPL.Syntax
 import SPL.Lex
@@ -22,7 +23,7 @@ satisfy p = P.tokenPrim
   (\t -> if p t then Just t else Nothing)
 
 token :: Token -> Parser Token
-token = satisfy . (==)
+token t = satisfy (== t) <?> show t
 
 check :: (Token -> Maybe a) -> Parser a
 check f = P.tokenPrim
@@ -48,6 +49,12 @@ comment = toString <$> satisfy isCommentToken
     toString (TSingleComment s) = s
     toString (TBlockComment s)  = s
 
+parenthesised :: Parser a -> Parser a
+parenthesised p = token TParenOpen *> p <* token TParenClose
+
+braced :: Parser a -> Parser a
+braced p = token TBraceOpen *> p <* token TBraceClose
+
 var :: Parser Variable
 var = do
   t  <- Just <$> plainType <|> (token TVar $> Nothing)
@@ -60,13 +67,11 @@ var = do
 fun :: Parser Function
 fun = do
   id <- ident
-  token TParenOpen
-  args <- ident `sepBy` token TComma
-  token TParenClose
+  args <- parenthesised $ ident `sepBy` token TComma
   ftype <- optional (token TColonColon *> funType)
   token TBraceOpen
   vars <- many var
-  stmt <- statement
+  stmt <- statements
   token TBraceClose
   return $ Function id ftype args vars stmt
 
@@ -95,5 +100,20 @@ expr = literal -- TODO
       TBool b -> Just (LBool b)
       _       -> Nothing
 
+statements :: Parser Statement
+statements = foldr1 Seq <$> some statement <|> pure Nop
+
 statement :: Parser Statement
-statement = fail "" -- TODO
+statement =
+  liftM3 If
+    (token TIf *> parenthesised expr)
+    (braced statements)
+    (optional (token TElse *> braced statements)) <|>
+  liftM2 While
+    (token TWhile *> parenthesised expr)
+    (braced statements) <|>
+  liftM2 Assign
+    ident
+    (token TEquals *> expr <* token TSemicolon) <|>
+  Eval <$> (expr <* token TSemicolon) <|>
+  Return <$> (token TReturn *> optional expr <* token TSemicolon)