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