Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
81
Issues
81
List
Boards
Labels
Milestones
Merge Requests
8
Merge Requests
8
Packages
Packages
Container Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
e368d43a
Commit
e368d43a
authored
Nov 13, 2015
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Ity: give every region a vsymbol to use in VCs
parent
9cd6b3d0
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
21 additions
and
18 deletions
+21
-18
src/mlw/dexpr.ml
src/mlw/dexpr.ml
+1
-1
src/mlw/ity.ml
src/mlw/ity.ml
+15
-11
src/mlw/ity.mli
src/mlw/ity.mli
+1
-1
src/mlw/pmodule.ml
src/mlw/pmodule.ml
+4
-5
No files found.
src/mlw/dexpr.ml
View file @
e368d43a
...
...
@@ -256,7 +256,7 @@ let rec print_dity pur pri fmt = function
|
Dvar
{
contents
=
Dsim
(
d
,_
)}
->
Format
.
fprintf
fmt
"[%a]"
(
print_dity
true
0
)
d
|
Dvar
{
contents
=
Dreg
(
Dapp
(
s
,
tl
,
rl
)
,
{
tv_name
=
id
})}
|
Durg
(
Dapp
(
s
,
tl
,
rl
)
,
{
reg_
name
=
id
})
->
|
Durg
(
Dapp
(
s
,
tl
,
rl
)
,
{
reg_
vs
=
{
vs_name
=
id
}
})
->
Format
.
fprintf
fmt
(
protect_on
(
pri
>
1
&&
(
tl
<>
[]
||
rl
<>
[]
))
"%a%a%a@ @@%s"
)
Pretty
.
print_ts
s
.
its_ts
(
print_args
(
print_dity
pur
2
))
tl
...
...
src/mlw/ity.ml
View file @
e368d43a
...
...
@@ -46,7 +46,7 @@ and ity_node =
(** type variable and its purity status *)
and
region
=
{
reg_
name
:
ident
;
reg_
vs
:
vsymbol
;
reg_its
:
itysymbol
;
reg_args
:
ity
list
;
reg_regs
:
ity
list
;
...
...
@@ -70,7 +70,7 @@ end)
module
Reg
=
MakeMSHW
(
struct
type
t
=
region
let
tag
reg
=
reg
.
reg_name
.
id_tag
let
tag
reg
=
reg
.
reg_
vs
.
vs_
name
.
id_tag
end
)
module
PVsym
=
MakeMSHW
(
struct
...
...
@@ -107,12 +107,12 @@ let pv_equal : pvsymbol -> pvsymbol -> bool = (==)
let
its_hash
its
=
id_hash
its
.
its_ts
.
ts_name
let
ity_hash
ity
=
Weakhtbl
.
tag_hash
ity
.
ity_tag
let
reg_hash
reg
=
id_hash
reg
.
reg_name
let
reg_hash
reg
=
id_hash
reg
.
reg_
vs
.
vs_
name
let
pv_hash
pv
=
id_hash
pv
.
pv_vs
.
vs_name
let
its_compare
its1
its2
=
id_compare
its1
.
its_ts
.
ts_name
its2
.
its_ts
.
ts_name
let
ity_compare
ity1
ity2
=
Pervasives
.
compare
(
ity_hash
ity1
)
(
ity_hash
ity2
)
let
reg_compare
reg1
reg2
=
id_compare
reg1
.
reg_
name
reg2
.
reg
_name
let
reg_compare
reg1
reg2
=
id_compare
reg1
.
reg_
vs
.
vs_name
reg2
.
reg_vs
.
vs
_name
let
pv_compare
pv1
pv2
=
id_compare
pv1
.
pv_vs
.
vs_name
pv2
.
pv_vs
.
vs_name
exception
NonUpdatable
of
itysymbol
*
ity
...
...
@@ -162,8 +162,8 @@ let mk_ity node = {
ity_tag
=
Weakhtbl
.
dummy_tag
;
}
let
mk_reg
name
s
tl
rl
=
{
reg_
name
=
id_register
name
;
let
mk_reg
v
s
tl
rl
=
{
reg_
vs
=
v
;
reg_its
=
s
;
reg_args
=
(
check_its_args
s
tl
;
tl
);
reg_regs
=
rl
;
...
...
@@ -201,6 +201,10 @@ let rec ty_of_ity ity = match ity.ity_node with
ty_app
s
.
its_ts
(
List
.
map
ty_of_ity
tl
)
|
Ityvar
(
v
,_
)
->
ty_var
v
let
mk_reg
id
s
tl
rl
=
let
ty
=
ty_app
s
.
its_ts
(
List
.
map
ty_of_ity
tl
)
in
mk_reg
(
create_vsymbol
id
ty
)
s
tl
rl
(* generic traversal functions *)
let
dfold
fn
acc
l1
l2
=
...
...
@@ -488,7 +492,7 @@ let its_inst_regs fresh_reg s tl =
try
sbs
,
Mreg
.
find
r
sbs
.
isb_reg
with
Not_found
->
let
sbs
,
tl
=
Lists
.
map_fold_left
ity_inst
sbs
r
.
reg_args
in
let
sbs
,
rl
=
Lists
.
map_fold_left
ity_inst
sbs
r
.
reg_regs
in
let
ity
=
fresh_reg
(
id_clone
r
.
reg_name
)
r
.
reg_its
tl
rl
in
let
ity
=
fresh_reg
r
.
reg_vs
.
vs_name
r
.
reg_its
tl
rl
in
{
sbs
with
isb_reg
=
Mreg
.
add
r
ity
sbs
.
isb_reg
}
,
ity
in
Lists
.
map_fold_left
reg_inst
(
its_match_args
s
tl
)
s
.
its_regions
...
...
@@ -499,12 +503,12 @@ let its_match_smart fresh_reg s tl rl =
else
its_inst_regs
fresh_reg
s
tl
let
create_region
id
s
tl
rl
=
let
fresh
id
s
tl
rl
=
ity_reg
(
mk_reg
id
s
tl
rl
)
in
let
fresh
id
s
tl
rl
=
ity_reg
(
mk_reg
(
id_clone
id
)
s
tl
rl
)
in
let
sbs
,
rl
=
its_match_smart
fresh
s
tl
rl
in
create_region_raw
sbs
id
s
tl
rl
let
ity_app
s
tl
rl
=
let
fresh
id
s
tl
rl
=
ity_reg
(
mk_reg
id
s
tl
rl
)
in
let
fresh
id
s
tl
rl
=
ity_reg
(
mk_reg
(
id_clone
id
)
s
tl
rl
)
in
let
sbs
,
rl
=
its_match_smart
fresh
s
tl
rl
in
ity_app_raw
sbs
(
id_fresh
"rho"
)
s
tl
rl
...
...
@@ -1193,10 +1197,10 @@ let rprinter = create_ident_printer []
let
xprinter
=
create_ident_printer
[]
~
sanitizer
:
(
sanitizer
char_to_ualpha
char_to_alnumus
)
let
forget_reg
r
=
forget_id
rprinter
r
.
reg_name
let
forget_reg
r
=
forget_id
rprinter
r
.
reg_
vs
.
vs_
name
let
print_reg_name
fmt
r
=
fprintf
fmt
"@@%s"
(
id_unique
rprinter
r
.
reg_name
)
fprintf
fmt
"@@%s"
(
id_unique
rprinter
r
.
reg_
vs
.
vs_
name
)
let
print_args
pr
fmt
tl
=
if
tl
<>
[]
then
fprintf
fmt
"@ %a"
(
Pp
.
print_list
Pp
.
space
pr
)
tl
...
...
src/mlw/ity.mli
View file @
e368d43a
...
...
@@ -45,7 +45,7 @@ and ity_node = private
(** type variable and its purity status *)
and
region
=
private
{
reg_
name
:
ident
;
reg_
vs
:
vsymbol
;
reg_its
:
itysymbol
;
reg_args
:
ity
list
;
reg_regs
:
ity
list
;
...
...
src/mlw/pmodule.ml
View file @
e368d43a
...
...
@@ -423,21 +423,20 @@ and clone_reg cl reg =
with all top-level pvsymbols (local or external) before
descending into a let_defn. *)
try
Mreg
.
find
reg
cl
.
rn_table
with
Not_found
->
let
id
=
id_clone
reg
.
reg_vs
.
vs_name
in
let
tl
=
List
.
map
(
clone_ity
cl
)
reg
.
reg_args
in
let
rl
=
List
.
map
(
clone_ity
cl
)
reg
.
reg_regs
in
let
r
=
match
Mts
.
find_opt
reg
.
reg_its
.
its_ts
cl
.
ts_table
with
|
Some
its
->
create_region
(
id_clone
reg
.
reg_name
)
its
tl
rl
|
Some
its
->
create_region
id
its
tl
rl
|
None
->
(* creative indentation *)
begin
match
Mts
.
find_opt
reg
.
reg_its
.
its_ts
cl
.
ty_table
with
|
Some
{
ity_node
=
Ityreg
r
}
->
let
sbs
=
its_match_regs
reg
.
reg_its
tl
rl
in
let
tl
=
List
.
map
(
ity_full_inst
sbs
)
r
.
reg_args
in
let
rl
=
List
.
map
(
ity_full_inst
sbs
)
r
.
reg_regs
in
create_region
(
id_clone
reg
.
reg_name
)
r
.
reg_its
tl
rl
create_region
id
r
.
reg_its
tl
rl
|
Some
_
->
assert
false
|
None
->
create_region
(
id_clone
reg
.
reg_name
)
reg
.
reg_its
tl
rl
|
None
->
create_region
id
reg
.
reg_its
tl
rl
end
in
cl
.
rn_table
<-
Mreg
.
add
reg
r
cl
.
rn_table
;
r
...
...
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