Products/Haskellator
2
0
Fork 0
Code Issues Pull requests 1 Actions Packages Projects Releases Wiki Activity

considering scrapping this parser...

Browse source
This commit is contained in:
Yehowshua Immanuel 2024-12-09 22:51:27 -05:00
parent 87ca7637d8
commit 8430ca214e
5 changed files with 71 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
TODO.md
View file

@ -43,6 +43,7 @@
- [ ] Module - [ ] Module
- [ ] Remove weird GHC imports - [ ] Remove weird GHC imports
- [ ] Embed locs in AST - [ ] Embed locs in AST
- [ ] Scrap `pEolAndAdvanceToNextNonWs` and use `tok`
- [ ] Remove `preProcessDiscardComments` from exports - [ ] Remove `preProcessDiscardComments` from exports
- [x] Are the `try` statements in `pWireOption` correctly constructed? - [x] Are the `try` statements in `pWireOption` correctly constructed?
- [ ] Consider the very weird case where the process body has nothing, - [ ] Consider the very weird case where the process body has nothing,

4
app/Main.hs
View file

@ -18,9 +18,9 @@ main = do
-- Attempt to read the file -- Attempt to read the file
contents <- catch (readFile filePath) handleReadError contents <- catch (readFile filePath) handleReadError
putStrLn "File Contents:" putStrLn "File Contents:"
putStrLn $ Haskellator.preProcessDiscardComments contents putStrLn $ ppShow $ Haskellator.runParser contents
[] -> putStrLn "cabal run Haskellator -- <file-path>" [] -> putStrLn "cabal run Haskellator -- <file-path>"
putStrLn $ ppShow Haskellator.val -- putStrLn $ ppShow Haskellator.val
-- Handle potential file reading errors -- Handle potential file reading errors
handleReadError :: IOException -> IO String handleReadError :: IOException -> IO String

2
src/Haskellator.hs
View file

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

96
src/RTLILParser/Parser.hs
View file

@ -1,5 +1,4 @@
module RTLILParser.Parser( module RTLILParser.Parser(
preProcessDiscardComments,
RTLILParser.Parser.runParser, RTLILParser.Parser.runParser,
a, a,
val) where val) where
@ -62,16 +61,17 @@ import RTLILParser.Primitives(
,pEol ,pEol
,pOctal ,pOctal
,pEscapedChar ,pEscapedChar
,pEolAndAdvanceToNextNonWs ,advanceToNextToken
) )
-- taken from: https://yosyshq.readthedocs.io/projects/yosys/en/0.47/appendix/rtlil_text.html -- 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 -- parsers below are split int sections from the above link
runParser str = case parse pFile "pFile" preProcessedFile of runParser str = case parse pFile "pFile" preProcessedFile of
-- runParser str = case parse pCell "pCell" preProcessedFile of
Left err -> error $ show err Left err -> error $ show err
Right val -> val Right val -> val
where preProcessedFile = preProcessDiscardComments str where preProcessedFile = str
-- identifiers -- identifiers
pId :: Parser Id pId :: Parser Id
@ -130,29 +130,13 @@ pString = p <?> name where
delimiter = char '"' delimiter = char '"'
parseString = many (pEscapedChar <|> noneOf "\\\"") 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 -- file
pFile :: Parser File pFile :: Parser File
pFile = p <?> name where pFile = p <?> name where
name = "File" name = "File"
p = p =
File File
<$> pAutoIdxStmt <$> (advanceToNextToken *> pAutoIdxStmt)
<*> many pModule <*> many pModule
-- Autoindex statements -- Autoindex statements
@ -162,7 +146,7 @@ pAutoIdxStmt = p <?> name where
p = p =
AutoIdxStmt AutoIdxStmt
<$> (string "autoidx" *> pWs *> <$> (string "autoidx" *> pWs *>
pInteger <* pEolAndAdvanceToNextNonWs) pInteger <* advanceToNextToken)
-- Module -- Module
pModule :: Parser Module pModule :: Parser Module
@ -174,6 +158,7 @@ pModule = p <?> name where
moduleStmt <- pModuleStmt moduleStmt <- pModuleStmt
moduleBody <- pModuleBody moduleBody <- pModuleBody
pModuleEndStmt pModuleEndStmt
-- return $ Module moduleStmt attrs $ModuleBody []
return $ Module moduleStmt attrs moduleBody return $ Module moduleStmt attrs moduleBody
pModuleStmt :: Parser ModuleStmt pModuleStmt :: Parser ModuleStmt
@ -182,7 +167,7 @@ pModuleStmt = p <?> name where
p = p =
ModuleStmt ModuleStmt
<$> (string "module" *> pWs *> <$> (string "module" *> pWs *>
pId <* pEolAndAdvanceToNextNonWs) pId <* advanceToNextToken)
pModuleBody :: Parser ModuleBody pModuleBody :: Parser ModuleBody
pModuleBody = p <?> name where pModuleBody = p <?> name where
@ -206,7 +191,7 @@ pModuleBodyVariant = p <?> name where
try (ModuleBodyWire <$> pWire ) <|> try (ModuleBodyWire <$> pWire ) <|>
try (ModuleBodyMemory <$> pMemory ) <|> try (ModuleBodyMemory <$> pMemory ) <|>
try (ModuleBodyCell <$> pCell ) <|> try (ModuleBodyCell <$> pCell ) <|>
(ModuleBodyProcess <$> pProcess ) try (ModuleBodyProcess <$> pProcess )
pParamStmt :: Parser ParamStmt pParamStmt :: Parser ParamStmt
pParamStmt = p <?> name where pParamStmt = p <?> name where
@ -215,7 +200,7 @@ pParamStmt = p <?> name where
ParamStmt ParamStmt
<$> (string "parameter" *> pWs *> pId <* pWs) <$> (string "parameter" *> pWs *> pId <* pWs)
<*> optionMaybe pConstant <*> optionMaybe pConstant
<* pEolAndAdvanceToNextNonWs <* advanceToNextToken
pConstant :: Parser Constant pConstant :: Parser Constant
pConstant = p <?> name where pConstant = p <?> name where
@ -239,7 +224,7 @@ pAttrStmt = p <?> name where
AttrStmt AttrStmt
<$> (string "attribute" *> pWs *> pId) <$> (string "attribute" *> pWs *> pId)
<*> (pWs *> pConstant) <*> (pWs *> pConstant)
<* pEolAndAdvanceToNextNonWs <* advanceToNextToken
-- Signal Specifications -- Signal Specifications
pSigSpec :: Parser SigSpec pSigSpec :: Parser SigSpec
@ -269,7 +254,7 @@ applySlices base = p <?> name where
name = "ApplySlices" name = "ApplySlices"
p = p =
do do
maybeSlice <- optionMaybe pSlice maybeSlice <- optionMaybe $ try pSlice
case maybeSlice of case maybeSlice of
Nothing -> return base Nothing -> return base
Just slice -> applySlices (SigSpecSlice base slice) Just slice -> applySlices (SigSpecSlice base slice)
@ -279,7 +264,7 @@ pSlice = p <?> name where
name = "Slice" name = "Slice"
p = p =
Slice Slice
<$> (pMaybeWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs) <$> (pWs *> char '[' *> pMaybeWs *> pInteger <* pMaybeWs)
<*> (optionMaybe (char ':' *> pInteger) <* pMaybeWs <* char ']') <*> (optionMaybe (char ':' *> pInteger) <* pMaybeWs <* char ']')
-- Connections -- Connections
@ -290,7 +275,7 @@ pConnStmt = p <?> name where
ConnStmt ConnStmt
<$> (string "connect" *> pWs *> pSigSpec) <$> (string "connect" *> pWs *> pSigSpec)
<*> (pWs *> pSigSpec) <*> (pWs *> pSigSpec)
<* pEolAndAdvanceToNextNonWs <* advanceToNextToken
-- Wires -- Wires
pWire :: Parser Wire pWire :: Parser Wire
@ -306,8 +291,8 @@ pWireStmt = p <?> name where
name = "WireStmt" name = "WireStmt"
p = do p = do
string "wire" <* pWs string "wire" <* pWs
options <- many pWireOption <* pWs options <- many (pWireOption <* pWs)
wireId <- WireId <$> pId <* pEolAndAdvanceToNextNonWs wireId <- WireId <$> pId <* advanceToNextToken
return $ WireStmt wireId options return $ WireStmt wireId options
pWireId :: Parser WireId pWireId :: Parser WireId
@ -325,8 +310,8 @@ pWireOption = p <?> name where
try (WireOptionInput <$> (string "input" *> pWs *> pInteger)) <|> try (WireOptionInput <$> (string "input" *> pWs *> pInteger)) <|>
try (WireOptionOutput <$> (string "output" *> pWs *> pInteger)) <|> try (WireOptionOutput <$> (string "output" *> pWs *> pInteger)) <|>
try (WireOptionInout <$> (string "inout" *> pWs *> pInteger)) <|> try (WireOptionInout <$> (string "inout" *> pWs *> pInteger)) <|>
(string "upto" *> return WireOptionUpto) <|> try (string "upto" *> return WireOptionUpto) <|>
(string "signed" *> return WireOptionSigned) try (string "signed" *> return WireOptionSigned)
-- Memories -- Memories
pMemory :: Parser Memory pMemory :: Parser Memory
@ -346,7 +331,7 @@ pMemoryStmt = p <?> name where
(string "memory" <* pWs) (string "memory" <* pWs)
options <- (many pMemoryOption <* pWs) options <- (many pMemoryOption <* pWs)
memoryId <- MemoryID <$> pId memoryId <- MemoryID <$> pId
pEolAndAdvanceToNextNonWs advanceToNextToken
return $ MemoryStmt memoryId options return $ MemoryStmt memoryId options
pMemoryOption :: Parser MemoryOption pMemoryOption :: Parser MemoryOption
@ -378,7 +363,7 @@ pCellStmt = p <?> name where
cellType <- CellType <$> pId cellType <- CellType <$> pId
pWs pWs
cellId <- CellId <$> pId cellId <- CellId <$> pId
pEolAndAdvanceToNextNonWs advanceToNextToken
return $ CellStmt cellId cellType return $ CellStmt cellId cellType
pCellBodyStmt :: Parser CellBodyStmt pCellBodyStmt :: Parser CellBodyStmt
@ -400,9 +385,10 @@ pCellBodyParameter = p <?> name where
p = p =
do do
string "parameter" <* pWs string "parameter" <* pWs
sign <- optionMaybe pParameterSign <* pMaybeWs sign <- optionMaybe pParameterSign
id <- pId pMaybeWs
const <- pConstant <* pEolAndAdvanceToNextNonWs id <- pId <* pWs
const <- pConstant <* advanceToNextToken
return $ CellBodyParameter sign id const return $ CellBodyParameter sign id const
pCellBodyConnect :: Parser CellBodyStmt pCellBodyConnect :: Parser CellBodyStmt
@ -412,11 +398,11 @@ pCellBodyConnect = p <?> name where
do do
string "connect" <* pWs string "connect" <* pWs
id <- pId <* pWs id <- pId <* pWs
sigSpec <- pSigSpec <* pEolAndAdvanceToNextNonWs sigSpec <- pSigSpec <* advanceToNextToken
return $ CellConnect id sigSpec return $ CellConnect id sigSpec
pCellEndStmt :: Parser () pCellEndStmt :: Parser ()
pCellEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs) pCellEndStmt = void (string "end" <* advanceToNextToken)
<?> "CellEndStmt" <?> "CellEndStmt"
-- Processes -- Processes
@ -437,7 +423,7 @@ pProcStmt = p <?> name where
p = p =
ProcStmt ProcStmt
<$> (string "process" *> pWs *> pId) <$> (string "process" *> pWs *> pId)
<* pEolAndAdvanceToNextNonWs <* advanceToNextToken
pProcessBody :: Parser ProcessBody pProcessBody :: Parser ProcessBody
pProcessBody = p <?> name where pProcessBody = p <?> name where
@ -461,7 +447,7 @@ pAssignStmt = p <?> name where
p = p =
AssignStmt AssignStmt
<$> (string "assign" *> pWs *> pDestSigSpec) <$> (string "assign" *> pWs *> pDestSigSpec)
<*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs) <*> (pWs *> pSrcSigSpec <* advanceToNextToken)
pDestSigSpec :: Parser DestSigSpec pDestSigSpec :: Parser DestSigSpec
pDestSigSpec = (DestSigSpec <$> pSigSpec) <?> "DestSigSpec" pDestSigSpec = (DestSigSpec <$> pSigSpec) <?> "DestSigSpec"
@ -470,7 +456,7 @@ pSrcSigSpec :: Parser SrcSigSpec
pSrcSigSpec = (SrcSigSpec <$> pSigSpec) <?> "SrcSigSpec" pSrcSigSpec = (SrcSigSpec <$> pSigSpec) <?> "SrcSigSpec"
pProcEndStmt :: Parser () pProcEndStmt :: Parser ()
pProcEndStmt = void (string "end" <* pEolAndAdvanceToNextNonWs) pProcEndStmt = void (string "end" <* advanceToNextToken)
<?> "ProcEndStmt" <?> "ProcEndStmt"
-- Switches -- Switches
@ -480,7 +466,7 @@ pSwitch = p <?> name where
p = p =
Switch Switch
<$> pSwitchStmt <$> pSwitchStmt
<*> (many pCase <* pSwitchEndStmt) <*> many pCase <* pSwitchEndStmt
pSwitchStmt :: Parser SwitchStmt pSwitchStmt :: Parser SwitchStmt
pSwitchStmt = p <?> name where pSwitchStmt = p <?> name where
@ -489,17 +475,19 @@ pSwitchStmt = p <?> name where
do do
attrs <- many pAttrStmt attrs <- many pAttrStmt
string "switch" <* pWs string "switch" <* pWs
sigspec <- pSigSpec <* pEolAndAdvanceToNextNonWs sigspec <- pSigSpec <* advanceToNextToken
return $ SwitchStmt sigspec attrs return $ SwitchStmt sigspec attrs
pCase :: Parser Case pCase :: Parser Case
pCase = p <?> name where pCase = p <?> name where
name = "Case" name = "Case"
p = p =
Case do
<$> pCaseStmt attrs <- many pAttrStmt
<*> many pAttrStmt caseStmt <- pCaseStmt
<*> pCaseBody caseBody <- pCaseBody
return $ Case caseStmt attrs caseBody
-- return $ Case (CaseStmt Nothing) attrs (CaseBody [])
pCaseStmt :: Parser CaseStmt pCaseStmt :: Parser CaseStmt
pCaseStmt = p <?> name where pCaseStmt = p <?> name where
@ -509,7 +497,7 @@ pCaseStmt = p <?> name where
<$> ( <$> (
string "case" *> pWs string "case" *> pWs
*> optionMaybe pCompare *> optionMaybe pCompare
<* pEolAndAdvanceToNextNonWs) <* advanceToNextToken)
pCompare :: Parser Compare pCompare :: Parser Compare
pCompare = p <?> name where pCompare = p <?> name where
@ -526,10 +514,10 @@ pCaseBodyVariant = p <?> name where
name = "CaseBodyVariant" name = "CaseBodyVariant"
p = p =
try (CaseBodySwitchVariant <$> pSwitch ) <|> try (CaseBodySwitchVariant <$> pSwitch ) <|>
(CaseBodyAssignVariant <$> pAssignStmt) try (CaseBodyAssignVariant <$> pAssignStmt)
pSwitchEndStmt :: Parser () pSwitchEndStmt :: Parser ()
pSwitchEndStmt = void (string "end" *> pEolAndAdvanceToNextNonWs) pSwitchEndStmt = void (string "end" *> advanceToNextToken)
<?> "SwitchEndStmt" <?> "SwitchEndStmt"
-- Syncs -- Syncs
@ -556,14 +544,14 @@ pSigSpecPredicatedSyncStmt = p <?> name where
p = p =
do do
syncType <- pSyncType <* pWs syncType <- pSyncType <* pWs
sigSpec <- pSigSpec <* pEolAndAdvanceToNextNonWs sigSpec <- pSigSpec <* advanceToNextToken
return $ SigSpecPredicated sigSpec syncType return $ SigSpecPredicated sigSpec syncType
pNonSigSpecPredicatedSyncStmt :: Parser SyncStmt pNonSigSpecPredicatedSyncStmt :: Parser SyncStmt
pNonSigSpecPredicatedSyncStmt = p <?> name where pNonSigSpecPredicatedSyncStmt = p <?> name where
name = "NonSigSpecPredicatedSyncStmt" name = "NonSigSpecPredicatedSyncStmt"
p = p =
keyword <* pEolAndAdvanceToNextNonWs keyword <* advanceToNextToken
where keyword = where keyword =
(Global <$ string "global" ) <|> (Global <$ string "global" ) <|>
(Init <$ string "init" ) <|> (Init <$ string "init" ) <|>
@ -585,7 +573,7 @@ pUpdateStmt = p <?> name where
p = p =
UpdateStmt UpdateStmt
<$> (string "update" *> pWs *> pDestSigSpec) <$> (string "update" *> pWs *> pDestSigSpec)
<*> (pWs *> pSrcSigSpec <* pEolAndAdvanceToNextNonWs) <*> (pWs *> pSrcSigSpec <* advanceToNextToken)
-- would correspond to `123456789[0:9][0:8]` -- would correspond to `123456789[0:9][0:8]`
exampleSigSpecSlice = exampleSigSpecSlice =

19
src/RTLILParser/Primitives.hs
View file

@ -5,7 +5,7 @@ module RTLILParser.Primitives(
,pEol ,pEol
,pOctal ,pOctal
,pEscapedChar ,pEscapedChar
,pEolAndAdvanceToNextNonWs ,advanceToNextToken
) where ) where
import Control.Monad (void) import Control.Monad (void)
@ -42,8 +42,17 @@ pWs = many1 (oneOf " \t")
pNonWs :: Parser Char pNonWs :: Parser Char
pNonWs = noneOf " \t\r\n" pNonWs = noneOf " \t\r\n"
pEol :: Parser String pEol :: Parser ()
pEol = many1 (oneOf "\r\n") pEol = void (many1 (oneOf "\r\n") <* pMaybeWs)
pEolAndAdvanceToNextNonWs :: Parser () -- a comment begins with # and ends at the end of the line
pEolAndAdvanceToNextNonWs = void $ pEol *> pMaybeWs -- 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))