diff --git a/TODO.md b/TODO.md index 76e1872..ddbda4d 100644 --- a/TODO.md +++ b/TODO.md @@ -43,6 +43,7 @@ - [ ] Module - [ ] Remove weird GHC imports - [ ] Embed locs in AST + - [ ] Scrap `pEolAndAdvanceToNextNonWs` and use `tok` - [ ] Remove `preProcessDiscardComments` from exports - [x] Are the `try` statements in `pWireOption` correctly constructed? - [ ] Consider the very weird case where the process body has nothing, diff --git a/app/Main.hs b/app/Main.hs index 488313c..82248bf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -18,9 +18,9 @@ main = do -- Attempt to read the file contents <- catch (readFile filePath) handleReadError putStrLn "File Contents:" - putStrLn $ Haskellator.preProcessDiscardComments contents + putStrLn $ ppShow $ Haskellator.runParser contents [] -> putStrLn "cabal run Haskellator -- " - putStrLn $ ppShow Haskellator.val + -- putStrLn $ ppShow Haskellator.val -- Handle potential file reading errors handleReadError :: IOException -> IO String diff --git a/src/Haskellator.hs b/src/Haskellator.hs index f26d0c9..5232727 100644 --- a/src/Haskellator.hs +++ b/src/Haskellator.hs @@ -1,11 +1,9 @@ module Haskellator( val, - preProcessDiscardComments, runParser ) where import RTLILParser.Parser( val, - preProcessDiscardComments, runParser, ) \ No newline at end of file diff --git a/src/RTLILParser/Parser.hs b/src/RTLILParser/Parser.hs index e2eb0de..38b705a 100644 --- a/src/RTLILParser/Parser.hs +++ b/src/RTLILParser/Parser.hs @@ -1,5 +1,4 @@ module RTLILParser.Parser( - preProcessDiscardComments, RTLILParser.Parser.runParser, a, val) where @@ -62,16 +61,17 @@ import RTLILParser.Primitives( ,pEol ,pOctal ,pEscapedChar - ,pEolAndAdvanceToNextNonWs + ,advanceToNextToken ) -- 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 +-- runParser str = case parse pCell "pCell" preProcessedFile of Left err -> error $ show err Right val -> val - where preProcessedFile = preProcessDiscardComments str + where preProcessedFile = str -- identifiers pId :: Parser Id @@ -130,29 +130,13 @@ pString = p name where delimiter = char '"' parseString = many (pEscapedChar <|> noneOf "\\\"") --- comments --- | Removes entire comment lines starting with '#' and inline comments -preProcessDiscardComments :: String -> String -preProcessDiscardComments input = - unlines $ map stripComment $ filter (not . isCommentLine) $ lines input - where - -- Checks if a line is a comment line (starts with '#') - isCommentLine line = case dropWhile (== ' ') line of - ('#':_) -> 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 = p name where name = "File" p = File - <$> pAutoIdxStmt + <$> (advanceToNextToken *> pAutoIdxStmt) <*> many pModule -- Autoindex statements @@ -162,7 +146,7 @@ pAutoIdxStmt = p name where p = AutoIdxStmt <$> (string "autoidx" *> pWs *> - pInteger <* pEolAndAdvanceToNextNonWs) + pInteger <* advanceToNextToken) -- Module pModule :: Parser Module @@ -174,6 +158,7 @@ pModule = p name where moduleStmt <- pModuleStmt moduleBody <- pModuleBody pModuleEndStmt + -- return $ Module moduleStmt attrs $ModuleBody [] return $ Module moduleStmt attrs moduleBody pModuleStmt :: Parser ModuleStmt @@ -182,7 +167,7 @@ pModuleStmt = p name where p = ModuleStmt <$> (string "module" *> pWs *> - pId <* pEolAndAdvanceToNextNonWs) + pId <* advanceToNextToken) pModuleBody :: Parser ModuleBody pModuleBody = p name where @@ -206,7 +191,7 @@ pModuleBodyVariant = p name where try (ModuleBodyWire <$> pWire ) <|> try (ModuleBodyMemory <$> pMemory ) <|> try (ModuleBodyCell <$> pCell ) <|> - (ModuleBodyProcess <$> pProcess ) + try (ModuleBodyProcess <$> pProcess ) pParamStmt :: Parser ParamStmt pParamStmt = p name where @@ -215,7 +200,7 @@ pParamStmt = p name where ParamStmt <$> (string "parameter" *> pWs *> pId <* pWs) <*> optionMaybe pConstant - <* pEolAndAdvanceToNextNonWs + <* advanceToNextToken pConstant :: Parser Constant pConstant = p name where @@ -239,7 +224,7 @@ pAttrStmt = p name where AttrStmt <$> (string "attribute" *> pWs *> pId) <*> (pWs *> pConstant) - <* pEolAndAdvanceToNextNonWs + <* advanceToNextToken -- Signal Specifications pSigSpec :: Parser SigSpec @@ -269,7 +254,7 @@ applySlices base = p name where name = "ApplySlices" p = do - maybeSlice <- optionMaybe pSlice + maybeSlice <- optionMaybe $ try pSlice case maybeSlice of Nothing -> return base Just slice -> applySlices (SigSpecSlice base slice) @@ -279,7 +264,7 @@ pSlice = p name where name = "Slice" p = Slice - <$> (pMaybeWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs) + <$> (pWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs) <*> (optionMaybe (char ':' *> pInteger) <* pMaybeWs <* char ']') -- Connections @@ -290,7 +275,7 @@ pConnStmt = p name where ConnStmt <$> (string "connect" *> pWs *> pSigSpec) <*> (pWs *> pSigSpec) - <* pEolAndAdvanceToNextNonWs + <* advanceToNextToken -- Wires pWire :: Parser Wire @@ -306,8 +291,8 @@ pWireStmt = p name where name = "WireStmt" p = do string "wire" <* pWs - options <- many pWireOption <* pWs - wireId <- WireId <$> pId <* pEolAndAdvanceToNextNonWs + options <- many (pWireOption <* pWs) + wireId <- WireId <$> pId <* advanceToNextToken return $ WireStmt wireId options pWireId :: Parser WireId @@ -325,8 +310,8 @@ pWireOption = p name where try (WireOptionInput <$> (string "input" *> pWs *> pInteger)) <|> try (WireOptionOutput <$> (string "output" *> pWs *> pInteger)) <|> try (WireOptionInout <$> (string "inout" *> pWs *> pInteger)) <|> - (string "upto" *> return WireOptionUpto) <|> - (string "signed" *> return WireOptionSigned) + try (string "upto" *> return WireOptionUpto) <|> + try (string "signed" *> return WireOptionSigned) -- Memories pMemory :: Parser Memory @@ -346,7 +331,7 @@ pMemoryStmt = p name where (string "memory" <* pWs) options <- (many pMemoryOption <* pWs) memoryId <- MemoryID <$> pId - pEolAndAdvanceToNextNonWs + advanceToNextToken return $ MemoryStmt memoryId options pMemoryOption :: Parser MemoryOption @@ -378,7 +363,7 @@ pCellStmt = p name where cellType <- CellType <$> pId pWs cellId <- CellId <$> pId - pEolAndAdvanceToNextNonWs + advanceToNextToken return $ CellStmt cellId cellType pCellBodyStmt :: Parser CellBodyStmt @@ -400,9 +385,10 @@ pCellBodyParameter = p name where p = do string "parameter" <* pWs - sign <- optionMaybe pParameterSign <* pMaybeWs - id <- pId - const <- pConstant <* pEolAndAdvanceToNextNonWs + sign <- optionMaybe pParameterSign + pMaybeWs + id <- pId <* pWs + const <- pConstant <* advanceToNextToken return $ CellBodyParameter sign id const pCellBodyConnect :: Parser CellBodyStmt @@ -412,11 +398,11 @@ pCellBodyConnect = p name where do string "connect" <* pWs id <- pId <* pWs - sigSpec <- pSigSpec <* pEolAndAdvanceToNextNonWs + sigSpec <- pSigSpec <* advanceToNextToken return $ CellConnect id sigSpec pCellEndStmt :: Parser () -pCellEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs) +pCellEndStmt = void (string "end" <* advanceToNextToken) "CellEndStmt" -- Processes @@ -437,7 +423,7 @@ pProcStmt = p name where p = ProcStmt <$> (string "process" *> pWs *> pId) - <* pEolAndAdvanceToNextNonWs + <* advanceToNextToken pProcessBody :: Parser ProcessBody pProcessBody = p name where @@ -461,7 +447,7 @@ pAssignStmt = p name where p = AssignStmt <$> (string "assign" *> pWs *> pDestSigSpec) - <*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs) + <*> (pWs *> pSrcSigSpec <* advanceToNextToken) pDestSigSpec :: Parser DestSigSpec pDestSigSpec = (DestSigSpec <$> pSigSpec) "DestSigSpec" @@ -470,51 +456,53 @@ pSrcSigSpec :: Parser SrcSigSpec pSrcSigSpec = (SrcSigSpec <$> pSigSpec) "SrcSigSpec" pProcEndStmt :: Parser () -pProcEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs) +pProcEndStmt = void (string "end" <* advanceToNextToken) "ProcEndStmt" -- Switches pSwitch :: Parser Switch pSwitch = p name where name = "Switch" - p = + p = Switch <$> pSwitchStmt - <*> (many pCase <* pSwitchEndStmt) + <*> many pCase <* pSwitchEndStmt pSwitchStmt :: Parser SwitchStmt pSwitchStmt = p name where name = "SwitchStmt" - p = + p = do attrs <- many pAttrStmt string "switch" <* pWs - sigspec <- pSigSpec <* pEolAndAdvanceToNextNonWs + sigspec <- pSigSpec <* advanceToNextToken return $ SwitchStmt sigspec attrs pCase :: Parser Case pCase = p name where name = "Case" p = - Case - <$> pCaseStmt - <*> many pAttrStmt - <*> pCaseBody + do + attrs <- many pAttrStmt + caseStmt <- pCaseStmt + caseBody <- pCaseBody + return $ Case caseStmt attrs caseBody + -- return $ Case (CaseStmt Nothing) attrs (CaseBody []) pCaseStmt :: Parser CaseStmt pCaseStmt = p name where name = "CaseStmt" - p = + p = CaseStmt <$> ( string "case" *> pWs *> optionMaybe pCompare - <* pEolAndAdvanceToNextNonWs) + <* advanceToNextToken) pCompare :: Parser Compare pCompare = p name where name = "Compare" - p = + p = Compare <$> pSigSpec `sepBy` (pMaybeWs *> char ',' *> pMaybeWs) @@ -524,19 +512,19 @@ pCaseBody = (CaseBody <$> many pCaseBodyVariant) "CaseBody" pCaseBodyVariant :: Parser CaseBodyVariants pCaseBodyVariant = p name where name = "CaseBodyVariant" - p = + p = try (CaseBodySwitchVariant <$> pSwitch ) <|> - (CaseBodyAssignVariant <$> pAssignStmt) + try (CaseBodyAssignVariant <$> pAssignStmt) pSwitchEndStmt :: Parser () -pSwitchEndStmt = void (string "end" *> pEolAndAdvanceToNextNonWs) +pSwitchEndStmt = void (string "end" *> advanceToNextToken) "SwitchEndStmt" -- Syncs pSync :: Parser Sync pSync = p name where name = "Sync" - p = + p = Sync <$> pSyncStmt <*> many pUpdateStmt @@ -544,7 +532,7 @@ pSync = p name where pSyncStmt :: Parser SyncStmt pSyncStmt = p name where name = "SyncStmt" - p = + p = pKeywordSync *> pSigSpecPredicatedSyncStmt <|> pNonSigSpecPredicatedSyncStmt @@ -553,17 +541,17 @@ pSyncStmt = p name where pSigSpecPredicatedSyncStmt :: Parser SyncStmt pSigSpecPredicatedSyncStmt = p name where name = "SigSpecPredicatedSyncStmt" - p = + p = do syncType <- pSyncType <* pWs - sigSpec <- pSigSpec <* pEolAndAdvanceToNextNonWs + sigSpec <- pSigSpec <* advanceToNextToken return $ SigSpecPredicated sigSpec syncType pNonSigSpecPredicatedSyncStmt :: Parser SyncStmt pNonSigSpecPredicatedSyncStmt = p name where name = "NonSigSpecPredicatedSyncStmt" - p = - keyword <* pEolAndAdvanceToNextNonWs + p = + keyword <* advanceToNextToken where keyword = (Global <$ string "global" ) <|> (Init <$ string "init" ) <|> @@ -582,10 +570,10 @@ pSyncType = p name where pUpdateStmt :: Parser UpdateStmt pUpdateStmt = p name where name = "UpdateStmt" - p = + p = UpdateStmt <$> (string "update" *> pWs *> pDestSigSpec) - <*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs) + <*> (pWs *> pSrcSigSpec <* advanceToNextToken) -- would correspond to `123456789[0:9][0:8]` exampleSigSpecSlice = diff --git a/src/RTLILParser/Primitives.hs b/src/RTLILParser/Primitives.hs index f45092f..4a6517c 100644 --- a/src/RTLILParser/Primitives.hs +++ b/src/RTLILParser/Primitives.hs @@ -5,7 +5,7 @@ module RTLILParser.Primitives( ,pEol ,pOctal ,pEscapedChar - ,pEolAndAdvanceToNextNonWs + ,advanceToNextToken ) where import Control.Monad (void) @@ -28,8 +28,8 @@ pEscapedChar = do choice [ char 'n' >> return '\n' , char 't' >> return '\t' - , try pOctal - , anyChar + , try pOctal + , anyChar ] pMaybeWs :: Parser String @@ -42,8 +42,17 @@ pWs = many1 (oneOf " \t") pNonWs :: Parser Char pNonWs = noneOf " \t\r\n" -pEol :: Parser String -pEol = many1 (oneOf "\r\n") +pEol :: Parser () +pEol = void (many1 (oneOf "\r\n") <* pMaybeWs) -pEolAndAdvanceToNextNonWs :: Parser () -pEolAndAdvanceToNextNonWs = void $ pEol *> pMaybeWs \ No newline at end of file +-- 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 +pComment :: Parser String +pComment = do + char '#' + comment <- many (noneOf "\r\n") + pEol + return comment + +advanceToNextToken :: Parser () +advanceToNextToken = void (pMaybeWs *> many1 (void pComment <|> pEol)) \ No newline at end of file