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
c168ec47
Commit
c168ec47
authored
Apr 10, 2019
by
Zachary Snow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
added some error checking for struct pattern conversion
parent
37760007
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
29 additions
and
17 deletions
+29
-17
src/Convert/Struct.hs
+29
-17
No files found.
src/Convert/Struct.hs
View file @
c168ec47
...
@@ -215,38 +215,50 @@ convertAsgn structs types (lhs, expr) =
...
@@ -215,38 +215,50 @@ convertAsgn structs types (lhs, expr) =
convertExpr
(
Struct
(
Packed
sg
)
fields
rs
)
e
convertExpr
(
Struct
(
Packed
sg
)
fields
rs
)
e
convertExpr
(
Struct
(
Packed
_
)
fields
_
)
(
Pattern
[(
Just
"default"
,
e
)])
=
convertExpr
(
Struct
(
Packed
_
)
fields
_
)
(
Pattern
[(
Just
"default"
,
e
)])
=
Concat
$
take
(
length
fields
)
(
repeat
e
)
Concat
$
take
(
length
fields
)
(
repeat
e
)
convertExpr
(
Struct
(
Packed
sg
)
fields
[]
)
(
Pattern
items
)
=
convertExpr
(
Struct
(
Packed
sg
)
fields
[]
)
(
Pattern
itemsOrig
)
=
if
Map
.
notMember
structTf
structs
if
length
items
/=
length
fields
then
then
Pattern
items''
error
$
"struct pattern "
++
show
items
++
else
Concat
exprs
" doesn't have the same # of items as "
++
show
structTf
else
if
itemsFieldNames
/=
fieldNames
then
error
$
"struct pattern "
++
show
items
++
" has fields "
++
show
itemsFieldNames
++
", but struct type has fields "
++
show
fieldNames
else
if
Map
.
notMember
structTf
structs
then
Pattern
items
else
Concat
$
map
packItem
items
where
where
subMap
=
\
(
Just
ident
,
subExpr
)
->
subMap
=
\
(
Just
ident
,
subExpr
)
->
(
Just
ident
,
convertExpr
(
lookupFieldType
fields
ident
)
subExpr
)
(
Just
ident
,
convertExpr
(
lookupFieldType
fields
ident
)
subExpr
)
structTf
=
Struct
(
Packed
sg
)
fields
structTf
=
Struct
(
Packed
sg
)
fields
items
'
=
items
Named
=
-- if the pattern does not use identifiers, use the
-- if the pattern does not use identifiers, use the
-- identifiers from the struct type definition in order
-- identifiers from the struct type definition in order
if
not
(
all
(
isJust
.
fst
)
items
)
if
not
(
all
(
isJust
.
fst
)
items
Orig
)
then
zip
(
map
(
Just
.
snd
)
fields
)
(
map
snd
items
)
then
zip
(
map
(
Just
.
snd
)
fields
)
(
map
snd
items
Orig
)
else
items
else
items
Orig
items
''
=
map
subMap
items'
items
=
sortOn
itemPosition
$
map
subMap
itemsNamed
fieldNames
=
map
snd
fields
fieldNames
=
map
snd
fields
itemsFieldNames
=
map
(
fromJust
.
fst
)
items
itemPosition
=
\
(
Just
x
,
_
)
->
fromJust
$
elemIndex
x
fieldNames
itemPosition
=
\
(
Just
x
,
_
)
->
fromJust
$
elemIndex
x
fieldNames
packItem
(
Just
x
,
Number
n
)
=
packItem
(
Just
x
,
Number
n
)
=
Number
$
if
size
/=
show
resSize
case
readMaybe
unticked
::
Maybe
Int
of
then
error
$
"literal "
++
show
n
++
" for "
++
show
x
Nothing
->
++
" doesn't have struct field size "
++
show
size
if
unticked
==
n
else
Number
res
then
n
else
size
++
n
Just
num
->
size
++
"'d"
++
show
num
where
where
Number
size
=
rangeSize
$
lookupUnstructRange
structTf
x
Number
size
=
rangeSize
$
lookupUnstructRange
structTf
x
unticked
=
case
n
of
unticked
=
case
n
of
'
\'
'
:
rest
->
rest
'
\'
'
:
rest
->
rest
rest
->
rest
rest
->
rest
resSize
=
(
read
$
takeWhile
(
/=
'
\'
')
res
)
::
Int
res
=
case
readMaybe
unticked
::
Maybe
Int
of
Nothing
->
if
unticked
==
n
then
n
else
size
++
n
Just
num
->
size
++
"'d"
++
show
num
packItem
(
_
,
itemExpr
)
=
itemExpr
packItem
(
_
,
itemExpr
)
=
itemExpr
exprs
=
map
packItem
$
sortOn
itemPosition
items''
convertExpr
_
other
=
other
convertExpr
_
other
=
other
-- try expression conversion by looking at the *innermost* type first
-- try expression conversion by looking at the *innermost* type first
...
...
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