diff options
author | Yann Herklotz <git@ymhg.org> | 2019-04-01 10:55:40 +0100 |
---|---|---|
committer | Yann Herklotz <git@ymhg.org> | 2019-04-01 10:55:40 +0100 |
commit | bac2f24871d95eeb3aa3fc898a7656fc4f5f094a (patch) | |
tree | abae8302d3a07eec39fe1a3d05077d4505a0b2bb /src/VeriFuzz/Parser | |
parent | ce3b5a9dc47c2325e1e9cc61279972048b9fbabd (diff) | |
download | verismith-bac2f24871d95eeb3aa3fc898a7656fc4f5f094a.tar.gz verismith-bac2f24871d95eeb3aa3fc898a7656fc4f5f094a.zip |
Run through brittany
Diffstat (limited to 'src/VeriFuzz/Parser')
-rw-r--r-- | src/VeriFuzz/Parser/Parser.hs | 157 | ||||
-rw-r--r-- | src/VeriFuzz/Parser/Preprocess.hs | 124 | ||||
-rw-r--r-- | src/VeriFuzz/Parser/Token.hs | 11 |
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 |