From 7378b86829ce79f49b947a0744cbb6d8546a65aa Mon Sep 17 00:00:00 2001
From: Yann Herklotz Grave <git@yannherklotzgrave.com>
Date: Wed, 13 Feb 2019 19:53:30 +0000
Subject: Add expression to parser

---
 src/VeriFuzz/Parser.hs | 115 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 111 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs
index fd56027..4b2d076 100644
--- a/src/VeriFuzz/Parser.hs
+++ b/src/VeriFuzz/Parser.hs
@@ -13,13 +13,120 @@ whole Verilog syntax, as the AST does not support it either.
 
 module VeriFuzz.Parser where
 
+import           Control.Applicative  ((<|>))
 import           Data.Attoparsec.Text
+import           Data.Functor         (($>))
 import           Data.Text            (Text)
 import qualified Data.Text            as T
 import           VeriFuzz.AST
+import           VeriFuzz.CodeGen
 
-parseDescription :: Text -> Parser Description
-parseDescription = undefined
+commaSep :: Parser a -> Parser [a]
+commaSep f = sepBy f (skipSpace *> char ',' *> skipSpace)
 
-parseVerilogSrc :: Text -> Parser VerilogSrc
-parseVerilogSrc t = VerilogSrc <$> many1 (parseDescription t)
+aroundList :: Parser a -> Parser b -> Parser c -> Parser [c]
+aroundList a b c = do
+  l <- a *> skipSpace *> commaSep c
+  _ <- b
+  return l
+
+parseBinOp :: Parser BinaryOperator
+parseBinOp =
+  "+"       $> BinPlus
+  <|> "-"   $> BinMinus
+  <|> "*"   $> BinTimes
+  <|> "/"   $> BinDiv
+  <|> "%"   $> BinMod
+  <|> "=="  $> BinEq
+  <|> "!="  $> BinNEq
+  <|> "===" $> BinCEq
+  <|> "!==" $> BinCNEq
+  <|> "&&"  $> BinLAnd
+  <|> "||"  $> BinLOr
+  <|> "<"   $> BinLT
+  <|> "<="  $> BinLEq
+  <|> ">"   $> BinGT
+  <|> ">="  $> BinGEq
+  <|> "&"   $> BinAnd
+  <|> "|"   $> BinOr
+  <|> "^"   $> BinXor
+  <|> "^~"  $> BinXNor
+  <|> "~^"  $> BinXNorInv
+  <|> "**"  $> BinPower
+  <|> "<<"  $> BinLSL
+  <|> ">>"  $> BinLSR
+  <|> "<<<" $> BinASL
+  <|> ">>>" $> BinASR
+
+parseUnOp :: Parser UnaryOperator
+parseUnOp =
+  "+" $> UnPlus
+  <|> "-" $> UnMinus
+  <|> "!" $> UnLNot
+  <|> "~" $> UnNot
+  <|> "&" $> UnAnd
+  <|> "~&" $> UnNand
+  <|> "|" $> UnOr
+  <|> "~|" $> UnNor
+  <|> "^" $> UnXor
+  <|> "~^" $> UnNxor
+  <|> "^~" $> UnNxorInv
+
+parseExpr :: Parser Expr
+parseExpr = cond <|> binop <|> unop <|> conc <|> brack <|> var <|> num
+  where
+    var = Id . Identifier . T.pack <$> many1 letter
+    num = Number 32 <$> decimal
+    binop = do
+      lhs <- var <|> num
+      bo <- skipSpace *> parseBinOp
+      skipSpace
+      BinOp lhs bo <$> parseExpr
+    brack = do
+      expr <- "(" *> skipSpace *> parseExpr
+      skipSpace *> ")" *> skipSpace
+      return expr
+    cond = do
+      expr1 <- parseExpr
+      skipSpace *> "?" *> skipSpace
+      expr2 <- parseExpr
+      skipSpace *> ":" *> skipSpace
+      expr3 <- parseExpr
+      skipSpace
+      return $ Cond expr1 expr2 expr3
+    conc = Concat <$> aroundList "{" "}" parseExpr
+    unop = do
+      uo <- parseUnOp
+      skipSpace
+      UnOp uo <$> parseExpr
+
+parseContAssign :: Parser ContAssign
+parseContAssign = do
+  var <- Identifier . T.pack <$> (skipSpace *> "assign" *> skipSpace *> many1 letter)
+  expr <- skipSpace *> "=" *> skipSpace *> parseExpr
+  _ <- skipSpace *> ";"
+  return $ ContAssign var expr
+
+parseModItem :: Parser [ModItem]
+parseModItem = fmap ModCA <$> many1 parseContAssign
+
+parseModList :: Parser [Identifier]
+parseModList = list <|> skipSpace $> []
+  where
+    list = fmap (Identifier . T.pack)
+           <$> aroundList "(" ")" (many1 letter)
+
+parseModDecl :: Parser ModDecl
+parseModDecl = do
+  name <- Identifier . T.pack <$> ("module" *> skipSpace *> many1 letter)
+  modL <- fmap (Port Wire 1) <$> (skipSpace *> parseModList)
+  _ <- skipSpace *> ";"
+  modItem <- parseModItem <|> skipSpace $> []
+  _ <- skipSpace *> "endmodule"
+  return $ ModDecl name [Port Wire 1 "y"] modL modItem
+
+parseDescription :: Parser Description
+parseDescription = Description <$> (skipSpace *> parseModDecl)
+
+parseVerilogSrc :: Parser VerilogSrc
+parseVerilogSrc = VerilogSrc <$> many1 parseDescription
-- 
cgit