working on naming parsers

TODO.md

@@ -1,4 +1,4 @@
- # General and Planning
+# General and Planning
  - [ ] might need many validation phases
    - [ ] it's conceivable that one could construct a Yosys memory Cell 
          with invalid parameters
@@ -34,7 +34,7 @@
        parser doesn't conflict(exhibit a partial early match) with 
        the argument of the parser after the argument of the `many` parser.
 
- # Parser Development
+# Parser Development
  - [x] Sync
  - [ ] Process
  - [x] Finish `pCell` with `pCellEndStmt`
@@ -42,6 +42,8 @@
  - [x] Remove all instances of `_ <-`
  - [ ] Module
  - [ ] Remove weird GHC imports
+ - [ ] Embed locs in AST
+ - [ ] Remove `preProcessDiscardComments` from exports
  - [x] Are the `try` statements in `pWireOption` correctly constructed?
  - [ ] Consider the very weird case where the process body has nothing,
        thus, `pEolAndAdvanceToNextNonWs` may never get invoked in any of
@@ -56,7 +58,7 @@
             I still need to verify how other parsers behave. For example, what
             happens if we have a cell with no `<cell-body-stmt>`
 
- # Parser Verification
+# Parser Verification
  - [ ] I think only EOL terminated parsers should be responsible 
        for advancing the Parsec scanner to the next non-space...
  - [ ] lift grammar into prover and show that all EOL terminated parsers

app/Main.hs

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

src/Haskellator.hs

@@ -1,3 +1,11 @@
-module Haskellator(val) where
+module Haskellator(
+    val,
+    preProcessDiscardComments,
+    runParser
+    ) where
 
-    import RTLILParser.Parser(val)
+    import RTLILParser.Parser(
+        val,
+        preProcessDiscardComments,
+        runParser,
+        )

src/RTLILParser/Parser.hs

@@ -1,6 +1,6 @@
 module RTLILParser.Parser(
     preProcessDiscardComments,
-    pFile,
+    RTLILParser.Parser.runParser,
     a,
     val) where
 
@@ -68,16 +68,24 @@ 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" preProcessedFile of
+    Left err -> error $ show err
+    Right val -> val
+    where preProcessedFile = preProcessDiscardComments str
+
 -- identifiers
 pId :: Parser Id
 pId = Public  <$> pPublicId
   <|> Autogen <$> pAutogenId
+  <?> "Id"
 
 pPublicId   :: Parser PublicId
 pPublicId   = PublicId <$> (char '\\' *> many1 pNonWs)
+    <?> "PublicId"
 
 pAutogenId  :: Parser AutogenId
 pAutogenId  = AutogenId <$> (char '$' *> many1 pNonWs)
+    <?> "AutogenId"
 
 -- values
 pValue :: Parser Value
@@ -86,6 +94,7 @@ pValue = do
     char '\''
     value <- many pBinaryDigit
     return $ Value (read width) (binaryStringToInt value)
+    <?> "Value"
 
 pDecimalDigit :: Parser Char
 pDecimalDigit = oneOf "0123456789"
@@ -93,7 +102,7 @@ pDecimalDigit = oneOf "0123456789"
 -- update in the future to support 4 state logic
 -- by converting x and z to 0 and warning about it.
 pBinaryDigit :: Parser Char
-pBinaryDigit = oneOf "01"
+pBinaryDigit = oneOf "01" <?> "BinaryDigit"
 
 pInteger :: Parser Int
 pInteger = do
@@ -103,37 +112,46 @@ pInteger = do
     return $ case sign of
         Just _  -> -value
         Nothing ->  value
+    <?> "Integer"
 
 -- strings
 pString :: Parser String
 pString =
     between delimiter delimiter parseString
+    <?> "String"
     where
         delimiter = char '"'
         parseString = many (pEscapedChar <|> noneOf "\\\"")
 
 -- comments
--- | Removes inline comments starting with '#' while preserving newlines
+-- | Removes entire comment lines starting with '#' and inline comments
 preProcessDiscardComments :: String -> String
-preProcessDiscardComments input = unlines $ map stripComment $ lines input
+preProcessDiscardComments input = 
-  where
+    unlines $ map stripComment $ filter (not . isCommentLine) $ lines input
-    -- Strips comments from a single line
+    where
-    stripComment line = case break (== '#') line of
+      -- Checks if a line is a comment line (starts with '#')
-        (code, "")   -> code       -- No comment found
+      isCommentLine line = case dropWhile (== ' ') line of
-        (code, _)    -> code       -- Strip everything after '#'
+          ('#':_) -> True   -- Line starts with '#'
+          _       -> False  -- Line does not start with '#'
 
+      -- Strips inline comments from a single line
+      stripComment line = case break (== '#') line of
+          (code, "") -> code    -- No comment found
+          (code, _)  -> code    -- Strip everything after '#'
 
 -- file
 pFile :: Parser File
 pFile = File
     <$> pAutoIdxStmt
     <*> many pModule
+    <?> "File"
 
 -- Autoindex statements
 pAutoIdxStmt :: Parser AutoIdxStmt
 pAutoIdxStmt = AutoIdxStmt
     <$> (string "autoidx" *> pWs *>
          pInteger <* pEolAndAdvanceToNextNonWs)
+    <?> "AutoIdxStmt"
 
 -- Module
 pModule :: Parser Module
@@ -143,15 +161,18 @@ pModule = do
     moduleBody  <- pModuleBody
     pModuleEndStmt
     return $ Module moduleStmt attrs moduleBody
+    <?> "Module"
 
 pModuleStmt :: Parser ModuleStmt
 pModuleStmt = ModuleStmt 
     <$> (string "module" *> pWs *> 
          pId <* pEolAndAdvanceToNextNonWs)
+    <?> "ModuleStmt"
 
 pModuleBody :: Parser ModuleBody
 pModuleBody = ModuleBody
     <$> many pModuleBodyVariant
+    <?> "ModuleBody"
 
 pModuleBodyVariant :: Parser ModuleBodyVariant
 pModuleBodyVariant = 
@@ -167,92 +188,125 @@ pModuleBodyVariant =
     try (ModuleBodyMemory       <$> pMemory   ) <|>
     try (ModuleBodyCell         <$> pCell     ) <|>
         (ModuleBodyProcess      <$> pProcess  )
+    <?> "ModuleBodyVariant"
 
 pParamStmt :: Parser ParamStmt
 pParamStmt = ParamStmt
     <$> (string "parameter" *> pWs *> pId <* pWs)
     <*> optionMaybe pConstant
     <*  pEolAndAdvanceToNextNonWs
+    <?> "ParamStmt"
 
 pConstant :: Parser Constant
-pConstant =
+pConstant = p <?> name where
-    try (ConstantValue      <$> pValue  )
+    name = "Constant"
-    <|> (ConstantInteger    <$> pInteger)
+    p = 
-    <|> (ConstantString     <$> pString )
+        try (ConstantValue      <$> pValue  )
+        <|> (ConstantInteger    <$> pInteger)
+        <|> (ConstantString     <$> pString )
 
 pModuleEndStmt :: Parser ()
-pModuleEndStmt = void (string "end")
+pModuleEndStmt = p <?> name where
+    name = "ModuleEndStmt"
+    p = 
+        void (string "end")
 
 -- Attribute statements
 pAttrStmt :: Parser AttrStmt
-pAttrStmt = AttrStmt
+pAttrStmt = p <?> name where
-    <$> (string "attribute" *> pWs *> pId)
+    name = "AttrStmt"
-    <*> (pWs *> pConstant)
+    p = 
-    <*  pEolAndAdvanceToNextNonWs
+        AttrStmt
+        <$> (string "attribute" *> pWs *> pId)
+        <*> (pWs *> pConstant)
+        <*  pEolAndAdvanceToNextNonWs
 
 -- Signal Specifications
 pSigSpec :: Parser SigSpec
-pSigSpec = do
+pSigSpec = p <?> name where
-    baseSigSpec <- (SigSpecConstant <$> pConstant)
+    name = "SigSpec"
-                   <|>
+    p =
-                   (SigSpecWireId   <$> pWireId)
+        do
-                   <|>
+        baseSigSpec <- (SigSpecConstant <$> pConstant)
-                   pSigSpecConcat
+                    <|>
-    applySlices baseSigSpec
+                    (SigSpecWireId   <$> pWireId)
+                    <|>
+                    pSigSpecConcat
+        applySlices baseSigSpec
 
 pSigSpecConcat :: Parser SigSpec
-pSigSpecConcat = do
+pSigSpecConcat = p <?> name where
-    char '{' <* pWs
+    name = "SigSpecConcat"
-    sigspecs    <- pSigSpec `sepBy` pWs
+    p = 
-    pWs <* char '}'
+        do
-    return $ SigSpecConcat sigspecs
+        char '{' <* pWs
+        sigspecs    <- pSigSpec `sepBy` pWs
+        pWs <* char '}'
+        return $ SigSpecConcat sigspecs
 
 applySlices :: SigSpec -> Parser SigSpec
-applySlices base = do
+applySlices base = p <?> name where
-    maybeSlice <- optionMaybe pSlice
+    name = "ApplySlices"
-    case maybeSlice of
+    p =
-        Nothing -> return base
+        do
-        Just slice -> applySlices (SigSpecSlice base slice)
+        maybeSlice <- optionMaybe pSlice
+        case maybeSlice of
+            Nothing -> return base
+            Just slice -> applySlices (SigSpecSlice base slice)
 
 pSlice :: Parser Slice
-pSlice =
+pSlice = p <?> name where
-    Slice
+    name = "Slice"
-    <$> (pMaybeWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs)
+    p =
-    <*> (optionMaybe (char ':' *> pInteger) <* pMaybeWs <* char ']')
+        Slice
+        <$> (pMaybeWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs)
+        <*> (optionMaybe (char ':' *> pInteger) <* pMaybeWs <* char ']')
 
 -- Connections
 pConnStmt :: Parser ConnStmt
-pConnStmt = ConnStmt
+pConnStmt = p <?> name where
-    <$> (string "connect" *> pWs *> pSigSpec)
+    name = "ConnStmt"
-    <*> (pWs *> pSigSpec)
+    p =
-    <*  pEolAndAdvanceToNextNonWs
+        ConnStmt
+        <$> (string "connect" *> pWs *> pSigSpec)
+        <*> (pWs *> pSigSpec)
+        <*  pEolAndAdvanceToNextNonWs
 
 -- Wires
 pWire :: Parser Wire
-pWire = do
+pWire = p <?> name where
-    attrs <- many pAttrStmt
+    name = "Wire"
-    wireStmt <- pWireStmt
+    p = do
-    return $ Wire wireStmt attrs
+        attrs <- many pAttrStmt
+        wireStmt <- pWireStmt
+        return $ Wire wireStmt attrs
 
 pWireStmt :: Parser WireStmt
-pWireStmt = do
+pWireStmt = p <?> name where
-    string "wire" <* pWs
+    name = "WireStmt"
-    options <- many pWireOption <* pWs
+    p = do
-    wireId  <- WireId <$> pId <* pEolAndAdvanceToNextNonWs
+        string "wire" <* pWs
-    return $ WireStmt wireId options
+        options <- many pWireOption <* pWs
+        wireId  <- WireId <$> pId <* pEolAndAdvanceToNextNonWs
+        return $ WireStmt wireId options
 
 pWireId :: Parser WireId
-pWireId = WireId <$> pId
+pWireId = p <?> name where
+    name = "WireId"
+    p = 
+        WireId <$> pId
 
 pWireOption :: Parser WireOption
-pWireOption =
+pWireOption = p <?> name where
-    try (WireOptionWidth  <$> (string "width"  *> pWs *> pInteger)) <|>
+    name = "WireOption"
-    try (WireOptionOffset <$> (string "offset" *> pWs *> pInteger)) <|>
+    p = 
-    try (WireOptionInput  <$> (string "input"  *> pWs *> pInteger)) <|>
+        try (WireOptionWidth  <$> (string "width"  *> pWs *> pInteger)) <|>
-    try (WireOptionOutput <$> (string "output" *> pWs *> pInteger)) <|>
+        try (WireOptionOffset <$> (string "offset" *> pWs *> pInteger)) <|>
-    try (WireOptionInout  <$> (string "inout"  *> pWs *> pInteger)) <|>
+        try (WireOptionInput  <$> (string "input"  *> pWs *> pInteger)) <|>
-    (string "upto"      *> return WireOptionUpto)                   <|>
+        try (WireOptionOutput <$> (string "output" *> pWs *> pInteger)) <|>
-    (string "signed"    *> return WireOptionSigned)
+        try (WireOptionInout  <$> (string "inout"  *> pWs *> pInteger)) <|>
+        (string "upto"      *> return WireOptionUpto)                   <|>
+        (string "signed"    *> return WireOptionSigned)
 
 -- Memories
 pMemory :: Parser Memory