all parsers now named I believe

src/RTLILParser/Parser.hs

@@ -75,29 +75,33 @@ runParser str = case parse pFile "pFile" preProcessedFile of
 
 -- identifiers
 pId :: Parser Id
-pId = Public  <$> pPublicId
+pId = p <?> name where
+    name = "Id"
+    p =
+        Public  <$> pPublicId
         <|> Autogen <$> pAutogenId
-  <?> "Id"
 
 pPublicId   :: Parser PublicId
-pPublicId   = PublicId <$> (char '\\' *> many1 pNonWs)
+pPublicId   = (PublicId <$> (char '\\' *> many1 pNonWs))
     <?> "PublicId"
 
 pAutogenId  :: Parser AutogenId
-pAutogenId  = AutogenId <$> (char '$' *> many1 pNonWs)
+pAutogenId  = (AutogenId <$> (char '$' *> many1 pNonWs))
            <?> "AutogenId"
 
 -- values
 pValue :: Parser Value
-pValue = do
+pValue = p <?> name where
+    name = "Value"
+    p =
+        do
         width <- many1 pDecimalDigit
         char '\''
         value <- many pBinaryDigit
         return $ Value (read width) (binaryStringToInt value)
-    <?> "Value"
 
 pDecimalDigit :: Parser Char
-pDecimalDigit = oneOf "0123456789"
+pDecimalDigit = oneOf "0123456789" <?> "DecimalDigit"
 
 -- update in the future to support 4 state logic
 -- by converting x and z to 0 and warning about it.
@@ -105,20 +109,23 @@ pBinaryDigit :: Parser Char
 pBinaryDigit = oneOf "01" <?> "BinaryDigit"
 
 pInteger :: Parser Int
-pInteger = do
+pInteger = p <?> name where
+    name = "Integer"
+    p =
+        do
         sign <- optionMaybe (char '-')
         digits <- many1 pDecimalDigit
         let value = read digits
         return $ case sign of
             Just _  -> -value
             Nothing ->  value
-    <?> "Integer"
 
 -- strings
 pString :: Parser String
-pString =
+pString = p <?> name where
+    name = "String"
+    p =
         between delimiter delimiter parseString
-    <?> "String"
         where
             delimiter = char '"'
             parseString = many (pEscapedChar <|> noneOf "\\\"")
@@ -141,41 +148,52 @@ preProcessDiscardComments input =
 
 -- file
 pFile :: Parser File
-pFile = File
+pFile = p <?> name where
+    name = "File"
+    p =
+        File
         <$> pAutoIdxStmt
         <*> many pModule
-    <?> "File"
 
 -- Autoindex statements
 pAutoIdxStmt :: Parser AutoIdxStmt
-pAutoIdxStmt = AutoIdxStmt
+pAutoIdxStmt = p <?> name where
+    name = "AutoIdxStmt"
+    p =
+        AutoIdxStmt
         <$> (string "autoidx" *> pWs *>
             pInteger <* pEolAndAdvanceToNextNonWs)
-    <?> "AutoIdxStmt"
 
 -- Module
 pModule :: Parser Module
-pModule = do
+pModule = p <?> name where
+    name = "Module"
+    p =
+        do
         attrs       <- many pAttrStmt
         moduleStmt  <- pModuleStmt
         moduleBody  <- pModuleBody
         pModuleEndStmt
         return $ Module moduleStmt attrs moduleBody
-    <?> "Module"
 
 pModuleStmt :: Parser ModuleStmt
-pModuleStmt = ModuleStmt 
+pModuleStmt = p <?> name where
+    name = "ModuleStmt"
+    p =
+        ModuleStmt
         <$> (string "module" *> pWs *>
             pId <* pEolAndAdvanceToNextNonWs)
-    <?> "ModuleStmt"
 
 pModuleBody :: Parser ModuleBody
-pModuleBody = ModuleBody
+pModuleBody = p <?> name where
+    name = "ModuleBody"
+    p =
+        ModuleBody
         <$> many pModuleBodyVariant
-    <?> "ModuleBody"
 
 pModuleBodyVariant :: Parser ModuleBodyVariant
-pModuleBodyVariant = 
+pModuleBodyVariant = p <?> name where
+    name = "ModuleBodyVariant"
     -- `pWire`, `pMemory`, `pCell`, `pProcess` all
     -- start by parsing attribute statements, so we
     -- need backtracking since we can't determin which
@@ -183,19 +201,21 @@ pModuleBodyVariant =
     -- we encounter alone. `pParamStmt` technically doesn't
     -- need to be prefixed by `try`, so that is a stylistic
     -- choice.
+    p =
         try (ModuleBodyParamStmt    <$> pParamStmt) <|>
         try (ModuleBodyWire         <$> pWire     ) <|>
         try (ModuleBodyMemory       <$> pMemory   ) <|>
         try (ModuleBodyCell         <$> pCell     ) <|>
             (ModuleBodyProcess      <$> pProcess  )
-    <?> "ModuleBodyVariant"
 
 pParamStmt :: Parser ParamStmt
-pParamStmt = ParamStmt
+pParamStmt = p <?> name where
+    name = "ParamStmt"
+    p =
+        ParamStmt
         <$> (string "parameter" *> pWs *> pId <* pWs)
         <*> optionMaybe pConstant
         <*  pEolAndAdvanceToNextNonWs
-    <?> "ParamStmt"
 
 pConstant :: Parser Constant
 pConstant = p <?> name where
@@ -310,13 +330,19 @@ pWireOption = p <?> name where
 
 -- Memories
 pMemory :: Parser Memory
-pMemory = do
+pMemory = p <?> name where
+    name = "Memory"
+    p =
+        do
         attrs <- many pAttrStmt
         memoryStmt <- pMemoryStmt
         return $ Memory memoryStmt attrs
 
 pMemoryStmt :: Parser MemoryStmt
-pMemoryStmt = do
+pMemoryStmt = p <?> name where
+    name = "MemoryStmt"
+    p =
+        do
         (string "memory" <* pWs)
         options     <- (many pMemoryOption <* pWs)
         memoryId    <- MemoryID <$> pId
@@ -324,21 +350,29 @@ pMemoryStmt = do
         return $ MemoryStmt memoryId options
 
 pMemoryOption :: Parser MemoryOption
-pMemoryOption =
+pMemoryOption = p <?> name where
+    name = "MemoryOption"
+    p =
         try (MemoryOptionWidth  <$> (string "width"  *> pWs *> pInteger)) <|>
         try (MemoryOptionSize   <$> (string "size"   *> pWs *> pInteger)) <|>
         try (MemoryOptionOffset <$> (string "offset" *> pWs *> pInteger))
 
 -- Cells
 pCell :: Parser Cell
-pCell = do
+pCell = p <?> name where
+    name = "Cell"
+    p =
+        do
         attrStmts       <- many pAttrStmt
         cellStmt        <- pCellStmt
         cellBodyStmts   <- many pCellBodyStmt <* pCellEndStmt
         return $ Cell cellStmt attrStmts cellBodyStmts
 
 pCellStmt :: Parser CellStmt
-pCellStmt = do
+pCellStmt = p <?> name where
+    name = "CellStmt"
+    p =
+        do
         string "cell"
         pWs
         cellType <- CellType <$> pId
@@ -348,15 +382,23 @@ pCellStmt = do
         return $ CellStmt cellId cellType
 
 pCellBodyStmt :: Parser CellBodyStmt
-pCellBodyStmt = pCellBodyParameter <|> pCellBodyConnect
+pCellBodyStmt = p <?> name where
+    name = "CellBodyStmt"
+    p =
+        pCellBodyParameter <|> pCellBodyConnect
 
 pParameterSign :: Parser ParameterSign
-pParameterSign =
+pParameterSign = p <?> name where
+    name = "ParameterSign"
+    p =
         (Signed     <$ string "signed") <|>
         (Real       <$ string "real")
 
 pCellBodyParameter :: Parser CellBodyStmt
-pCellBodyParameter = do
+pCellBodyParameter = p <?> name where
+    name = "CellBodyParameter"
+    p =
+        do
         string "parameter" <* pWs
         sign    <- optionMaybe pParameterSign <* pMaybeWs
         id      <- pId
@@ -364,7 +406,10 @@ pCellBodyParameter = do
         return $ CellBodyParameter sign id const
 
 pCellBodyConnect :: Parser CellBodyStmt
-pCellBodyConnect = do
+pCellBodyConnect = p <?> name where
+    name = "CellBodyConnect"
+    p =
+        do
         string "connect" <* pWs
         id      <- pId <* pWs
         sigSpec <- pSigSpec <* pEolAndAdvanceToNextNonWs
@@ -372,10 +417,14 @@ pCellBodyConnect = do
 
 pCellEndStmt :: Parser ()
 pCellEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs)
+            <?> "CellEndStmt"
 
 -- Processes
 pProcess :: Parser Process
-pProcess = do
+pProcess = p <?> name where
+    name = "Process"
+    p =
+        do
         attrs       <- many pAttrStmt
         procStmt    <- pProcStmt
         processBody <- pProcessBody
@@ -383,12 +432,18 @@ pProcess = do
         return $ Process procStmt attrs processBody
 
 pProcStmt :: Parser ProcStmt
-pProcStmt = ProcStmt
+pProcStmt = p <?> name where
+    name = "ProcStmt"
+    p =
+        ProcStmt
         <$> (string "process" *> pWs *> pId)
         <*  pEolAndAdvanceToNextNonWs
 
 pProcessBody :: Parser ProcessBody
-pProcessBody = do
+pProcessBody = p <?> name where
+    name = "ProcessBody"
+    p =
+        do
         -- Since the pAssignStmt parser begins with "assign" and the pSwitch
         -- parser technically begins with "attribute", these both starting
         -- with the character 'a', we need to be able to rewind failed
@@ -401,80 +456,113 @@ pProcessBody = do
         return $ ProcessBody assignStmtsBefore switch assignStmtsAfter syncs
 
 pAssignStmt :: Parser AssignStmt
-pAssignStmt = AssignStmt
+pAssignStmt = p <?> name where
+    name = "AssignStmt"
+    p =
+        AssignStmt
         <$> (string "assign" *> pWs *> pDestSigSpec)
         <*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs)
 
 pDestSigSpec :: Parser DestSigSpec
-pDestSigSpec = DestSigSpec <$> pSigSpec
+pDestSigSpec = (DestSigSpec <$> pSigSpec) <?> "DestSigSpec"
 
 pSrcSigSpec :: Parser SrcSigSpec
-pSrcSigSpec = SrcSigSpec <$> pSigSpec
+pSrcSigSpec = (SrcSigSpec <$> pSigSpec) <?> "SrcSigSpec"
 
 pProcEndStmt :: Parser ()
 pProcEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs)
+            <?> "ProcEndStmt"
 
 -- Switches
 pSwitch :: Parser Switch
-pSwitch = Switch
+pSwitch = p <?> name where
+    name = "Switch"
+    p = 
+        Switch
         <$> pSwitchStmt
         <*> (many pCase <* pSwitchEndStmt)
 
 pSwitchStmt :: Parser SwitchStmt
-pSwitchStmt = do
+pSwitchStmt =  p <?> name where
+    name = "SwitchStmt"
+    p = 
+        do
         attrs   <- many pAttrStmt
         string "switch"  <* pWs
         sigspec <- pSigSpec <* pEolAndAdvanceToNextNonWs
         return $ SwitchStmt sigspec attrs
 
 pCase :: Parser Case
-pCase = Case
+pCase = p <?> name where
+    name = "Case"
+    p =
+        Case
         <$> pCaseStmt
         <*> many pAttrStmt
         <*> pCaseBody
 
 pCaseStmt :: Parser CaseStmt
-pCaseStmt = CaseStmt
+pCaseStmt = p <?> name where
+    name = "CaseStmt"
+    p = 
+        CaseStmt
         <$> (
             string "case" *> pWs
             *> optionMaybe pCompare
             <* pEolAndAdvanceToNextNonWs)
 
 pCompare :: Parser Compare
-pCompare = Compare
+pCompare = p <?> name where
+    name = "Compare"
+    p = 
+        Compare
         <$> pSigSpec `sepBy` (pMaybeWs *> char ',' *> pMaybeWs)
 
 pCaseBody :: Parser CaseBody
-pCaseBody = CaseBody <$> many pCaseBodyVariant
+pCaseBody = (CaseBody <$> many pCaseBodyVariant) <?> "CaseBody"
 
 pCaseBodyVariant :: Parser CaseBodyVariants
-pCaseBodyVariant =
+pCaseBodyVariant = p <?> name where
+    name = "CaseBodyVariant"
+    p = 
         try (CaseBodySwitchVariant <$> pSwitch    ) <|>
             (CaseBodyAssignVariant <$> pAssignStmt)
 
 pSwitchEndStmt :: Parser ()
 pSwitchEndStmt = void (string "end" *> pEolAndAdvanceToNextNonWs) 
+              <?> "SwitchEndStmt"
 
 -- Syncs
 pSync :: Parser Sync
-pSync = Sync
+pSync = p <?> name where
+    name = "Sync"
+    p = 
+        Sync
         <$> pSyncStmt
         <*> many pUpdateStmt
 
 pSyncStmt :: Parser SyncStmt
-pSyncStmt =  pKeywordSync *>
+pSyncStmt =  p <?> name where
+    name = "SyncStmt"
+    p = 
+        pKeywordSync *>
                     pSigSpecPredicatedSyncStmt <|>
                     pNonSigSpecPredicatedSyncStmt
                     where pKeywordSync = string "sync" *> pWs
 
 pSigSpecPredicatedSyncStmt :: Parser SyncStmt
-pSigSpecPredicatedSyncStmt = do
+pSigSpecPredicatedSyncStmt = p <?> name where
+    name = "SigSpecPredicatedSyncStmt"
+    p = 
+        do
         syncType    <-  pSyncType <* pWs
         sigSpec     <-  pSigSpec  <* pEolAndAdvanceToNextNonWs
         return $ SigSpecPredicated sigSpec syncType
 
 pNonSigSpecPredicatedSyncStmt :: Parser SyncStmt
-pNonSigSpecPredicatedSyncStmt =
+pNonSigSpecPredicatedSyncStmt = p <?> name where
+    name = "NonSigSpecPredicatedSyncStmt"
+    p = 
         keyword <* pEolAndAdvanceToNextNonWs
         where keyword =
                 (Global <$ string "global"  ) <|>
@@ -482,7 +570,9 @@ pNonSigSpecPredicatedSyncStmt =
                 (Always <$ string "always"  )
 
 pSyncType :: Parser SyncType
-pSyncType =
+pSyncType = p <?> name where
+    name = "SyncType"
+    p =
         (Low        <$ string "low"     )   <|>
         (High       <$ string "high"    )   <|>
         (Posedge    <$ string "posedge" )   <|>
@@ -490,7 +580,10 @@ pSyncType =
         (Edge       <$ string "edge"    )
 
 pUpdateStmt :: Parser UpdateStmt
-pUpdateStmt = UpdateStmt
+pUpdateStmt = p <?> name where
+    name = "UpdateStmt"
+    p = 
+        UpdateStmt
         <$> (string "update" *> pWs *> pDestSigSpec)
         <*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs)