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 }
...@@ -588,38 +591,29 @@ Identifiers :: { [Identifier] } ...@@ -588,38 +591,29 @@ Identifiers :: { [Identifier] }
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] }
...@@ -635,7 +629,7 @@ Direction :: { Direction } ...@@ -635,7 +629,7 @@ Direction :: { Direction }
ModuleItems :: { [ModuleItem] } ModuleItems :: { [ModuleItem] }
: {- empty -} { [] } : {- empty -} { [] }
| ModuleItems ModuleItem { $1 ++ $2 } | ModuleItems MITrace ModuleItem { $1 ++ [$2] ++ $3 }
| ModuleItems ";" { $1 } | ModuleItems ";" { $1 }
ModuleItem :: { [ModuleItem] } ModuleItem :: { [ModuleItem] }
...@@ -770,7 +764,7 @@ LHSAsgn :: { (LHS, Expr) } ...@@ -770,7 +764,7 @@ LHSAsgn :: { (LHS, Expr) }
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,11 +974,11 @@ IdxVarsInside :: { [Maybe Identifier] } ...@@ -980,11 +974,11 @@ 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] }
...@@ -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)
......
{-# 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