Commit dd0eb598 by Zachary Snow

added source trace comments

- Trace comments cover module items, decls, and stmts
- Added pseudo-lexer to Alex parser for monadic Position production
- Added Position to every DeclToken
- Removed Comment PackageItem
- Added CommentStmt and CommentDecl
- Fixed traversal skipping outer MIAttr ModuleItems
- Generally cleaned up Parser modules
parent 9f180f91
...@@ -15,7 +15,7 @@ convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem ...@@ -15,7 +15,7 @@ convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
convertModuleItem :: ModuleItem -> ModuleItem convertModuleItem :: ModuleItem -> ModuleItem
convertModuleItem (AssertionItem item) = convertModuleItem (AssertionItem item) =
Generate $ Generate $
map (GenModuleItem . MIPackageItem . Comment) $ map (GenModuleItem . MIPackageItem . Decl . CommentDecl) $
"removed an assertion item" : "removed an assertion item" :
(lines $ show $ AssertionItem item) (lines $ show $ AssertionItem item)
convertModuleItem other = traverseStmts convertStmt other convertModuleItem other = traverseStmts convertStmt other
......
...@@ -191,6 +191,7 @@ prefixModuleItems prefix = ...@@ -191,6 +191,7 @@ prefixModuleItems prefix =
prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me
prefixDecl (Param s t x e) = Param s t (prefix ++ x) e prefixDecl (Param s t x e) = Param s t (prefix ++ x) e
prefixDecl (ParamType s x mt) = ParamType s (prefix ++ x) mt prefixDecl (ParamType s x mt) = ParamType s (prefix ++ x) mt
prefixDecl (CommentDecl c) = CommentDecl c
prefixExpr :: Expr -> Expr prefixExpr :: Expr -> Expr
prefixExpr (Ident x) = Ident (prefix ++ x) prefixExpr (Ident x) = Ident (prefix ++ x)
prefixExpr other = other prefixExpr other = other
...@@ -229,12 +230,15 @@ lookupType _ expr = ...@@ -229,12 +230,15 @@ lookupType _ expr =
-- convert an interface instantiation into a series of equivalent module items -- convert an interface instantiation into a series of equivalent module items
inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem] inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem]
inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
(:) (MIPackageItem $ Comment $ "expanded instance: " ++ instanceName) $ (:) comment $
flip (++) portBindings $ flip (++) portBindings $
map (traverseNestedModuleItems removeModport) $ map (traverseNestedModuleItems removeModport) $
map (traverseNestedModuleItems removeDeclDir) $ map (traverseNestedModuleItems removeDeclDir) $
itemsPrefixed itemsPrefixed
where where
comment = MIPackageItem $ Decl $ CommentDecl $
"expanded instance: " ++ instanceName
prefix = instanceName ++ "_" prefix = instanceName ++ "_"
itemsPrefixed = itemsPrefixed =
map (prefixModuleItems prefix) $ map (prefixModuleItems prefix) $
...@@ -257,7 +261,7 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = ...@@ -257,7 +261,7 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
removeDeclDir other = other removeDeclDir other = other
removeModport :: ModuleItem -> ModuleItem removeModport :: ModuleItem -> ModuleItem
removeModport (Modport x _) = removeModport (Modport x _) =
MIPackageItem $ Comment $ "removed modport " ++ x MIPackageItem $ Decl $ CommentDecl $ "removed modport " ++ x
removeModport other = other removeModport other = other
instanceParamMap = Map.fromList instanceParams instanceParamMap = Map.fromList instanceParams
......
...@@ -88,10 +88,11 @@ convertDescription ports orig = ...@@ -88,10 +88,11 @@ convertDescription ports orig =
if null newItems if null newItems
then Instance moduleName params instanceName rs bindings then Instance moduleName params instanceName rs bindings
else Generate $ map GenModuleItem $ else Generate $ map GenModuleItem $
(MIPackageItem $ Comment "rewrote reg-to-output bindings") : comment : newItems ++
newItems ++
[Instance moduleName params instanceName rs bindings'] [Instance moduleName params instanceName rs bindings']
where where
comment = MIPackageItem $ Decl $ CommentDecl
"rewrote reg-to-output bindings"
(bindings', newItemsList) = unzip $ map fixBinding bindings (bindings', newItemsList) = unzip $ map fixBinding bindings
newItems = concat newItemsList newItems = concat newItemsList
fixBinding :: PortBinding -> (PortBinding, [ModuleItem]) fixBinding :: PortBinding -> (PortBinding, [ModuleItem])
......
...@@ -51,8 +51,7 @@ traverseDeclM (Variable dir t ident a me) = do ...@@ -51,8 +51,7 @@ traverseDeclM (Variable dir t ident a me) = do
traverseDeclM (Param s t ident e) = do traverseDeclM (Param s t ident e) = do
t' <- traverseTypeM t [] ident t' <- traverseTypeM t [] ident
return $ Param s t' ident e return $ Param s t' ident e
traverseDeclM (ParamType s ident mt) = traverseDeclM other = return other
return $ ParamType s ident mt
traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
traverseTypeM t a ident = do traverseTypeM t a ident = do
......
...@@ -104,7 +104,7 @@ piName (Typedef _ ident ) = Just ident ...@@ -104,7 +104,7 @@ piName (Typedef _ ident ) = Just ident
piName (Decl (Variable _ _ ident _ _)) = Just ident piName (Decl (Variable _ _ ident _ _)) = Just ident
piName (Decl (Param _ _ ident _)) = Just ident piName (Decl (Param _ _ ident _)) = Just ident
piName (Decl (ParamType _ ident _)) = Just ident piName (Decl (ParamType _ ident _)) = Just ident
piName (Decl (CommentDecl _)) = Nothing
piName (Import x y) = Just $ show $ Import x y piName (Import x y) = Just $ show $ Import x y
piName (Export _) = Nothing piName (Export _) = Nothing
piName (Comment _) = Nothing
piName (Directive _) = Nothing piName (Directive _) = Nothing
...@@ -175,7 +175,7 @@ piName (Typedef _ ident ) = Just ident ...@@ -175,7 +175,7 @@ piName (Typedef _ ident ) = Just ident
piName (Decl (Variable _ _ ident _ _)) = Just ident piName (Decl (Variable _ _ ident _ _)) = Just ident
piName (Decl (Param _ _ ident _)) = Just ident piName (Decl (Param _ _ ident _)) = Just ident
piName (Decl (ParamType _ ident _)) = Just ident piName (Decl (ParamType _ ident _)) = Just ident
piName (Decl (CommentDecl _)) = Nothing
piName (Import _ _) = Nothing piName (Import _ _) = Nothing
piName (Export _) = Nothing piName (Export _) = Nothing
piName (Comment _) = Nothing
piName (Directive _) = Nothing piName (Directive _) = Nothing
...@@ -15,12 +15,49 @@ convert = map convertFile ...@@ -15,12 +15,49 @@ convert = map convertFile
convertFile :: AST -> AST convertFile :: AST -> AST
convertFile = convertFile =
traverseDescriptions (traverseModuleItems convertModuleItem) . traverseDescriptions (traverseModuleItems convertModuleItem) .
filter (not . isComment) filter (not . isTopLevelComment)
isComment :: Description -> Bool isTopLevelComment :: Description -> Bool
isComment (PackageItem (Comment _)) = True isTopLevelComment (PackageItem (Decl CommentDecl{})) = True
isComment _ = False isTopLevelComment _ = False
convertModuleItem :: ModuleItem -> ModuleItem convertModuleItem :: ModuleItem -> ModuleItem
convertModuleItem (MIPackageItem (Comment _)) = Generate [] convertModuleItem (MIAttr _ (Generate [])) = Generate []
convertModuleItem other = other convertModuleItem (MIPackageItem (Decl CommentDecl{})) = Generate []
convertModuleItem (MIPackageItem item) =
MIPackageItem $ convertPackageItem item
convertModuleItem other =
traverseStmts (traverseNestedStmts convertStmt) other
convertPackageItem :: PackageItem -> PackageItem
convertPackageItem (Function l t x decls stmts) =
Function l t x decls' stmts'
where
decls' = convertDecls decls
stmts' = convertStmts stmts
convertPackageItem (Task l x decls stmts) =
Task l x decls' stmts'
where
decls' = convertDecls decls
stmts' = convertStmts stmts
convertPackageItem other = other
convertStmt :: Stmt -> Stmt
convertStmt (CommentStmt _) = Null
convertStmt (Block kw name decls stmts) =
Block kw name decls' stmts
where decls' = convertDecls decls
convertStmt (For (Left decls) cond incr stmt) =
For (Left decls') cond incr stmt
where decls' = convertDecls decls
convertStmt other = other
convertDecls :: [Decl] -> [Decl]
convertDecls = filter (not . isCommentDecl)
where
isCommentDecl :: Decl -> Bool
isCommentDecl CommentDecl{} = True
isCommentDecl _ = False
convertStmts :: [Stmt] -> [Stmt]
convertStmts = map $ traverseNestedStmts convertStmt
...@@ -45,6 +45,7 @@ traverseDeclM decl = do ...@@ -45,6 +45,7 @@ traverseDeclM decl = do
Variable _ t x _ _ -> modify $ Map.insert x t Variable _ t x _ _ -> modify $ Map.insert x t
Param _ t x _ -> modify $ Map.insert x t Param _ t x _ -> modify $ Map.insert x t
ParamType _ _ _ -> return () ParamType _ _ _ -> return ()
CommentDecl _ -> return ()
return decl return decl
traverseModuleItemM :: ModuleItem -> ST ModuleItem traverseModuleItemM :: ModuleItem -> ST ModuleItem
......
...@@ -194,8 +194,8 @@ traverseDeclM structs origDecl = do ...@@ -194,8 +194,8 @@ traverseDeclM structs origDecl = do
modify $ Map.insert x t modify $ Map.insert x t
e' <- convertDeclExpr x e e' <- convertDeclExpr x e
return $ Param s t x e' return $ Param s t x e'
ParamType s x mt -> ParamType{} -> return origDecl
return $ ParamType s x mt CommentDecl{} -> return origDecl
where where
convertDeclExpr :: Identifier -> Expr -> State Types Expr convertDeclExpr :: Identifier -> Expr -> State Types Expr
convertDeclExpr x e = do convertDeclExpr x e = do
......
...@@ -131,7 +131,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d ...@@ -131,7 +131,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
let genItems' = filter (/= GenNull) genItems let genItems' = filter (/= GenNull) genItems
mapM fullGenItemMapper genItems' >>= mapper . Generate mapM fullGenItemMapper genItems' >>= mapper . Generate
fullMapper (MIAttr attr mi) = fullMapper (MIAttr attr mi) =
fullMapper mi >>= return . MIAttr attr fullMapper mi >>= mapper . MIAttr attr
fullMapper other = mapper other fullMapper other = mapper other
fullGenItemMapper = traverseNestedGenItemsM genItemMapper fullGenItemMapper = traverseNestedGenItemsM genItemMapper
genItemMapper (GenModuleItem moduleItem) = do genItemMapper (GenModuleItem moduleItem) = do
...@@ -264,6 +264,7 @@ traverseSinglyNestedStmtsM fullMapper = cs ...@@ -264,6 +264,7 @@ traverseSinglyNestedStmtsM fullMapper = cs
cs (Continue) = return Continue cs (Continue) = return Continue
cs (Break) = return Break cs (Break) = return Break
cs (Null) = return Null cs (Null) = return Null
cs (CommentStmt c) = return $ CommentStmt c
traverseAssertionStmtsM :: Monad m => MapperM m Stmt -> MapperM m Assertion traverseAssertionStmtsM :: Monad m => MapperM m Stmt -> MapperM m Assertion
traverseAssertionStmtsM mapper = assertionMapper traverseAssertionStmtsM mapper = assertionMapper
...@@ -548,6 +549,8 @@ exprMapperHelpers exprMapper = ...@@ -548,6 +549,8 @@ exprMapperHelpers exprMapper =
a' <- mapM rangeMapper a a' <- mapM rangeMapper a
me' <- maybeExprMapper me me' <- maybeExprMapper me
return $ Variable d t' x a' me' return $ Variable d t' x a' me'
declMapper (CommentDecl c) =
return $ CommentDecl c
lhsMapper (LHSRange l m r) = lhsMapper (LHSRange l m r) =
rangeMapper r >>= return . LHSRange l m rangeMapper r >>= return . LHSRange l m
...@@ -640,8 +643,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper ...@@ -640,8 +643,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper
return $ Generate items' return $ Generate items'
moduleItemMapper (MIPackageItem (Directive c)) = moduleItemMapper (MIPackageItem (Directive c)) =
return $ MIPackageItem $ Directive c return $ MIPackageItem $ Directive c
moduleItemMapper (MIPackageItem (Comment c)) =
return $ MIPackageItem $ Comment c
moduleItemMapper (MIPackageItem (Import x y)) = moduleItemMapper (MIPackageItem (Import x y)) =
return $ MIPackageItem $ Import x y return $ MIPackageItem $ Import x y
moduleItemMapper (MIPackageItem (Export x)) = moduleItemMapper (MIPackageItem (Export x)) =
...@@ -744,6 +745,7 @@ traverseStmtExprsM exprMapper = flatStmtMapper ...@@ -744,6 +745,7 @@ traverseStmtExprsM exprMapper = flatStmtMapper
flatStmtMapper (Continue) = return Continue flatStmtMapper (Continue) = return Continue
flatStmtMapper (Break) = return Break flatStmtMapper (Break) = return Break
flatStmtMapper (Null) = return Null flatStmtMapper (Null) = return Null
flatStmtMapper (CommentStmt c) = return $ CommentStmt c
initsMapper (Left decls) = mapM declMapper decls >>= return . Left initsMapper (Left decls) = mapM declMapper decls >>= return . Left
initsMapper (Right asgns) = mapM mapper asgns >>= return . Right initsMapper (Right asgns) = mapM mapper asgns >>= return . Right
...@@ -926,6 +928,7 @@ traverseTypesM mapper item = ...@@ -926,6 +928,7 @@ traverseTypesM mapper item =
maybeMapper mt >>= \mt' -> return $ ParamType s x mt' maybeMapper mt >>= \mt' -> return $ ParamType s x mt'
declMapper (Variable d t x a me) = declMapper (Variable d t x a me) =
fullMapper t >>= \t' -> return $ Variable d t' x a me fullMapper t >>= \t' -> return $ Variable d t' x a me
declMapper (CommentDecl c) = return $ CommentDecl c
miMapper (MIPackageItem (Typedef t x)) = miMapper (MIPackageItem (Typedef t x)) =
fullMapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x fullMapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x
miMapper (MIPackageItem (Function l t x d s)) = miMapper (MIPackageItem (Function l t x d s)) =
......
...@@ -53,7 +53,8 @@ traverseDeclM decl = do ...@@ -53,7 +53,8 @@ traverseDeclM decl = do
Param _ t ident _ -> do Param _ t ident _ -> do
modify $ Map.insert ident t modify $ Map.insert ident t
return decl' return decl'
ParamType _ _ _ -> return decl' ParamType{} -> return decl'
CommentDecl{} -> return decl'
traverseModuleItemM :: ModuleItem -> State Info ModuleItem traverseModuleItemM :: ModuleItem -> State Info ModuleItem
traverseModuleItemM item = traverseTypesM traverseTypeM item traverseModuleItemM item = traverseTypesM traverseTypeM item
......
...@@ -30,7 +30,7 @@ convert = ...@@ -30,7 +30,7 @@ convert =
getTypedef _ = return () getTypedef _ = return ()
removeTypedef :: Description -> Description removeTypedef :: Description -> Description
removeTypedef (PackageItem (Typedef _ x)) = removeTypedef (PackageItem (Typedef _ x)) =
PackageItem $ Comment $ "removed typedef: " ++ x PackageItem $ Decl $ CommentDecl $ "removed typedef: " ++ x
removeTypedef other = other removeTypedef other = other
convertDescription :: Types -> Description -> Description convertDescription :: Types -> Description -> Description
...@@ -48,7 +48,7 @@ convertDescription globalTypes description = ...@@ -48,7 +48,7 @@ convertDescription globalTypes description =
getTypedef _ = return () getTypedef _ = return ()
removeTypedef :: ModuleItem -> ModuleItem removeTypedef :: ModuleItem -> ModuleItem
removeTypedef (MIPackageItem (Typedef _ x)) = removeTypedef (MIPackageItem (Typedef _ x)) =
MIPackageItem $ Comment $ "removed typedef: " ++ x MIPackageItem $ Decl $ CommentDecl $ "removed typedef: " ++ x
removeTypedef other = other removeTypedef other = other
convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
convertTypeOrExpr (Left (TypeOf (Ident x))) = convertTypeOrExpr (Left (TypeOf (Ident x))) =
......
...@@ -45,10 +45,7 @@ traverseDeclM (orig @ (Variable dir _ x _ me)) = do ...@@ -45,10 +45,7 @@ traverseDeclM (orig @ (Variable dir _ x _ me)) = do
then lift $ tell $ Set.singleton orig then lift $ tell $ Set.singleton orig
else return () else return ()
return orig return orig
traverseDeclM (orig @ (Param _ _ _ _)) = traverseDeclM other = return other
return orig
traverseDeclM (orig @ (ParamType _ _ _)) =
return orig
-- pack the given decls marked for packing -- pack the given decls marked for packing
packDecl :: DeclSet -> Decl -> Decl packDecl :: DeclSet -> Decl -> Decl
...@@ -59,8 +56,7 @@ packDecl decls (orig @ (Variable d t x a me)) = do ...@@ -59,8 +56,7 @@ packDecl decls (orig @ (Variable d t x a me)) = do
let t' = tf $ a ++ rs let t' = tf $ a ++ rs
Variable d t' x [] me Variable d t' x [] me
else orig else orig
packDecl _ (orig @ Param{}) = orig packDecl _ other = other
packDecl _ (orig @ ParamType{}) = orig
traverseModuleItemM :: ModuleItem -> ST ModuleItem traverseModuleItemM :: ModuleItem -> ST ModuleItem
......
...@@ -23,6 +23,7 @@ data Decl ...@@ -23,6 +23,7 @@ data Decl
= Param ParamScope Type Identifier Expr = Param ParamScope Type Identifier Expr
| ParamType ParamScope Identifier (Maybe Type) | ParamType ParamScope Identifier (Maybe Type)
| Variable Direction Type Identifier [Range] (Maybe Expr) | Variable Direction Type Identifier [Range] (Maybe Expr)
| CommentDecl String
deriving (Eq, Ord) deriving (Eq, Ord)
instance Show Decl where instance Show Decl where
...@@ -30,6 +31,10 @@ instance Show Decl where ...@@ -30,6 +31,10 @@ instance Show Decl where
show (Param s t x e) = printf "%s %s%s = %s;" (show s) (showPad t) x (show e) show (Param s t x e) = printf "%s %s%s = %s;" (show s) (showPad t) x (show e)
show (ParamType s x mt) = printf "%s type %s%s;" (show s) x (showAssignment mt) show (ParamType s x mt) = printf "%s type %s%s;" (show s) x (showAssignment mt)
show (Variable d t x a me) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment me) show (Variable d t x a me) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment me)
show (CommentDecl c) =
if elem '\n' c
then "// " ++ show c
else "// " ++ c
data Direction data Direction
= Input = Input
......
...@@ -61,7 +61,6 @@ data PackageItem ...@@ -61,7 +61,6 @@ data PackageItem
| Export (Maybe (Identifier, Maybe Identifier)) | Export (Maybe (Identifier, Maybe Identifier))
| Decl Decl | Decl Decl
| Directive String | Directive String
| Comment String
deriving Eq deriving Eq
instance Show PackageItem where instance Show PackageItem where
...@@ -79,10 +78,6 @@ instance Show PackageItem where ...@@ -79,10 +78,6 @@ instance Show PackageItem where
show (Export (Just (x, y))) = printf "export %s::%s;" x (fromMaybe "*" y) show (Export (Just (x, y))) = printf "export %s::%s;" x (fromMaybe "*" y)
show (Decl decl) = show decl show (Decl decl) = show decl
show (Directive str) = str show (Directive str) = str
show (Comment c) =
if elem '\n' c
then "// " ++ show c
else "// " ++ c
data PartKW data PartKW
= Module = Module
......
...@@ -54,6 +54,7 @@ data Stmt ...@@ -54,6 +54,7 @@ data Stmt
| Continue | Continue
| Break | Break
| Null | Null
| CommentStmt String
deriving Eq deriving Eq
instance Show Stmt where instance Show Stmt where
...@@ -98,8 +99,15 @@ instance Show Stmt where ...@@ -98,8 +99,15 @@ instance Show Stmt where
show (Continue ) = "continue;" show (Continue ) = "continue;"
show (Break ) = "break;" show (Break ) = "break;"
show (Null ) = ";" show (Null ) = ";"
show (CommentStmt c) =
if elem '\n' c
then "// " ++ show c
else "// " ++ c
showBranch :: Stmt -> String showBranch :: Stmt -> String
showBranch (Block Seq "" [] [CommentStmt c, stmt]) =
'\n' : (indent $ unlines' $ map show stmts)
where stmts = [CommentStmt c, stmt]
showBranch (block @ Block{}) = ' ' : show block showBranch (block @ Block{}) = ' ' : show block
showBranch stmt = '\n' : (indent $ show stmt) showBranch stmt = '\n' : (indent $ show stmt)
......
...@@ -6,10 +6,12 @@ module Language.SystemVerilog.Parser ...@@ -6,10 +6,12 @@ module Language.SystemVerilog.Parser
) where ) where
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.State
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Language.SystemVerilog.AST (AST) import Language.SystemVerilog.AST (AST)
import Language.SystemVerilog.Parser.Lex (lexFile, Env) import Language.SystemVerilog.Parser.Lex (lexFile, Env)
import Language.SystemVerilog.Parser.Parse (parse) import Language.SystemVerilog.Parser.Parse (parse)
import Language.SystemVerilog.Parser.Tokens (Position(..), tokenPosition)
-- parses a compilation unit given include search paths and predefined macros -- parses a compilation unit given include search paths and predefined macros
parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST]) parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST])
...@@ -32,5 +34,9 @@ parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env) ...@@ -32,5 +34,9 @@ parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env)
parseFile' includePaths env path = do parseFile' includePaths env path = do
result <- liftIO $ lexFile includePaths env path result <- liftIO $ lexFile includePaths env path
(tokens, env') <- liftEither result (tokens, env') <- liftEither result
ast <- parse tokens let position =
if null tokens
then Position path 1 1
else tokenPosition $ head tokens
ast <- evalStateT parse (position, tokens)
return (ast, env') return (ast, env')
...@@ -11,15 +11,18 @@ ...@@ -11,15 +11,18 @@
- the ability to easily blame/diff this file. - the ability to easily blame/diff this file.
-} -}
{ {
{-# LANGUAGE BlockArguments #-}
module Language.SystemVerilog.Parser.Parse (parse) where module Language.SystemVerilog.Parser.Parse (parse) where
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.State
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
import Language.SystemVerilog.Parser.ParseDecl import Language.SystemVerilog.Parser.ParseDecl
import Language.SystemVerilog.Parser.Tokens import Language.SystemVerilog.Parser.Tokens
} }
%monad { ExceptT String IO } %monad { ParseState }
%lexer { positionKeep } { TokenEOF }
%name parse %name parse
%tokentype { Token } %tokentype { Token }
%error { parseError } %error { parseError }
...@@ -586,40 +589,31 @@ Identifiers :: { [Identifier] } ...@@ -586,40 +589,31 @@ Identifiers :: { [Identifier] }
-- uses delimiter propagation hack to avoid conflicts -- uses delimiter propagation hack to avoid conflicts
DeclTokens(delim) :: { [DeclToken] } DeclTokens(delim) :: { [DeclToken] }
: DeclToken delim { [$1] } : DeclToken delim { [$1] }
| DeclToken DeclTokens(delim) { [$1] ++ $2 } | DeclToken DeclTokens(delim) { [$1] ++ $2 }
| AsgnOp Expr "," DeclTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 } | Identifier ParamBindings DeclTokens(delim) {% posInject \p -> [DTIdent p $1, DTParams p $2] ++ $3 }
| AsgnOp Expr delim { [DTAsgn $1 $2] } | AsgnOp Expr "," DeclTokens(delim) {% posInject \p -> [DTAsgn p $1 $2, DTComma p] ++ $4 }
| AsgnOp Expr delim {% posInject \p -> [DTAsgn p $1 $2] }
DeclToken :: { DeclToken } DeclToken :: { DeclToken }
: DeclOrStmtToken { $1 } : "," {% posInject \p -> DTComma p }
| ParameterBindings { DTParams $1 } | "[" "]" {% posInject \p -> DTAutoDim p }
| PartSelect {% posInject \p -> DTRange p $1 }
DeclOrStmtTokens(delim) :: { [DeclToken] } | Identifier {% posInject \p -> DTIdent p $1 }
: DeclOrStmtToken delim { [$1] } | Direction {% posInject \p -> DTDir p $1 }
| DeclOrStmtToken DeclOrStmtTokens(delim) { [$1] ++ $2 } | "[" Expr "]" {% posInject \p -> DTBit p $2 }
| AsgnOp Expr "," DeclOrStmtTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 } | LHSConcat {% posInject \p -> DTConcat p $1 }
| AsgnOp Expr delim { [DTAsgn $1 $2] } | PartialType {% posInject \p -> DTType p $1 }
| IncOrDecOperator delim { [DTAsgn (AsgnOp $1) (Number "1")] } | "." Identifier {% posInject \p -> DTDot p $2 }
| "<=" opt(DelayOrEventControl) Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2 $3, DTComma] ++ $5 } | PortBindings {% posInject \p -> DTInstance p $1 }
| "<=" opt(DelayOrEventControl) Expr delim { [DTAsgnNBlk $2 $3] } | Signing {% posInject \p -> DTSigning p $1 }
DeclOrStmtToken :: { DeclToken } | ExplicitLifetime {% posInject \p -> DTLifetime p $1 }
: "," { DTComma } | "const" PartialType {% posInject \p -> DTType p $2 }
| "[" "]" { DTAutoDim } | Identifier "::" Identifier {% posInject \p -> DTPSIdent p $1 $3 }
| PartSelect { DTRange $1 } | "{" StreamOp StreamSize Concat "}" {% posInject \p -> DTStream p $2 $3 (map toLHS $4) }
| Identifier { DTIdent $1 } | "{" StreamOp Concat "}" {% posInject \p -> DTStream p $2 (Number "1") (map toLHS $3) }
| Direction { DTDir $1 } | opt("var") "type" "(" Expr ")" {% posInject \p -> DTType p (\Unspecified -> \[] -> TypeOf $4) }
| "[" Expr "]" { DTBit $2 } | "<=" opt(DelayOrEventControl) Expr {% posInject \p -> DTAsgnNBlk p $2 $3 }
| LHSConcat { DTConcat $1 } | IncOrDecOperator {% posInject \p -> DTAsgn p (AsgnOp $1) (Number "1") }
| PartialType { DTType $1 }
| "." Identifier { DTDot $2 }
| PortBindings { DTInstance $1 }
| Signing { DTSigning $1 }
| ExplicitLifetime { DTLifetime $1 }
| Identifier "::" Identifier { DTPSIdent $1 $3 }
| "const" PartialType { DTType $2 }
| "{" StreamOp StreamSize Concat "}" { DTStream $2 $3 (map toLHS $4) }
| "{" StreamOp Concat "}" { DTStream $2 (Number "1") (map toLHS $3) }
| opt("var") "type" "(" Expr ")" { DTType $ \Unspecified -> \[] -> TypeOf $4 }
VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] } VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
: VariablePortIdentifier { [$1] } : VariablePortIdentifier { [$1] }
...@@ -634,9 +628,9 @@ Direction :: { Direction } ...@@ -634,9 +628,9 @@ Direction :: { Direction }
| "output" { Output } | "output" { Output }
ModuleItems :: { [ModuleItem] } ModuleItems :: { [ModuleItem] }
: {- empty -} { [] } : {- empty -} { [] }
| ModuleItems ModuleItem { $1 ++ $2 } | ModuleItems MITrace ModuleItem { $1 ++ [$2] ++ $3 }
| ModuleItems ";" { $1 } | ModuleItems ";" { $1 }
ModuleItem :: { [ModuleItem] } ModuleItem :: { [ModuleItem] }
: NonGenerateModuleItem { $1 } : NonGenerateModuleItem { $1 }
...@@ -768,9 +762,9 @@ LHSAsgn :: { (LHS, Expr) } ...@@ -768,9 +762,9 @@ LHSAsgn :: { (LHS, Expr) }
: LHS "=" Expr { ($1, $3) } : LHS "=" Expr { ($1, $3) }
PackageItems :: { [PackageItem] } PackageItems :: { [PackageItem] }
: {- empty -} { [] } : {- empty -} { [] }
| PackageItems ";" { $1 } | PackageItems ";" { $1 }
| PackageItems PackageItem { $1 ++ $2 } | PackageItems PITrace PackageItem { $1 ++ [$2] ++ $3 }
PackageItem :: { [PackageItem] } PackageItem :: { [PackageItem] }
: DeclTokens(";") { map Decl $ parseDTsAsDecls $1 } : DeclTokens(";") { map Decl $ parseDTsAsDecls $1 }
| ParameterDecl(";") { map Decl $1 } | ParameterDecl(";") { map Decl $1 }
...@@ -888,7 +882,7 @@ PortBinding :: { PortBinding } ...@@ -888,7 +882,7 @@ PortBinding :: { PortBinding }
| Expr { ("", Just $1) } | Expr { ("", Just $1) }
| ".*" { ("*", Nothing) } | ".*" { ("*", Nothing) }
ParameterBindings :: { [ParamBinding] } ParamBindings :: { [ParamBinding] }
: "#" "(" ParamBindingsInside ")" { $3 } : "#" "(" ParamBindingsInside ")" { $3 }
ParamBindingsInside :: { [ParamBinding] } ParamBindingsInside :: { [ParamBinding] }
: ParamBinding { [$1] } : ParamBinding { [$1] }
...@@ -903,12 +897,13 @@ Stmts :: { [Stmt] } ...@@ -903,12 +897,13 @@ Stmts :: { [Stmt] }
| Stmts Stmt { $1 ++ [$2] } | Stmts Stmt { $1 ++ [$2] }
Stmt :: { Stmt } Stmt :: { Stmt }
: StmtAsgn { $1 } : StmtTrace StmtAsgn { Block Seq "" [] [$1, $2] }
| StmtNonAsgn { $1 } | StmtTrace StmtNonAsgn { $2 }
StmtAsgn :: { Stmt } StmtAsgn :: { Stmt }
: LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 } : LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
| LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") } | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") }
| IncOrDecOperator LHS ";" { AsgnBlk (AsgnOp $1) $2 (Number "1") }
| LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 } | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
| LHS ";" { Subroutine (lhsToExpr $1) (Args [] []) } | LHS ";" { Subroutine (lhsToExpr $1) (Args [] []) }
| LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 } | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 }
...@@ -940,7 +935,6 @@ StmtNonBlock :: { Stmt } ...@@ -940,7 +935,6 @@ StmtNonBlock :: { Stmt }
| "->>" Identifier ";" { Trigger False $2 } | "->>" Identifier ";" { Trigger False $2 }
| AttributeInstance Stmt { StmtAttr $1 $2 } | AttributeInstance Stmt { StmtAttr $1 $2 }
| ProceduralAssertionStatement { Assertion $1 } | ProceduralAssertionStatement { Assertion $1 }
| IncOrDecOperator LHS ";" { AsgnBlk (AsgnOp $1) $2 (Number "1") }
| "void" "'" "(" Expr CallArgs ")" ";" { Subroutine $4 $5 } | "void" "'" "(" Expr CallArgs ")" ";" { Subroutine $4 $5 }
BlockKWPar :: { BlockKW } BlockKWPar :: { BlockKW }
...@@ -980,12 +974,12 @@ IdxVarsInside :: { [Maybe Identifier] } ...@@ -980,12 +974,12 @@ IdxVarsInside :: { [Maybe Identifier] }
| opt(Identifier) "," IdxVarsInside { $1 : $3 } | opt(Identifier) "," IdxVarsInside { $1 : $3 }
DeclsAndStmts :: { ([Decl], [Stmt]) } DeclsAndStmts :: { ([Decl], [Stmt]) }
: DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $1 $2 } : StmtTrace DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $2 $3 }
| StmtNonAsgn Stmts { ([], $1 : $2) } | StmtTrace StmtNonAsgn Stmts { ([], $1 : $2 : $3) }
| {- empty -} { ([], []) } | StmtTrace {- empty -} { ([], []) }
DeclOrStmt :: { ([Decl], [Stmt]) } DeclOrStmt :: { ([Decl], [Stmt]) }
: DeclOrStmtTokens(";") { parseDTsAsDeclOrAsgn $1 } : DeclTokens(";") { parseDTsAsDeclOrStmt $1 }
| ParameterDecl(";") { ($1, []) } | ParameterDecl(";") { ($1, []) }
ModuleParameterDecl(delim) :: { [Decl] } ModuleParameterDecl(delim) :: { [Decl] }
: ParameterDecl(delim) { $1 } : ParameterDecl(delim) { $1 }
...@@ -1271,12 +1265,40 @@ DimFn :: { DimFn } ...@@ -1271,12 +1265,40 @@ DimFn :: { DimFn }
| "$increment" { FnIncrement } | "$increment" { FnIncrement }
| "$size" { FnSize } | "$size" { FnSize }
MITrace :: { ModuleItem }
: PITrace { MIPackageItem $1 }
PITrace :: { PackageItem }
: Trace { Decl $ CommentDecl $1 }
StmtTrace :: { Stmt }
: Trace { CommentStmt $1 }
Trace :: { String }
: position { "Trace: " ++ show $1 }
position :: { Position }
: {- empty -} {% gets fst }
{ {
parseError :: [Token] -> ExceptT String IO a type ParseState = StateT (Position, [Token]) (ExceptT String IO)
posInject :: (Position -> a) -> ParseState a
posInject cont = do
pos <- gets fst
return $ cont pos
positionKeep :: (Token -> ParseState a) -> ParseState a
positionKeep cont = do
tokens <- gets snd
case tokens of
[] -> cont TokenEOF
tok : toks -> do
put (tokenPosition tok, toks)
cont tok
parseError :: Token -> ParseState a
parseError a = case a of parseError a = case a of
[] -> throwError $ "Parse error: no tokens left to parse." TokenEOF -> throwError $ "Parse error: no tokens left to parse."
Token t s p : _ -> throwError $ show p ++ ": Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ")." Token t s p -> throwError $ show p ++ ": Parse error: unexpected token '"
++ s ++ "' (" ++ show t ++ ")."
genItemsToGenItem :: [GenItem] -> GenItem genItemsToGenItem :: [GenItem] -> GenItem
genItemsToGenItem [x] = x genItemsToGenItem [x] = x
...@@ -1288,6 +1310,7 @@ combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2) ...@@ -1288,6 +1310,7 @@ combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)
makeInput :: Decl -> Decl makeInput :: Decl -> Decl
makeInput (Variable Local t x a me) = Variable Input t x a me makeInput (Variable Local t x a me) = Variable Input t x a me
makeInput (Variable Input t x a me) = Variable Input t x a me makeInput (Variable Input t x a me) = Variable Input t x a me
makeInput (CommentDecl c) = CommentDecl c
makeInput other = makeInput other =
error $ "unexpected non-var or non-input decl: " ++ (show other) error $ "unexpected non-var or non-input decl: " ++ (show other)
......
{- sv2v {- sv2v
- Author: Zachary Snow <zach@zachjs.com> - Author: Zachary Snow <zach@zachjs.com>
- -
- Advanced parser for declarations and module instantiations. - Advanced parser for declarations, module instantiations, and some statements.
- -
- This module exists because the SystemVerilog grammar has conflicts which - This module exists because the SystemVerilog grammar is not LALR(1), and
- cannot be resolved by an LALR(1) parser. This module provides an interface - Happy can only produce LALR(1) parsers. This module provides an interface for
- for parsing an list of "DeclTokens" into `Decl`s and/or `ModuleItem`s. This - parsing a list of "DeclTokens" into `Decl`s, `ModuleItem`s, or `Stmt`s. This
- works through a series of functions which have an greater lookahead for - works through a series of functions which have use a greater lookahead for
- resolving the conflicts. - resolving the conflicts.
- -
- Consider the following two module declarations: - Consider the following two module declarations:
...@@ -16,12 +16,19 @@ ...@@ -16,12 +16,19 @@
- When `{one} two ,` is on the stack, it is impossible to know whether to A) - When `{one} two ,` is on the stack, it is impossible to know whether to A)
- shift `three` to add to the current declaration list; or B) to reduce the - shift `three` to add to the current declaration list; or B) to reduce the
- stack and begin a new port declaration; without looking ahead more than 1 - stack and begin a new port declaration; without looking ahead more than 1
- token (even ignoring the fact that a range is itself multiple tokens). - token.
- -
- While I previous had some success dealing with conflicts in the parser with - While I previously had some success dealing with these conflicts with
- increasingly convoluted grammars, this became more and more untenable as I - increasingly convoluted grammars, this became more and more untenable as I
- added support for more SystemVerilog constructs. - added support for more SystemVerilog constructs.
- -
- Because declarations and statements are subject to the same kind of
- conflicts, this module additionally provides an interface for parsing
- DeclTokens as either declarations or the basic statements (either assignments
- or task/function calls) with which they can conflict. The initialization
- portion of a for loop also allows for declarations and assignments, and so a
- similar interface is provided for this case.
-
- This parser is very liberal, and so accepts some syntactically invalid files. - This parser is very liberal, and so accepts some syntactically invalid files.
- In the future, we may add some basic type-checking to complain about - In the future, we may add some basic type-checking to complain about
- malformed input files. However, we generally assume that users have tested - malformed input files. However, we generally assume that users have tested
...@@ -34,40 +41,41 @@ module Language.SystemVerilog.Parser.ParseDecl ...@@ -34,40 +41,41 @@ module Language.SystemVerilog.Parser.ParseDecl
, parseDTsAsModuleItems , parseDTsAsModuleItems
, parseDTsAsDecls , parseDTsAsDecls
, parseDTsAsDecl , parseDTsAsDecl
, parseDTsAsDeclOrAsgn , parseDTsAsDeclOrStmt
, parseDTsAsDeclsOrAsgns , parseDTsAsDeclsOrAsgns
) where ) where
import Data.List (elemIndex, findIndex, findIndices, partition) import Data.List (findIndex, findIndices, partition)
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
import Language.SystemVerilog.Parser.Tokens (Position(..))
-- [PUBLIC]: combined (irregular) tokens for declarations -- [PUBLIC]: combined (irregular) tokens for declarations
data DeclToken data DeclToken
= DTComma = DTComma Position
| DTAutoDim | DTAutoDim Position
| DTAsgn AsgnOp Expr | DTAsgn Position AsgnOp Expr
| DTAsgnNBlk (Maybe Timing) Expr | DTAsgnNBlk Position (Maybe Timing) Expr
| DTRange (PartSelectMode, Range) | DTRange Position (PartSelectMode, Range)
| DTIdent Identifier | DTIdent Position Identifier
| DTPSIdent Identifier Identifier | DTPSIdent Position Identifier Identifier
| DTDir Direction | DTDir Position Direction
| DTType (Signing -> [Range] -> Type) | DTType Position (Signing -> [Range] -> Type)
| DTParams [ParamBinding] | DTParams Position [ParamBinding]
| DTInstance [PortBinding] | DTInstance Position [PortBinding]
| DTBit Expr | DTBit Position Expr
| DTConcat [LHS] | DTConcat Position [LHS]
| DTStream StreamOp Expr [LHS] | DTStream Position StreamOp Expr [LHS]
| DTDot Identifier | DTDot Position Identifier
| DTSigning Signing | DTSigning Position Signing
| DTLifetime Lifetime | DTLifetime Position Lifetime
deriving (Show, Eq) deriving (Show, Eq)
-- entrypoints besides `parseDTsAsDeclOrAsgn` use this to disallow `DTAsgnNBlk` -- entrypoints besides `parseDTsAsDeclOrStmt` use this to disallow `DTAsgnNBlk`
-- and `DTAsgn` with a binary assignment operator because we don't expect to see -- and `DTAsgn` with a binary assignment operator because we don't expect to see
-- those assignment oeprators in declarations -- those assignment operators in declarations
forbidNonEqAsgn :: [DeclToken] -> a -> a forbidNonEqAsgn :: [DeclToken] -> a -> a
forbidNonEqAsgn tokens = forbidNonEqAsgn tokens =
if any isNonEqAsgn tokens if any isNonEqAsgn tokens
...@@ -75,8 +83,8 @@ forbidNonEqAsgn tokens = ...@@ -75,8 +83,8 @@ forbidNonEqAsgn tokens =
else id else id
where where
isNonEqAsgn :: DeclToken -> Bool isNonEqAsgn :: DeclToken -> Bool
isNonEqAsgn (DTAsgnNBlk _ _) = True isNonEqAsgn (DTAsgnNBlk _ _ _) = True
isNonEqAsgn (DTAsgn (AsgnOp _) _) = True isNonEqAsgn (DTAsgn _ (AsgnOp _) _) = True
isNonEqAsgn _ = False isNonEqAsgn _ = False
...@@ -100,14 +108,13 @@ parseDTsAsPortDecls pieces = ...@@ -100,14 +108,13 @@ parseDTsAsPortDecls pieces =
simpleIdents = map extractIdent $ filter isIdent pieces simpleIdents = map extractIdent $ filter isIdent pieces
declarations = parseDTsAsDecls pieces declarations = parseDTsAsDecls pieces
isComma :: DeclToken -> Bool extractIdent = \(DTIdent _ x) -> x
isComma token = token == DTComma
extractIdent = \(DTIdent x) -> x
portNames :: [Decl] -> [Identifier] portNames :: [Decl] -> [Identifier]
portNames items = mapMaybe portName items portNames items = mapMaybe portName items
portName :: Decl -> Maybe Identifier portName :: Decl -> Maybe Identifier
portName (Variable _ _ ident _ _) = Just ident portName (Variable _ _ ident _ _) = Just ident
portName CommentDecl{} = Nothing
portName decl = portName decl =
error $ "unexpected non-variable port declaration: " ++ (show decl) error $ "unexpected non-variable port declaration: " ++ (show decl)
...@@ -125,29 +132,29 @@ parseDTsAsModuleItems tokens = ...@@ -125,29 +132,29 @@ parseDTsAsModuleItems tokens =
map (MIPackageItem . Decl) $ parseDTsAsDecl tokens map (MIPackageItem . Decl) $ parseDTsAsDecl tokens
where where
isElabTask :: DeclToken -> Bool isElabTask :: DeclToken -> Bool
isElabTask (DTIdent x) = elem x elabTasks isElabTask (DTIdent _ x) = elem x elabTasks
where elabTasks = ["$fatal", "$error", "$warning", "$info"] where elabTasks = ["$fatal", "$error", "$warning", "$info"]
isElabTask _ = False isElabTask _ = False
isInstance :: DeclToken -> Bool isInstance :: DeclToken -> Bool
isInstance (DTInstance _) = True isInstance (DTInstance{}) = True
isInstance _ = False isInstance _ = False
-- internal; approximates the behavior of the elaboration system tasks -- internal; approximates the behavior of the elaboration system tasks
asElabTask :: [DeclToken] -> [ModuleItem] asElabTask :: [DeclToken] -> [ModuleItem]
asElabTask [DTIdent name, DTInstance args] = asElabTask [DTIdent _ name, DTInstance _ args] =
if name == "$info" if name == "$info"
then [] -- just drop them for simplicity then [] -- just drop them for simplicity
else [Instance "ThisModuleDoesNotExist" [] name' Nothing args] else [Instance "ThisModuleDoesNotExist" [] name' Nothing args]
where name' = "__sv2v_elab_" ++ tail name where name' = "__sv2v_elab_" ++ tail name
asElabTask [DTIdent name] = asElabTask [DTIdent pos name] =
asElabTask [DTIdent name, DTInstance []] asElabTask [DTIdent pos name, DTInstance pos []]
asElabTask tokens = asElabTask tokens =
error $ "could not parse elaboration system task: " ++ show tokens error $ "could not parse elaboration system task: " ++ show tokens
-- internal; parser for module instantiations -- internal; parser for module instantiations
parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem] parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]
parseDTsAsIntantiations (DTIdent name : tokens) = parseDTsAsIntantiations (DTIdent _ name : tokens) =
if not (all isInstanceToken rest) if not (all isInstanceToken rest)
then error $ "instantiations mixed with other items: " ++ (show rest) then error $ "instantiations mixed with other items: " ++ (show rest)
else step rest else step rest
...@@ -157,23 +164,23 @@ parseDTsAsIntantiations (DTIdent name : tokens) = ...@@ -157,23 +164,23 @@ parseDTsAsIntantiations (DTIdent name : tokens) =
step toks = step toks =
Instance name params x mr p : follow Instance name params x mr p : follow
where where
(inst, toks') = span (DTComma /=) toks (inst, toks') = span (not . isComma) toks
(x, mr, p) = case inst of (x, mr, p) = case inst of
[DTIdent a, DTRange (NonIndexed, s), DTInstance b] -> [DTIdent _ a, DTRange _ (NonIndexed, s), DTInstance _ b] ->
(a, Just s , b) (a, Just s , b)
[DTIdent a, DTInstance b] -> (a, Nothing, b) [DTIdent _ a, DTInstance _ b] -> (a, Nothing, b)
_ -> error $ "unrecognized instantiation of " ++ name _ -> error $ "unrecognized instantiation of " ++ name
++ ": " ++ show inst ++ ": " ++ show inst
follow = x `seq` if null toks' then [] else step (tail toks') follow = x `seq` if null toks' then [] else step (tail toks')
(params, rest) = (params, rest) =
case head tokens of case head tokens of
DTParams ps -> (ps, tail tokens) DTParams _ ps -> (ps, tail tokens)
_ -> ([], tokens) _ -> ([], tokens)
isInstanceToken :: DeclToken -> Bool isInstanceToken :: DeclToken -> Bool
isInstanceToken (DTInstance _) = True isInstanceToken (DTInstance{}) = True
isInstanceToken (DTRange _) = True isInstanceToken (DTRange{}) = True
isInstanceToken (DTIdent _) = True isInstanceToken (DTIdent{}) = True
isInstanceToken DTComma = True isInstanceToken (DTComma{}) = True
isInstanceToken _ = False isInstanceToken _ = False
parseDTsAsIntantiations tokens = parseDTsAsIntantiations tokens =
error $ error $
...@@ -200,19 +207,22 @@ parseDTsAsDecl tokens = ...@@ -200,19 +207,22 @@ parseDTsAsDecl tokens =
-- [PUBLIC]: parser for single block item declarations or assign or arg-less -- [PUBLIC]: parser for single block item declarations or assign or arg-less
-- subroutine call statetments -- subroutine call statements
parseDTsAsDeclOrAsgn :: [DeclToken] -> ([Decl], [Stmt]) parseDTsAsDeclOrStmt :: [DeclToken] -> ([Decl], [Stmt])
parseDTsAsDeclOrAsgn [DTIdent f] = ([], [Subroutine (Ident f) (Args [] [])]) parseDTsAsDeclOrStmt [DTIdent pos f] = ([], [traceStmt pos, Subroutine (Ident f) (Args [] [])])
parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (PSIdent p f) (Args [] [])]) parseDTsAsDeclOrStmt [DTPSIdent pos p f] = ([], [traceStmt pos, Subroutine (PSIdent p f) (Args [] [])])
parseDTsAsDeclOrAsgn tokens = parseDTsAsDeclOrStmt (DTAsgn pos (AsgnOp op) e : tok : toks) =
parseDTsAsDeclOrStmt $ (tok : toks) ++ [DTAsgn pos (AsgnOp op) e]
parseDTsAsDeclOrStmt tokens =
if (isStmt (last tokens) || tripLookahead tokens) && maybeLhs /= Nothing if (isStmt (last tokens) || tripLookahead tokens) && maybeLhs /= Nothing
then ([], [stmt]) then ([], [traceStmt pos, stmt])
else (parseDTsAsDecl tokens, []) else (parseDTsAsDecl tokens, [])
where where
pos = tokPos $ last tokens
stmt = case last tokens of stmt = case last tokens of
DTAsgn op e -> AsgnBlk op lhs e DTAsgn _ op e -> AsgnBlk op lhs e
DTAsgnNBlk mt e -> Asgn mt lhs e DTAsgnNBlk _ mt e -> Asgn mt lhs e
DTInstance args -> Subroutine (lhsToExpr lhs) (instanceToArgs args) DTInstance _ args -> Subroutine (lhsToExpr lhs) (instanceToArgs args)
_ -> error $ "invalid block item decl or stmt: " ++ (show tokens) _ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
maybeLhs = takeLHS $ init tokens maybeLhs = takeLHS $ init tokens
Just lhs = maybeLhs Just lhs = maybeLhs
...@@ -222,6 +232,9 @@ parseDTsAsDeclOrAsgn tokens = ...@@ -222,6 +232,9 @@ parseDTsAsDeclOrAsgn tokens =
isStmt (DTInstance{}) = True isStmt (DTInstance{}) = True
isStmt _ = False isStmt _ = False
traceStmt :: Position -> Stmt
traceStmt pos = CommentStmt $ "Trace: " ++ show pos
-- converts port bindings to call args -- converts port bindings to call args
instanceToArgs :: [PortBinding] -> Args instanceToArgs :: [PortBinding] -> Args
instanceToArgs bindings = instanceToArgs bindings =
...@@ -242,7 +255,7 @@ parseDTsAsDeclsOrAsgns tokens = ...@@ -242,7 +255,7 @@ parseDTsAsDeclsOrAsgns tokens =
where where
hasLeadingAsgn = hasLeadingAsgn =
-- if there is an asgn token before the next comma -- if there is an asgn token before the next comma
case (elemIndex DTComma tokens, findIndex isAsgnToken tokens) of case (findIndex isComma tokens, findIndex isAsgnToken tokens) of
(Just a, Just b) -> a > b (Just a, Just b) -> a > b
(Nothing, Just _) -> True (Nothing, Just _) -> True
_ -> False _ -> False
...@@ -252,27 +265,27 @@ parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)] ...@@ -252,27 +265,27 @@ parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]
parseDTsAsAsgns tokens = parseDTsAsAsgns tokens =
case l1 of case l1 of
[] -> [asgn] [] -> [asgn]
DTComma : remaining -> asgn : parseDTsAsAsgns remaining DTComma{} : remaining -> asgn : parseDTsAsAsgns remaining
_ -> error $ "bad assignment tokens: " ++ show tokens _ -> error $ "bad assignment tokens: " ++ show tokens
where where
(lhsToks, l0) = break isDTAsgn tokens (lhsToks, l0) = break isDTAsgn tokens
lhs = case takeLHS lhsToks of lhs = case takeLHS lhsToks of
Nothing -> error $ "could not parse as LHS: " ++ show lhsToks Nothing -> error $ "could not parse as LHS: " ++ show lhsToks
Just l -> l Just l -> l
DTAsgn AsgnOpEq expr : l1 = l0 DTAsgn _ AsgnOpEq expr : l1 = l0
asgn = (lhs, expr) asgn = (lhs, expr)
isDTAsgn :: DeclToken -> Bool isDTAsgn :: DeclToken -> Bool
isDTAsgn (DTAsgn _ _) = True isDTAsgn (DTAsgn{}) = True
isDTAsgn _ = False isDTAsgn _ = False
isAsgnToken :: DeclToken -> Bool isAsgnToken :: DeclToken -> Bool
isAsgnToken (DTBit _) = True isAsgnToken (DTBit _ _) = True
isAsgnToken (DTConcat _) = True isAsgnToken (DTConcat _ _) = True
isAsgnToken (DTStream _ _ _) = True isAsgnToken (DTStream _ _ _ _) = True
isAsgnToken (DTDot _) = True isAsgnToken (DTDot _ _) = True
isAsgnToken (DTAsgnNBlk _ _) = True isAsgnToken (DTAsgnNBlk _ _ _) = True
isAsgnToken (DTAsgn (AsgnOp _) _) = True isAsgnToken (DTAsgn _ (AsgnOp _) _) = True
isAsgnToken _ = False isAsgnToken _ = False
takeLHS :: [DeclToken] -> Maybe LHS takeLHS :: [DeclToken] -> Maybe LHS
...@@ -281,40 +294,41 @@ takeLHS (t : ts) = ...@@ -281,40 +294,41 @@ takeLHS (t : ts) =
foldl takeLHSStep (takeLHSStart t) ts foldl takeLHSStep (takeLHSStart t) ts
takeLHSStart :: DeclToken -> Maybe LHS takeLHSStart :: DeclToken -> Maybe LHS
takeLHSStart (DTConcat lhss) = Just $ LHSConcat lhss takeLHSStart (DTConcat _ lhss) = Just $ LHSConcat lhss
takeLHSStart (DTStream o e lhss) = Just $ LHSStream o e lhss takeLHSStart (DTStream _ o e lhss) = Just $ LHSStream o e lhss
takeLHSStart (DTIdent x ) = Just $ LHSIdent x takeLHSStart (DTIdent _ x ) = Just $ LHSIdent x
takeLHSStart _ = Nothing takeLHSStart _ = Nothing
takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
takeLHSStep (Just curr) (DTBit e ) = Just $ LHSBit curr e takeLHSStep (Just curr) (DTBit _ e ) = Just $ LHSBit curr e
takeLHSStep (Just curr) (DTRange (m,r)) = Just $ LHSRange curr m r takeLHSStep (Just curr) (DTRange _ (m,r)) = Just $ LHSRange curr m r
takeLHSStep (Just curr) (DTDot x ) = Just $ LHSDot curr x takeLHSStep (Just curr) (DTDot _ x ) = Just $ LHSDot curr x
takeLHSStep _ _ = Nothing takeLHSStep _ _ = Nothing
-- batches together seperate declaration lists -- batches together separate declaration lists
type Triplet = (Identifier, [Range], Maybe Expr) type Triplet = (Identifier, [Range], Maybe Expr)
type Component = (Direction, Type, [Triplet]) type Component = (Direction, Type, [Triplet])
finalize :: Component -> [Decl] finalize :: (Position, Component) -> [Decl]
finalize (dir, typ, trips) = finalize (pos, (dir, typ, trips)) =
CommentDecl ("Trace: " ++ show pos) :
map (\(x, a, me) -> Variable dir typ x a me) trips map (\(x, a, me) -> Variable dir typ x a me) trips
-- internal; entrypoint of the critical portion of our parser -- internal; entrypoint of the critical portion of our parser
parseDTsAsComponents :: [DeclToken] -> [Component] parseDTsAsComponents :: [DeclToken] -> [(Position, Component)]
parseDTsAsComponents [] = [] parseDTsAsComponents [] = []
parseDTsAsComponents tokens = parseDTsAsComponents tokens =
component : parseDTsAsComponents tokens' (position, component) : parseDTsAsComponents tokens'
where where
(component, tokens') = parseDTsAsComponent tokens (position, component, tokens') = parseDTsAsComponent tokens
parseDTsAsComponent :: [DeclToken] -> (Component, [DeclToken]) parseDTsAsComponent :: [DeclToken] -> (Position, Component, [DeclToken])
parseDTsAsComponent [] = error "parseDTsAsComponent unexpected end of tokens" parseDTsAsComponent [] = error "parseDTsAsComponent unexpected end of tokens"
parseDTsAsComponent l0 = parseDTsAsComponent l0 =
if l /= Nothing && l /= Just Automatic if l /= Nothing && l /= Just Automatic
then error $ "unexpected non-automatic lifetime: " ++ show l0 then error $ "unexpected non-automatic lifetime: " ++ show l0
else (component, l5) else (position, component, l5)
where where
(dir, l1) = takeDir l0 (dir, l1) = takeDir l0
(l , l2) = takeLifetime l1 (l , l2) = takeLifetime l1
...@@ -322,7 +336,7 @@ parseDTsAsComponent l0 = ...@@ -322,7 +336,7 @@ parseDTsAsComponent l0 =
(rs , l4) = takeRanges l3 (rs , l4) = takeRanges l3
(tps, l5) = takeTrips l4 True (tps, l5) = takeTrips l4 True
component = (dir, tf rs, tps) component = (dir, tf rs, tps)
position = tokPos $ head l0
takeTrips :: [DeclToken] -> Bool -> ([Triplet], [DeclToken]) takeTrips :: [DeclToken] -> Bool -> ([Triplet], [DeclToken])
takeTrips [] True = error "incomplete declaration" takeTrips [] True = error "incomplete declaration"
...@@ -358,33 +372,33 @@ tripLookahead l0 = ...@@ -358,33 +372,33 @@ tripLookahead l0 =
-- type name, as type names must be followed by a first identifier before a -- type name, as type names must be followed by a first identifier before a
-- comma or the end of the list -- comma or the end of the list
else else
(not $ null l3) && (head l3 == DTComma) (not $ null l3) && (isComma $ head l3)
where where
(_ , l1) = takeIdent l0 (_ , l1) = takeIdent l0
(_ , l2) = takeRanges l1 (_ , l2) = takeRanges l1
(asgn, l3) = takeAsgn l2 (asgn, l3) = takeAsgn l2
takeDir :: [DeclToken] -> (Direction, [DeclToken]) takeDir :: [DeclToken] -> (Direction, [DeclToken])
takeDir (DTDir dir : rest) = (dir , rest) takeDir (DTDir _ dir : rest) = (dir , rest)
takeDir rest = (Local, rest) takeDir rest = (Local, rest)
takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken]) takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken])
takeLifetime (DTLifetime l : rest) = (Just l, rest) takeLifetime (DTLifetime _ l : rest) = (Just l, rest)
takeLifetime rest = (Nothing, rest) takeLifetime rest = (Nothing, rest)
takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken]) takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken])
takeType (DTIdent a : DTDot b : rest) = (InterfaceT a (Just b), rest) takeType (DTIdent _ a : DTDot _ b : rest) = (InterfaceT a (Just b), rest)
takeType (DTType tf : DTSigning sg : rest) = (tf sg , rest) takeType (DTType _ tf : DTSigning _ sg : rest) = (tf sg , rest)
takeType (DTType tf : rest) = (tf Unspecified , rest) takeType (DTType _ tf : rest) = (tf Unspecified , rest)
takeType (DTSigning sg : rest) = (Implicit sg , rest) takeType (DTSigning _ sg : rest) = (Implicit sg , rest)
takeType (DTPSIdent ps tn : rest) = (Alias (Just ps) tn , rest) takeType (DTPSIdent _ ps tn : rest) = (Alias (Just ps) tn , rest)
takeType (DTIdent tn : rest) = takeType (DTIdent pos tn : rest) =
if couldBeTypename if couldBeTypename
then (Alias (Nothing) tn , rest) then (Alias (Nothing) tn , rest)
else (Implicit Unspecified, DTIdent tn : rest) else (Implicit Unspecified, DTIdent pos tn : rest)
where where
couldBeTypename = couldBeTypename =
case (findIndex isIdent rest, elemIndex DTComma rest) of case (findIndex isIdent rest, findIndex isComma rest) of
-- no identifiers left => no decl asgns -- no identifiers left => no decl asgns
(Nothing, _) -> False (Nothing, _) -> False
-- an identifier is left, and no more commas -- an identifier is left, and no more commas
...@@ -397,14 +411,14 @@ takeRanges :: [DeclToken] -> ([Range], [DeclToken]) ...@@ -397,14 +411,14 @@ takeRanges :: [DeclToken] -> ([Range], [DeclToken])
takeRanges [] = ([], []) takeRanges [] = ([], [])
takeRanges (token : tokens) = takeRanges (token : tokens) =
case token of case token of
DTRange (NonIndexed, r) -> (r : rs, rest ) DTRange _ (NonIndexed, r) -> (r : rs, rest )
DTBit s -> (asRange s : rs, rest ) DTBit _ s -> (asRange s : rs, rest )
DTAutoDim -> DTAutoDim _ ->
case rest of case rest of
(DTAsgn AsgnOpEq (Pattern l) : _) -> autoDim l (DTAsgn _ AsgnOpEq (Pattern l) : _) -> autoDim l
(DTAsgn AsgnOpEq (Concat l) : _) -> autoDim l (DTAsgn _ AsgnOpEq (Concat l) : _) -> autoDim l
_ -> ([] , token : tokens) _ -> ([] , token : tokens)
_ -> ([] , token : tokens) _ -> ([] , token : tokens)
where where
(rs, rest) = takeRanges tokens (rs, rest) = takeRanges tokens
asRange s = (Number "0", BinOp Sub s (Number "1")) asRange s = (Number "0", BinOp Sub s (Number "1"))
...@@ -417,24 +431,47 @@ takeRanges (token : tokens) = ...@@ -417,24 +431,47 @@ takeRanges (token : tokens) =
hi = Number $ show (n - 1) hi = Number $ show (n - 1)
-- Matching DTAsgnNBlk here allows tripLookahead to work both for standard -- Matching DTAsgnNBlk here allows tripLookahead to work both for standard
-- declarations and in `parseDTsAsDeclOrAsgn`, where we're checking for an -- declarations and in `parseDTsAsDeclOrStmt`, where we're checking for an
-- assignment assignment statement. The other entry points disallow -- assignment statement. The other entry points disallow `DTAsgnNBlk`, so this
-- `DTAsgnNBlk`, so this doesn't liberalize the parser. -- doesn't liberalize the parser.
takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken]) takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
takeAsgn (DTAsgn AsgnOpEq e : rest) = (Just e , rest) takeAsgn (DTAsgn _ AsgnOpEq e : rest) = (Just e , rest)
takeAsgn (DTAsgnNBlk _ e : rest) = (Just e , rest) takeAsgn (DTAsgnNBlk _ _ e : rest) = (Just e , rest)
takeAsgn rest = (Nothing, rest) takeAsgn rest = (Nothing, rest)
takeComma :: [DeclToken] -> (Bool, [DeclToken]) takeComma :: [DeclToken] -> (Bool, [DeclToken])
takeComma [] = (False, []) takeComma [] = (False, [])
takeComma (DTComma : rest) = (True, rest) takeComma (DTComma{} : rest) = (True, rest)
takeComma toks = error $ "expected comma or end of decl, got: " ++ show toks takeComma toks = error $ "expected comma or end of decl, got: " ++ show toks
takeIdent :: [DeclToken] -> (Identifier, [DeclToken]) takeIdent :: [DeclToken] -> (Identifier, [DeclToken])
takeIdent (DTIdent x : rest) = (x, rest) takeIdent (DTIdent _ x : rest) = (x, rest)
takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens
isIdent :: DeclToken -> Bool isIdent :: DeclToken -> Bool
isIdent (DTIdent _) = True isIdent (DTIdent{}) = True
isIdent _ = False isIdent _ = False
isComma :: DeclToken -> Bool
isComma (DTComma{}) = True
isComma _ = False
tokPos :: DeclToken -> Position
tokPos (DTComma p) = p
tokPos (DTAutoDim p) = p
tokPos (DTAsgn p _ _) = p
tokPos (DTAsgnNBlk p _ _) = p
tokPos (DTRange p _) = p
tokPos (DTIdent p _) = p
tokPos (DTPSIdent p _ _) = p
tokPos (DTDir p _) = p
tokPos (DTType p _) = p
tokPos (DTParams p _) = p
tokPos (DTInstance p _) = p
tokPos (DTBit p _) = p
tokPos (DTConcat p _) = p
tokPos (DTStream p _ _ _) = p
tokPos (DTDot p _) = p
tokPos (DTSigning p _) = p
tokPos (DTLifetime p _) = p
{-# LANGUAGE PatternSynonyms #-}
{- sv2v {- sv2v
- Author: Tom Hawkins <tomahawkins@gmail.com> - Author: Tom Hawkins <tomahawkins@gmail.com>
- Modified by: Zachary Snow <zach@zachjs.com> - Modified by: Zachary Snow <zach@zachjs.com>
...@@ -11,6 +12,8 @@ module Language.SystemVerilog.Parser.Tokens ...@@ -11,6 +12,8 @@ module Language.SystemVerilog.Parser.Tokens
, Position (..) , Position (..)
, tokenString , tokenString
, tokenName , tokenName
, tokenPosition
, pattern TokenEOF
) where ) where
import Text.Printf import Text.Printf
...@@ -21,6 +24,12 @@ tokenString (Token _ s _) = s ...@@ -21,6 +24,12 @@ tokenString (Token _ s _) = s
tokenName :: Token -> TokenName tokenName :: Token -> TokenName
tokenName (Token kw _ _) = kw tokenName (Token kw _ _) = kw
tokenPosition :: Token -> Position
tokenPosition (Token _ _ pos) = pos
pattern TokenEOF :: Token
pattern TokenEOF = Token MacroBoundary "" (Position "" 0 0)
data Position data Position
= Position String Int Int = Position String Int Int
deriving Eq deriving Eq
......
...@@ -4,4 +4,18 @@ module top; ...@@ -4,4 +4,18 @@ module top;
x++; x++;
$display(x); $display(x);
end end
initial begin
++x;
$display(x);
end
initial begin
repeat (0);
x++;
$display(x);
end
initial begin
repeat (0);
++x;
$display(x);
end
endmodule endmodule
module top; module top;
integer x = 0; integer x = 0;
initial begin initial repeat (4) begin
x = x + 1; x = x + 1;
$display(x); $display(x);
end end
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment