currently passing most of (currently small) corpus

TODO.md

@@ -27,6 +27,10 @@
  - [ ] Embed locs in AST
  - [ ] Name new parsers
  - [ ] Remove `a` and `val` from exports
+ - [ ] Permit all binary characters. Add validation pass later.
+ - [ ] Correct comment parser
+ - [ ] What does it mean to have an empty sigspec concat in
+       `{ <sigspec>* }`
 
 # Parser Verification
  - [ ] I think only EOL terminated parsers should be responsible 

app/Main.hs

@@ -18,7 +18,7 @@ main = do
             -- Attempt to read the file
             contents <- catch (readFile filePath) handleReadError
             putStrLn "File Contents:"
-            putStrLn $ ppShow $ Haskellator.runParser contents
+            putStrLn $ ppShow $ Haskellator.runParser contents filePath
         [] -> putStrLn "cabal run Haskellator -- <file-path>"
     -- putStrLn $ ppShow Haskellator.val
 

src/RTLILParser/AST.hs

@@ -65,7 +65,7 @@ data AutogenId      = AutogenId     String  deriving (Show)
 -- values
 data Value = Value
     { width :: Int
-    , value :: Int
+    , binaryValue :: String
     }
     deriving (Show)
 

src/RTLILParser/Parser.hs

@@ -68,7 +68,8 @@ import RTLILParser.Primitives(
 -- taken from: https://yosyshq.readthedocs.io/projects/yosys/en/0.47/appendix/rtlil_text.html
 -- parsers below are split int sections from the above link
 
-runParser str = case parse pFile "pFile" str of
+runParser :: String -> SourceName -> File
+runParser str filename = case parse pFile filename str of
     Left err -> error $ show err
     Right val -> val
 
@@ -96,16 +97,17 @@ pValue = p <?> name where
         do
         width <- many1 pDecimalDigit
         char '\''
-        value <- many pBinaryDigit
+        binaryValue <- many pBinaryDigit
-        return $ Value (read width) (binaryStringToInt value)
+        return $ Value (read width) binaryValue
 
 pDecimalDigit :: Parser Char
 pDecimalDigit = oneOf "0123456789" <?> "DecimalDigit"
 
--- update in the future to support 4 state logic
+-- Haskellator simulation will likely only support 0/1 and 
--- by converting x and z to 0 and warning about it.
+-- don't cares. We can however be permissive when parsing, 
+-- and raise errors later during validation.
 pBinaryDigit :: Parser Char
-pBinaryDigit = oneOf "01" <?> "BinaryDigit"
+pBinaryDigit = oneOf "01xzm-" <?> "BinaryDigit"
 
 pInteger :: Parser Int
 pInteger = p <?> name where
@@ -153,7 +155,7 @@ pModule = p <?> name where
     name = "Module"
     p =
         do
-        attrs       <- many pAttrStmt
+        attrs       <- many (try pAttrStmt)
         moduleStmt  <- pModuleStmt
         moduleBody  <- pModuleBody
         pModuleEndStmt
@@ -173,7 +175,7 @@ pModuleBody = p <?> name where
     name = "ModuleBody"
     p =
         ModuleBody
-        <$> many pModuleBodyVariant
+        <$> many (try pModuleBodyVariant)
 
 pModuleBodyVariant :: Parser ModuleBodyVariant
 pModuleBodyVariant = p <?> name where
@@ -245,8 +247,8 @@ pSigSpecConcat = p <?> name where
     p =
         do
         char '{' <* pWs
-        sigspecs    <- pSigSpec `sepBy` pWs
+        sigspecs    <- many $ pSigSpec <* pWs
-        pWs <* char '}'
+        char '}'
         return $ SigSpecConcat sigspecs
 
 applySlices :: SigSpec -> Parser SigSpec
@@ -331,7 +333,7 @@ pMemoryStmt = p <?> name where
     p =
         do
         (string "memory" <* pWs)
-        options     <- (many pMemoryOption <* pWs)
+        options     <- (many pMemoryOption <* pMaybeWs)
         memoryId    <- MemoryID <$> pId
         advanceToNextToken
         return $ MemoryStmt memoryId options
@@ -439,8 +441,8 @@ pProcessBody = p <?> name where
         -- character being an 'a' would have been consumed.
         assignStmts <- many $ try pAssignStmt
         switch      <- many $ try pSwitch
-        -- syncs       <- many pSync
+        syncs       <- many pSync
-        return $ ProcessBody [] [] []
+        return $ ProcessBody assignStmts switch syncs
 
 pAssignStmt :: Parser AssignStmt
 pAssignStmt = p <?> name where
@@ -488,7 +490,6 @@ pCase = p <?> name where
         caseStmt <- pCaseStmt
         caseBody <- pCaseBody
         return $ Case caseStmt attrs caseBody
-        -- return $ Case (CaseStmt Nothing) attrs (CaseBody [])
 
 pCaseStmt :: Parser CaseStmt
 pCaseStmt = p <?> name where
@@ -496,7 +497,7 @@ pCaseStmt = p <?> name where
     p =
         CaseStmt
         <$> (
-            string "case" *> pWs
+            string "case" *> pMaybeWs
             *> optionMaybe pCompare
             <* advanceToNextToken)
 
@@ -512,8 +513,8 @@ pCaseBody = p <?> name where
     name = "CaseBody"
     p =
         CaseBody
-        <$> many pAssignStmt
+        <$> many (try pAssignStmt)
-        <*> many pSwitch
+        <*> many (try pSwitch)
 
 pCaseBodyVariant :: Parser CaseBodyVariants
 pCaseBodyVariant = p <?> name where

src/RTLILParser/Primitives.hs

@@ -34,17 +34,17 @@ pEscapedChar = do
         ]
 
 pMaybeWs :: Parser String
-pMaybeWs = many (oneOf " \t")
+pMaybeWs = many (oneOf " \t") <?> "MaybeWs"
 
 pWs :: Parser String
-pWs = many1 (oneOf " \t")
+pWs = many1 (oneOf " \t") <?> "Ws"
 
 -- https://github.com/YosysHQ/yosys/blob/111b747d2797238eadf541879848492a9d34909a/frontends/rtlil/rtlil_lexer.l#L88C1-L88C17
 pNonWs :: Parser Char
-pNonWs = noneOf " \t\r\n"
+pNonWs = noneOf " \t\r\n" <?> "NonWs"
 
 pEol :: Parser ()
-pEol = void (many1 (oneOf "\r\n") <* pMaybeWs)
+pEol = void (oneOf "\r\n") <?> "Eol"
 
 -- a comment begins with # and ends at the end of the line
 -- a comment can be be inline, but must still end at the end of the line
@@ -60,12 +60,12 @@ pComment = p <?> name where
 
 advanceToNextToken :: Parser ()
 advanceToNextToken = p <?> name where
-    name = "AdvanceToNextToken" 
+    name = "AdvanceToNextToken"
-    p = 
+    p =
-        void (pMaybeWs *> many1 (void pComment <|> pEol))
+        void (pMaybeWs *> many1 (void pComment <|> (pEol <* pMaybeWs)))
 
 advanceToFirstToken :: Parser ()
 advanceToFirstToken = p <?> name where
     name = "AdvanceToFirstToken"
-    p = 
+    p =
-        void (pMaybeWs *> many (void pComment <|> pEol))
+        void (pMaybeWs *> many (void pComment <|> (pEol <* pMaybeWs)))