Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
S
sv2v
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
lvzhengyang
sv2v
Commits
12be5697
Commit
12be5697
authored
Jun 14, 2020
by
Zachary Snow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
reduce usage of maybe
parent
b71e0f53
Hide whitespace changes
Inline
Side-by-side
Showing
31 changed files
with
250 additions
and
260 deletions
+250
-260
src/Convert/BlockDecl.hs
+5
-3
src/Convert/EmptyArgs.hs
+2
-2
src/Convert/Enum.hs
+4
-5
src/Convert/ForDecl.hs
+8
-6
src/Convert/Foreach.hs
+1
-1
src/Convert/FuncRoutine.hs
+1
-1
src/Convert/Interface.hs
+20
-20
src/Convert/Jump.hs
+2
-2
src/Convert/KWArgs.hs
+4
-5
src/Convert/Logic.hs
+9
-10
src/Convert/MultiplePacked.hs
+2
-2
src/Convert/NestPI.hs
+16
-16
src/Convert/Package.hs
+16
-16
src/Convert/ParamType.hs
+5
-5
src/Convert/SignCast.hs
+2
-2
src/Convert/Simplify.hs
+2
-2
src/Convert/SizeCast.hs
+2
-2
src/Convert/StarPort.hs
+3
-3
src/Convert/Stream.hs
+3
-3
src/Convert/Struct.hs
+8
-11
src/Convert/Traverse.hs
+28
-40
src/Convert/TypeOf.hs
+3
-3
src/Convert/UnpackedArray.hs
+6
-6
src/Language/SystemVerilog/AST/Attr.hs
+2
-2
src/Language/SystemVerilog/AST/Decl.hs
+4
-3
src/Language/SystemVerilog/AST/Expr.hs
+7
-8
src/Language/SystemVerilog/AST/ModuleItem.hs
+12
-13
src/Language/SystemVerilog/AST/Stmt.hs
+6
-6
src/Language/SystemVerilog/AST/Type.hs
+2
-2
src/Language/SystemVerilog/Parser/Parse.y
+47
-41
src/Language/SystemVerilog/Parser/ParseDecl.hs
+18
-19
No files found.
src/Convert/BlockDecl.hs
View file @
12be5697
...
...
@@ -42,9 +42,11 @@ convertStmt (Block Seq name decls stmts) =
convertStmt
other
=
other
splitDecl
::
Decl
->
(
Decl
,
Maybe
(
LHS
,
Expr
))
splitDecl
(
Variable
d
t
ident
a
(
Just
e
))
=
(
Variable
d
t
ident
a
Nothing
,
Just
(
LHSIdent
ident
,
e
))
splitDecl
other
=
(
other
,
Nothing
)
splitDecl
(
decl
@
(
Variable
_
_
_
_
Nil
))
=
(
decl
,
Nothing
)
splitDecl
(
Variable
d
t
ident
a
e
)
=
(
Variable
d
t
ident
a
Nil
,
Just
(
LHSIdent
ident
,
e
))
splitDecl
decl
=
(
decl
,
Nothing
)
asgnStmt
::
(
LHS
,
Expr
)
->
Stmt
asgnStmt
=
uncurry
$
Asgn
AsgnOpEq
Nothing
src/Convert/EmptyArgs.hs
View file @
12be5697
...
...
@@ -31,7 +31,7 @@ convertDescription other = other
traverseFunctionsM
::
ModuleItem
->
Writer
Idents
ModuleItem
traverseFunctionsM
(
MIPackageItem
(
Function
ml
t
f
decls
stmts
))
=
do
let
dummyDecl
=
Variable
Input
(
Implicit
Unspecified
[]
)
"_sv2v_unused"
[]
N
othing
let
dummyDecl
=
Variable
Input
(
Implicit
Unspecified
[]
)
"_sv2v_unused"
[]
N
il
decls'
<-
do
if
any
isInput
decls
then
return
decls
...
...
@@ -49,6 +49,6 @@ convertExpr :: Idents -> Expr -> Expr
convertExpr
functions
(
Call
(
Ident
func
)
(
Args
[]
[]
))
=
Call
(
Ident
func
)
(
Args
args
[]
)
where
args
=
if
Set
.
member
func
functions
then
[
Just
$
Number
"0"
]
then
[
Number
"0"
]
else
[]
convertExpr
_
other
=
other
src/Convert/Enum.hs
View file @
12be5697
...
...
@@ -26,7 +26,7 @@ import qualified Data.Set as Set
import
Convert.Traverse
import
Language.SystemVerilog.AST
type
EnumInfo
=
(
Type
,
[(
Identifier
,
Maybe
Expr
)])
type
EnumInfo
=
(
Type
,
[(
Identifier
,
Expr
)])
type
Enums
=
Set
.
Set
EnumInfo
convert
::
[
AST
]
->
[
AST
]
...
...
@@ -84,10 +84,9 @@ makeEnumItems (itemType, l) =
keys
=
map
fst
l
vals
=
tail
$
scanl
step
(
Number
"-1"
)
(
map
snd
l
)
noDuplicates
=
all
(
null
.
tail
.
flip
elemIndices
vals
)
vals
step
::
Expr
->
Maybe
Expr
->
Expr
step
_
(
Just
expr
)
=
expr
step
expr
Nothing
=
simplify
$
BinOp
Add
expr
(
Number
"1"
)
step
::
Expr
->
Expr
->
Expr
step
expr
Nil
=
simplify
$
BinOp
Add
expr
(
Number
"1"
)
step
_
expr
=
expr
toPackageItem
::
Identifier
->
Expr
->
PackageItem
toPackageItem
x
v
=
Decl
$
Param
Localparam
itemType
x
v'
...
...
src/Convert/ForDecl.hs
View file @
12be5697
...
...
@@ -23,7 +23,7 @@ convertStmt (For (Left []) cc asgns stmt) =
convertStmt
$
For
(
Right
[]
)
cc
asgns
stmt
convertStmt
(
For
(
Right
[]
)
cc
asgns
stmt
)
=
convertStmt
$
For
inits
cc
asgns
stmt
where
inits
=
Left
[
dummyDecl
(
Just
$
Number
"0"
)
]
where
inits
=
Left
[
dummyDecl
$
Number
"0"
]
convertStmt
(
orig
@
(
For
(
Right
[
_
])
_
_
_
))
=
orig
convertStmt
(
For
(
Left
inits
)
cc
asgns
stmt
)
=
...
...
@@ -47,13 +47,15 @@ convertStmt (For (Right origPairs) cc asgns stmt) =
convertStmt
other
=
other
splitDecl
::
Decl
->
(
Decl
,
(
LHS
,
Expr
))
splitDecl
(
Variable
d
t
ident
a
(
Just
e
))
=
(
Variable
d
t
ident
a
Nothing
,
(
LHSIdent
ident
,
e
))
splitDecl
other
=
error
$
"invalid for loop decl: "
++
show
other
splitDecl
(
decl
@
(
Variable
_
_
_
_
Nil
))
=
error
$
"invalid for loop decl: "
++
show
decl
splitDecl
(
Variable
d
t
ident
a
e
)
=
(
Variable
d
t
ident
a
Nil
,
(
LHSIdent
ident
,
e
))
splitDecl
decl
=
error
$
"invalid for loop decl: "
++
show
decl
asgnStmt
::
(
LHS
,
Expr
)
->
Stmt
asgnStmt
=
uncurry
$
Asgn
AsgnOpEq
Nothing
dummyDecl
::
Maybe
Expr
->
Decl
dummyDecl
::
Expr
->
Decl
dummyDecl
=
Variable
Local
(
IntegerAtom
TInteger
Unspecified
)
"_sv2v_dummy"
[]
src/Convert/Foreach.hs
View file @
12be5697
...
...
@@ -29,7 +29,7 @@ convertStmt (Foreach x idxs stmt) =
where
queryFn
f
=
DimFn
f
(
Right
$
Ident
x
)
(
Number
$
show
d
)
idxDecl
=
Variable
Local
(
IntegerAtom
TInteger
Unspecified
)
i
[]
$
Just
$
queryFn
FnLeft
(
queryFn
FnLeft
)
cmp
=
Mux
(
BinOp
Eq
(
queryFn
FnIncrement
)
(
Number
"1"
))
(
BinOp
Ge
(
Ident
i
)
(
queryFn
FnRight
))
...
...
src/Convert/FuncRoutine.hs
View file @
12be5697
...
...
@@ -41,5 +41,5 @@ convertStmt functions (Subroutine (Ident func) args) =
where
t
=
TypeOf
e
e
=
Call
(
Ident
func
)
args
decl
=
Variable
Local
t
"sv2v_void"
[]
(
Just
e
)
decl
=
Variable
Local
t
"sv2v_void"
[]
e
convertStmt
_
other
=
other
src/Convert/Interface.hs
View file @
12be5697
...
...
@@ -103,8 +103,8 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
Just
res
->
snd
res
Nothing
->
error
$
"could not find interface "
++
show
interfaceName
mapper
(
dir
,
port
,
expr
)
=
Variable
dir
mpt
(
ident
++
"_"
++
port
)
mprs
N
othing
where
(
mpt
,
mprs
)
=
lookupType
interfaceItems
(
fromJust
expr
)
Variable
dir
mpt
(
ident
++
"_"
++
port
)
mprs
N
il
where
(
mpt
,
mprs
)
=
lookupType
interfaceItems
expr
mapInterface
(
Instance
part
params
ident
Nothing
instancePorts
)
=
-- expand modport port bindings
case
Map
.
lookup
part
interfaces
of
...
...
@@ -125,15 +125,15 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
traverseExprs
(
traverseNestedExprs
$
convertExpr
its
mps
)
.
traverseLHSs
(
traverseNestedLHSs
$
convertLHS
its
mps
)
where
locals
=
Set
.
fromList
$
map
Maybe
declVarIdent
decls
locals
=
Set
.
fromList
$
map
declVarIdent
decls
its
=
Map
.
withoutKeys
instances
locals
mps
=
Map
.
withoutKeys
modports
locals
declVarIdent
::
Decl
->
Maybe
Identifier
declVarIdent
(
Variable
_
_
x
_
_
)
=
Just
x
declVarIdent
_
=
Nothing
declVarIdent
::
Decl
->
Identifier
declVarIdent
(
Variable
_
_
x
_
_
)
=
x
declVarIdent
_
=
""
expandPortBinding
::
Identifier
->
PortBinding
->
Int
->
[
PortBinding
]
expandPortBinding
_
(
origBinding
@
(
portName
,
Just
(
Dot
(
Ident
instanceName
)
modportName
)
))
_
=
expandPortBinding
_
(
origBinding
@
(
portName
,
Dot
(
Ident
instanceName
)
modportName
))
_
=
-- expand instance modport bound to a modport
if
Map
.
member
instanceName
instances
&&
modportDecls
/=
Nothing
then
expandPortBinding'
portName
instanceName
$
fromJust
modportDecls
...
...
@@ -141,7 +141,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
where
interfaceName
=
instances
Map
.!
instanceName
modportDecls
=
lookupModport
interfaceName
modportName
expandPortBinding
moduleName
(
origBinding
@
(
portName
,
Just
(
Ident
ident
)
))
idx
=
expandPortBinding
moduleName
(
origBinding
@
(
portName
,
Ident
ident
))
idx
=
case
(
instances
Map
.!?
ident
,
modports
Map
.!?
ident
)
of
(
Nothing
,
Nothing
)
->
[
origBinding
]
(
Just
interfaceName
,
_
)
->
...
...
@@ -176,17 +176,17 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
(
_
,
Just
modportDecls
)
->
-- modport directly bound to a modport
expandPortBinding'
portName
ident
$
map
redirect
modportDecls
where
redirect
(
d
,
x
,
_
)
=
(
d
,
x
,
Just
$
Ident
x
)
where
redirect
(
d
,
x
,
_
)
=
(
d
,
x
,
Ident
x
)
expandPortBinding
_
other
_
=
[
other
]
expandPortBinding'
::
Identifier
->
Identifier
->
[
ModportDecl
]
->
[
PortBinding
]
expandPortBinding'
portName
instanceName
modportDecls
=
map
mapper
modportDecls
where
mapper
(
_
,
x
,
me
)
=
(
x'
,
m
e'
)
mapper
(
_
,
x
,
e
)
=
(
x'
,
e'
)
where
x'
=
if
null
portName
then
""
else
portName
++
'_'
:
x
me'
=
fmap
(
traverseNestedExprs
prefixExpr
)
m
e
e'
=
traverseNestedExprs
prefixExpr
e
prefixExpr
::
Expr
->
Expr
prefixExpr
(
Ident
x
)
=
Ident
(
instanceName
++
'_'
:
x
)
prefixExpr
other
=
other
...
...
@@ -217,7 +217,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po
interfaceItems
collectModportDecls
::
ModuleItem
->
Writer
[
ModportDecl
]
()
collectModportDecls
(
MIPackageItem
(
Decl
(
Variable
d
_
x
_
_
)))
=
tell
[(
d'
,
x
,
Just
$
Ident
x
)]
tell
[(
d'
,
x
,
Ident
x
)]
where
d'
=
if
d
==
Local
then
Inout
else
d
collectModportDecls
_
=
return
()
...
...
@@ -251,10 +251,10 @@ prefixModuleItems prefix =
traverseLHSs
(
traverseNestedLHSs
prefixLHS
)
where
prefixDecl
::
Decl
->
Decl
prefixDecl
(
Variable
d
t
x
a
me
)
=
Variable
d
t
(
prefix
x
)
a
m
e
prefixDecl
(
Param
s
t
x
e
)
=
Param
s
t
(
prefix
x
)
e
prefixDecl
(
ParamType
s
x
mt
)
=
ParamType
s
(
prefix
x
)
mt
prefixDecl
(
CommentDecl
c
)
=
CommentDecl
c
prefixDecl
(
Variable
d
t
x
a
e
)
=
Variable
d
t
(
prefix
x
)
a
e
prefixDecl
(
Param
s
t
x
e
)
=
Param
s
t
(
prefix
x
)
e
prefixDecl
(
ParamType
s
x
mt
)
=
ParamType
s
(
prefix
x
)
mt
prefixDecl
(
CommentDecl
c
)
=
CommentDecl
c
prefixExpr
::
Expr
->
Expr
prefixExpr
(
Ident
x
)
=
Ident
(
prefix
x
)
prefixExpr
other
=
other
...
...
@@ -343,8 +343,8 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
zip
instancePortNames
instancePortExprs
removeDeclDir
::
ModuleItem
->
ModuleItem
removeDeclDir
(
MIPackageItem
(
Decl
(
Variable
_
t
x
a
m
e
)))
=
MIPackageItem
$
Decl
$
Variable
Local
t
x
a
m
e
removeDeclDir
(
MIPackageItem
(
Decl
(
Variable
_
t
x
a
e
)))
=
MIPackageItem
$
Decl
$
Variable
Local
t
x
a
e
removeDeclDir
other
=
other
removeModport
::
ModuleItem
->
ModuleItem
removeModport
(
Modport
x
_
)
=
...
...
@@ -370,11 +370,11 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
overrideParam
other
=
other
portBindingItem
::
PortBinding
->
Maybe
ModuleItem
portBindingItem
(
ident
,
Just
expr
)
=
portBindingItem
(
_
,
Nil
)
=
Nothing
portBindingItem
(
ident
,
expr
)
=
Just
$
if
declDirs
Map
.!
ident
==
Input
then
Assign
AssignOptionNone
(
LHSIdent
ident
)
expr
else
Assign
AssignOptionNone
(
toLHS
expr
)
(
Ident
ident
)
portBindingItem
(
_
,
Nothing
)
=
Nothing
declDirs
=
execWriter
$
mapM
(
collectDeclsM
collectDeclDir
)
itemsPrefixed
...
...
src/Convert/Jump.hs
View file @
12be5697
...
...
@@ -77,7 +77,7 @@ addJumpStateDeclTF :: [Decl] -> [Stmt] -> ([Decl], [Stmt])
addJumpStateDeclTF
decls
stmts
=
if
uses
&&
not
declares
then
(
decls
++
[
Variable
Local
jumpStateType
jumpState
[]
(
Just
jsNone
)
]
[
Variable
Local
jumpStateType
jumpState
[]
jsNone
]
,
stmts
)
else
if
uses
then
(
decls
,
stmts
)
...
...
@@ -256,7 +256,7 @@ convertLoop loop comp stmt = do
]
let
jsStackIdent
=
jumpState
++
"_"
++
show
origLoopDepth
let
jsStackDecl
=
Variable
Local
jumpStateType
jsStackIdent
[]
(
Just
$
Ident
jumpState
)
(
Ident
jumpState
)
let
jsStackRestore
=
If
NoCheck
(
BinOp
Ne
(
Ident
jumpState
)
jsReturn
)
(
asgn
jumpState
(
Ident
jsStackIdent
))
...
...
src/Convert/KWArgs.hs
View file @
12be5697
...
...
@@ -10,7 +10,6 @@
module
Convert.KWArgs
(
convert
)
where
import
Data.List
(
elemIndex
,
sortOn
)
import
Data.Maybe
(
mapMaybe
)
import
Control.Monad.Writer
import
qualified
Data.Map.Strict
as
Map
...
...
@@ -39,11 +38,11 @@ collectTF _ = return ()
collectTFDecls
::
Identifier
->
[
Decl
]
->
Writer
TFs
()
collectTFDecls
name
decls
=
tell
$
Map
.
singleton
name
$
mapMaybe
getInput
decls
tell
$
Map
.
singleton
name
$
filter
(
not
.
null
)
$
map
getInput
decls
where
getInput
::
Decl
->
Maybe
Identifier
getInput
(
Variable
Input
_
ident
_
_
)
=
Just
ident
getInput
_
=
Nothing
getInput
::
Decl
->
Identifier
getInput
(
Variable
Input
_
ident
_
_
)
=
ident
getInput
_
=
""
convertExpr
::
TFs
->
Expr
->
Expr
convertExpr
tfs
(
Call
expr
args
)
=
...
...
src/Convert/Logic.hs
View file @
12be5697
...
...
@@ -102,10 +102,10 @@ convertDescription ports orig =
unzip
$
map
(
uncurry
fixBinding
)
$
zip
bindings
[
0
..
]
newItems
=
concat
newItemsList
fixBinding
::
PortBinding
->
Int
->
(
PortBinding
,
[
ModuleItem
])
fixBinding
(
portName
,
Just
expr
)
portIdx
=
fixBinding
(
portName
,
expr
)
portIdx
=
if
portDir
/=
Just
Output
||
Set
.
disjoint
usedIdents
origIdents
then
((
portName
,
Just
expr
),
[]
)
else
((
portName
,
Just
tmpExpr
),
items
)
then
((
portName
,
expr
),
[]
)
else
((
portName
,
tmpExpr
),
items
)
where
portDir
=
lookupPortDir
portName
portIdx
usedIdents
=
execWriter
$
...
...
@@ -115,7 +115,7 @@ convertDescription ports orig =
t
=
Net
(
NetType
TWire
)
Unspecified
[(
DimsFn
FnBits
$
Right
expr
,
Number
"1"
)]
items
=
[
MIPackageItem
$
Decl
$
Variable
Local
t
tmp
[]
N
othing
[
MIPackageItem
$
Decl
$
Variable
Local
t
tmp
[]
N
il
,
AlwaysC
AlwaysComb
$
Asgn
AsgnOpEq
Nothing
lhs
tmpExpr
]
lhs
=
case
exprToLHS
expr
of
Just
l
->
l
...
...
@@ -123,7 +123,6 @@ convertDescription ports orig =
error
$
"bad non-lhs, non-net expr "
++
show
expr
++
" connected to output port "
++
portName
++
" of "
++
instanceName
fixBinding
other
_
=
(
other
,
[]
)
lookupPortDir
::
Identifier
->
Int
->
Maybe
Direction
lookupPortDir
""
portIdx
=
case
Map
.
lookup
moduleName
ports
of
...
...
@@ -138,8 +137,8 @@ convertDescription ports orig =
fixModuleItem
other
=
other
-- rewrite variable declarations to have the correct type
convertModuleItem
(
MIPackageItem
(
Decl
(
Variable
dir
(
IntegerVector
_
sg
mr
)
ident
a
m
e
)))
=
MIPackageItem
$
Decl
$
Variable
dir'
(
t
mr
)
ident
a
m
e
convertModuleItem
(
MIPackageItem
(
Decl
(
Variable
dir
(
IntegerVector
_
sg
mr
)
ident
a
e
)))
=
MIPackageItem
$
Decl
$
Variable
dir'
(
t
mr
)
ident
a
e
where
t
=
if
Set
.
member
ident
fixedIdents
then
IntegerVector
TReg
sg
...
...
@@ -153,8 +152,8 @@ convertDescription ports orig =
convertDecl
::
Decl
->
Decl
convertDecl
(
Param
s
(
IntegerVector
_
sg
rs
)
x
e
)
=
Param
s
(
Implicit
sg
rs
)
x
e
convertDecl
(
Variable
d
(
IntegerVector
TLogic
sg
rs
)
x
a
m
e
)
=
Variable
d
(
IntegerVector
TReg
sg
rs
)
x
a
m
e
convertDecl
(
Variable
d
(
IntegerVector
TLogic
sg
rs
)
x
a
e
)
=
Variable
d
(
IntegerVector
TReg
sg
rs
)
x
a
e
convertDecl
other
=
other
regIdents
::
ModuleItem
->
Writer
Idents
()
...
...
@@ -180,7 +179,7 @@ traverseStmtM :: Stmt -> StateT Idents (Writer Idents) Stmt
traverseStmtM
(
Timing
_
stmt
)
=
traverseStmtM
stmt
traverseStmtM
(
Subroutine
(
Ident
f
)
args
)
=
do
case
args
of
Args
[
_
,
Just
(
Ident
x
)
,
_
]
[]
->
Args
[
_
,
Ident
x
,
_
]
[]
->
-- assuming that no one will readmem into a local variable
if
f
==
"$readmemh"
||
f
==
"$readmemb"
then
lift
$
tell
$
Set
.
singleton
x
...
...
src/Convert/MultiplePacked.hs
View file @
12be5697
...
...
@@ -47,9 +47,9 @@ convertDescription other = other
-- collects and converts declarations with multiple packed dimensions
traverseDeclM
::
Decl
->
State
Info
Decl
traverseDeclM
(
Variable
dir
t
ident
a
m
e
)
=
do
traverseDeclM
(
Variable
dir
t
ident
a
e
)
=
do
t'
<-
traverseTypeM
t
a
ident
return
$
Variable
dir
t'
ident
a
m
e
return
$
Variable
dir
t'
ident
a
e
traverseDeclM
(
Param
s
t
ident
e
)
=
do
t'
<-
traverseTypeM
t
[]
ident
return
$
Param
s
t'
ident
e
...
...
src/Convert/NestPI.hs
View file @
12be5697
...
...
@@ -26,15 +26,15 @@ convert =
(
traverseDescriptions
.
convertDescription
)
isPI
::
Description
->
Bool
isPI
(
PackageItem
Import
{})
=
False
isPI
(
PackageItem
item
)
=
piName
item
/=
Nothing
isPI
(
PackageItem
item
)
=
piName
item
/=
""
isPI
_
=
False
-- collects packages items missing
collectDescriptionM
::
Description
->
Writer
PIs
()
collectDescriptionM
(
PackageItem
item
)
=
do
case
piName
item
of
Nothing
->
return
()
Just
ident
->
tell
$
Map
.
singleton
ident
item
""
->
return
()
ident
->
tell
$
Map
.
singleton
ident
item
collectDescriptionM
_
=
return
()
-- nests packages items missing from modules
...
...
@@ -77,8 +77,8 @@ addItems _ _ [] = []
collectPIsM
::
ModuleItem
->
Writer
Idents
()
collectPIsM
(
MIPackageItem
item
)
=
case
piName
item
of
Nothing
->
return
()
Just
ident
->
tell
$
Set
.
singleton
ident
""
->
return
()
ident
->
tell
$
Set
.
singleton
ident
collectPIsM
_
=
return
()
-- writes down the names of subroutine invocations
...
...
@@ -98,14 +98,14 @@ collectTypenamesM (Alias _ x _) = tell $ Set.singleton x
collectTypenamesM
_
=
return
()
-- returns the "name" of a package item, if it has one
piName
::
PackageItem
->
Maybe
Identifier
piName
(
Function
_
_
ident
_
_
)
=
Just
ident
piName
(
Task
_
ident
_
_
)
=
Just
ident
piName
(
Typedef
_
ident
)
=
Just
ident
piName
(
Decl
(
Variable
_
_
ident
_
_
))
=
Just
ident
piName
(
Decl
(
Param
_
_
ident
_
))
=
Just
ident
piName
(
Decl
(
ParamType
_
ident
_
))
=
Just
ident
piName
(
Decl
(
CommentDecl
_
))
=
Nothing
piName
(
Import
x
y
)
=
Just
$
show
$
Import
x
y
piName
(
Export
_
)
=
Nothing
piName
(
Directive
_
)
=
Nothing
piName
::
PackageItem
->
Identifier
piName
(
Function
_
_
ident
_
_
)
=
ident
piName
(
Task
_
ident
_
_
)
=
ident
piName
(
Typedef
_
ident
)
=
ident
piName
(
Decl
(
Variable
_
_
ident
_
_
))
=
ident
piName
(
Decl
(
Param
_
_
ident
_
))
=
ident
piName
(
Decl
(
ParamType
_
ident
_
))
=
ident
piName
(
Decl
(
CommentDecl
_
))
=
""
piName
(
Import
x
y
)
=
show
$
Import
x
y
piName
(
Export
_
)
=
""
piName
(
Directive
_
)
=
""
src/Convert/Package.hs
View file @
12be5697
...
...
@@ -98,7 +98,7 @@ prefixPackageItem packageName idents item =
convertType
(
Enum
t
items
rs
)
=
Enum
t
items'
rs
where
items'
=
map
prefixItem
items
prefixItem
(
x
,
me
)
=
(
prefix
x
,
m
e
)
prefixItem
(
x
,
e
)
=
(
prefix
x
,
e
)
convertType
other
=
other
convertExpr
(
Ident
x
)
=
Ident
$
prefix
x
convertExpr
other
=
other
...
...
@@ -120,8 +120,8 @@ collectDescriptionM (Package _ name items) =
toPackageItems
::
PackageItem
->
PackageItems
toPackageItems
item
=
case
piName
item
of
Nothing
->
[]
Just
x
->
[(
x
,
item
)]
""
->
[]
x
->
[(
x
,
item
)]
isImport
::
PackageItem
->
Bool
isImport
(
Import
_
_
)
=
True
isImport
_
=
False
...
...
@@ -146,8 +146,8 @@ traverseDescription packages description =
writePIName
::
ModuleItem
->
Writer
Idents
()
writePIName
(
MIPackageItem
item
)
=
case
piName
item
of
Nothing
->
return
()
Just
x
->
tell
$
Set
.
singleton
x
""
->
return
()
x
->
tell
$
Set
.
singleton
x
writePIName
_
=
return
()
traverseModuleItem
::
Idents
->
Packages
->
ModuleItem
->
ModuleItem
...
...
@@ -177,14 +177,14 @@ traverseModuleItem _ _ item =
traverseType
other
=
other
-- returns the "name" of a package item, if it has one
piName
::
PackageItem
->
Maybe
Identifier
piName
(
Function
_
_
ident
_
_
)
=
Just
ident
piName
(
Task
_
ident
_
_
)
=
Just
ident
piName
(
Typedef
_
ident
)
=
Just
ident
piName
(
Decl
(
Variable
_
_
ident
_
_
))
=
Just
ident
piName
(
Decl
(
Param
_
_
ident
_
))
=
Just
ident
piName
(
Decl
(
ParamType
_
ident
_
))
=
Just
ident
piName
(
Decl
(
CommentDecl
_
))
=
Nothing
piName
(
Import
_
_
)
=
Nothing
piName
(
Export
_
)
=
Nothing
piName
(
Directive
_
)
=
Nothing
piName
::
PackageItem
->
Identifier
piName
(
Function
_
_
ident
_
_
)
=
ident
piName
(
Task
_
ident
_
_
)
=
ident
piName
(
Typedef
_
ident
)
=
ident
piName
(
Decl
(
Variable
_
_
ident
_
_
))
=
ident
piName
(
Decl
(
Param
_
_
ident
_
))
=
ident
piName
(
Decl
(
ParamType
_
ident
_
))
=
ident
piName
(
Decl
(
CommentDecl
_
))
=
""
piName
(
Import
_
_
)
=
""
piName
(
Export
_
)
=
""
piName
(
Directive
_
)
=
""
src/Convert/ParamType.hs
View file @
12be5697
...
...
@@ -99,11 +99,11 @@ convert files =
where
maybeTypeMap
=
snd
$
info
Map
.!
name
typeMap
=
defaultInstance
maybeTypeMap
existingNames
=
map
m
aybeM
oduleName
existing
alreadyExists
=
(
flip
elem
existingNames
)
.
m
aybeM
oduleName
m
aybeModuleName
::
Description
->
Maybe
Identifier
m
aybeModuleName
(
Part
_
_
_
_
x
_
_
)
=
Just
x
m
aybeModuleName
_
=
Nothing
existingNames
=
map
moduleName
existing
alreadyExists
=
(
flip
elem
existingNames
)
.
moduleName
m
oduleName
::
Description
->
Identifier
m
oduleName
(
Part
_
_
_
_
x
_
_
)
=
x
m
oduleName
_
=
""
replaceDefault
_
other
=
[
other
]
removeDefaultTypeParams
::
Description
->
Description
...
...
src/Convert/SignCast.hs
View file @
12be5697
...
...
@@ -23,7 +23,7 @@ convert =
convertExpr
::
Expr
->
Expr
convertExpr
(
Cast
(
Left
(
Implicit
Signed
[]
))
e
)
=
Call
(
Ident
"$signed"
)
(
Args
[
Just
e
]
[]
)
Call
(
Ident
"$signed"
)
(
Args
[
e
]
[]
)
convertExpr
(
Cast
(
Left
(
Implicit
Unsigned
[]
))
e
)
=
Call
(
Ident
"$unsigned"
)
(
Args
[
Just
e
]
[]
)
Call
(
Ident
"$unsigned"
)
(
Args
[
e
]
[]
)
convertExpr
other
=
other
src/Convert/Simplify.hs
View file @
12be5697
...
...
@@ -70,13 +70,13 @@ convertExpr info (DimFn f v e) =
DimFn
f
v
e'
where
e'
=
simplify
$
substitute
info
e
convertExpr
info
(
Call
(
Ident
"$clog2"
)
(
Args
[
Just
e
]
[]
))
=
convertExpr
info
(
Call
(
Ident
"$clog2"
)
(
Args
[
e
]
[]
))
=
if
clog2'
==
clog2
then
clog2
else
clog2'
where
e'
=
simplify
$
substitute
info
e
clog2
=
Call
(
Ident
"$clog2"
)
(
Args
[
Just
e'
]
[]
)
clog2
=
Call
(
Ident
"$clog2"
)
(
Args
[
e'
]
[]
)
clog2'
=
simplify
clog2
convertExpr
info
(
Mux
cc
aa
bb
)
=
if
before
==
after
...
...
src/Convert/SizeCast.hs
View file @
12be5697
...
...
@@ -97,7 +97,7 @@ traverseExprM =
convertCastWithSigningM
s
e
sg
=
do
lift
$
tell
$
Set
.
singleton
(
s
,
sg
)
let
f
=
castFnName
s
sg
let
args
=
Args
[
Just
e
]
[]
let
args
=
Args
[
e
]
[]
return
$
Call
(
Ident
f
)
args
castFn
::
Expr
->
Signing
->
Description
...
...
@@ -109,7 +109,7 @@ castFn e sg =
r
=
(
simplify
$
BinOp
Sub
e
(
Number
"1"
),
Number
"0"
)
t
=
IntegerVector
TLogic
sg
[
r
]
fnName
=
castFnName
e
sg
decl
=
Variable
Input
t
inp
[]
N
othing
decl
=
Variable
Input
t
inp
[]
N
il
castFnName
::
Expr
->
Signing
->
String
castFnName
e
sg
=
...
...
src/Convert/StarPort.hs
View file @
12be5697
...
...
@@ -31,12 +31,12 @@ mapInstance modulePorts (Instance m p x r bindings) =
alreadyBound
::
[
Identifier
]
alreadyBound
=
map
fst
bindings
expandBinding
::
PortBinding
->
[
PortBinding
]
expandBinding
(
"*"
,
N
othing
)
=
expandBinding
(
"*"
,
N
il
)
=
case
Map
.
lookup
m
modulePorts
of
Just
l
->
map
(
\
port
->
(
port
,
Just
$
Ident
port
))
$
map
(
\
port
->
(
port
,
Ident
port
))
$
filter
(
\
s
->
not
$
elem
s
alreadyBound
)
$
l
-- if we can't find it, just skip :(
Nothing
->
[(
"*"
,
N
othing
)]
Nothing
->
[(
"*"
,
N
il
)]
expandBinding
other
=
[
other
]
mapInstance
_
other
=
other
src/Convert/Stream.hs
View file @
12be5697
...
...
@@ -20,9 +20,9 @@ convertDescription other = other
streamerBlock
::
Expr
->
Expr
->
(
LHS
->
Expr
->
Stmt
)
->
LHS
->
Expr
->
Stmt
streamerBlock
chunk
size
asgn
output
input
=
Block
Seq
""
[
Variable
Local
t
inp
[]
$
Just
input
,
Variable
Local
t
out
[]
N
othing
,
Variable
Local
(
IntegerAtom
TInteger
Unspecified
)
idx
[]
N
othing
[
Variable
Local
t
inp
[]
input
,
Variable
Local
t
out
[]
N
il
,
Variable
Local
(
IntegerAtom
TInteger
Unspecified
)
idx
[]
N
il
]
[
For
inits
cmp
incr
stmt
,
If
NoCheck
cmp2
stmt2
Null
...
...
src/Convert/Struct.hs
View file @
12be5697
...
...
@@ -189,16 +189,13 @@ collectTFArgsM _ = return ()
traverseDeclM
::
Structs
->
Decl
->
State
Types
Decl
traverseDeclM
structs
origDecl
=
do
case
origDecl
of
Variable
d
t
x
a
m
e
->
do
Variable
d
t
x
a
e
->
do
let
(
tf
,
rs
)
=
typeRanges
t
if
isRangeable
t
then
modify
$
Map
.
insert
x
(
tf
$
a
++
rs
)
else
return
()
case
me
of
Nothing
->
return
origDecl
Just
e
->
do
e'
<-
convertDeclExpr
x
e
return
$
Variable
d
t
x
a
(
Just
e'
)
e'
<-
convertDeclExpr
x
e
return
$
Variable
d
t
x
a
e'
Param
s
t
x
e
->
do
modify
$
Map
.
insert
x
t
e'
<-
convertDeclExpr
x
e
...
...
@@ -223,7 +220,7 @@ packerFn structTf =
Function
Automatic
(
structTf
[]
)
fnName
decls
[
retStmt
]
where
Struct
_
fields
[]
=
structTf
[]
toInput
(
t
,
x
)
=
Variable
Input
t
x
[]
N
othing
toInput
(
t
,
x
)
=
Variable
Input
t
x
[]
N
il
decls
=
map
toInput
fields
retStmt
=
Return
$
Concat
$
map
(
Ident
.
snd
)
fields
fnName
=
packerFnName
structTf
...
...
@@ -269,6 +266,7 @@ convertAsgn structs types (lhs, expr) =
-- try expression conversion by looking at the *outermost* type first
convertExpr
::
Type
->
Expr
->
Expr
convertExpr
_
Nil
=
Nil
convertExpr
t
(
Mux
c
e1
e2
)
=
Mux
c
e1'
e2'
where
...
...
@@ -316,7 +314,7 @@ convertAsgn structs types (lhs, expr) =
else
if
Map
.
member
structTf
structs
then
Call
(
Ident
$
packerFnName
structTf
)
(
Args
(
map
(
Just
.
snd
)
items
)
[]
)
(
Args
(
map
snd
items
)
[]
)
else
Pattern
items
where
...
...
@@ -551,9 +549,8 @@ convertCall structs types fn (Args pnArgs kwArgs) =
args
=
Args
(
map
snd
$
map
convertArg
$
zip
idxs
pnArgs
)
(
map
convertArg
kwArgs
)
convertArg
::
(
Identifier
,
Maybe
Expr
)
->
(
Identifier
,
Maybe
Expr
)
convertArg
(
x
,
Nothing
)
=
(
x
,
Nothing
)
convertArg
(
x
,
Just
e
)
=
(
x
,
Just
e'
)
convertArg
::
(
Identifier
,
Expr
)
->
(
Identifier
,
Expr
)
convertArg
(
x
,
e
)
=
(
x
,
e'
)
where
(
_
,
e'
)
=
convertAsgn
structs
types
(
LHSIdent
$
f
++
":"
++
x
,
e
)
...
...
src/Convert/Traverse.hs
View file @
12be5697
...
...
@@ -300,13 +300,10 @@ traverseAssertionExprsM mapper = assertionMapper
c'
<-
mapper
c
return
$
Left
(
a
,
b
,
c'
)
seqMatchItemMapper
(
Right
(
x
,
(
Args
l
p
)))
=
do
l'
<-
mapM
ma
ybeExprMa
pper
l
pes
<-
mapM
ma
ybeExprMa
pper
$
map
snd
p
l'
<-
mapM
mapper
l
pes
<-
mapM
mapper
$
map
snd
p
let
p'
=
zip
(
map
fst
p
)
pes
return
$
Right
(
x
,
Args
l'
p'
)
maybeExprMapper
Nothing
=
return
Nothing
maybeExprMapper
(
Just
e
)
=
mapper
e
>>=
return
.
Just
ppMapper
constructor
p1
p2
=
do
p1'
<-
propExprMapper
p1
p2'
<-
propExprMapper
p2
...
...
@@ -331,10 +328,10 @@ traverseAssertionExprsM mapper = assertionMapper
spMapper
PropExprFollowsNO
se
pe
propExprMapper
(
PropExprIff
p1
p2
)
=
ppMapper
PropExprIff
p1
p2
propSpecMapper
(
PropertySpec
ms
m
e
pe
)
=
do
me'
<-
maybeExprMapper
m
e
propSpecMapper
(
PropertySpec
ms
e
pe
)
=
do
e'
<-
mapper
e
pe'
<-
propExprMapper
pe
return
$
PropertySpec
ms
m
e'
pe'
return
$
PropertySpec
ms
e'
pe'
assertionExprMapper
(
Left
e
)
=
propSpecMapper
e
>>=
return
.
Left
assertionExprMapper
(
Right
e
)
=
...
...
@@ -408,10 +405,7 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr
traverseNestedExprsM
mapper
=
exprMapper
where
exprMapper
e
=
mapper
e
>>=
em
(
_
,
_
,
_
,
_
,
typeMapper
)
=
exprMapperHelpers
exprMapper
maybeExprMapper
Nothing
=
return
Nothing
maybeExprMapper
(
Just
e
)
=
exprMapper
e
>>=
return
.
Just
(
_
,
_
,
_
,
typeMapper
)
=
exprMapperHelpers
exprMapper
typeOrExprMapper
(
Left
t
)
=
typeMapper
t
>>=
return
.
Left
typeOrExprMapper
(
Right
e
)
=
...
...
@@ -448,8 +442,8 @@ traverseNestedExprsM mapper = exprMapper
return
$
Stream
o
e'
l'
em
(
Call
e
(
Args
l
p
))
=
do
e'
<-
exprMapper
e
l'
<-
mapM
maybeE
xprMapper
l
pes
<-
mapM
maybeE
xprMapper
$
map
snd
p
l'
<-
mapM
e
xprMapper
l
pes
<-
mapM
e
xprMapper
$
map
snd
p
let
p'
=
zip
(
map
fst
p
)
pes
return
$
Call
e'
(
Args
l'
p'
)
em
(
UniOp
o
e
)
=
...
...
@@ -493,9 +487,9 @@ traverseNestedExprsM mapper = exprMapper
em
(
Nil
)
=
return
Nil
exprMapperHelpers
::
Monad
m
=>
MapperM
m
Expr
->
(
MapperM
m
Range
,
MapperM
m
(
Maybe
Expr
),
MapperM
m
Decl
,
MapperM
m
LHS
,
MapperM
m
Type
)
(
MapperM
m
Range
,
MapperM
m
Decl
,
MapperM
m
LHS
,
MapperM
m
Type
)
exprMapperHelpers
exprMapper
=
(
rangeMapper
,
maybeExprMapper
,
declMapper
,
traverseNestedLHSsM
lhsMapper
,
typeMapper
)
(
rangeMapper
,
declMapper
,
traverseNestedLHSsM
lhsMapper
,
typeMapper
)
where
rangeMapper
(
a
,
b
)
=
do
...
...
@@ -503,10 +497,6 @@ exprMapperHelpers exprMapper =
b'
<-
exprMapper
b
return
(
a'
,
b'
)
maybeExprMapper
Nothing
=
return
Nothing
maybeExprMapper
(
Just
e
)
=
exprMapper
e
>>=
return
.
Just
typeMapper'
(
TypeOf
expr
)
=
exprMapper
expr
>>=
return
.
TypeOf
typeMapper'
t
=
do
...
...
@@ -526,11 +516,11 @@ exprMapperHelpers exprMapper =
declMapper
(
ParamType
s
x
mt
)
=
do
mt'
<-
maybeTypeMapper
mt
return
$
ParamType
s
x
mt'
declMapper
(
Variable
d
t
x
a
m
e
)
=
do
declMapper
(
Variable
d
t
x
a
e
)
=
do
t'
<-
typeMapper
t
a'
<-
mapM
rangeMapper
a
me'
<-
maybeExprMapper
m
e
return
$
Variable
d
t'
x
a'
m
e'
e'
<-
exprMapper
e
return
$
Variable
d
t'
x
a'
e'
declMapper
(
CommentDecl
c
)
=
return
$
CommentDecl
c
...
...
@@ -547,13 +537,13 @@ traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleIt
traverseExprsM'
strat
exprMapper
=
moduleItemMapper
where
(
rangeMapper
,
maybeExprMapper
,
declMapper
,
lhsMapper
,
typeMapper
)
(
rangeMapper
,
declMapper
,
lhsMapper
,
typeMapper
)
=
exprMapperHelpers
exprMapper
stmtMapper
=
traverseNestedStmtsM
(
traverseStmtExprsM
exprMapper
)
portBindingMapper
(
p
,
m
e
)
=
maybeExprMapper
me
>>=
\
me'
->
return
(
p
,
m
e'
)
portBindingMapper
(
p
,
e
)
=
exprMapper
e
>>=
\
e'
->
return
(
p
,
e'
)
paramBindingMapper
(
p
,
Left
t
)
=
typeMapper
t
>>=
\
t'
->
return
(
p
,
Left
t'
)
...
...
@@ -616,12 +606,12 @@ traverseExprsM' strat exprMapper = moduleItemMapper
moduleItemMapper
(
Modport
x
l
)
=
mapM
modportDeclMapper
l
>>=
return
.
Modport
x
moduleItemMapper
(
NInputGate
kw
d
x
lhs
exprs
)
=
do
d'
<-
maybeE
xprMapper
d
d'
<-
e
xprMapper
d
exprs'
<-
mapM
exprMapper
exprs
lhs'
<-
lhsMapper
lhs
return
$
NInputGate
kw
d'
x
lhs'
exprs'
moduleItemMapper
(
NOutputGate
kw
d
x
lhss
expr
)
=
do
d'
<-
maybeE
xprMapper
d
d'
<-
e
xprMapper
d
lhss'
<-
mapM
lhsMapper
lhss
expr'
<-
exprMapper
expr
return
$
NOutputGate
kw
d'
x
lhss'
expr'
...
...
@@ -655,10 +645,9 @@ traverseExprsM' strat exprMapper = moduleItemMapper
return
$
GenCase
e'
cases'
genItemMapper
other
=
return
other
modportDeclMapper
(
dir
,
ident
,
Just
e
)
=
do
modportDeclMapper
(
dir
,
ident
,
e
)
=
do
e'
<-
exprMapper
e
return
(
dir
,
ident
,
Just
e'
)
modportDeclMapper
other
=
return
other
return
(
dir
,
ident
,
e'
)
traverseExprs'
::
TFStrategy
->
Mapper
Expr
->
Mapper
ModuleItem
traverseExprs'
strat
=
unmonad
$
traverseExprsM'
strat
...
...
@@ -676,8 +665,7 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt
traverseStmtExprsM
exprMapper
=
flatStmtMapper
where
(
_
,
maybeExprMapper
,
declMapper
,
lhsMapper
,
_
)
=
exprMapperHelpers
exprMapper
(
_
,
declMapper
,
lhsMapper
,
_
)
=
exprMapperHelpers
exprMapper
caseMapper
(
exprs
,
stmt
)
=
do
exprs'
<-
mapM
exprMapper
exprs
...
...
@@ -715,8 +703,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
flatStmtMapper
(
Timing
event
stmt
)
=
return
$
Timing
event
stmt
flatStmtMapper
(
Subroutine
e
(
Args
l
p
))
=
do
e'
<-
exprMapper
e
l'
<-
mapM
maybeE
xprMapper
l
pes
<-
mapM
maybeE
xprMapper
$
map
snd
p
l'
<-
mapM
e
xprMapper
l
pes
<-
mapM
e
xprMapper
$
map
snd
p
let
p'
=
zip
(
map
fst
p
)
pes
return
$
Subroutine
e'
(
Args
l'
p'
)
flatStmtMapper
(
Return
expr
)
=
...
...
@@ -897,7 +885,7 @@ collectExprTypesM = collectify traverseExprTypesM
traverseTypeExprsM
::
Monad
m
=>
MapperM
m
Expr
->
MapperM
m
Type
traverseTypeExprsM
mapper
=
typeMapper
where
(
_
,
_
,
_
,
_
,
typeMapper
)
=
exprMapperHelpers
mapper
where
(
_
,
_
,
_
,
typeMapper
)
=
exprMapperHelpers
mapper
traverseTypeExprs
::
Mapper
Expr
->
Mapper
Type
traverseTypeExprs
=
unmonad
traverseTypeExprsM
...
...
@@ -918,8 +906,8 @@ traverseTypesM' strategy mapper item =
fullMapper
t
>>=
\
t'
->
return
$
Param
s
t'
x
e
declMapper
(
ParamType
s
x
mt
)
=
maybeMapper
mt
>>=
\
mt'
->
return
$
ParamType
s
x
mt'
declMapper
(
Variable
d
t
x
a
m
e
)
=
fullMapper
t
>>=
\
t'
->
return
$
Variable
d
t'
x
a
m
e
declMapper
(
Variable
d
t
x
a
e
)
=
fullMapper
t
>>=
\
t'
->
return
$
Variable
d
t'
x
a
e
declMapper
(
CommentDecl
c
)
=
return
$
CommentDecl
c
miMapper
(
MIPackageItem
(
Typedef
t
x
))
=
fullMapper
t
>>=
\
t'
->
return
$
MIPackageItem
$
Typedef
t'
x
...
...
@@ -1111,9 +1099,9 @@ traverseScopesM declMapper moduleItemMapper stmtMapper =
redirectModuleItem
(
MIPackageItem
(
Function
ml
t
x
decls
stmts
))
=
do
prevState
<-
get
t'
<-
do
res
<-
declMapper
$
Variable
Local
t
x
[]
N
othing
res
<-
declMapper
$
Variable
Local
t
x
[]
N
il
case
res
of
Variable
Local
newType
_
[]
N
othing
->
return
newType
Variable
Local
newType
_
[]
N
il
->
return
newType
_
->
error
$
"redirected func ret traverse failed: "
++
show
res
decls'
<-
mapM
declMapper
decls
stmts'
<-
mapM
fullStmtMapper
stmts
...
...
src/Convert/TypeOf.hs
View file @
12be5697
...
...
@@ -46,12 +46,12 @@ traverseDeclM decl = do
item
<-
traverseModuleItemM
(
MIPackageItem
$
Decl
decl
)
let
MIPackageItem
(
Decl
decl'
)
=
item
case
decl'
of
Variable
d
t
ident
a
m
e
->
do
Variable
d
t
ident
a
e
->
do
let
t'
=
injectRanges
t
a
modify
$
Map
.
insert
ident
t'
return
$
case
t'
of
UnpackedType
t''
a'
->
Variable
d
t''
ident
a'
m
e
_
->
Variable
d
t'
ident
[]
m
e
UnpackedType
t''
a'
->
Variable
d
t''
ident
a'
e
_
->
Variable
d
t'
ident
[]
e
Param
_
t
ident
_
->
do
let
t'
=
if
t
==
Implicit
Unspecified
[]
then
IntegerAtom
TInteger
Unspecified
...
...
src/Convert/UnpackedArray.hs
View file @
12be5697
...
...
@@ -40,9 +40,9 @@ convertDescription description =
-- collects and converts multi-dimensional packed-array declarations
traverseDeclM
::
Decl
->
ST
Decl
traverseDeclM
(
orig
@
(
Variable
dir
_
x
_
m
e
))
=
do
traverseDeclM
(
orig
@
(
Variable
dir
_
x
_
e
))
=
do
modify
$
Map
.
insert
x
orig
()
<-
if
dir
/=
Local
||
me
/=
Nothing
()
<-
if
dir
/=
Local
||
e
/=
Nil
then
lift
$
tell
$
Set
.
singleton
orig
else
return
()
return
orig
...
...
@@ -50,12 +50,12 @@ traverseDeclM other = return other
-- pack the given decls marked for packing
packDecl
::
DeclSet
->
Decl
->
Decl
packDecl
decls
(
orig
@
(
Variable
d
t
x
a
m
e
))
=
do
packDecl
decls
(
orig
@
(
Variable
d
t
x
a
e
))
=
do
if
Set
.
member
orig
decls
then
do
let
(
tf
,
rs
)
=
typeRanges
t
let
t'
=
tf
$
a
++
rs
Variable
d
t'
x
[]
m
e
Variable
d
t'
x
[]
e
else
orig
packDecl
_
other
=
other
...
...
@@ -73,9 +73,9 @@ traverseModuleItemM' (Instance a b c d bindings) = do
return
$
Instance
a
b
c
d
bindings'
where
collectBinding
::
PortBinding
->
ST
PortBinding
collectBinding
(
y
,
Just
(
Ident
x
)
)
=
do
collectBinding
(
y
,
Ident
x
)
=
do
flatUsageM
x
return
(
y
,
Just
(
Ident
x
)
)
return
(
y
,
Ident
x
)
collectBinding
other
=
return
other
traverseModuleItemM'
other
=
return
other
...
...
src/Language/SystemVerilog/AST/Attr.hs
View file @
12be5697
...
...
@@ -20,10 +20,10 @@ data Attr
=
Attr
[
AttrSpec
]
deriving
Eq
type
AttrSpec
=
(
Identifier
,
Maybe
Expr
)
type
AttrSpec
=
(
Identifier
,
Expr
)
instance
Show
Attr
where
show
(
Attr
specs
)
=
printf
"(* %s *)"
$
commas
$
map
showSpec
specs
showSpec
::
AttrSpec
->
String
showSpec
(
x
,
me
)
=
x
++
showAssignment
m
e
showSpec
(
x
,
e
)
=
x
++
showAssignment
e
src/Language/SystemVerilog/AST/Decl.hs
View file @
12be5697
...
...
@@ -22,15 +22,16 @@ import Language.SystemVerilog.AST.Expr (Expr, Range, showRanges, showAssignment)
data
Decl
=
Param
ParamScope
Type
Identifier
Expr
|
ParamType
ParamScope
Identifier
(
Maybe
Type
)
|
Variable
Direction
Type
Identifier
[
Range
]
(
Maybe
Expr
)
|
Variable
Direction
Type
Identifier
[
Range
]
Expr
|
CommentDecl
String
deriving
(
Eq
,
Ord
)
instance
Show
Decl
where
showList
l
_
=
unlines'
$
map
show
l
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
(
Variable
d
t
x
a
me
)
=
printf
"%s%s%s%s%s;"
(
showPad
d
)
(
showPad
t
)
x
(
showRanges
a
)
(
showAssignment
me
)
show
(
ParamType
s
x
mt
)
=
printf
"%s type %s%s;"
(
show
s
)
x
tStr
where
tStr
=
maybe
""
((
" = "
++
)
.
show
)
mt
show
(
Variable
d
t
x
a
e
)
=
printf
"%s%s%s%s%s;"
(
showPad
d
)
(
showPad
t
)
x
(
showRanges
a
)
(
showAssignment
e
)
show
(
CommentDecl
c
)
=
if
elem
'
\n
'
c
then
"// "
++
show
c
...
...
src/Language/SystemVerilog/AST/Expr.hs
View file @
12be5697
...
...
@@ -127,15 +127,14 @@ instance Show Expr where
showsPrec
_
e
=
\
s
->
show
e
++
s
data
Args
=
Args
[
Maybe
Expr
]
[(
Identifier
,
Maybe
Expr
)]
=
Args
[
Expr
]
[(
Identifier
,
Expr
)]
deriving
(
Eq
,
Ord
)
instance
Show
Args
where
show
(
Args
pnArgs
kwArgs
)
=
"("
++
(
commas
strs
)
++
")"
where
strs
=
(
map
showPnArg
pnArgs
)
++
(
map
showKwArg
kwArgs
)
showPnArg
=
maybe
""
show
showKwArg
(
x
,
me
)
=
printf
".%s(%s)"
x
(
showPnArg
me
)
strs
=
(
map
show
pnArgs
)
++
(
map
showKwArg
kwArgs
)
showKwArg
(
x
,
e
)
=
printf
".%s(%s)"
x
(
show
e
)
data
PartSelectMode
=
NonIndexed
...
...
@@ -177,9 +176,9 @@ instance Show DimFn where
show
FnSize
=
"$size"
showAssignment
::
Show
a
=>
Maybe
a
->
String
showAssignment
N
othing
=
""
showAssignment
(
Just
val
)
=
" = "
++
show
val
showAssignment
::
Expr
->
String
showAssignment
N
il
=
""
showAssignment
val
=
" = "
++
show
val
showRanges
::
[
Range
]
->
String
showRanges
[]
=
""
...
...
@@ -241,7 +240,7 @@ simplify (orig @ (Repeat (Number n) exprs)) =
simplify
(
Concat
[
expr
])
=
expr
simplify
(
Concat
exprs
)
=
Concat
$
filter
(
/=
Concat
[]
)
exprs
simplify
(
orig
@
(
Call
(
Ident
"$clog2"
)
(
Args
[
Just
(
Number
n
)
]
[]
)))
=
simplify
(
orig
@
(
Call
(
Ident
"$clog2"
)
(
Args
[
Number
n
]
[]
)))
=
case
readNumber
n
of
Nothing
->
orig
Just
x
->
Number
$
show
$
clog2
x
...
...
src/Language/SystemVerilog/AST/ModuleItem.hs
View file @
12be5697
...
...
@@ -17,7 +17,6 @@ module Language.SystemVerilog.AST.ModuleItem
)
where
import
Data.List
(
intercalate
)
import
Data.Maybe
(
fromJust
,
isJust
)
import
Text.Printf
(
printf
)
import
Language.SystemVerilog.AST.ShowHelp
...
...
@@ -43,8 +42,8 @@ data ModuleItem
|
Initial
Stmt
|
Final
Stmt
|
MIPackageItem
PackageItem
|
NInputGate
NInputGateKW
(
Maybe
Expr
)
Identifier
LHS
[
Expr
]
|
NOutputGate
NOutputGateKW
(
Maybe
Expr
)
Identifier
[
LHS
]
Expr
|
NInputGate
NInputGateKW
Expr
Identifier
LHS
[
Expr
]
|
NOutputGate
NOutputGateKW
Expr
Identifier
[
LHS
]
Expr
|
AssertionItem
AssertionItem
deriving
Eq
...
...
@@ -77,17 +76,17 @@ showPorts :: [PortBinding] -> String
showPorts
ports
=
indentedParenList
$
map
showPort
ports
showPort
::
PortBinding
->
String
showPort
(
"*"
,
N
othing
)
=
".*"
showPort
(
"*"
,
N
il
)
=
".*"
showPort
(
i
,
arg
)
=
if
i
==
""
then
show
(
fromJust
arg
)
else
printf
".%s(%s)"
i
(
if
isJust
arg
then
show
$
fromJust
arg
else
""
)
then
show
arg
else
printf
".%s(%s)"
i
(
show
arg
)
showGate
::
Show
k
=>
k
->
Maybe
Expr
->
Identifier
->
[
String
]
->
String
showGate
::
Show
k
=>
k
->
Expr
->
Identifier
->
[
String
]
->
String
showGate
kw
d
x
args
=
printf
"%s %s%s(%s);"
(
show
kw
)
delayStr
nameStr
(
commas
args
)
where
delayStr
=
maybe
""
(
showPad
.
Delay
)
d
delayStr
=
if
d
==
Nil
then
""
else
showPad
$
Delay
d
nameStr
=
showPad
$
Ident
x
showParams
::
[
ParamBinding
]
->
String
...
...
@@ -100,16 +99,16 @@ showParam (i, arg) =
where
fmt
=
if
i
==
""
then
"%s%s"
else
".%s(%s)"
showModportDecl
::
ModportDecl
->
String
showModportDecl
(
dir
,
ident
,
m
e
)
=
if
me
==
Just
(
Ident
ident
)
showModportDecl
(
dir
,
ident
,
e
)
=
if
e
==
Ident
ident
then
printf
"%s %s"
(
show
dir
)
ident
else
printf
"%s .%s(%s)"
(
show
dir
)
ident
(
maybe
""
show
m
e
)
else
printf
"%s .%s(%s)"
(
show
dir
)
ident
(
show
e
)
type
PortBinding
=
(
Identifier
,
Maybe
Expr
)
type
PortBinding
=
(
Identifier
,
Expr
)
type
ParamBinding
=
(
Identifier
,
TypeOrExpr
)
type
ModportDecl
=
(
Direction
,
Identifier
,
Maybe
Expr
)
type
ModportDecl
=
(
Direction
,
Identifier
,
Expr
)
data
AlwaysKW
=
Always
...
...
src/Language/SystemVerilog/AST/Stmt.hs
View file @
12be5697
...
...
@@ -244,18 +244,18 @@ showAssertionExpr (Left e) = printf "property (%s\n)" (show e)
showAssertionExpr
(
Right
e
)
=
printf
"(%s)"
(
show
e
)
data
PropertySpec
=
PropertySpec
(
Maybe
Sense
)
(
Maybe
Expr
)
PropExpr
=
PropertySpec
(
Maybe
Sense
)
Expr
PropExpr
deriving
Eq
instance
Show
PropertySpec
where
show
(
PropertySpec
ms
m
e
pe
)
=
printf
"%s%s
\n\t
%s"
msStr
m
eStr
(
show
pe
)
show
(
PropertySpec
ms
e
pe
)
=
printf
"%s%s
\n\t
%s"
msStr
eStr
(
show
pe
)
where
msStr
=
case
ms
of
Nothing
->
""
Just
s
->
printf
"@(%s) "
(
show
s
)
meStr
=
case
m
e
of
N
othing
->
""
Just
e
->
printf
"disable iff (%s)"
(
show
e
)
eStr
=
case
e
of
N
il
->
""
_
->
printf
"disable iff (%s)"
(
show
e
)
data
ViolationCheck
=
Unique
...
...
src/Language/SystemVerilog/AST/Type.hs
View file @
12be5697
...
...
@@ -33,7 +33,7 @@ import Language.SystemVerilog.AST.ShowHelp
type
Identifier
=
String
type
Item
=
(
Identifier
,
Maybe
Expr
)
type
Item
=
(
Identifier
,
Expr
)
type
Field
=
(
Type
,
Identifier
)
data
Type
...
...
@@ -63,7 +63,7 @@ instance Show Type where
show
(
Enum
t
vals
r
)
=
printf
"enum %s{%s}%s"
tStr
(
commas
$
map
showVal
vals
)
(
showRanges
r
)
where
tStr
=
showPad
t
showVal
::
(
Identifier
,
Maybe
Expr
)
->
String
showVal
::
(
Identifier
,
Expr
)
->
String
showVal
(
x
,
e
)
=
x
++
(
showAssignment
e
)
show
(
Struct
p
items
r
)
=
printf
"struct %s{
\n
%s
\n
}%s"
(
showPad
p
)
(
showFields
items
)
(
showRanges
r
)
show
(
Union
p
items
r
)
=
printf
"union %s{
\n
%s
\n
}%s"
(
showPad
p
)
(
showFields
items
)
(
showRanges
r
)
...
...
src/Language/SystemVerilog/Parser/Parse.y
View file @
12be5697
...
...
@@ -509,7 +509,7 @@ NonIntegerType :: { NonIntegerType }
|
"string"
{
TString
}
|
"event"
{
TEvent
}
EnumItems
::
{
[(
Identifier
,
Maybe
Expr
)]
}
EnumItems
::
{
[(
Identifier
,
Expr
)]
}
:
VariablePortIdentifiers
{
$
1
}
StructItems
::
{
[(
Type
,
Identifier
)]
}
...
...
@@ -589,12 +589,12 @@ ModportPortsDeclaration(delim) :: { [ModportDecl] }
:
ModportSimplePortsDeclaration
(
delim
)
{
$
1
}
ModportSimplePortsDeclaration
(
delim
)
::
{
[
ModportDecl
]
}
:
Direction
ModportSimplePorts
delim
{
map
(
\
(
a
,
b
)
->
(
$
1
,
a
,
b
))
$
2
}
ModportSimplePorts
::
{
[(
Identifier
,
Maybe
Expr
)]
}
ModportSimplePorts
::
{
[(
Identifier
,
Expr
)]
}
:
ModportSimplePort
{
[
$
1
]
}
|
ModportSimplePorts
","
ModportSimplePort
{
$
1
++
[
$
3
]
}
ModportSimplePort
::
{
(
Identifier
,
Maybe
Expr
)
}
:
"."
Identifier
"("
opt
(
Expr
)
")"
{
(
$
2
,
$
4
)
}
|
Identifier
{
(
$
1
,
Just
$
Ident
$
1
)
}
ModportSimplePort
::
{
(
Identifier
,
Expr
)
}
:
"."
Identifier
"("
ExprOrNil
")"
{
(
$
2
,
$
4
)
}
|
Identifier
{
(
$
1
,
Ident
$
1
)
}
Identifier
::
{
Identifier
}
:
simpleIdentifier
{
tokenString
$
1
}
...
...
@@ -636,12 +636,12 @@ DeclTokenAsgn :: { DeclToken }
:
"="
opt
(
DelayOrEvent
)
Expr
{
%
posInject
\
p
->
DTAsgn
p
AsgnOpEq
$
2
$
3
}
|
AsgnBinOp
Expr
{
%
posInject
\
p
->
DTAsgn
p
$
1
Nothing
$
2
}
VariablePortIdentifiers
::
{
[(
Identifier
,
Maybe
Expr
)]
}
VariablePortIdentifiers
::
{
[(
Identifier
,
Expr
)]
}
:
VariablePortIdentifier
{
[
$
1
]
}
|
VariablePortIdentifiers
","
VariablePortIdentifier
{
$
1
++
[
$
3
]
}
VariablePortIdentifier
::
{
(
Identifier
,
Maybe
Expr
)
}
:
Identifier
{
(
$
1
,
N
othing
)
}
|
Identifier
"="
Expr
{
(
$
1
,
Just
$
3
)
}
VariablePortIdentifier
::
{
(
Identifier
,
Expr
)
}
:
Identifier
{
(
$
1
,
N
il
)
}
|
Identifier
"="
Expr
{
(
$
1
,
$
3
)
}
Direction
::
{
Direction
}
:
"inout"
{
Inout
}
...
...
@@ -705,8 +705,8 @@ SimpleImmediateAssertionStatement :: { Assertion }
|
"cover"
"("
Expr
")"
Stmt
{
Cover
(
Right
$
3
)
$
5
}
PropertySpec
::
{
PropertySpec
}
:
opt
(
ClockingEvent
)
"disable"
"iff"
"("
Expr
")"
PropExpr
{
PropertySpec
$
1
(
Just
$
5
)
$
7
}
|
opt
(
ClockingEvent
)
PropExpr
{
PropertySpec
$
1
(
Nothing
)
$
2
}
:
opt
(
ClockingEvent
)
"disable"
"iff"
"("
Expr
")"
PropExpr
{
PropertySpec
$
1
$
5
$
7
}
|
opt
(
ClockingEvent
)
PropExpr
{
PropertySpec
$
1
Nil
$
2
}
PropExpr
::
{
PropExpr
}
:
SeqExpr
{
PropExpr
$
1
}
...
...
@@ -752,23 +752,26 @@ AttrSpecs :: { [AttrSpec] }
:
AttrSpec
{
[
$
1
]
}
|
AttrSpecs
","
AttrSpec
{
$
1
++
[
$
3
]
}
AttrSpec
::
{
AttrSpec
}
:
Identifier
"="
Expr
{
(
$
1
,
Just
$
3
)
}
|
Identifier
{
(
$
1
,
N
othing
)
}
:
Identifier
"="
Expr
{
(
$
1
,
$
3
)
}
|
Identifier
{
(
$
1
,
N
il
)
}
NInputGates
::
{
[(
Maybe
Expr
,
Identifier
,
LHS
,
[
Expr
])]
}
NInputGates
::
{
[(
Expr
,
Identifier
,
LHS
,
[
Expr
])]
}
:
NInputGate
{
[
$
1
]
}
|
NInputGates
","
NInputGate
{
$
1
++
[
$
3
]}
NOutputGates
::
{
[(
Maybe
Expr
,
Identifier
,
[
LHS
],
Expr
)]
}
NOutputGates
::
{
[(
Expr
,
Identifier
,
[
LHS
],
Expr
)]
}
:
NOutputGate
{
[
$
1
]
}
|
NOutputGates
","
NOutputGate
{
$
1
++
[
$
3
]}
NInputGate
::
{
(
Maybe
Expr
,
Identifier
,
LHS
,
[
Expr
])
}
:
opt
(
DelayControl
)
opt
(
Identifier
)
"("
LHS
","
Exprs
")"
{
(
$
1
,
fromMaybe
""
$
2
,
$
4
,
$
6
)
}
NOutputGate
::
{
(
Maybe
Expr
,
Identifier
,
[
LHS
],
Expr
)
}
:
opt
(
DelayControl
)
opt
(
Identifier
)
"("
NOutputGateItems
{
(
$
1
,
fromMaybe
""
$
2
,
fst
$
4
,
snd
$
4
)
}
NInputGate
::
{
(
Expr
,
Identifier
,
LHS
,
[
Expr
])
}
:
DelayControlOrNil
opt
(
Identifier
)
"("
LHS
","
Exprs
")"
{
(
$
1
,
fromMaybe
""
$
2
,
$
4
,
$
6
)
}
NOutputGate
::
{
(
Expr
,
Identifier
,
[
LHS
],
Expr
)
}
:
DelayControlOrNil
opt
(
Identifier
)
"("
NOutputGateItems
{
(
$
1
,
fromMaybe
""
$
2
,
fst
$
4
,
snd
$
4
)
}
NOutputGateItems
::
{
([
LHS
],
Expr
)
}
:
Expr
")"
{
(
[]
,
$
1
)
}
|
Expr
","
NOutputGateItems
{
(
fst
$
3
++
[
toLHS
$
1
],
snd
$
3
)
}
DelayControlOrNil
::
{
Expr
}
:
DelayControl
{
$
1
}
|
{- empty -}
{
Nil
}
NInputGateKW
::
{
NInputGateKW
}
:
"and"
{
GateAnd
}
...
...
@@ -937,10 +940,10 @@ PortBindingsInside :: { [PortBinding] }
:
PortBinding
{
[
$
1
]
}
|
PortBinding
","
PortBindingsInside
{
$
1
:
$
3
}
PortBinding
::
{
PortBinding
}
:
"."
Identifier
"("
opt
(
Expr
)
")"
{
(
$
2
,
$
4
)
}
|
"."
Identifier
{
(
$
2
,
Just
$
Ident
$
2
)
}
|
Expr
{
(
""
,
Just
$
1
)
}
|
".*"
{
(
"*"
,
N
othing
)
}
:
"."
Identifier
"("
ExprOrNil
")"
{
(
$
2
,
$
4
)
}
|
"."
Identifier
{
(
$
2
,
Ident
$
2
)
}
|
Expr
{
(
""
,
$
1
)
}
|
".*"
{
(
"*"
,
N
il
)
}
ParamBindings
::
{
[
ParamBinding
]
}
:
"#"
"("
")"
{
[]
}
...
...
@@ -984,8 +987,7 @@ StmtNonBlock :: { Stmt }
|
"for"
"("
ForInit
ForCond
ForStep
")"
Stmt
{
For
$
3
$
4
$
5
$
7
}
|
Unique
CaseKW
"("
Expr
")"
Cases
"endcase"
{
Case
$
1
$
2
$
4
$
6
}
|
TimingControl
Stmt
{
Timing
$
1
$
2
}
|
"return"
Expr
";"
{
Return
$
2
}
|
"return"
";"
{
Return
Nil
}
|
"return"
ExprOrNil
";"
{
Return
$
2
}
|
"break"
";"
{
Break
}
|
"continue"
";"
{
Continue
}
|
"while"
"("
Expr
")"
Stmt
{
While
$
3
$
5
}
...
...
@@ -1131,22 +1133,22 @@ Time :: { String }
CallArgs
::
{
Args
}
:
"("
CallArgsInside
")"
{
$
2
}
CallArgsInside
::
{
Args
}
:
{- empty -}
{
Args
[
]
[]
}
|
NamedCallArgsFollow
{
Args
[
]
$
1
}
|
Expr
NamedCallArgs
{
Args
[
Just
$
1
]
$
2
}
|
UnnamedCallArgs
NamedCallArgs
{
Args
(
N
othing
:
$
1
)
$
2
}
|
Expr
UnnamedCallArgs
NamedCallArgs
{
Args
(
Just
$
1
:
$
2
)
$
3
}
UnnamedCallArgs
::
{
[
Maybe
Expr
]
}
:
","
opt
(
Expr
)
{
[
$
2
]
}
|
UnnamedCallArgs
","
opt
(
Expr
)
{
$
1
++
[
$
3
]
}
NamedCallArgs
::
{
[(
Identifier
,
Maybe
Expr
)]
}
:
{- empty -}
{
Args
[ ]
[]
}
|
NamedCallArgsFollow
{
Args
[ ]
$
1
}
|
Expr
NamedCallArgs
{
Args
[
$
1
]
$
2
}
|
UnnamedCallArgs
NamedCallArgs
{
Args
(
N
il
:
$
1
)
$
2
}
|
Expr
UnnamedCallArgs
NamedCallArgs
{
Args
(
$
1
:
$
2
)
$
3
}
UnnamedCallArgs
::
{
[
Expr
]
}
:
","
ExprOrNil
{
[
$
2
]
}
|
UnnamedCallArgs
","
ExprOrNil
{
$
1
++
[
$
3
]
}
NamedCallArgs
::
{
[(
Identifier
,
Expr
)]
}
:
{- empty -}
{
[]
}
|
","
NamedCallArgsFollow
{
$
2
}
NamedCallArgsFollow
::
{
[(
Identifier
,
Maybe
Expr
)]
}
NamedCallArgsFollow
::
{
[(
Identifier
,
Expr
)]
}
:
NamedCallArg
{
[
$
1
]
}
|
NamedCallArgsFollow
","
NamedCallArg
{
$
1
++
[
$
3
]
}
NamedCallArg
::
{
(
Identifier
,
Maybe
Expr
)
}
:
"."
Identifier
"("
opt
(
Expr
)
")"
{
(
$
2
,
$
4
)
}
NamedCallArg
::
{
(
Identifier
,
Expr
)
}
:
"."
Identifier
"("
ExprOrNil
")"
{
(
$
2
,
$
4
)
}
Exprs
::
{
[
Expr
]
}
:
Expr
{
[
$
1
]
}
...
...
@@ -1230,6 +1232,10 @@ Expr :: { Expr }
|
"~^"
Expr
%
prec
REDUCE_OP
{
UniOp
RedXnor
$
2
}
|
"^~"
Expr
%
prec
REDUCE_OP
{
UniOp
RedXnor
$
2
}
ExprOrNil
::
{
Expr
}
:
Expr
{
$
1
}
|
{- empty -}
{
Nil
}
PatternItems
::
{
[(
Identifier
,
Expr
)]
}
:
PatternNamedItems
{
$
1
}
|
PatternUnnamedItems
{
zip
(
repeat
""
)
$
1
}
...
...
@@ -1373,15 +1379,15 @@ combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt])
combineDeclsAndStmts
(
a1
,
b1
)
(
a2
,
b2
)
=
(
a1
++
a2
,
b1
++
b2
)
makeInput
::
Decl
->
Decl
makeInput
(
Variable
Local
t
x
a
me
)
=
Variable
Input
t
x
a
m
e
makeInput
(
Variable
Input
t
x
a
me
)
=
Variable
Input
t
x
a
m
e
makeInput
(
Variable
Local
t
x
a
e
)
=
Variable
Input
t
x
a
e
makeInput
(
Variable
Input
t
x
a
e
)
=
Variable
Input
t
x
a
e
makeInput
(
CommentDecl
c
)
=
CommentDecl
c
makeInput
other
=
error
$
"unexpected non-var or non-input decl: "
++
(
show
other
)
defaultFuncInput
::
Decl
->
Decl
defaultFuncInput
(
Variable
dir
(
Implicit
sg
rs
)
x
a
m
e
)
=
Variable
dir
t
x
a
m
e
defaultFuncInput
(
Variable
dir
(
Implicit
sg
rs
)
x
a
e
)
=
Variable
dir
t
x
a
e
where
t
=
if
dir
==
Input
||
dir
==
Inout
then
IntegerVector
TLogic
sg
rs
...
...
src/Language/SystemVerilog/Parser/ParseDecl.hs
View file @
12be5697
...
...
@@ -46,7 +46,6 @@ module Language.SystemVerilog.Parser.ParseDecl
)
where
import
Data.List
(
findIndex
,
findIndices
,
partition
)
import
Data.Maybe
(
mapMaybe
)
import
Language.SystemVerilog.AST
import
Language.SystemVerilog.Parser.Tokens
(
Position
(
..
))
...
...
@@ -112,20 +111,20 @@ parseDTsAsPortDecls pieces =
propagateDirections
::
Direction
->
[
Decl
]
->
[
Decl
]
propagateDirections
dir
(
decl
@
(
Variable
_
InterfaceT
{}
_
_
_
)
:
decls
)
=
decl
:
propagateDirections
dir
decls
propagateDirections
lastDir
(
Variable
currDir
t
x
a
m
e
:
decls
)
=
propagateDirections
lastDir
(
Variable
currDir
t
x
a
e
:
decls
)
=
decl
:
propagateDirections
dir
decls
where
decl
=
Variable
dir
t
x
a
m
e
decl
=
Variable
dir
t
x
a
e
dir
=
if
currDir
==
Local
then
lastDir
else
currDir
propagateDirections
dir
(
decl
:
decls
)
=
decl
:
propagateDirections
dir
decls
propagateDirections
_
[]
=
[]
portNames
::
[
Decl
]
->
[
Identifier
]
portNames
items
=
mapMaybe
portName
items
portName
::
Decl
->
Maybe
Identifier
portName
(
Variable
_
_
ident
_
_
)
=
Just
ident
portName
CommentDecl
{}
=
Nothing
portNames
=
filter
(
not
.
null
)
.
map
portName
portName
::
Decl
->
Identifier
portName
(
Variable
_
_
ident
_
_
)
=
ident
portName
CommentDecl
{}
=
""
portName
decl
=
error
$
"unexpected non-variable port declaration: "
++
(
show
decl
)
...
...
@@ -315,12 +314,12 @@ takeLHSStep _ _ = Nothing
-- batches together separate declaration lists
type
Triplet
=
(
Identifier
,
[
Range
],
Maybe
Expr
)
type
Triplet
=
(
Identifier
,
[
Range
],
Expr
)
type
Component
=
(
Direction
,
Type
,
[
Triplet
])
finalize
::
(
Position
,
Component
)
->
[
Decl
]
finalize
(
pos
,
(
dir
,
typ
,
trips
))
=
CommentDecl
(
"Trace: "
++
show
pos
)
:
map
(
\
(
x
,
a
,
me
)
->
Variable
dir
typ
x
a
m
e
)
trips
map
(
\
(
x
,
a
,
e
)
->
Variable
dir
typ
x
a
e
)
trips
-- internal; entrypoint of the critical portion of our parser
...
...
@@ -354,11 +353,11 @@ takeTrips l0 force =
then
(
[]
,
l0
)
else
(
trip
:
trips
,
l5
)
where
(
x
,
l1
)
=
takeIdent
l0
(
a
,
l2
)
=
takeRanges
l1
(
m
e
,
l3
)
=
takeAsgn
l2
(
_
,
l4
)
=
takeComma
l3
trip
=
(
x
,
a
,
m
e
)
(
x
,
l1
)
=
takeIdent
l0
(
a
,
l2
)
=
takeRanges
l1
(
e
,
l3
)
=
takeAsgn
l2
(
_
,
l4
)
=
takeComma
l3
trip
=
(
x
,
a
,
e
)
(
trips
,
l5
)
=
takeTrips
l4
False
tripLookahead
::
[
DeclToken
]
->
Bool
...
...
@@ -369,7 +368,7 @@ tripLookahead l0 =
False
-- if the identifier is the last token, or if it assigned a value, then we
-- know we must have a valid triplet ahead
else
if
null
l1
||
asgn
/=
N
othing
then
else
if
null
l1
||
asgn
/=
N
il
then
True
-- if there is an ident followed by some number of ranges, and that's it,
-- then there is a trailing declaration of an array ahead
...
...
@@ -442,12 +441,12 @@ takeRanges (token : tokens) =
-- both for standard declarations and in `parseDTsAsDeclOrStmt`, where we're
-- checking for an assignment statement. The other entry points disallow
-- `AsgnOpNonBlocking`, so this doesn't liberalize the parser.
takeAsgn
::
[
DeclToken
]
->
(
Maybe
Expr
,
[
DeclToken
])
takeAsgn
::
[
DeclToken
]
->
(
Expr
,
[
DeclToken
])
takeAsgn
(
DTAsgn
_
op
Nothing
e
:
rest
)
=
if
op
==
AsgnOpEq
||
op
==
AsgnOpNonBlocking
then
(
Just
e
,
rest
)
else
(
N
othing
,
rest
)
takeAsgn
rest
=
(
N
othing
,
rest
)
then
(
e
,
rest
)
else
(
N
il
,
rest
)
takeAsgn
rest
=
(
N
il
,
rest
)
takeComma
::
[
DeclToken
]
->
(
Bool
,
[
DeclToken
])
takeComma
[]
=
(
False
,
[]
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment