aboutsummaryrefslogtreecommitdiffstats
path: root/src/VeriFuzz/Parser
diff options
context:
space:
mode:
Diffstat (limited to 'src/VeriFuzz/Parser')
-rw-r--r--src/VeriFuzz/Parser/Parser.hs157
-rw-r--r--src/VeriFuzz/Parser/Preprocess.hs124
-rw-r--r--src/VeriFuzz/Parser/Token.hs11
3 files changed, 158 insertions, 134 deletions
diff --git a/src/VeriFuzz/Parser/Parser.hs b/src/VeriFuzz/Parser/Parser.hs
index 084cfe2..d7dc4ee 100644
--- a/src/VeriFuzz/Parser/Parser.hs
+++ b/src/VeriFuzz/Parser/Parser.hs
@@ -65,8 +65,9 @@ satisfy' :: (Token -> Maybe a) -> Parser a
satisfy' = tokenPrim show nextPos
nextPos :: SourcePos -> Token -> [Token] -> SourcePos
-nextPos pos _ (Token _ _ (Position _ l c):_) = setSourceColumn (setSourceLine pos l) c
-nextPos pos _ [] = pos
+nextPos pos _ (Token _ _ (Position _ l c) : _) =
+ setSourceColumn (setSourceLine pos l) c
+nextPos pos _ [] = pos
-- | Parses given `TokenName`.
tok :: TokenName -> Parser TokenName
@@ -101,15 +102,16 @@ parseVar = Id <$> identifier
systemFunc :: String -> Parser String
systemFunc s = satisfy' matchId
- where
- matchId (Token IdSystem s' _) =
- if s == s' then Just s else Nothing
- matchId _ = Nothing
+ where
+ matchId (Token IdSystem s' _) = if s == s' then Just s else Nothing
+ matchId _ = Nothing
parseFunction :: Parser Function
parseFunction =
- systemFunc "$unsigned" $> UnSignedFunc
- <|> systemFunc "$signed" $> SignedFunc
+ systemFunc "$unsigned"
+ $> UnSignedFunc
+ <|> systemFunc "$signed"
+ $> SignedFunc
parseFun :: Parser Expr
parseFun = do
@@ -143,51 +145,51 @@ parseExpr = do
-- | Table of binary and unary operators that encode the right precedence for
-- each.
parseTable :: [[ParseOperator Expr]]
-parseTable
- = [ [prefix SymBang (UnOp UnLNot), prefix SymTildy (UnOp UnNot)]
- , [ prefix SymAmp (UnOp UnAnd)
- , prefix SymBar (UnOp UnOr)
- , prefix SymTildyAmp (UnOp UnNand)
- , prefix SymTildyBar (UnOp UnNor)
- , prefix SymHat (UnOp UnXor)
- , prefix SymTildyHat (UnOp UnNxor)
- , prefix SymHatTildy (UnOp UnNxorInv)
- ]
- , [prefix SymPlus (UnOp UnPlus), prefix SymDash (UnOp UnMinus)]
- , [binary SymAsterAster (sBinOp BinPower) AssocRight]
- , [ binary SymAster (sBinOp BinTimes) AssocLeft
- , binary SymSlash (sBinOp BinDiv) AssocLeft
- , binary SymPercent (sBinOp BinMod) AssocLeft
- ]
- , [ binary SymPlus (sBinOp BinPlus) AssocLeft
- , binary SymDash (sBinOp BinPlus) AssocLeft
- ]
- , [ binary SymLtLt (sBinOp BinLSL) AssocLeft
- , binary SymGtGt (sBinOp BinLSR) AssocLeft
- ]
- , [ binary SymLtLtLt (sBinOp BinASL) AssocLeft
- , binary SymGtGtGt (sBinOp BinASR) AssocLeft
- ]
- , [ binary SymLt (sBinOp BinLT) AssocNone
- , binary SymGt (sBinOp BinGT) AssocNone
- , binary SymLtEq (sBinOp BinLEq) AssocNone
- , binary SymGtEq (sBinOp BinLEq) AssocNone
- ]
- , [ binary SymEqEq (sBinOp BinEq) AssocNone
- , binary SymBangEq (sBinOp BinNEq) AssocNone
- ]
- , [ binary SymEqEqEq (sBinOp BinEq) AssocNone
- , binary SymBangEqEq (sBinOp BinNEq) AssocNone
- ]
- , [binary SymAmp (sBinOp BinAnd) AssocLeft]
- , [ binary SymHat (sBinOp BinXor) AssocLeft
- , binary SymHatTildy (sBinOp BinXNor) AssocLeft
- , binary SymTildyHat (sBinOp BinXNorInv) AssocLeft
- ]
- , [binary SymBar (sBinOp BinOr) AssocLeft]
- , [binary SymAmpAmp (sBinOp BinLAnd) AssocLeft]
- , [binary SymBarBar (sBinOp BinLOr) AssocLeft]
+parseTable =
+ [ [prefix SymBang (UnOp UnLNot), prefix SymTildy (UnOp UnNot)]
+ , [ prefix SymAmp (UnOp UnAnd)
+ , prefix SymBar (UnOp UnOr)
+ , prefix SymTildyAmp (UnOp UnNand)
+ , prefix SymTildyBar (UnOp UnNor)
+ , prefix SymHat (UnOp UnXor)
+ , prefix SymTildyHat (UnOp UnNxor)
+ , prefix SymHatTildy (UnOp UnNxorInv)
+ ]
+ , [prefix SymPlus (UnOp UnPlus), prefix SymDash (UnOp UnMinus)]
+ , [binary SymAsterAster (sBinOp BinPower) AssocRight]
+ , [ binary SymAster (sBinOp BinTimes) AssocLeft
+ , binary SymSlash (sBinOp BinDiv) AssocLeft
+ , binary SymPercent (sBinOp BinMod) AssocLeft
+ ]
+ , [ binary SymPlus (sBinOp BinPlus) AssocLeft
+ , binary SymDash (sBinOp BinPlus) AssocLeft
+ ]
+ , [ binary SymLtLt (sBinOp BinLSL) AssocLeft
+ , binary SymGtGt (sBinOp BinLSR) AssocLeft
+ ]
+ , [ binary SymLtLtLt (sBinOp BinASL) AssocLeft
+ , binary SymGtGtGt (sBinOp BinASR) AssocLeft
+ ]
+ , [ binary SymLt (sBinOp BinLT) AssocNone
+ , binary SymGt (sBinOp BinGT) AssocNone
+ , binary SymLtEq (sBinOp BinLEq) AssocNone
+ , binary SymGtEq (sBinOp BinLEq) AssocNone
]
+ , [ binary SymEqEq (sBinOp BinEq) AssocNone
+ , binary SymBangEq (sBinOp BinNEq) AssocNone
+ ]
+ , [ binary SymEqEqEq (sBinOp BinEq) AssocNone
+ , binary SymBangEqEq (sBinOp BinNEq) AssocNone
+ ]
+ , [binary SymAmp (sBinOp BinAnd) AssocLeft]
+ , [ binary SymHat (sBinOp BinXor) AssocLeft
+ , binary SymHatTildy (sBinOp BinXNor) AssocLeft
+ , binary SymTildyHat (sBinOp BinXNorInv) AssocLeft
+ ]
+ , [binary SymBar (sBinOp BinOr) AssocLeft]
+ , [binary SymAmpAmp (sBinOp BinLAnd) AssocLeft]
+ , [binary SymBarBar (sBinOp BinLOr) AssocLeft]
+ ]
binary :: TokenName -> (a -> a -> a) -> Assoc -> ParseOperator a
binary name fun = Infix ((tok name <?> "binary") >> return fun)
@@ -207,27 +209,29 @@ parseContAssign = do
numLit :: Parser String
numLit = satisfy' matchId
- where
- matchId (Token LitNumber s _) = Just s
- matchId _ = Nothing
+ where
+ matchId (Token LitNumber s _) = Just s
+ matchId _ = Nothing
number :: Parser Decimal
number = number' <$> numLit
where
- number' :: String -> Decimal
- number' a
- | all (flip elem ['0' .. '9']) a = fromInteger $ read a
- | head a == '\'' = fromInteger $ f a
- | isInfixOf "'" a = Decimal (read w) (f b)
- | otherwise = error $ "Invalid number format: " ++ a
- where
- w = takeWhile (/= '\'') a
- b = dropWhile (/= '\'') a
- f a'
- | isPrefixOf "'d" a' = read $ drop 2 a'
- | isPrefixOf "'h" a' = read $ "0x" ++ drop 2 a'
- | isPrefixOf "'b" a' = foldl (\ n b' -> shiftL n 1 .|. (if b' == '1' then 1 else 0)) 0 (drop 2 a')
- | otherwise = error $ "Invalid number format: " ++ a'
+ number' :: String -> Decimal
+ number' a | all (flip elem ['0' .. '9']) a = fromInteger $ read a
+ | head a == '\'' = fromInteger $ f a
+ | isInfixOf "'" a = Decimal (read w) (f b)
+ | otherwise = error $ "Invalid number format: " ++ a
+ where
+ w = takeWhile (/= '\'') a
+ b = dropWhile (/= '\'') a
+ f a'
+ | isPrefixOf "'d" a' = read $ drop 2 a'
+ | isPrefixOf "'h" a' = read $ "0x" ++ drop 2 a'
+ | isPrefixOf "'b" a' = foldl
+ (\n b' -> shiftL n 1 .|. (if b' == '1' then 1 else 0))
+ 0
+ (drop 2 a')
+ | otherwise = error $ "Invalid number format: " ++ a'
toInteger' :: Decimal -> Integer
toInteger' (Decimal _ n) = n
@@ -243,10 +247,10 @@ parseRange = do
strId :: Parser String
strId = satisfy' matchId
- where
- matchId (Token IdSimple s _) = Just s
- matchId (Token IdEscaped s _) = Just s
- matchId _ = Nothing
+ where
+ matchId (Token IdSimple s _) = Just s
+ matchId (Token IdEscaped s _) = Just s
+ matchId _ = Nothing
identifier :: Parser Identifier
identifier = Identifier . T.pack <$> strId
@@ -277,8 +281,7 @@ parseModItem :: Parser ModItem
parseModItem = (ModCA <$> parseContAssign) <|> parseDecl
parseModList :: Parser [Identifier]
-parseModList = list <|> return []
- where list = parens $ commaSep identifier
+parseModList = list <|> return [] where list = parens $ commaSep identifier
filterDecl :: PortDir -> ModItem -> Bool
filterDecl p (Decl (Just p') _) = p == p'
@@ -289,8 +292,8 @@ modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort
parseModDecl :: Parser ModDecl
parseModDecl = do
- name <- tok KWModule *> identifier
- _ <- fmap defaultPort <$> parseModList
+ name <- tok KWModule *> identifier
+ _ <- fmap defaultPort <$> parseModList
tok' SymSemi
modItem <- option [] . try $ many1 parseModItem
tok' KWEndmodule
diff --git a/src/VeriFuzz/Parser/Preprocess.hs b/src/VeriFuzz/Parser/Preprocess.hs
index c0a4246..1483a83 100644
--- a/src/VeriFuzz/Parser/Preprocess.hs
+++ b/src/VeriFuzz/Parser/Preprocess.hs
@@ -15,74 +15,94 @@ Edits to the original code are warning fixes and formatting changes.
-}
module VeriFuzz.Parser.Preprocess
- ( uncomment
- , preprocess
- ) where
+ ( uncomment
+ , preprocess
+ )
+where
-- | Remove comments from code.
uncomment :: FilePath -> String -> String
uncomment file = uncomment'
where
- uncomment' a = case a of
- "" -> ""
- '/' : '/' : rest -> " " ++ removeEOL rest
- '/' : '*' : rest -> " " ++ remove rest
- '"' : rest -> '"' : ignoreString rest
- b : rest -> b : uncomment' rest
+ uncomment' a = case a of
+ "" -> ""
+ '/' : '/' : rest -> " " ++ removeEOL rest
+ '/' : '*' : rest -> " " ++ remove rest
+ '"' : rest -> '"' : ignoreString rest
+ b : rest -> b : uncomment' rest
- removeEOL a = case a of
- "" -> ""
- '\n' : rest -> '\n' : uncomment' rest
- '\t' : rest -> '\t' : removeEOL rest
- _ : rest -> ' ' : removeEOL rest
+ removeEOL a = case a of
+ "" -> ""
+ '\n' : rest -> '\n' : uncomment' rest
+ '\t' : rest -> '\t' : removeEOL rest
+ _ : rest -> ' ' : removeEOL rest
- remove a = case a of
- "" -> error $ "File ended without closing comment (*/): " ++ file
- '"' : rest -> removeString rest
- '\n' : rest -> '\n' : remove rest
- '\t' : rest -> '\t' : remove rest
- '*' : '/' : rest -> " " ++ uncomment' rest
- _ : rest -> " " ++ remove rest
+ remove a = case a of
+ "" -> error $ "File ended without closing comment (*/): " ++ file
+ '"' : rest -> removeString rest
+ '\n' : rest -> '\n' : remove rest
+ '\t' : rest -> '\t' : remove rest
+ '*' : '/' : rest -> " " ++ uncomment' rest
+ _ : rest -> " " ++ remove rest
- removeString a = case a of
- "" -> error $ "File ended without closing string: " ++ file
- '"' : rest -> " " ++ remove rest
- '\\' : '"' : rest -> " " ++ removeString rest
- '\n' : rest -> '\n' : removeString rest
- '\t' : rest -> '\t' : removeString rest
- _ : rest -> ' ' : removeString rest
+ removeString a = case a of
+ "" -> error $ "File ended without closing string: " ++ file
+ '"' : rest -> " " ++ remove rest
+ '\\' : '"' : rest -> " " ++ removeString rest
+ '\n' : rest -> '\n' : removeString rest
+ '\t' : rest -> '\t' : removeString rest
+ _ : rest -> ' ' : removeString rest
- ignoreString a = case a of
- "" -> error $ "File ended without closing string: " ++ file
- '"' : rest -> '"' : uncomment' rest
- '\\' : '"' : rest -> "\\\"" ++ ignoreString rest
- b : rest -> b : ignoreString rest
+ ignoreString a = case a of
+ "" -> error $ "File ended without closing string: " ++ file
+ '"' : rest -> '"' : uncomment' rest
+ '\\' : '"' : rest -> "\\\"" ++ ignoreString rest
+ b : rest -> b : ignoreString rest
-- | A simple `define preprocessor.
preprocess :: [(String, String)] -> FilePath -> String -> String
-preprocess env file content = unlines $ pp True [] env $ lines $ uncomment file content
+preprocess env file content = unlines $ pp True [] env $ lines $ uncomment
+ file
+ content
where
- pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
- pp _ _ _ [] = []
- pp on stack env_ (a : rest) = case words a of
- "`define" : name : value -> "" : pp on stack (if on then (name, ppLine env_ $ unwords value) : env_ else env_) rest
- "`ifdef" : name : _ -> "" : pp (on && elem name (map fst env_)) (on : stack) env_ rest
- "`ifndef" : name : _ -> "" : pp (on && notElem name (map fst env_)) (on : stack) env_ rest
- "`else" : _
- | not $ null stack -> "" : pp (head stack && not on) stack env_ rest
- | otherwise -> error $ "`else without associated `ifdef/`ifndef: " ++ file
- "`endif" : _
- | not $ null stack -> "" : pp (head stack) (tail stack) env_ rest
- | otherwise -> error $ "`endif without associated `ifdef/`ifndef: " ++ file
- _ -> (if on then ppLine env_ a else "") : pp on stack env_ rest
+ pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
+ pp _ _ _ [] = []
+ pp on stack env_ (a : rest) = case words a of
+ "`define" : name : value ->
+ ""
+ : pp
+ on
+ stack
+ (if on
+ then (name, ppLine env_ $ unwords value) : env_
+ else env_
+ )
+ rest
+ "`ifdef" : name : _ ->
+ "" : pp (on && elem name (map fst env_)) (on : stack) env_ rest
+ "`ifndef" : name : _ ->
+ "" : pp (on && notElem name (map fst env_)) (on : stack) env_ rest
+ "`else" : _
+ | not $ null stack
+ -> "" : pp (head stack && not on) stack env_ rest
+ | otherwise
+ -> error $ "`else without associated `ifdef/`ifndef: " ++ file
+ "`endif" : _
+ | not $ null stack
+ -> "" : pp (head stack) (tail stack) env_ rest
+ | otherwise
+ -> error $ "`endif without associated `ifdef/`ifndef: " ++ file
+ _ -> (if on then ppLine env_ a else "") : pp on stack env_ rest
ppLine :: [(String, String)] -> String -> String
-ppLine _ "" = ""
+ppLine _ "" = ""
ppLine env ('`' : a) = case lookup name env of
- Just value -> value ++ ppLine env rest
- Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env
+ Just value -> value ++ ppLine env rest
+ Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env
where
- name = takeWhile (flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_']) a
- rest = drop (length name) a
+ name = takeWhile
+ (flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_'])
+ a
+ rest = drop (length name) a
ppLine env (a : b) = a : ppLine env b
diff --git a/src/VeriFuzz/Parser/Token.hs b/src/VeriFuzz/Parser/Token.hs
index f776dd8..811331b 100644
--- a/src/VeriFuzz/Parser/Token.hs
+++ b/src/VeriFuzz/Parser/Token.hs
@@ -1,9 +1,10 @@
module VeriFuzz.Parser.Token
- ( Token (..)
- , TokenName (..)
- , Position (..)
- , tokenString
- ) where
+ ( Token(..)
+ , TokenName(..)
+ , Position(..)
+ , tokenString
+ )
+where
import Text.Printf
generated by cgit (git 2.34.1) at 2024-07-05 01:40:01 +0000