From 19c70b8eaa1126f1648b009d99092432a5c88059 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 1 Sep 2017 18:14:43 +0200
Subject: Structs + typedefs

---
 ProgramParser.hs | 107 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 67 insertions(+), 40 deletions(-)

(limited to 'ProgramParser.hs')

diff --git a/ProgramParser.hs b/ProgramParser.hs
index a71d07e..411e063 100644
--- a/ProgramParser.hs
+++ b/ProgramParser.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TupleSections #-}
+
 module ProgramParser(parseProgram) where
 
 import Control.Monad
@@ -19,20 +21,32 @@ parseProgram s = case parse pProgram "" s of
     Right p -> Right p
 
 pProgram :: Parser Program
-pProgram = do
-    pWhiteComment
-    decls <- many pDecl
-    eof
-    return $ Program (lefts decls) (rights decls)
-
-pDecl :: Parser (Either DVar DFunc)
-pDecl = (Right <$> pDFunc) <|> (Left <$> pDVar)
+pProgram = between pWhiteComment eof go
+  where
+    go :: Parser Program
+    go = (pDTypedef >>= \d -> addTypedef d <$> go) <|>
+         (pDFunc >>= \d -> addFunc d <$> go) <|>
+         (pDVar >>= \d -> addVar d <$> go) <|>
+         return (Program [] [] [])
+
+    addTypedef d (Program a b c) = Program (d:a) b c
+    addVar d (Program a b c) = Program a (d:b) c
+    addFunc d (Program a b c) = Program a b (d:c)
+
+pDTypedef :: Parser DTypedef
+pDTypedef = do
+    symbol "type"
+    n <- pName
+    symbol ":="
+    t <- pType
+    symbol ";"
+    return $ DTypedef n t
 
 pDFunc :: Parser DFunc
 pDFunc = do
     symbol "func"
-    rt <- (Just <$> pType) <|> return Nothing
-    n <- pName
+    (rt,n) <- (try $ pType >>= \t -> (Just t,) <$> pName) <|>
+              ((Nothing,) <$> pName)
     symbol "("
     args <- sepBy pTypeAndName (symbol ",")
     symbol ")"
@@ -41,8 +55,7 @@ pDFunc = do
 
 pDVar :: Parser DVar
 pDVar = do
-    t <- pType
-    n <- pName
+    (t,n) <- try pTypeAndName
     symbol ":="
     e <- pExpression
     symbol ";"
@@ -52,16 +65,27 @@ pTypeAndName :: Parser (Type, Name)
 pTypeAndName = (,) <$> pType <*> pName
 
 pType :: Parser Type
-pType = do
-    t <- pBasicType
-    (do
-        symbol "["
-        msz <- optionMaybe pInteger
-        symbol "]"
-        return $ TArr t msz) <|> return t
+pType = (flip label "type") $
+    pStruct <|> do
+        t <- pBasicType
+        (do
+            symbol "["
+            msz <- optionMaybe pInteger
+            symbol "]"
+            return $ TArr t msz) <|> return t
+
+pStruct :: Parser Type
+pStruct = do
+    symbol "struct"
+    symbol "{"
+    ms <- many $ pTypeAndName <* symbol ";"
+    symbol "}"
+    return $ TStruct ms
 
 pBasicType :: Parser Type
-pBasicType = (symbol "int" >> return TInt) <|> (symbol "char" >> return TChar)
+pBasicType = (symbol "int" >> return TInt) <|>
+             (symbol "char" >> return TChar) <|>
+             (TName <$> pName)
 
 pBlock :: Parser Block
 pBlock = do
@@ -134,7 +158,7 @@ pSExpr = do
     return $ SExpr e
 
 pExpression :: Parser Expression
-pExpression = E.buildExpressionParser optable litparser
+pExpression = E.buildExpressionParser optable litparser <?> "expression"
   where
     optable =
         [[E.Infix (symbol "**" >> return (mkEBin BOPow)) E.AssocRight],
@@ -163,11 +187,14 @@ pExpression = E.buildExpressionParser optable litparser
 
     litparser :: Parser Expression
     litparser = do
-        pops <- many pPrefixOp
-        e <- pParenExpr <|> pENew <|> pCastExpr <|> (mkELit <$> pLiteral)
-        subs <- many $ between (symbol "[") (symbol "]") pExpression
-        let e' = foldl (\ex sub -> ESubscript ex sub Nothing) e subs
-            e'' = foldl (\ex pop -> EUn pop ex Nothing) e' pops
+        preops <- many pPrefixOp
+        e <- pParenExpr <|> pENew <|> (mkELit <$> pLiteral)
+        postops <- many pPostfixOp
+        let e' = foldl (\ex op -> case op of
+                            Left sub -> ESubscript ex sub Nothing
+                            Right n -> EGet ex n Nothing)
+                       e postops
+            e'' = foldl (\ex pop -> EUn pop ex Nothing) e' preops
         return e''
 
 pAsExpression :: Parser AsExpression
@@ -180,6 +207,12 @@ pPrefixOp :: Parser UnaryOp
 pPrefixOp = (symbol "!" >> return UONot) <|>
             (symbol "-" >> return UONeg)
 
+-- Left: subscript; Right: dot-index
+pPostfixOp :: Parser (Either Expression Name)
+pPostfixOp =
+    (Left <$> between (symbol "[") (symbol "]") pExpression) <|>
+    (Right <$> (symbol "." >> pName))
+
 pParenExpr :: Parser Expression
 pParenExpr = do
     symbol "("
@@ -187,13 +220,6 @@ pParenExpr = do
     symbol ")"
     return e
 
-pCastExpr :: Parser Expression
-pCastExpr = do
-    t <- try $ pType <* symbol "("
-    e <- pExpression
-    symbol ")"
-    return $ ECast t e
-
 pENew :: Parser Expression
 pENew = do
     symbol "new"
@@ -206,7 +232,7 @@ pENew = do
 pLiteral :: Parser Literal
 pLiteral =
     (LInt <$> pInteger) <|> (LChar <$> pCharLit) <|> (LStr <$> pString) <|>
-    pLCall <|> (LVar <$> pName)
+    pLStruct <|> pLCall <|> (LVar <$> pName)
 
 pCharLit :: Parser Char
 pCharLit = do
@@ -237,6 +263,13 @@ pString = do
     void $ char '"'
     return s
 
+pLStruct :: Parser Literal
+pLStruct = do
+    symbol "{"
+    ms <- sepBy (pName >>= \n -> symbol "=" >> pExpression >>= \e -> return (n,e)) (symbol ",")
+    symbol "}"
+    return $ LStruct ms
+
 pLCall :: Parser Literal
 pLCall = do
     n <- try $ pName <* symbol "("
@@ -310,9 +343,3 @@ pBlockComment = do
     void $ sepEndBy (manyTill anyToken (lookAhead $ try (string "/*") <|> try (string "*/")))
                     pBlockComment
     void $ string "*/"
-
-lefts :: [Either a b] -> [a]
-lefts = foldr (\e l -> either (:l) (const l) e) []
-
-rights :: [Either a b] -> [b]
-rights = foldr (\e l -> either (const l) (:l) e) []
-- 
cgit v1.2.3-54-g00ecf