Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
pub
frama-c
Commits
a0ada244
Commit
a0ada244
authored
Nov 06, 2020
by
Allan Blanchard
Browse files
[kernel] Simplifies merge assigns
parent
637af0a0
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/kernel_internals/parsing/logic_parser.mly
View file @
a0ada244
...
...
@@ -109,44 +109,40 @@
let
loc_ext
d
=
{
extended_node
=
d
;
extended_loc
=
loc
()
}
let
concat_deps
ds1
ds2
=
let
fold
ds
d
=
if
List
.
exists
(
is_same_lexpr
d
)
ds
then
ds
else
d
::
ds
in
let
ds
=
List
.
fold_left
fold
[]
ds1
in
let
ds
=
List
.
fold_left
fold
ds
ds2
in
List
.
rev
ds
let
filter_from
(
l
,
d
)
=
match
d
with
|
From
ds
->
l
,
From
(
concat_deps
[]
ds
)
|
_
->
l
,
d
let
filter_from
l
=
function
|
FromAny
->
l
,
FromAny
|
From
ds
->
let
f
ds
d
=
if
List
.
exists
(
is_same_lexpr
d
)
ds
then
ds
else
d
::
ds
in
l
,
From
(
List
.(
rev
(
fold_left
f
[]
ds
)))
let
concat_froms
a1
a2
=
let
compare_pair
(
l
1
,_
)
(
l
2
,_
)
=
is_same_lexpr
l
1
l
2
in
let
compare_pair
(
b
1
,_
)
(
b
2
,_
)
=
is_same_lexpr
b
1
b
2
in
(* NB: the following has an horrible complexity, but the order of
clauses in the input is preserved. *)
let
concat_one
acc
(
_
,
d2
as
f2
)
=
let
f2
=
filter_from
f2
in
let
concat_one
acc
(
l
,
f2
)
=
let
(
_
,
f2
)
as
p
=
filter_from
l
f2
in
try
let
(
_
,
d
1
)
=
List
.
find
(
compare_pair
f2
)
acc
let
(
_
,
f
1
)
=
List
.
find
(
compare_pair
p
)
acc
in
match
(
d
1
,
d
2
)
with
match
(
f
1
,
f
2
)
with
|
_
,
FromAny
->
(* the new fundeps does not give more information than the one
which is already present. Just ignore it.
*)
acc
|
FromAny
,
From
_
->
|
FromAny
,
_
->
(* the new fundeps is strictly more precise than the old one.
We replace the old dependency by the new one, but keep
the location at its old place in the list. This ensures
that we get the exact same clause if we try to
link the original contract with its pretty-printed version. *)
Extlib
.
replace
compare_pair
f2
acc
Extlib
.
replace
compare_pair
p
acc
|
From
_
,
From
_
->
(* we keep the two functional dependencies,
as they have to be proved separately. *)
acc
@
[
f2
]
with
Not_found
->
acc
@
[
f2
]
acc
@
[
p
]
with
Not_found
->
acc
@
[
p
]
in
List
.
fold_left
concat_one
a1
a2
let
concat_allocation
fa1
fa2
=
...
...
src/kernel_services/ast_printing/cil_printer.ml
View file @
a0ada244
...
...
@@ -2912,23 +2912,17 @@ class cil_printer () = object (self)
(
function
(
a
,_
)
->
not
(
Logic_const
.
is_exit_status
a
.
it_content
))
l
in
let
remove_duplicates
l
=
let
unique_assigned_locs
=
let
same
t1
t2
=
Cil_datatype
.
Term
.
equal
t1
.
it_content
t2
.
it_content
in
let
rec
aux
l
acc
=
match
l
with
|
[]
->
acc
|
(
x
,_
)
::
l
when
List
.
exists
(
same
x
)
acc
->
aux
l
acc
|
(
x
,_
)
::
l
->
aux
l
(
x
::
acc
)
in
List
.
rev
(
aux
l
[]
)
let
f
l
(
a
,_
)
=
if
List
.
exists
(
same
a
)
l
then
l
else
a
::
l
in
List
.
rev
(
List
.
fold_left
f
[]
without_result
)
in
let
l
=
remove_duplicates
without_result
in
fprintf
fmt
"@[<h>%t%a@]"
(
fun
fmt
->
if
without_result
<>
[]
then
Format
.
fprintf
fmt
"%a "
self
#
pp_acsl_keyword
kw
)
(
Pretty_utils
.
pp_list
~
sep
:
",@ "
~
suf
:
";@]"
(
fun
fmt
t
->
self
#
identified_term
fmt
t
))
l
unique_assigned_locs
method
private
assigns_deps
kw
fmt
=
function
|
WritesAny
->
()
...
...
Write
Preview
Supports
Markdown
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