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
30acc3e3
Commit
30acc3e3
authored
Aug 12, 2021
by
Zachary Snow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fix spacing of as-patterns for future GHC upgrade
parent
536eba46
Show whitespace changes
Inline
Side-by-side
Showing
27 changed files
with
103 additions
and
103 deletions
+103
-103
src/Convert/BlockDecl.hs
+1
-1
src/Convert/DimensionQuery.hs
+2
-2
src/Convert/EmptyArgs.hs
+1
-1
src/Convert/ExprUtils.hs
+12
-12
src/Convert/FuncRoutine.hs
+1
-1
src/Convert/HierConst.hs
+3
-3
src/Convert/ImplicitNet.hs
+4
-4
src/Convert/Interface.hs
+6
-6
src/Convert/Jump.hs
+1
-1
src/Convert/KWArgs.hs
+1
-1
src/Convert/MultiplePacked.hs
+8
-8
src/Convert/Package.hs
+7
-7
src/Convert/ParamNoDefault.hs
+1
-1
src/Convert/ParamType.hs
+8
-8
src/Convert/Scoper.hs
+1
-1
src/Convert/Simplify.hs
+1
-1
src/Convert/Stream.hs
+2
-2
src/Convert/StringParam.hs
+2
-2
src/Convert/Struct.hs
+5
-5
src/Convert/TypeOf.hs
+6
-6
src/Convert/UnbasedUnsized.hs
+2
-2
src/Convert/UnnamedGenBlock.hs
+6
-6
src/Language/SystemVerilog/AST/Expr.hs
+8
-8
src/Language/SystemVerilog/AST/Number.hs
+2
-2
src/Language/SystemVerilog/AST/Stmt.hs
+4
-4
src/Language/SystemVerilog/Parser/Parse.y
+4
-4
src/Language/SystemVerilog/Parser/ParseDecl.hs
+4
-4
No files found.
src/Convert/BlockDecl.hs
View file @
30acc3e3
...
@@ -42,7 +42,7 @@ convertStmt (Block Seq name decls stmts) =
...
@@ -42,7 +42,7 @@ 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
(
decl
@
(
Variable
_
_
_
_
Nil
)
)
=
splitDecl
decl
@
(
Variable
_
_
_
_
Nil
)
=
(
decl
,
Nothing
)
(
decl
,
Nothing
)
splitDecl
(
Variable
d
t
ident
a
e
)
=
splitDecl
(
Variable
d
t
ident
a
e
)
=
(
Variable
d
t
ident
a
Nil
,
Just
(
LHSIdent
ident
,
e
))
(
Variable
d
t
ident
a
Nil
,
Just
(
LHSIdent
ident
,
e
))
...
...
src/Convert/DimensionQuery.hs
View file @
30acc3e3
...
@@ -56,12 +56,12 @@ convertExpr (DimsFn fn (Right e)) =
...
@@ -56,12 +56,12 @@ convertExpr (DimsFn fn (Right e)) =
DimsFn
fn
$
Left
$
TypeOf
e
DimsFn
fn
$
Left
$
TypeOf
e
convertExpr
(
DimFn
fn
(
Right
e
)
d
)
=
convertExpr
(
DimFn
fn
(
Right
e
)
d
)
=
DimFn
fn
(
Left
$
TypeOf
e
)
d
DimFn
fn
(
Left
$
TypeOf
e
)
d
convertExpr
(
orig
@
(
DimsFn
FnUnpackedDimensions
(
Left
t
)
))
=
convertExpr
orig
@
(
DimsFn
FnUnpackedDimensions
(
Left
t
))
=
case
t
of
case
t
of
UnpackedType
_
rs
->
RawNum
$
fromIntegral
$
length
rs
UnpackedType
_
rs
->
RawNum
$
fromIntegral
$
length
rs
TypeOf
{}
->
orig
TypeOf
{}
->
orig
_
->
RawNum
0
_
->
RawNum
0
convertExpr
(
orig
@
(
DimsFn
FnDimensions
(
Left
t
)
))
=
convertExpr
orig
@
(
DimsFn
FnDimensions
(
Left
t
))
=
case
t
of
case
t
of
IntegerAtom
{}
->
RawNum
1
IntegerAtom
{}
->
RawNum
1
Alias
{}
->
orig
Alias
{}
->
orig
...
...
src/Convert/EmptyArgs.hs
View file @
30acc3e3
...
@@ -20,7 +20,7 @@ convert :: [AST] -> [AST]
...
@@ -20,7 +20,7 @@ convert :: [AST] -> [AST]
convert
=
map
$
traverseDescriptions
convertDescription
convert
=
map
$
traverseDescriptions
convertDescription
convertDescription
::
Description
->
Description
convertDescription
::
Description
->
Description
convertDescription
(
description
@
Part
{})
=
convertDescription
description
@
Part
{}
=
traverseModuleItems
traverseModuleItems
(
traverseExprs
$
traverseNestedExprs
$
convertExpr
functions
)
(
traverseExprs
$
traverseNestedExprs
$
convertExpr
functions
)
description'
description'
...
...
src/Convert/ExprUtils.hs
View file @
30acc3e3
...
@@ -44,9 +44,9 @@ simplifyStep (Concat [Number (Decimal size _ value)]) =
...
@@ -44,9 +44,9 @@ simplifyStep (Concat [Number (Decimal size _ value)]) =
Number
$
Decimal
size
False
value
Number
$
Decimal
size
False
value
simplifyStep
(
Concat
[
Number
(
Based
size
_
base
value
kinds
)])
=
simplifyStep
(
Concat
[
Number
(
Based
size
_
base
value
kinds
)])
=
Number
$
Based
size
False
base
value
kinds
Number
$
Based
size
False
base
value
kinds
simplifyStep
(
Concat
[
e
@
Stream
{}])
=
e
simplifyStep
(
Concat
[
e
@
Stream
{}])
=
e
simplifyStep
(
Concat
[
e
@
Concat
{}])
=
e
simplifyStep
(
Concat
[
e
@
Concat
{}])
=
e
simplifyStep
(
Concat
[
e
@
Repeat
{}])
=
e
simplifyStep
(
Concat
[
e
@
Repeat
{}])
=
e
simplifyStep
(
Concat
es
)
=
Concat
$
filter
(
/=
Concat
[]
)
es
simplifyStep
(
Concat
es
)
=
Concat
$
filter
(
/=
Concat
[]
)
es
simplifyStep
(
Repeat
(
Dec
0
)
_
)
=
Concat
[]
simplifyStep
(
Repeat
(
Dec
0
)
_
)
=
Concat
[]
simplifyStep
(
Repeat
(
Dec
1
)
es
)
=
Concat
es
simplifyStep
(
Repeat
(
Dec
1
)
es
)
=
Concat
es
...
@@ -91,23 +91,23 @@ simplifyBinOp Add (UniOp UniSub e1) e2 = BinOp Sub e2 e1
...
@@ -91,23 +91,23 @@ simplifyBinOp Add (UniOp UniSub e1) e2 = BinOp Sub e2 e1
simplifyBinOp
Sub
e1
(
UniOp
UniSub
e2
)
=
BinOp
Add
e1
e2
simplifyBinOp
Sub
e1
(
UniOp
UniSub
e2
)
=
BinOp
Add
e1
e2
simplifyBinOp
Sub
(
UniOp
UniSub
e1
)
e2
=
UniOp
UniSub
$
BinOp
Add
e1
e2
simplifyBinOp
Sub
(
UniOp
UniSub
e1
)
e2
=
UniOp
UniSub
$
BinOp
Add
e1
e2
simplifyBinOp
Add
(
BinOp
Add
e
(
n1
@
Number
{}))
(
n2
@
Number
{})
=
simplifyBinOp
Add
(
BinOp
Add
e
n1
@
Number
{})
n2
@
Number
{}
=
BinOp
Add
e
(
BinOp
Add
n1
n2
)
BinOp
Add
e
(
BinOp
Add
n1
n2
)
simplifyBinOp
Sub
(
n1
@
Number
{})
(
BinOp
Sub
(
n2
@
Number
{})
e
)
=
simplifyBinOp
Sub
n1
@
Number
{}
(
BinOp
Sub
n2
@
Number
{}
e
)
=
BinOp
Add
(
BinOp
Sub
n1
n2
)
e
BinOp
Add
(
BinOp
Sub
n1
n2
)
e
simplifyBinOp
Sub
(
n1
@
Number
{})
(
BinOp
Sub
e
(
n2
@
Number
{})
)
=
simplifyBinOp
Sub
n1
@
Number
{}
(
BinOp
Sub
e
n2
@
Number
{}
)
=
BinOp
Sub
(
BinOp
Add
n1
n2
)
e
BinOp
Sub
(
BinOp
Add
n1
n2
)
e
simplifyBinOp
Sub
(
BinOp
Add
e
(
n1
@
Number
{}))
(
n2
@
Number
{})
=
simplifyBinOp
Sub
(
BinOp
Add
e
n1
@
Number
{})
n2
@
Number
{}
=
BinOp
Add
e
(
BinOp
Sub
n1
n2
)
BinOp
Add
e
(
BinOp
Sub
n1
n2
)
simplifyBinOp
Add
(
n1
@
Number
{})
(
BinOp
Add
(
n2
@
Number
{})
e
)
=
simplifyBinOp
Add
n1
@
Number
{}
(
BinOp
Add
n2
@
Number
{}
e
)
=
BinOp
Add
(
BinOp
Add
n1
n2
)
e
BinOp
Add
(
BinOp
Add
n1
n2
)
e
simplifyBinOp
Add
(
n1
@
Number
{})
(
BinOp
Sub
e
(
n2
@
Number
{})
)
=
simplifyBinOp
Add
n1
@
Number
{}
(
BinOp
Sub
e
n2
@
Number
{}
)
=
BinOp
Add
e
(
BinOp
Sub
n1
n2
)
BinOp
Add
e
(
BinOp
Sub
n1
n2
)
simplifyBinOp
Sub
(
BinOp
Sub
e
(
n1
@
Number
{}))
(
n2
@
Number
{})
=
simplifyBinOp
Sub
(
BinOp
Sub
e
n1
@
Number
{})
n2
@
Number
{}
=
BinOp
Sub
e
(
BinOp
Add
n1
n2
)
BinOp
Sub
e
(
BinOp
Add
n1
n2
)
simplifyBinOp
Add
(
BinOp
Sub
e
(
n1
@
Number
{}))
(
n2
@
Number
{})
=
simplifyBinOp
Add
(
BinOp
Sub
e
n1
@
Number
{})
n2
@
Number
{}
=
BinOp
Sub
e
(
BinOp
Sub
n1
n2
)
BinOp
Sub
e
(
BinOp
Sub
n1
n2
)
simplifyBinOp
Add
(
BinOp
Sub
(
n1
@
Number
{})
e
)
(
n2
@
Number
{})
=
simplifyBinOp
Add
(
BinOp
Sub
n1
@
Number
{}
e
)
n2
@
Number
{}
=
BinOp
Sub
(
BinOp
Add
n1
n2
)
e
BinOp
Sub
(
BinOp
Add
n1
n2
)
e
simplifyBinOp
Ge
(
BinOp
Sub
e
(
Dec
1
))
(
Dec
0
)
=
BinOp
Ge
e
(
toDec
1
)
simplifyBinOp
Ge
(
BinOp
Sub
e
(
Dec
1
))
(
Dec
0
)
=
BinOp
Ge
e
(
toDec
1
)
...
...
src/Convert/FuncRoutine.hs
View file @
30acc3e3
...
@@ -22,7 +22,7 @@ convert :: [AST] -> [AST]
...
@@ -22,7 +22,7 @@ convert :: [AST] -> [AST]
convert
=
map
$
traverseDescriptions
convertDescription
convert
=
map
$
traverseDescriptions
convertDescription
convertDescription
::
Description
->
Description
convertDescription
::
Description
->
Description
convertDescription
(
description
@
Part
{})
=
convertDescription
description
@
Part
{}
=
traverseModuleItems
traverseModuleItem
description
traverseModuleItems
traverseModuleItem
description
where
where
traverseModuleItem
=
traverseModuleItem
=
...
...
src/Convert/HierConst.hs
View file @
30acc3e3
...
@@ -48,7 +48,7 @@ convertDescription (Part attrs extern kw lifetime name ports items) =
...
@@ -48,7 +48,7 @@ convertDescription (Part attrs extern kw lifetime name ports items) =
convertDescription
description
=
description
convertDescription
description
=
description
expandParam
::
[
Identifier
]
->
ModuleItem
->
ModuleItem
expandParam
::
[
Identifier
]
->
ModuleItem
->
ModuleItem
expandParam
shadowed
(
MIPackageItem
(
Decl
(
param
@
(
Param
Parameter
_
x
_
)
)))
=
expandParam
shadowed
(
MIPackageItem
(
Decl
param
@
(
Param
Parameter
_
x
_
)))
=
if
elem
x
shadowed
if
elem
x
shadowed
then
Generate
$
map
(
GenModuleItem
.
wrap
)
[
param
,
extra
]
then
Generate
$
map
(
GenModuleItem
.
wrap
)
[
param
,
extra
]
else
wrap
param
else
wrap
param
...
@@ -82,14 +82,14 @@ traverseDeclM decl = do
...
@@ -82,14 +82,14 @@ traverseDeclM decl = do
-- substitute hierarchical references to constants
-- substitute hierarchical references to constants
traverseExprM
::
Expr
->
ST
Expr
traverseExprM
::
Expr
->
ST
Expr
traverseExprM
(
expr
@
(
Dot
_
x
)
)
=
do
traverseExprM
expr
@
(
Dot
_
x
)
=
do
expr'
<-
traverseSinglyNestedExprsM
traverseExprM
expr
expr'
<-
traverseSinglyNestedExprsM
traverseExprM
expr
detailsE
<-
lookupElemM
expr'
detailsE
<-
lookupElemM
expr'
detailsX
<-
lookupElemM
x
detailsX
<-
lookupElemM
x
case
(
detailsE
,
detailsX
)
of
case
(
detailsE
,
detailsX
)
of
(
Just
([
_
,
_
],
_
,
Left
{}),
Just
([
_
,
_
],
_
,
Left
{}))
->
(
Just
([
_
,
_
],
_
,
Left
{}),
Just
([
_
,
_
],
_
,
Left
{}))
->
return
$
Ident
x
return
$
Ident
x
(
Just
(
accesses
@
[
Access
_
Nil
,
_
],
_
,
Left
False
),
_
)
->
do
(
Just
(
accesses
@
[
Access
_
Nil
,
_
],
_
,
Left
False
),
_
)
->
do
details
<-
lookupElemM
$
prefix
x
details
<-
lookupElemM
$
prefix
x
when
(
details
==
Nothing
)
$
when
(
details
==
Nothing
)
$
insertElem
accesses
(
Left
True
)
insertElem
accesses
(
Left
True
)
...
...
src/Convert/ImplicitNet.hs
View file @
30acc3e3
...
@@ -49,20 +49,20 @@ traverseDeclM decl = do
...
@@ -49,20 +49,20 @@ traverseDeclM decl = do
traverseModuleItemM
::
DefaultNetType
->
ModuleItem
->
Scoper
()
ModuleItem
traverseModuleItemM
::
DefaultNetType
->
ModuleItem
->
Scoper
()
ModuleItem
traverseModuleItemM
_
(
Genvar
x
)
=
traverseModuleItemM
_
(
Genvar
x
)
=
insertElem
x
()
>>
return
(
Genvar
x
)
insertElem
x
()
>>
return
(
Genvar
x
)
traverseModuleItemM
defaultNetType
(
orig
@
(
Assign
_
x
_
)
)
=
do
traverseModuleItemM
defaultNetType
orig
@
(
Assign
_
x
_
)
=
do
needsLHS
defaultNetType
x
needsLHS
defaultNetType
x
return
orig
return
orig
traverseModuleItemM
defaultNetType
(
orig
@
(
NInputGate
_
_
x
lhs
exprs
)
)
=
do
traverseModuleItemM
defaultNetType
orig
@
(
NInputGate
_
_
x
lhs
exprs
)
=
do
insertElem
x
()
insertElem
x
()
needsLHS
defaultNetType
lhs
needsLHS
defaultNetType
lhs
_
<-
mapM
(
needsExpr
defaultNetType
)
exprs
_
<-
mapM
(
needsExpr
defaultNetType
)
exprs
return
orig
return
orig
traverseModuleItemM
defaultNetType
(
orig
@
(
NOutputGate
_
_
x
lhss
expr
)
)
=
do
traverseModuleItemM
defaultNetType
orig
@
(
NOutputGate
_
_
x
lhss
expr
)
=
do
insertElem
x
()
insertElem
x
()
_
<-
mapM
(
needsLHS
defaultNetType
)
lhss
_
<-
mapM
(
needsLHS
defaultNetType
)
lhss
needsExpr
defaultNetType
expr
needsExpr
defaultNetType
expr
return
orig
return
orig
traverseModuleItemM
defaultNetType
(
orig
@
(
Instance
_
_
x
_
ports
)
)
=
do
traverseModuleItemM
defaultNetType
orig
@
(
Instance
_
_
x
_
ports
)
=
do
insertElem
x
()
insertElem
x
()
_
<-
mapM
(
needsExpr
defaultNetType
.
snd
)
ports
_
<-
mapM
(
needsExpr
defaultNetType
.
snd
)
ports
return
orig
return
orig
...
...
src/Convert/Interface.hs
View file @
30acc3e3
...
@@ -88,7 +88,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
...
@@ -88,7 +88,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
traverseModuleItemM
::
ModuleItem
->
Scoper
[
ModportDecl
]
ModuleItem
traverseModuleItemM
::
ModuleItem
->
Scoper
[
ModportDecl
]
ModuleItem
traverseModuleItemM
(
Modport
modportName
modportDecls
)
=
traverseModuleItemM
(
Modport
modportName
modportDecls
)
=
insertElem
modportName
modportDecls
>>
return
(
Generate
[]
)
insertElem
modportName
modportDecls
>>
return
(
Generate
[]
)
traverseModuleItemM
(
instanceItem
@
Instance
{})
=
do
traverseModuleItemM
instanceItem
@
Instance
{}
=
do
modports
<-
embedScopes
(
\
l
()
->
l
)
()
modports
<-
embedScopes
(
\
l
()
->
l
)
()
if
isNothing
maybePartInfo
then
if
isNothing
maybePartInfo
then
return
instanceItem
return
instanceItem
...
@@ -129,7 +129,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
...
@@ -129,7 +129,7 @@ convertDescription parts (Part attrs extern Module lifetime name ports items) =
-- add explicit slices for bindings of entire modport instance arrays
-- add explicit slices for bindings of entire modport instance arrays
addImpliedSlice
::
Scopes
[
ModportDecl
]
->
Expr
->
Expr
addImpliedSlice
::
Scopes
[
ModportDecl
]
->
Expr
->
Expr
addImpliedSlice
modports
(
orig
@
(
Dot
expr
modportName
)
)
=
addImpliedSlice
modports
orig
@
(
Dot
expr
modportName
)
=
case
lookupIntfElem
modports
(
InstArrKey
expr
)
of
case
lookupIntfElem
modports
(
InstArrKey
expr
)
of
Just
(
_
,
_
,
InstArrVal
l
r
)
->
Just
(
_
,
_
,
InstArrVal
l
r
)
->
Dot
(
Range
expr
NonIndexed
(
l
,
r
))
modportName
Dot
(
Range
expr
NonIndexed
(
l
,
r
))
modportName
...
@@ -485,7 +485,7 @@ inlineInstance global ranges modportBindings items partName
...
@@ -485,7 +485,7 @@ inlineInstance global ranges modportBindings items partName
case
lookup
(
Bit
expr
Tag
)
exprReplacements
of
case
lookup
(
Bit
expr
Tag
)
exprReplacements
of
Just
resolved
->
replaceArrTag
(
replaceExpr'
local
elt
)
resolved
Just
resolved
->
replaceArrTag
(
replaceExpr'
local
elt
)
resolved
Nothing
->
Bit
(
replaceExpr'
local
expr
)
(
replaceExpr'
local
elt
)
Nothing
->
Bit
(
replaceExpr'
local
expr
)
(
replaceExpr'
local
elt
)
replaceExpr'
local
(
expr
@
(
Dot
Ident
{}
_
)
)
=
replaceExpr'
local
expr
@
(
Dot
Ident
{}
_
)
=
case
lookup
expr
exprReplacements
of
case
lookup
expr
exprReplacements
of
Just
expr'
->
expr'
Just
expr'
->
expr'
Nothing
->
checkExprResolution
local
expr
$
Nothing
->
checkExprResolution
local
expr
$
...
@@ -555,7 +555,7 @@ inlineInstance global ranges modportBindings items partName
...
@@ -555,7 +555,7 @@ inlineInstance global ranges modportBindings items partName
Implicit
Unspecified
rs
->
Implicit
Unspecified
rs
->
IntegerVector
TLogic
Unspecified
rs
IntegerVector
TLogic
Unspecified
rs
_
->
t
_
->
t
removeDeclDir
decl
@
Net
{}
=
removeDeclDir
decl
@
Net
{}
=
traverseNetAsVar
removeDeclDir
decl
traverseNetAsVar
removeDeclDir
decl
removeDeclDir
other
=
other
removeDeclDir
other
=
other
...
@@ -620,7 +620,7 @@ inlineInstance global ranges modportBindings items partName
...
@@ -620,7 +620,7 @@ inlineInstance global ranges modportBindings items partName
collectDeclDir
(
Variable
dir
_
ident
_
_
)
=
collectDeclDir
(
Variable
dir
_
ident
_
_
)
=
when
(
dir
/=
Local
)
$
when
(
dir
/=
Local
)
$
tell
$
Map
.
singleton
ident
dir
tell
$
Map
.
singleton
ident
dir
collectDeclDir
net
@
Net
{}
=
collectDeclDir
net
@
Net
{}
=
collectNetAsVarM
collectDeclDir
net
collectNetAsVarM
collectDeclDir
net
collectDeclDir
_
=
return
()
collectDeclDir
_
=
return
()
findDeclDir
::
Identifier
->
Direction
findDeclDir
::
Identifier
->
Direction
...
@@ -641,7 +641,7 @@ inlineInstance global ranges modportBindings items partName
...
@@ -641,7 +641,7 @@ inlineInstance global ranges modportBindings items partName
loopVar
=
"_arr_"
++
key
loopVar
=
"_arr_"
++
key
isArray
=
not
$
null
ranges
isArray
=
not
$
null
ranges
[
arrayRange
@
(
arrayLeft
,
arrayRight
)]
=
ranges
[
arrayRange
@
(
arrayLeft
,
arrayRight
)]
=
ranges
-- wrap the given item in a generate loop if necessary
-- wrap the given item in a generate loop if necessary
wrapInstance
::
Identifier
->
[
ModuleItem
]
->
ModuleItem
wrapInstance
::
Identifier
->
[
ModuleItem
]
->
ModuleItem
...
...
src/Convert/Jump.hs
View file @
30acc3e3
...
@@ -105,7 +105,7 @@ addJumpStateDeclStmt stmt =
...
@@ -105,7 +105,7 @@ addJumpStateDeclStmt stmt =
where
(
decls
,
[
stmt'
])
=
addJumpStateDeclTF
[]
[
stmt
]
where
(
decls
,
[
stmt'
])
=
addJumpStateDeclTF
[]
[
stmt
]
removeJumpState
::
Stmt
->
Stmt
removeJumpState
::
Stmt
->
Stmt
removeJumpState
(
orig
@
(
Asgn
_
_
(
LHSIdent
ident
)
_
)
)
=
removeJumpState
orig
@
(
Asgn
_
_
(
LHSIdent
ident
)
_
)
=
if
ident
==
jumpState
if
ident
==
jumpState
then
Null
then
Null
else
orig
else
orig
...
...
src/Convert/KWArgs.hs
View file @
30acc3e3
...
@@ -55,7 +55,7 @@ convertStmt tfs (Subroutine expr args) =
...
@@ -55,7 +55,7 @@ convertStmt tfs (Subroutine expr args) =
convertStmt
_
other
=
other
convertStmt
_
other
=
other
convertInvoke
::
TFs
->
(
Expr
->
Args
->
a
)
->
Expr
->
Args
->
a
convertInvoke
::
TFs
->
(
Expr
->
Args
->
a
)
->
Expr
->
Args
->
a
convertInvoke
tfs
constructor
(
Ident
func
)
(
Args
pnArgs
(
kwArgs
@
(
_
:
_
)
))
=
convertInvoke
tfs
constructor
(
Ident
func
)
(
Args
pnArgs
kwArgs
@
(
_
:
_
))
=
case
tfs
Map
.!?
func
of
case
tfs
Map
.!?
func
of
Nothing
->
constructor
(
Ident
func
)
(
Args
pnArgs
kwArgs
)
Nothing
->
constructor
(
Ident
func
)
(
Args
pnArgs
kwArgs
)
Just
ordered
->
constructor
(
Ident
func
)
(
Args
args
[]
)
Just
ordered
->
constructor
(
Ident
func
)
(
Args
args
[]
)
...
...
src/Convert/MultiplePacked.hs
View file @
30acc3e3
...
@@ -42,7 +42,7 @@ convert :: [AST] -> [AST]
...
@@ -42,7 +42,7 @@ convert :: [AST] -> [AST]
convert
=
map
$
traverseDescriptions
convertDescription
convert
=
map
$
traverseDescriptions
convertDescription
convertDescription
::
Description
->
Description
convertDescription
::
Description
->
Description
convertDescription
(
description
@
(
Part
_
_
Module
_
_
_
_
)
)
=
convertDescription
description
@
(
Part
_
_
Module
_
_
_
_
)
=
partScoper
traverseDeclM
traverseModuleItemM
traverseGenItemM
traverseStmtM
partScoper
traverseDeclM
traverseModuleItemM
traverseGenItemM
traverseStmtM
description
description
convertDescription
other
=
other
convertDescription
other
=
other
...
@@ -52,7 +52,7 @@ traverseDeclM :: Decl -> Scoper TypeInfo Decl
...
@@ -52,7 +52,7 @@ traverseDeclM :: Decl -> Scoper TypeInfo Decl
traverseDeclM
(
Variable
dir
t
ident
a
e
)
=
do
traverseDeclM
(
Variable
dir
t
ident
a
e
)
=
do
t'
<-
traverseTypeM
t
a
ident
t'
<-
traverseTypeM
t
a
ident
traverseDeclExprsM
traverseExprM
$
Variable
dir
t'
ident
a
e
traverseDeclExprsM
traverseExprM
$
Variable
dir
t'
ident
a
e
traverseDeclM
net
@
Net
{}
=
traverseDeclM
net
@
Net
{}
=
traverseNetAsVarM
traverseDeclM
net
traverseNetAsVarM
traverseDeclM
net
traverseDeclM
(
Param
s
t
ident
e
)
=
do
traverseDeclM
(
Param
s
t
ident
e
)
=
do
t'
<-
traverseTypeM
t
[]
ident
t'
<-
traverseTypeM
t
[]
ident
...
@@ -233,7 +233,7 @@ convertExpr scopes =
...
@@ -233,7 +233,7 @@ convertExpr scopes =
if
head
x
==
tag
if
head
x
==
tag
then
Ident
$
tail
x
then
Ident
$
tail
x
else
Ident
x
else
Ident
x
rewriteExpr
(
orig
@
(
Bit
(
Bit
expr
idxInner
)
idxOuter
)
)
=
rewriteExpr
orig
@
(
Bit
(
Bit
expr
idxInner
)
idxOuter
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
Bit
expr'
idx'
then
Bit
expr'
idx'
else
rewriteExprLowPrec
orig
else
rewriteExprLowPrec
orig
...
@@ -244,7 +244,7 @@ convertExpr scopes =
...
@@ -244,7 +244,7 @@ convertExpr scopes =
idxOuter'
=
orientIdx
dimOuter
idxOuter
idxOuter'
=
orientIdx
dimOuter
idxOuter
base
=
BinOp
Mul
idxInner'
(
rangeSize
dimOuter
)
base
=
BinOp
Mul
idxInner'
(
rangeSize
dimOuter
)
idx'
=
simplify
$
BinOp
Add
base
idxOuter'
idx'
=
simplify
$
BinOp
Add
base
idxOuter'
rewriteExpr
(
orig
@
(
Range
(
Bit
expr
idxInner
)
NonIndexed
rangeOuter
)
)
=
rewriteExpr
orig
@
(
Range
(
Bit
expr
idxInner
)
NonIndexed
rangeOuter
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
rewriteExpr
$
Range
exprOuter
IndexedMinus
range
then
rewriteExpr
$
Range
exprOuter
IndexedMinus
range
else
rewriteExprLowPrec
orig
else
rewriteExprLowPrec
orig
...
@@ -256,7 +256,7 @@ convertExpr scopes =
...
@@ -256,7 +256,7 @@ convertExpr scopes =
base
=
endianCondExpr
rangeOuter
baseDec
baseInc
base
=
endianCondExpr
rangeOuter
baseDec
baseInc
len
=
rangeSize
rangeOuter
len
=
rangeSize
rangeOuter
range
=
(
base
,
len
)
range
=
(
base
,
len
)
rewriteExpr
(
orig
@
(
Range
(
Bit
expr
idxInner
)
modeOuter
rangeOuter
)
)
=
rewriteExpr
orig
@
(
Range
(
Bit
expr
idxInner
)
modeOuter
rangeOuter
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
Range
expr'
modeOuter
range'
then
Range
expr'
modeOuter
range'
else
rewriteExprLowPrec
orig
else
rewriteExprLowPrec
orig
...
@@ -279,7 +279,7 @@ convertExpr scopes =
...
@@ -279,7 +279,7 @@ convertExpr scopes =
rewriteExprLowPrec
other
rewriteExprLowPrec
other
rewriteExprLowPrec
::
Expr
->
Expr
rewriteExprLowPrec
::
Expr
->
Expr
rewriteExprLowPrec
(
orig
@
(
Bit
expr
idx
)
)
=
rewriteExprLowPrec
orig
@
(
Bit
expr
idx
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
Range
expr'
mode'
range'
then
Range
expr'
mode'
range'
else
orig
else
orig
...
@@ -291,7 +291,7 @@ convertExpr scopes =
...
@@ -291,7 +291,7 @@ convertExpr scopes =
len
=
rangeSize
dimOuter
len
=
rangeSize
dimOuter
base
=
BinOp
Add
(
endianCondExpr
dimOuter
(
snd
dimOuter
)
(
fst
dimOuter
))
(
BinOp
Mul
idx'
len
)
base
=
BinOp
Add
(
endianCondExpr
dimOuter
(
snd
dimOuter
)
(
fst
dimOuter
))
(
BinOp
Mul
idx'
len
)
range'
=
(
simplify
base
,
simplify
len
)
range'
=
(
simplify
base
,
simplify
len
)
rewriteExprLowPrec
(
orig
@
(
Range
expr
NonIndexed
range
)
)
=
rewriteExprLowPrec
orig
@
(
Range
expr
NonIndexed
range
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
rewriteExpr
$
Range
expr
IndexedMinus
range'
then
rewriteExpr
$
Range
expr
IndexedMinus
range'
else
orig
else
orig
...
@@ -302,7 +302,7 @@ convertExpr scopes =
...
@@ -302,7 +302,7 @@ convertExpr scopes =
base
=
endianCondExpr
range
baseDec
baseInc
base
=
endianCondExpr
range
baseDec
baseInc
len
=
rangeSize
range
len
=
rangeSize
range
range'
=
(
base
,
len
)
range'
=
(
base
,
len
)
rewriteExprLowPrec
(
orig
@
(
Range
expr
mode
range
)
)
=
rewriteExprLowPrec
orig
@
(
Range
expr
mode
range
)
=
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
if
isJust
maybeDims
&&
expr
==
rewriteExpr
expr
then
Range
expr'
mode'
range'
then
Range
expr'
mode'
range'
else
orig
else
orig
...
...
src/Convert/Package.hs
View file @
30acc3e3
...
@@ -87,8 +87,8 @@ collectPackageM (Class _ name decls items) =
...
@@ -87,8 +87,8 @@ collectPackageM (Class _ name decls items) =
tell
(
Map
.
empty
,
Map
.
singleton
name
(
decls
,
map
unpackClassItem
items
),
[]
)
tell
(
Map
.
empty
,
Map
.
singleton
name
(
decls
,
map
unpackClassItem
items
),
[]
)
where
where
unpackClassItem
::
ClassItem
->
PackageItem
unpackClassItem
::
ClassItem
->
PackageItem
unpackClassItem
(
item
@
(
_
,
Task
{})
)
=
checkTF
item
unpackClassItem
item
@
(
_
,
Task
{}
)
=
checkTF
item
unpackClassItem
(
item
@
(
_
,
Function
{})
)
=
checkTF
item
unpackClassItem
item
@
(
_
,
Function
{}
)
=
checkTF
item
unpackClassItem
item
=
checkNonTF
item
unpackClassItem
item
=
checkNonTF
item
checkTF
::
ClassItem
->
PackageItem
checkTF
::
ClassItem
->
PackageItem
checkTF
(
QStatic
,
item
)
=
item
checkTF
(
QStatic
,
item
)
=
item
...
@@ -242,7 +242,7 @@ processItems topName packageName moduleItems = do
...
@@ -242,7 +242,7 @@ processItems topName packageName moduleItems = do
-- produces partial mappings of exported identifiers, while also
-- produces partial mappings of exported identifiers, while also
-- checking the validity of the exports
-- checking the validity of the exports
resolveExportMI
::
IdentStateMap
->
ModuleItem
->
PackagesState
IdentStateMap
resolveExportMI
::
IdentStateMap
->
ModuleItem
->
PackagesState
IdentStateMap
resolveExportMI
mapping
(
MIPackageItem
(
item
@
(
Export
pkg
ident
)
))
=
resolveExportMI
mapping
(
MIPackageItem
item
@
(
Export
pkg
ident
))
=
if
null
packageName
if
null
packageName
then
error
$
"invalid "
++
(
init
$
show
item
)
then
error
$
"invalid "
++
(
init
$
show
item
)
++
" outside of package"
++
" outside of package"
...
@@ -304,12 +304,12 @@ processItems topName packageName moduleItems = do
...
@@ -304,12 +304,12 @@ processItems topName packageName moduleItems = do
++
intercalate
", "
rootPkgs
++
intercalate
", "
rootPkgs
traversePackageItemM
::
PackageItem
->
Scope
PackageItem
traversePackageItemM
::
PackageItem
->
Scope
PackageItem
traversePackageItemM
(
orig
@
(
Import
pkg
ident
)
)
=
do
traversePackageItemM
orig
@
(
Import
pkg
ident
)
=
do
if
null
ident
if
null
ident
then
wildcardImports
pkg
then
wildcardImports
pkg
else
explicitImport
pkg
ident
else
explicitImport
pkg
ident
return
$
Decl
$
CommentDecl
$
"removed "
++
show
orig
return
$
Decl
$
CommentDecl
$
"removed "
++
show
orig
traversePackageItemM
(
orig
@
(
Export
pkg
ident
)
)
=
do
traversePackageItemM
orig
@
(
Export
pkg
ident
)
=
do
()
<-
when
(
not
(
null
pkg
||
null
ident
))
$
do
()
<-
when
(
not
(
null
pkg
||
null
ident
))
$
do
localName
<-
resolveIdent
ident
localName
<-
resolveIdent
ident
rootPkg
<-
lift
$
resolveRootPackage
pkg
ident
rootPkg
<-
lift
$
resolveRootPackage
pkg
ident
...
@@ -459,7 +459,7 @@ findPackage packageName = do
...
@@ -459,7 +459,7 @@ findPackage packageName = do
assertMsg
(
not
$
elem
packageName
stack
)
$
assertMsg
(
not
$
elem
packageName
stack
)
$
"package dependency loop: "
++
show
first
++
" depends on "
"package dependency loop: "
++
show
first
++
" depends on "
++
intercalate
", which depends on "
(
map
show
rest
)
++
intercalate
", which depends on "
(
map
show
rest
)
let
Just
(
package
@
(
exports
,
_
))
=
maybePackage
let
Just
package
@
(
exports
,
_
)
=
maybePackage
if
Map
.
null
exports
if
Map
.
null
exports
then
do
then
do
-- process and resolve this package
-- process and resolve this package
...
@@ -613,7 +613,7 @@ toRootPackage sourcePackage identState =
...
@@ -613,7 +613,7 @@ toRootPackage sourcePackage identState =
-- nests packages items missing from modules
-- nests packages items missing from modules
convertDescription
::
PIs
->
Description
->
Description
convertDescription
::
PIs
->
Description
->
Description
convertDescription
pis
(
orig
@
Part
{})
=
convertDescription
pis
orig
@
Part
{}
=
if
Map
.
null
pis
if
Map
.
null
pis
then
orig
then
orig
else
Part
attrs
extern
kw
lifetime
name
ports
items'
else
Part
attrs
extern
kw
lifetime
name
ports
items'
...
...
src/Convert/ParamNoDefault.hs
View file @
30acc3e3
...
@@ -65,7 +65,7 @@ traverseDeclM other = return other
...
@@ -65,7 +65,7 @@ traverseDeclM other = return other
-- check for instances missing values for parameters without defaults
-- check for instances missing values for parameters without defaults
traverseModuleItem
::
Parts
->
ModuleItem
->
ModuleItem
traverseModuleItem
::
Parts
->
ModuleItem
->
ModuleItem
traverseModuleItem
parts
(
orig
@
(
Instance
part
params
name
_
_
)
)
=
traverseModuleItem
parts
orig
@
(
Instance
part
params
name
_
_
)
=
if
maybePartInfo
==
Nothing
||
null
missingParams
if
maybePartInfo
==
Nothing
||
null
missingParams
then
orig
then
orig
else
error
$
"instance "
++
show
name
++
" of "
++
show
part
else
error
$
"instance "
++
show
name
++
" of "
++
show
part
...
...
src/Convert/ParamType.hs
View file @
30acc3e3
...
@@ -39,7 +39,7 @@ convert files =
...
@@ -39,7 +39,7 @@ convert files =
-- add type parameter instantiations
-- add type parameter instantiations
files''
=
map
(
concatMap
explodeDescription
)
files'
files''
=
map
(
concatMap
explodeDescription
)
files'
explodeDescription
::
Description
->
[
Description
]
explodeDescription
::
Description
->
[
Description
]
explodeDescription
(
part
@
(
Part
_
_
_
_
name
_
_
)
)
=
explodeDescription
part
@
(
Part
_
_
_
_
name
_
_
)
=
(
part
:
)
$
(
part
:
)
$
filter
(
not
.
alreadyExists
)
$
filter
(
not
.
alreadyExists
)
$
map
(
rewriteModule
part
)
theseInstances
map
(
rewriteModule
part
)
theseInstances
...
@@ -57,7 +57,7 @@ convert files =
...
@@ -57,7 +57,7 @@ convert files =
both
(
Map
.
fromListWith
Set
.
union
)
$
both
(
Map
.
fromListWith
Set
.
union
)
$
execWriter
$
mapM
(
mapM
collectUsageM
)
files''
execWriter
$
mapM
(
mapM
collectUsageM
)
files''
collectUsageM
::
Description
->
Writer
(
UsageMap
,
UsageMap
)
()
collectUsageM
::
Description
->
Writer
(
UsageMap
,
UsageMap
)
()
collectUsageM
(
part
@
(
Part
_
_
_
_
name
_
_
)
)
=
collectUsageM
part
@
(
Part
_
_
_
_
name
_
_
)
=
tell
$
both
makeList
$
execWriter
$
tell
$
both
makeList
$
execWriter
$
(
collectModuleItemsM
collectModuleItemM
)
part
(
collectModuleItemsM
collectModuleItemM
)
part
where
makeList
s
=
zip
(
Set
.
toList
s
)
(
repeat
$
Set
.
singleton
name
)
where
makeList
s
=
zip
(
Set
.
toList
s
)
(
repeat
$
Set
.
singleton
name
)
...
@@ -93,7 +93,7 @@ convert files =
...
@@ -93,7 +93,7 @@ convert files =
-- instantiate the type parameters if this is a used default instance
-- instantiate the type parameters if this is a used default instance
reduceTypeDefaults
::
Description
->
Description
reduceTypeDefaults
::
Description
->
Description
reduceTypeDefaults
(
part
@
(
Part
_
_
_
_
name
_
_
)
)
=
reduceTypeDefaults
part
@
(
Part
_
_
_
_
name
_
_
)
=
if
shouldntReduce
if
shouldntReduce
then
part
then
part
else
traverseModuleItems
(
traverseDecls
rewriteDecl
)
part
else
traverseModuleItems
(
traverseDecls
rewriteDecl
)
part
...
@@ -149,7 +149,7 @@ convert files =
...
@@ -149,7 +149,7 @@ convert files =
additionalParamItems
=
concatMap
makeAddedParams
$
additionalParamItems
=
concatMap
makeAddedParams
$
Map
.
toList
$
Map
.
map
snd
inst
Map
.
toList
$
Map
.
map
snd
inst
rewriteExpr
::
Expr
->
Expr
rewriteExpr
::
Expr
->
Expr
rewriteExpr
(
orig
@
(
Dot
(
Ident
x
)
y
)
)
=
rewriteExpr
orig
@
(
Dot
(
Ident
x
)
y
)
=
if
x
==
m
if
x
==
m
then
Dot
(
Ident
m'
)
y
then
Dot
(
Ident
m'
)
y
else
orig
else
orig
...
@@ -157,7 +157,7 @@ convert files =
...
@@ -157,7 +157,7 @@ convert files =
traverseExprTypes
rewriteType
$
traverseExprTypes
rewriteType
$
traverseSinglyNestedExprs
rewriteExpr
other
traverseSinglyNestedExprs
rewriteExpr
other
rewriteLHS
::
LHS
->
LHS
rewriteLHS
::
LHS
->
LHS
rewriteLHS
(
orig
@
(
LHSDot
(
LHSIdent
x
)
y
)
)
=
rewriteLHS
orig
@
(
LHSDot
(
LHSIdent
x
)
y
)
=
if
x
==
m
if
x
==
m
then
LHSDot
(
LHSIdent
m'
)
y
then
LHSDot
(
LHSIdent
m'
)
y
else
orig
else
orig
...
@@ -192,7 +192,7 @@ convert files =
...
@@ -192,7 +192,7 @@ convert files =
-- write down module parameter names and type parameters
-- write down module parameter names and type parameters
collectDescriptionM
::
Description
->
Writer
Modules
()
collectDescriptionM
::
Description
->
Writer
Modules
()
collectDescriptionM
(
part
@
(
Part
_
_
_
_
name
_
_
)
)
=
collectDescriptionM
part
@
(
Part
_
_
_
_
name
_
_
)
=
tell
$
Map
.
singleton
name
typeMap
tell
$
Map
.
singleton
name
typeMap
where
where
typeMap
=
Map
.
fromList
$
execWriter
$
typeMap
=
Map
.
fromList
$
execWriter
$
...
@@ -250,7 +250,7 @@ prepareTypeExprs instanceName paramName =
...
@@ -250,7 +250,7 @@ prepareTypeExprs instanceName paramName =
(
traverseTypeExprsM
$
traverseNestedExprsM
prepareExpr
)
(
traverseTypeExprsM
$
traverseNestedExprsM
prepareExpr
)
where
where
prepareExpr
::
Expr
->
Writer
(
IdentSet
,
DeclMap
)
Expr
prepareExpr
::
Expr
->
Writer
(
IdentSet
,
DeclMap
)
Expr
prepareExpr
(
e
@
Call
{})
=
do
prepareExpr
e
@
Call
{}
=
do
tell
(
Set
.
empty
,
Map
.
singleton
x
decl
)
tell
(
Set
.
empty
,
Map
.
singleton
x
decl
)
prepareExpr
$
Ident
x
prepareExpr
$
Ident
x
where
where
...
@@ -281,7 +281,7 @@ convertGenItemM other =
...
@@ -281,7 +281,7 @@ convertGenItemM other =
-- attempt to rewrite instantiations with type parameters
-- attempt to rewrite instantiations with type parameters
convertModuleItemM
::
ModuleItem
->
Writer
Instances
ModuleItem
convertModuleItemM
::
ModuleItem
->
Writer
Instances
ModuleItem
convertModuleItemM
(
orig
@
(
Instance
m
bindings
x
r
p
)
)
=
convertModuleItemM
orig
@
(
Instance
m
bindings
x
r
p
)
=
if
hasOnlyExprs
then
if
hasOnlyExprs
then
return
orig
return
orig
else
if
not
hasUnresolvedTypes
then
do
else
if
not
hasUnresolvedTypes
then
do
...
...
src/Convert/Scoper.hs
View file @
30acc3e3
...
@@ -276,7 +276,7 @@ directResolve mapping (Access x Nil : rest) = do
...
@@ -276,7 +276,7 @@ directResolve mapping (Access x Nil : rest) = do
Entry
_
""
subMapping
<-
Map
.
lookup
x
mapping
Entry
_
""
subMapping
<-
Map
.
lookup
x
mapping
directResolve
subMapping
rest
directResolve
subMapping
rest
directResolve
mapping
(
Access
x
e
:
rest
)
=
do
directResolve
mapping
(
Access
x
e
:
rest
)
=
do
Entry
_
(
index
@
(
_
:
_
)
)
subMapping
<-
Map
.
lookup
x
mapping
Entry
_
index
@
(
_
:
_
)
subMapping
<-
Map
.
lookup
x
mapping
(
replacements
,
element
)
<-
directResolve
subMapping
rest
(
replacements
,
element
)
<-
directResolve
subMapping
rest
let
replacements'
=
Map
.
insert
index
e
replacements
let
replacements'
=
Map
.
insert
index
e
replacements
Just
(
replacements'
,
element
)
Just
(
replacements'
,
element
)
...
...
src/Convert/Simplify.hs
View file @
30acc3e3
...
@@ -155,6 +155,6 @@ substitute scopes expr =
...
@@ -155,6 +155,6 @@ substitute scopes expr =
substituteIdent
::
Scopes
Expr
->
Expr
->
Expr
substituteIdent
::
Scopes
Expr
->
Expr
->
Expr
substituteIdent
scopes
(
Ident
x
)
=
substituteIdent
scopes
(
Ident
x
)
=
case
lookupElem
scopes
x
of
case
lookupElem
scopes
x
of
Just
(
_
,
_
,
n
@
Number
{})
->
n
Just
(
_
,
_
,
n
@
Number
{})
->
n
_
->
Ident
x
_
->
Ident
x
substituteIdent
_
other
=
other
substituteIdent
_
other
=
other
src/Convert/Stream.hs
View file @
30acc3e3
...
@@ -27,7 +27,7 @@ traverseDeclM (Variable d t x [] (Stream StreamR _ exprs)) =
...
@@ -27,7 +27,7 @@ traverseDeclM (Variable d t x [] (Stream StreamR _ exprs)) =
expr'
=
resize
exprSize
lhsSize
expr
expr'
=
resize
exprSize
lhsSize
expr
lhsSize
=
DimsFn
FnBits
$
Left
t
lhsSize
=
DimsFn
FnBits
$
Left
t
exprSize
=
sizeof
expr
exprSize
=
sizeof
expr
traverseDeclM
(
Variable
d
t
x
[]
(
expr
@
(
Stream
StreamL
chunk
exprs
)
))
=
do
traverseDeclM
(
Variable
d
t
x
[]
expr
@
(
Stream
StreamL
chunk
exprs
))
=
do
inProcedure
<-
withinProcedureM
inProcedure
<-
withinProcedureM
if
inProcedure
if
inProcedure
then
return
$
Variable
d
t
x
[]
expr
then
return
$
Variable
d
t
x
[]
expr
...
@@ -40,7 +40,7 @@ traverseDeclM (Variable d t x [] (expr @ (Stream StreamL chunk exprs))) = do
...
@@ -40,7 +40,7 @@ traverseDeclM (Variable d t x [] (expr @ (Stream StreamL chunk exprs))) = do
expr'
=
Call
(
Ident
fnName
)
(
Args
[
Concat
exprs
]
[]
)
expr'
=
Call
(
Ident
fnName
)
(
Args
[
Concat
exprs
]
[]
)
traverseDeclM
(
Variable
d
t
x
a
expr
)
=
traverseDeclM
(
Variable
d
t
x
a
expr
)
=
traverseExprM
expr
>>=
return
.
Variable
d
t
x
a
traverseExprM
expr
>>=
return
.
Variable
d
t
x
a
traverseDeclM
decl
@
Net
{}
=
traverseNetAsVarM
traverseDeclM
decl
traverseDeclM
decl
@
Net
{}
=
traverseNetAsVarM
traverseDeclM
decl
traverseDeclM
decl
=
return
decl
traverseDeclM
decl
=
return
decl
traverseModuleItemM
::
ModuleItem
->
Scoper
()
ModuleItem
traverseModuleItemM
::
ModuleItem
->
Scoper
()
ModuleItem
...
...
src/Convert/StringParam.hs
View file @
30acc3e3
...
@@ -72,7 +72,7 @@ collectQueriedIdentsM _ _ = return ()
...
@@ -72,7 +72,7 @@ collectQueriedIdentsM _ _ = return ()
elaborateStringParam
::
Idents
->
ModuleItem
->
ModuleItem
elaborateStringParam
::
Idents
->
ModuleItem
->
ModuleItem
elaborateStringParam
idents
(
MIAttr
attr
item
)
=
elaborateStringParam
idents
(
MIAttr
attr
item
)
=
MIAttr
attr
$
elaborateStringParam
idents
item
MIAttr
attr
$
elaborateStringParam
idents
item
elaborateStringParam
idents
(
orig
@
(
StringParam
x
str
)
)
=
elaborateStringParam
idents
orig
@
(
StringParam
x
str
)
=
if
Set
.
member
x
idents
if
Set
.
member
x
idents
then
Generate
$
map
wrap
[
width
,
param
]
then
Generate
$
map
wrap
[
width
,
param
]
else
orig
else
orig
...
@@ -99,7 +99,7 @@ mapInstance partStringParams (Instance m params x rs ports) =
...
@@ -99,7 +99,7 @@ mapInstance partStringParams (Instance m params x rs ports) =
where
where
expand
::
[
Identifier
]
->
ParamBinding
->
[
ParamBinding
]
expand
::
[
Identifier
]
->
ParamBinding
->
[
ParamBinding
]
expand
_
(
paramName
,
Left
t
)
=
[(
paramName
,
Left
t
)]
expand
_
(
paramName
,
Left
t
)
=
[(
paramName
,
Left
t
)]
expand
stringParams
(
orig
@
(
paramName
,
Right
expr
)
)
=
expand
stringParams
orig
@
(
paramName
,
Right
expr
)
=
if
elem
paramName
stringParams
if
elem
paramName
stringParams
then
[(
widthName
paramName
,
Right
width
),
orig
]
then
[(
widthName
paramName
,
Right
width
),
orig
]
else
[
orig
]
else
[
orig
]
...
...
src/Convert/Struct.hs
View file @
30acc3e3
...
@@ -24,7 +24,7 @@ convert :: [AST] -> [AST]
...
@@ -24,7 +24,7 @@ convert :: [AST] -> [AST]
convert
=
map
$
traverseDescriptions
convertDescription
convert
=
map
$
traverseDescriptions
convertDescription
convertDescription
::
Description
->
Description
convertDescription
::
Description
->
Description
convertDescription
(
description
@
(
Part
_
_
Module
_
_
_
_
)
)
=
convertDescription
description
@
(
Part
_
_
Module
_
_
_
_
)
=
partScoper
traverseDeclM
traverseModuleItemM
traverseGenItemM
traverseStmtM
partScoper
traverseDeclM
traverseModuleItemM
traverseGenItemM
traverseStmtM
description
description
convertDescription
other
=
other
convertDescription
other
=
other
...
@@ -103,7 +103,7 @@ convertType t1 =
...
@@ -103,7 +103,7 @@ convertType t1 =
-- write down the types of declarations
-- write down the types of declarations
traverseDeclM
::
Decl
->
Scoper
Type
Decl
traverseDeclM
::
Decl
->
Scoper
Type
Decl
traverseDeclM
decl
@
Net
{}
=
traverseDeclM
decl
@
Net
{}
=
traverseNetAsVarM
traverseDeclM
decl
traverseNetAsVarM
traverseDeclM
decl
traverseDeclM
decl
=
do
traverseDeclM
decl
=
do
decl'
<-
case
decl
of
decl'
<-
case
decl
of
...
@@ -196,7 +196,7 @@ convertExpr t (Mux c e1 e2) =
...
@@ -196,7 +196,7 @@ convertExpr t (Mux c e1 e2) =
e1'
=
convertExpr
t
e1
e1'
=
convertExpr
t
e1
e2'
=
convertExpr
t
e2
e2'
=
convertExpr
t
e2
convertExpr
(
struct
@
(
Struct
_
fields
[]
)
)
(
Pattern
itemsOrig
)
=
convertExpr
struct
@
(
Struct
_
fields
[]
)
(
Pattern
itemsOrig
)
=
if
not
(
null
extraNames
)
then
if
not
(
null
extraNames
)
then
error
$
"pattern "
++
show
(
Pattern
itemsOrig
)
++
error
$
"pattern "
++
show
(
Pattern
itemsOrig
)
++
" has extra named fields "
++
show
extraNames
++
" has extra named fields "
++
show
extraNames
++
...
@@ -302,7 +302,7 @@ convertExpr (Implicit sg rs) expr =
...
@@ -302,7 +302,7 @@ convertExpr (Implicit sg rs) expr =
-- TODO: This is a conversion for concat array literals with elements
-- TODO: This is a conversion for concat array literals with elements
-- that are unsized numbers. This probably belongs somewhere else.
-- that are unsized numbers. This probably belongs somewhere else.
convertExpr
(
t
@
IntegerVector
{})
(
Concat
exprs
)
=
convertExpr
t
@
IntegerVector
{}
(
Concat
exprs
)
=
if
all
isUnsizedNumber
exprs
if
all
isUnsizedNumber
exprs
then
Concat
$
map
(
Cast
$
Left
t'
)
exprs
then
Concat
$
map
(
Cast
$
Left
t'
)
exprs
else
Concat
$
map
(
convertExpr
t'
)
exprs
else
Concat
$
map
(
convertExpr
t'
)
exprs
...
@@ -317,7 +317,7 @@ convertExpr (t @ IntegerVector{}) (Concat exprs) =
...
@@ -317,7 +317,7 @@ convertExpr (t @ IntegerVector{}) (Concat exprs) =
-- TODO: This is really a conversion for using default patterns to
-- TODO: This is really a conversion for using default patterns to
-- populate arrays. Maybe this should be somewhere else?
-- populate arrays. Maybe this should be somewhere else?
convertExpr
t
(
orig
@
(
Pattern
[(
Left
UnknownType
,
expr
)])
)
=
convertExpr
t
orig
@
(
Pattern
[(
Left
UnknownType
,
expr
)]
)
=
if
null
rs
if
null
rs
then
orig
then
orig
else
Repeat
count
[
expr'
]
else
Repeat
count
[
expr'
]
...
...
src/Convert/TypeOf.hs
View file @
30acc3e3
...
@@ -41,7 +41,7 @@ type ST = Scoper Type
...
@@ -41,7 +41,7 @@ type ST = Scoper Type
-- insert the given declaration into the scope, and convert an TypeOfs within
-- insert the given declaration into the scope, and convert an TypeOfs within
traverseDeclM
::
Decl
->
ST
Decl
traverseDeclM
::
Decl
->
ST
Decl
traverseDeclM
decl
@
Net
{}
=
traverseDeclM
decl
@
Net
{}
=
traverseNetAsVarM
traverseDeclM
decl
traverseNetAsVarM
traverseDeclM
decl
traverseDeclM
decl
=
do
traverseDeclM
decl
=
do
decl'
<-
traverseDeclNodesM
traverseTypeM
traverseExprM
decl
decl'
<-
traverseDeclNodesM
traverseTypeM
traverseExprM
decl
...
@@ -98,7 +98,7 @@ traverseExprM (Cast (Left (Implicit sg [])) expr) =
...
@@ -98,7 +98,7 @@ traverseExprM (Cast (Left (Implicit sg [])) expr) =
traverseExprM
(
Cast
(
Left
t
)
(
Number
(
UnbasedUnsized
bit
)))
=
traverseExprM
(
Cast
(
Left
t
)
(
Number
(
UnbasedUnsized
bit
)))
=
-- defer until this expression becomes explicit
-- defer until this expression becomes explicit
return
$
Cast
(
Left
t
)
(
Number
(
UnbasedUnsized
bit
))
return
$
Cast
(
Left
t
)
(
Number
(
UnbasedUnsized
bit
))
traverseExprM
(
Cast
(
Left
(
t
@
(
IntegerAtom
TInteger
_
)
))
expr
)
=
traverseExprM
(
Cast
(
Left
t
@
(
IntegerAtom
TInteger
_
))
expr
)
=
-- convert to cast to an integer vector type
-- convert to cast to an integer vector type
traverseExprM
$
Cast
(
Left
t'
)
expr
traverseExprM
$
Cast
(
Left
t'
)
expr
where
where
...
@@ -189,14 +189,14 @@ typeof (Number n) =
...
@@ -189,14 +189,14 @@ typeof (Number n) =
size
=
numberBitLength
n
size
=
numberBitLength
n
sg
=
if
numberIsSigned
n
then
Signed
else
Unspecified
sg
=
if
numberIsSigned
n
then
Signed
else
Unspecified
typeof
(
Call
(
Ident
x
)
args
)
=
typeofCall
x
args
typeof
(
Call
(
Ident
x
)
args
)
=
typeofCall
x
args
typeof
(
orig
@
(
Bit
e
_
)
)
=
do
typeof
orig
@
(
Bit
e
_
)
=
do
t
<-
typeof
e
t
<-
typeof
e
let
t'
=
popRange
t
let
t'
=
popRange
t
case
t
of
case
t
of
TypeOf
{}
->
lookupTypeOf
orig
TypeOf
{}
->
lookupTypeOf
orig
Alias
{}
->
return
$
TypeOf
orig
Alias
{}
->
return
$
TypeOf
orig
_
->
return
$
typeSignednessOverride
t'
Unsigned
t'
_
->
return
$
typeSignednessOverride
t'
Unsigned
t'
typeof
(
orig
@
(
Range
e
NonIndexed
r
)
)
=
do
typeof
orig
@
(
Range
e
NonIndexed
r
)
=
do
t
<-
typeof
e
t
<-
typeof
e
let
t'
=
replaceRange
r
t
let
t'
=
replaceRange
r
t
return
$
case
t
of
return
$
case
t
of
...
@@ -217,7 +217,7 @@ typeof (Range expr mode (base, len)) =
...
@@ -217,7 +217,7 @@ typeof (Range expr mode (base, len)) =
if
mode
==
IndexedPlus
if
mode
==
IndexedPlus
then
BinOp
Sub
(
BinOp
Add
base
len
)
(
RawNum
1
)
then
BinOp
Sub
(
BinOp
Add
base
len
)
(
RawNum
1
)
else
BinOp
Add
(
BinOp
Sub
base
len
)
(
RawNum
1
)
else
BinOp
Add
(
BinOp
Sub
base
len
)
(
RawNum
1
)
typeof
(
orig
@
(
Dot
e
x
)
)
=
do
typeof
orig
@
(
Dot
e
x
)
=
do
t
<-
typeof
e
t
<-
typeof
e
case
t
of
case
t
of
Struct
_
fields
[]
->
return
$
fieldsType
fields
Struct
_
fields
[]
->
return
$
fieldsType
fields
...
@@ -404,7 +404,7 @@ typeCastUnneeded t1 t2 =
...
@@ -404,7 +404,7 @@ typeCastUnneeded t1 t2 =
sz2
=
typeSize
t2
sz2
=
typeSize
t2
typeSize
::
Type
->
Maybe
Expr
typeSize
::
Type
->
Maybe
Expr
typeSize
(
IntegerVector
_
_
rs
)
=
Just
$
dimensionsSize
rs
typeSize
(
IntegerVector
_
_
rs
)
=
Just
$
dimensionsSize
rs
typeSize
(
t
@
IntegerAtom
{})
=
typeSize
t
@
IntegerAtom
{}
=
typeSize
$
tf
[(
RawNum
1
,
RawNum
1
)]
typeSize
$
tf
[(
RawNum
1
,
RawNum
1
)]
where
(
tf
,
[]
)
=
typeRanges
t
where
(
tf
,
[]
)
=
typeRanges
t
typeSize
_
=
Nothing
typeSize
_
=
Nothing
...
...
src/Convert/UnbasedUnsized.hs
View file @
30acc3e3
...
@@ -207,7 +207,7 @@ convertExpr _ (Cast te e) =
...
@@ -207,7 +207,7 @@ convertExpr _ (Cast te e) =
Cast
te
$
convertExpr
SelfDetermined
e
Cast
te
$
convertExpr
SelfDetermined
e
convertExpr
_
(
Concat
exprs
)
=
convertExpr
_
(
Concat
exprs
)
=
Concat
$
map
(
convertExpr
SelfDetermined
)
exprs
Concat
$
map
(
convertExpr
SelfDetermined
)
exprs
convertExpr
context
(
Pattern
[(
Left
UnknownType
,
e
@
UU
{})])
=
convertExpr
context
(
Pattern
[(
Left
UnknownType
,
e
@
UU
{})])
=
convertExpr
context
e
convertExpr
context
e
convertExpr
_
(
Pattern
items
)
=
convertExpr
_
(
Pattern
items
)
=
Pattern
$
zip
Pattern
$
zip
...
@@ -218,7 +218,7 @@ convertExpr _ (Call expr (Args pnArgs [])) =
...
@@ -218,7 +218,7 @@ convertExpr _ (Call expr (Args pnArgs [])) =
where
pnArgs'
=
map
(
convertExpr
SelfDetermined
)
pnArgs
where
pnArgs'
=
map
(
convertExpr
SelfDetermined
)
pnArgs
convertExpr
_
(
Repeat
count
exprs
)
=
convertExpr
_
(
Repeat
count
exprs
)
=
Repeat
count
$
map
(
convertExpr
SelfDetermined
)
exprs
Repeat
count
$
map
(
convertExpr
SelfDetermined
)
exprs
convertExpr
SelfDetermined
(
Mux
cond
(
e1
@
UU
{})
(
e2
@
UU
{})
)
=
convertExpr
SelfDetermined
(
Mux
cond
e1
@
UU
{}
e2
@
UU
{}
)
=
Mux
Mux
(
convertExpr
SelfDetermined
cond
)
(
convertExpr
SelfDetermined
cond
)
(
convertExpr
SelfDetermined
e1
)
(
convertExpr
SelfDetermined
e1
)
...
...
src/Convert/UnnamedGenBlock.hs
View file @
30acc3e3
...
@@ -31,10 +31,10 @@ initialState :: Info
...
@@ -31,10 +31,10 @@ initialState :: Info
initialState
=
(
[]
,
1
)
initialState
=
(
[]
,
1
)
traverseModuleItemM
::
ModuleItem
->
S
ModuleItem
traverseModuleItemM
::
ModuleItem
->
S
ModuleItem
traverseModuleItemM
(
item
@
(
Genvar
x
)
)
=
declaration
x
item
traverseModuleItemM
item
@
(
Genvar
x
)
=
declaration
x
item
traverseModuleItemM
(
item
@
(
NInputGate
_
_
x
_
_
)
)
=
declaration
x
item
traverseModuleItemM
item
@
(
NInputGate
_
_
x
_
_
)
=
declaration
x
item
traverseModuleItemM
(
item
@
(
NOutputGate
_
_
x
_
_
)
)
=
declaration
x
item
traverseModuleItemM
item
@
(
NOutputGate
_
_
x
_
_
)
=
declaration
x
item
traverseModuleItemM
(
item
@
(
Instance
_
_
x
_
_
)
)
=
declaration
x
item
traverseModuleItemM
item
@
(
Instance
_
_
x
_
_
)
=
declaration
x
item
traverseModuleItemM
(
MIPackageItem
(
Decl
decl
))
=
traverseModuleItemM
(
MIPackageItem
(
Decl
decl
))
=
traverseDeclM
decl
>>=
return
.
MIPackageItem
.
Decl
traverseDeclM
decl
>>=
return
.
MIPackageItem
.
Decl
traverseModuleItemM
(
MIAttr
attr
item
)
=
traverseModuleItemM
(
MIAttr
attr
item
)
=
...
@@ -56,10 +56,10 @@ traverseDeclM decl =
...
@@ -56,10 +56,10 @@ traverseDeclM decl =
-- label the generate blocks within an individual generate item which is already
-- label the generate blocks within an individual generate item which is already
-- in a list of generate items (top level or generate block)
-- in a list of generate items (top level or generate block)
traverseGenItemM
::
GenItem
->
S
GenItem
traverseGenItemM
::
GenItem
->
S
GenItem
traverseGenItemM
(
item
@
GenIf
{})
=
do
traverseGenItemM
item
@
GenIf
{}
=
do
item'
<-
labelGenElse
item
item'
<-
labelGenElse
item
incrCount
>>
return
item'
incrCount
>>
return
item'
traverseGenItemM
(
item
@
GenBlock
{})
=
do
traverseGenItemM
item
@
GenBlock
{}
=
do
item'
<-
labelBlock
item
item'
<-
labelBlock
item
incrCount
>>
return
item'
incrCount
>>
return
item'
traverseGenItemM
(
GenFor
a
b
c
item
)
=
do
traverseGenItemM
(
GenFor
a
b
c
item
)
=
do
...
...
src/Language/SystemVerilog/AST/Expr.hs
View file @
30acc3e3
...
@@ -91,11 +91,11 @@ instance Show Expr where
...
@@ -91,11 +91,11 @@ instance Show Expr where
showPatternItem
(
Left
t
,
v
)
=
printf
"%s: %s"
tStr
(
show
v
)
showPatternItem
(
Left
t
,
v
)
=
printf
"%s: %s"
tStr
(
show
v
)
where
tStr
=
if
null
(
show
t
)
then
"default"
else
show
t
where
tStr
=
if
null
(
show
t
)
then
"default"
else
show
t
show
(
MinTypMax
a
b
c
)
=
printf
"(%s : %s : %s)"
(
show
a
)
(
show
b
)
(
show
c
)
show
(
MinTypMax
a
b
c
)
=
printf
"(%s : %s : %s)"
(
show
a
)
(
show
b
)
(
show
c
)
show
(
e
@
UniOp
{})
=
showsPrec
0
e
""
show
e
@
UniOp
{}
=
showsPrec
0
e
""
show
(
e
@
BinOp
{})
=
showsPrec
0
e
""
show
e
@
BinOp
{}
=
showsPrec
0
e
""
show
(
e
@
Dot
{})
=
showsPrec
0
e
""
show
e
@
Dot
{}
=
showsPrec
0
e
""
show
(
e
@
Mux
{})
=
showsPrec
0
e
""
show
e
@
Mux
{}
=
showsPrec
0
e
""
show
(
e
@
Call
{})
=
showsPrec
0
e
""
show
e
@
Call
{}
=
showsPrec
0
e
""
showsPrec
_
(
UniOp
o
e
)
=
showsPrec
_
(
UniOp
o
e
)
=
shows
o
.
shows
o
.
...
@@ -185,12 +185,12 @@ showRange :: Range -> String
...
@@ -185,12 +185,12 @@ showRange :: Range -> String
showRange
(
h
,
l
)
=
'['
:
show
h
++
':'
:
show
l
++
"]"
showRange
(
h
,
l
)
=
'['
:
show
h
++
':'
:
show
l
++
"]"
showUniOpPrec
::
Expr
->
ShowS
showUniOpPrec
::
Expr
->
ShowS
showUniOpPrec
(
e
@
UniOp
{})
=
(
showParen
True
.
shows
)
e
showUniOpPrec
e
@
UniOp
{}
=
(
showParen
True
.
shows
)
e
showUniOpPrec
(
e
@
BinOp
{})
=
(
showParen
True
.
shows
)
e
showUniOpPrec
e
@
BinOp
{}
=
(
showParen
True
.
shows
)
e
showUniOpPrec
e
=
shows
e
showUniOpPrec
e
=
shows
e
showBinOpPrec
::
Expr
->
ShowS
showBinOpPrec
::
Expr
->
ShowS
showBinOpPrec
(
e
@
BinOp
{})
=
(
showParen
True
.
shows
)
e
showBinOpPrec
e
@
BinOp
{}
=
(
showParen
True
.
shows
)
e
showBinOpPrec
e
=
shows
e
showBinOpPrec
e
=
shows
e
type
ParamBinding
=
(
Identifier
,
TypeOrExpr
)
type
ParamBinding
=
(
Identifier
,
TypeOrExpr
)
...
...
src/Language/SystemVerilog/AST/Number.hs
View file @
30acc3e3
...
@@ -449,7 +449,7 @@ chunk base n0 =
...
@@ -449,7 +449,7 @@ chunk base n0 =
-- number concatenation
-- number concatenation
instance
Semigroup
Number
where
instance
Semigroup
Number
where
(
n1
@
Based
{})
<>
(
n2
@
Based
{})
=
n1
@
Based
{}
<>
n2
@
Based
{}
=
Based
size
signed
base
values
kinds
Based
size
signed
base
values
kinds
where
where
size
=
size1
+
size2
size
=
size1
+
size2
...
@@ -465,7 +465,7 @@ instance Semigroup Number where
...
@@ -465,7 +465,7 @@ instance Semigroup Number where
n1
<>
n2
=
n1
<>
n2
=
toBased
n1
<>
toBased
n2
toBased
n1
<>
toBased
n2
where
where
toBased
(
n
@
Based
{})
=
n
toBased
n
@
Based
{}
=
n
toBased
(
Decimal
size
signed
num
)
=
toBased
(
Decimal
size
signed
num
)
=
Based
size
signed
Hex
num
0
Based
size
signed
Hex
num
0
toBased
(
UnbasedUnsized
bit
)
=
toBased
(
UnbasedUnsized
bit
)
=
...
...
src/Language/SystemVerilog/AST/Stmt.hs
View file @
30acc3e3
...
@@ -104,9 +104,9 @@ showAssign :: (LHS, AsgnOp, Expr) -> String
...
@@ -104,9 +104,9 @@ showAssign :: (LHS, AsgnOp, Expr) -> String
showAssign
(
l
,
op
,
e
)
=
(
showPad
l
)
++
(
showPad
op
)
++
(
show
e
)
showAssign
(
l
,
op
,
e
)
=
(
showPad
l
)
++
(
showPad
op
)
++
(
show
e
)
showBranch
::
Stmt
->
String
showBranch
::
Stmt
->
String
showBranch
(
Block
Seq
""
[]
(
stmts
@
[
CommentStmt
{},
_
])
)
=
showBranch
(
Block
Seq
""
[]
stmts
@
[
CommentStmt
{},
_
]
)
=
'
\n
'
:
(
indent
$
show
stmts
)
'
\n
'
:
(
indent
$
show
stmts
)
showBranch
(
block
@
Block
{})
=
' '
:
show
block
showBranch
block
@
Block
{}
=
' '
:
show
block
showBranch
stmt
=
'
\n
'
:
(
indent
$
show
stmt
)
showBranch
stmt
=
'
\n
'
:
(
indent
$
show
stmt
)
showBlockedBranch
::
Stmt
->
String
showBlockedBranch
::
Stmt
->
String
...
@@ -129,11 +129,11 @@ showBlockedBranch stmt =
...
@@ -129,11 +129,11 @@ showBlockedBranch stmt =
_
->
False
_
->
False
showElseBranch
::
Stmt
->
String
showElseBranch
::
Stmt
->
String
showElseBranch
(
stmt
@
If
{})
=
' '
:
show
stmt
showElseBranch
stmt
@
If
{}
=
' '
:
show
stmt
showElseBranch
stmt
=
showBranch
stmt
showElseBranch
stmt
=
showBranch
stmt
showShortBranch
::
Stmt
->
String
showShortBranch
::
Stmt
->
String
showShortBranch
(
stmt
@
Asgn
{})
=
' '
:
show
stmt
showShortBranch
stmt
@
Asgn
{}
=
' '
:
show
stmt
showShortBranch
stmt
=
showBranch
stmt
showShortBranch
stmt
=
showBranch
stmt
showCase
::
Case
->
String
showCase
::
Case
->
String
...
...
src/Language/SystemVerilog/Parser/Parse.y
View file @
30acc3e3
...
@@ -1578,7 +1578,7 @@ caseInsideKW tok kw =
...
@@ -1578,7 +1578,7 @@ caseInsideKW tok kw =
parseError
(
tokenPosition
tok
)
$
"cannot use inside with "
++
show
kw
parseError
(
tokenPosition
tok
)
$
"cannot use inside with "
++
show
kw
addMIAttr
::
Attr
->
ModuleItem
->
ModuleItem
addMIAttr
::
Attr
->
ModuleItem
->
ModuleItem
addMIAttr
_
(
item
@
(
MIPackageItem
(
Decl
CommentDecl
{})
))
=
item
addMIAttr
_
item
@
(
MIPackageItem
(
Decl
CommentDecl
{}
))
=
item
addMIAttr
attr
item
=
MIAttr
attr
item
addMIAttr
attr
item
=
MIAttr
attr
item
missingToken
::
String
->
ParseState
a
missingToken
::
String
->
ParseState
a
...
@@ -1646,15 +1646,15 @@ makeTypeOf (Token _ _ pos) expr = (pos, check)
...
@@ -1646,15 +1646,15 @@ makeTypeOf (Token _ _ pos) expr = (pos, check)
check
sg
[]
=
unexpectedSigning
pos
sg
(
show
typ
)
check
sg
[]
=
unexpectedSigning
pos
sg
(
show
typ
)
addMITrace
::
ModuleItem
->
[
ModuleItem
]
->
[
ModuleItem
]
addMITrace
::
ModuleItem
->
[
ModuleItem
]
->
[
ModuleItem
]
addMITrace
_
items
@
(
MIPackageItem
(
Decl
CommentDecl
{})
:
_
)
=
items
addMITrace
_
items
@
(
MIPackageItem
(
Decl
CommentDecl
{})
:
_
)
=
items
addMITrace
trace
items
=
trace
:
items
addMITrace
trace
items
=
trace
:
items
addPITrace
::
PackageItem
->
[
PackageItem
]
->
[
PackageItem
]
addPITrace
::
PackageItem
->
[
PackageItem
]
->
[
PackageItem
]
addPITrace
_
items
@
(
Decl
CommentDecl
{}
:
_
)
=
items
addPITrace
_
items
@
(
Decl
CommentDecl
{}
:
_
)
=
items
addPITrace
trace
items
=
trace
:
items
addPITrace
trace
items
=
trace
:
items
addCITrace
::
ClassItem
->
[
ClassItem
]
->
[
ClassItem
]
addCITrace
::
ClassItem
->
[
ClassItem
]
->
[
ClassItem
]
addCITrace
_
items
@
((
_
,
Decl
CommentDecl
{})
:
_
)
=
items
addCITrace
_
items
@
((
_
,
Decl
CommentDecl
{})
:
_
)
=
items
addCITrace
trace
items
=
trace
:
items
addCITrace
trace
items
=
trace
:
items
makeFor
::
Either
[
Decl
]
[(
LHS
,
Expr
)]
->
Expr
->
[(
LHS
,
AsgnOp
,
Expr
)]
->
Stmt
->
Stmt
makeFor
::
Either
[
Decl
]
[(
LHS
,
Expr
)]
->
Expr
->
[(
LHS
,
AsgnOp
,
Expr
)]
->
Stmt
->
Stmt
...
...
src/Language/SystemVerilog/Parser/ParseDecl.hs
View file @
30acc3e3
...
@@ -82,7 +82,7 @@ parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma
...
@@ -82,7 +82,7 @@ parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma
where
where
dropTrailingComma
::
[
DeclToken
]
->
[
DeclToken
]
dropTrailingComma
::
[
DeclToken
]
->
[
DeclToken
]
dropTrailingComma
[]
=
[]
dropTrailingComma
[]
=
[]
dropTrailingComma
[
DTComma
{},
end
@
DTEnd
{}]
=
[
end
]
dropTrailingComma
[
DTComma
{},
end
@
DTEnd
{}]
=
[
end
]
dropTrailingComma
(
tok
:
toks
)
=
tok
:
dropTrailingComma
toks
dropTrailingComma
(
tok
:
toks
)
=
tok
:
dropTrailingComma
toks
-- internal parseDTsAsPortDecls after the removal of an optional trailing comma
-- internal parseDTsAsPortDecls after the removal of an optional trailing comma
...
@@ -102,7 +102,7 @@ parseDTsAsPortDecls' pieces =
...
@@ -102,7 +102,7 @@ parseDTsAsPortDecls' pieces =
pieces'
=
filter
(
not
.
isAttr
)
pieces
pieces'
=
filter
(
not
.
isAttr
)
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
e
:
decls
)
=
propagateDirections
lastDir
(
Variable
currDir
t
x
a
e
:
decls
)
=
decl
:
propagateDirections
dir
decls
decl
:
propagateDirections
dir
decls
...
@@ -167,7 +167,7 @@ parseDTsAsModuleItems tokens =
...
@@ -167,7 +167,7 @@ parseDTsAsModuleItems tokens =
-- internal; attempt to parse an elaboration system task
-- internal; attempt to parse an elaboration system task
asElabTask
::
[
DeclToken
]
->
Maybe
ModuleItem
asElabTask
::
[
DeclToken
]
->
Maybe
ModuleItem
asElabTask
tokens
=
do
asElabTask
tokens
=
do
DTIdent
_
x
@
(
'$'
:
_
)
<-
return
$
head
tokens
DTIdent
_
x
@
(
'$'
:
_
)
<-
return
$
head
tokens
severity
<-
lookup
x
elabTasks
severity
<-
lookup
x
elabTasks
Just
$
ElabTask
severity
args
Just
$
ElabTask
severity
args
where
where
...
@@ -328,7 +328,7 @@ parseDTsAsAsgns tokens =
...
@@ -328,7 +328,7 @@ parseDTsAsAsgns tokens =
"unexpected "
++
surprise
++
" in for loop initialization"
"unexpected "
++
surprise
++
" in for loop initialization"
shiftIncOrDec
::
[
DeclToken
]
->
[
DeclToken
]
shiftIncOrDec
::
[
DeclToken
]
->
[
DeclToken
]
shiftIncOrDec
(
tok
@
(
DTAsgn
_
AsgnOp
{}
_
_
)
:
toks
)
=
shiftIncOrDec
(
tok
@
(
DTAsgn
_
AsgnOp
{}
_
_
)
:
toks
)
=
before
++
tok
:
delim
:
shiftIncOrDec
after
before
++
tok
:
delim
:
shiftIncOrDec
after
where
(
before
,
delim
:
after
)
=
break
isCommaOrEnd
toks
where
(
before
,
delim
:
after
)
=
break
isCommaOrEnd
toks
shiftIncOrDec
[]
=
[]
shiftIncOrDec
[]
=
[]
...
...
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