1 files changed, 110 insertions, 63 deletions

diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs
index 3991a1f..ef91265 100644
--- a/src/VeriFuzz/Parser.hs
+++ b/src/VeriFuzz/Parser.hs
@@ -20,42 +20,39 @@ module VeriFuzz.Parser
   , parseExpr
   ) where
 
-import           Control.Applicative  ((<|>))
-import           Data.Attoparsec.Expr
-import           Data.Attoparsec.Text as A
-import           Data.Char            (isLetter)
-import           Data.Functor         (($>))
-import           Data.Text            (Text)
+import           Data.Functor          (($>))
+import           Data.Functor.Identity (Identity)
+import qualified Data.Text             as T
+import           Text.Parsec
+import           Text.Parsec.Expr
 import           VeriFuzz.AST
+import           VeriFuzz.Internal
+import           VeriFuzz.Lexer
+
+type Parser = Parsec String ()
+
+type ParseOperator = Operator String () Identity
 
 sBinOp :: BinaryOperator -> Expr -> Expr -> Expr
 sBinOp = sOp BinOp
   where
     sOp f b a = f a b
 
-parseExpr :: Parser Expr
-parseExpr = buildExpressionParser parseTable parseTerm
+parseExpr' :: Parser Expr
+parseExpr' = buildExpressionParser parseTable parseTerm
             <?> "expr"
 
 parseParens :: Parser a -> Parser a
 parseParens a = do
-  val <- "(" *> skipSpace *> a
-  _ <- skipSpace *> ")"
+  val <- string "(" *> spaces *> a
+  _ <- spaces *> string ")"
   return val
 
-constP :: Parser a -> Text -> Parser a
-constP p t = case parseOnly p t of
-  Left _  -> fail "constP"
-  Right a -> return a
-
-parseOf :: Parser Text -> Parser a -> Parser a
-parseOf ptxt pa = ptxt >>= constP pa
-
 ignoreWS :: Parser a -> Parser a
 ignoreWS a = do
-  skipSpace
+  spaces
   t <- a
-  skipSpace
+  spaces
   return t
 
 matchHex :: Char -> Bool
@@ -67,44 +64,61 @@ matchHex c = c == 'h' || c == 'H'
 matchDec :: Char -> Bool
 matchDec c = c == 'd' || c == 'D'
 
---matchOct :: Char -> Bool
---matchOct c = c == 'o' || c == 'O'
+matchOct :: Char -> Bool
+matchOct c = c == 'o' || c == 'O'
 
 -- | Parse a Number depending on if it is in a hex or decimal form. Octal and
 -- binary are not supported yet.
 parseNum :: Parser Expr
 parseNum = ignoreWS $ do
-  size <- decimal
-  _ <- "'"
+  size <- fromIntegral <$> decimal
+  _ <- string "'"
   matchNum size
   where
     matchNum size = (satisfy matchHex >> Number size <$> hexadecimal)
                     <|> (satisfy matchDec >> Number size <$> decimal)
+                    <|> (satisfy matchOct >> Number size <$> octal)
+
+parseVar :: Parser Expr
+parseVar = Id <$> ident
+
+parseFunction :: Parser Function
+parseFunction = string "unsigned" $> UnSignedFunc
+                <|> string "signed" $> SignedFunc
+
+parseFun :: Parser Expr
+parseFun = do
+  f <- spaces *> reservedOp "$" *> parseFunction
+  expr <- string "(" *> spaces *> parseExpr
+  _ <- spaces *> string ")" *> spaces
+  return $ Func f expr
 
 parseTerm :: Parser Expr
-parseTerm = (Concat <$> aroundList "{" "}" parseExpr)
-            <|> parseCond
-            <|> parseParens parseExpr
+parseTerm = parseParens parseExpr
+            <|> (Concat <$> aroundList (string "{") (string "}") parseExpr)
+            <|> parseFun
             <|> parseNum
+            <|> parseVar
             <?> "simple expr"
 
-takeUntil :: Char -> Parser Text
-takeUntil c = do
-  t <- takeWhile1 (/=c)
-  _ <- char c
-  return t
-
 -- | Parses the ternary conditional operator. It will behave in a right
 -- associative way.
-parseCond :: Parser Expr
-parseCond = do
-  x <- parseOf (takeUntil '?') parseExpr
-  y <- parseOf (takeUntil ':') parseExpr
-  Cond x y <$> parseExpr
+parseCond :: Expr -> Parser Expr
+parseCond e = do
+  _ <- reservedOp "?"
+  expr <- parseExpr
+  _ <- reservedOp ":"
+  Cond e expr <$> parseExpr
+
+parseExpr :: Parser Expr
+parseExpr = do
+  e <- parseExpr'
+  y <- option e $ parseCond e
+  return y
 
 -- | Table of binary and unary operators that encode the right precedence for
 -- each.
-parseTable :: [[Operator Text Expr]]
+parseTable :: [[ParseOperator Expr]]
 parseTable =
   [ [ prefix "!" (UnOp UnLNot), prefix "~" (UnOp UnNot) ]
   , [ prefix "&" (UnOp UnAnd), prefix "|" (UnOp UnOr), prefix "~&" (UnOp UnNand)
@@ -133,48 +147,81 @@ parseTable =
   , [ binary "|" (sBinOp BinLOr) AssocLeft ]
   ]
 
-binary :: Text -> (a -> a -> a) -> Assoc -> Operator Text a
-binary name fun = Infix ((string name <?> "binary") >> return fun)
-
-prefix :: Text -> (a -> a) -> Operator Text a
-prefix name fun = Prefix ((string name <?> "prefix") >> return fun)
+binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a
+binary name fun = Infix ((reservedOp name <?> "binary") >> return fun)
 
-commaSep :: Parser a -> Parser [a]
-commaSep f = sepBy f (skipSpace *> char ',' *> skipSpace)
+prefix :: String -> (a -> a) -> ParseOperator a
+prefix name fun = Prefix ((reservedOp name <?> "prefix") >> return fun)
 
 aroundList :: Parser a -> Parser b -> Parser c -> Parser [c]
 aroundList a b c = do
-  l <- a *> skipSpace *> commaSep c
+  l <- a *> spaces *> commaSep c
   _ <- b
   return l
 
 parseContAssign :: Parser ContAssign
 parseContAssign = do
-  var <- Identifier <$> (skipSpace *> "assign" *> skipSpace *> takeWhile1 isLetter)
-  expr <- skipSpace *> "=" *> skipSpace *> parseExpr
-  _ <- skipSpace *> ";"
+  var <- (spaces *> reserved "assign" *> spaces *> ident)
+  expr <- spaces *> reservedOp "=" *> spaces *> parseExpr
+  _ <- spaces *> string ";"
   return $ ContAssign var expr
 
-parseModItem :: Parser [ModItem]
-parseModItem = fmap ModCA <$> many1 parseContAssign
+-- | Parse a range and return the total size. As it is inclusive, 1 has to be
+-- added to the difference.
+parseRange :: Parser Int
+parseRange = do
+  rangeH <- string "[" *> spaces *> decimal
+  rangeL <- spaces *> string ":" *> spaces *> decimal
+  spaces *> string "]" *> spaces
+  return . fromIntegral $ rangeH - rangeL + 1
+
+ident :: Parser Identifier
+ident = Identifier . T.pack <$> identifier
+
+parseNetDecl :: Maybe PortDir -> Parser ModItem
+parseNetDecl pd = do
+  t <- option Wire type_
+  sign <- option False (reserved "signed" *> spaces $> True)
+  range <- option 1 parseRange
+  name <- ident
+  _ <- spaces *> string ";"
+  return . Decl pd . Port t sign range $ name
+  where
+    type_ = reserved "wire" *> spaces $> Wire
+            <|> reserved "reg" *> spaces $> Reg
+
+parsePortDir :: Parser PortDir
+parsePortDir =
+  reserved "output" *> spaces $> PortOut
+  <|> reserved "input" *> spaces $> PortIn
+  <|> reserved "inout" *> spaces $> PortInOut
+
+parseDecl :: Parser ModItem
+parseDecl =
+  (Just <$> parsePortDir >>= parseNetDecl)
+  <|> parseNetDecl Nothing
+
+parseModItem :: Parser ModItem
+parseModItem =
+  (ModCA <$> parseContAssign)
+  <|> parseDecl
 
 parseModList :: Parser [Identifier]
-parseModList = list <|> skipSpace $> []
+parseModList = list <|> spaces $> []
   where
-    list = fmap Identifier
-           <$> aroundList "(" ")" (takeWhile1 isLetter)
+    list = aroundList (string "(") (string ")") ident
 
 parseModDecl :: Parser ModDecl
 parseModDecl = do
-  name <- Identifier <$> ("module" *> skipSpace *> takeWhile1 isLetter)
-  modL <- fmap (Port Wire 1) <$> (skipSpace *> parseModList)
-  _ <- skipSpace *> ";"
-  modItem <- parseModItem <|> skipSpace $> []
-  _ <- skipSpace *> "endmodule"
-  return $ ModDecl name [Port Wire 1 "y"] modL modItem
+  name <- (reserved "module" *> ident)
+  modL <- fmap defaultPort <$> parseModList
+  _ <- string ";"
+  modItem <- option [] . try $ many1 parseModItem
+  _ <- reserved "endmodule"
+  return $ ModDecl name [defaultPort "y"] modL modItem
 
 parseDescription :: Parser Description
-parseDescription = Description <$> (skipSpace *> parseModDecl)
+parseDescription = Description <$> parseModDecl
 
 parseVerilogSrc :: Parser VerilogSrc
-parseVerilogSrc = VerilogSrc <$> many1 parseDescription
+parseVerilogSrc = VerilogSrc <$> many parseDescription