Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
125
Issues
125
List
Boards
Labels
Service Desk
Milestones
Merge Requests
16
Merge Requests
16
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
1b1cd199
Commit
1b1cd199
authored
Feb 22, 2013
by
Jean-Christophe Filliâtre
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
shapes of algebraic data types: name and constructor names taken into account
parent
e2434596
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
15 additions
and
8 deletions
+15
-8
src/session/termcode.ml
src/session/termcode.ml
+15
-8
No files found.
src/session/termcode.ml
View file @
1b1cd199
...
...
@@ -83,6 +83,8 @@ let tag_var = "V"
let
tag_wild
=
"w"
let
tag_as
=
"z"
let
ident_shape
~
push
id
acc
=
push
id
.
Ident
.
id_string
acc
let
const_shape
~
push
acc
c
=
let
b
=
Buffer
.
create
17
in
Format
.
bprintf
b
"%a"
Pretty
.
print_const
c
;
...
...
@@ -94,7 +96,7 @@ let rec pat_shape ~(push:string->'a->'a) c m (acc:'a) p : 'a =
|
Pvar
_
->
push
tag_var
acc
|
Papp
(
f
,
l
)
->
List
.
fold_left
(
pat_shape
~
push
c
m
)
(
push
(
f
.
ls_name
.
Ident
.
id_string
)
(
push
tag_app
acc
))
(
ident_shape
~
push
f
.
ls_name
(
push
tag_app
acc
))
l
|
Pas
(
p
,
_
)
->
push
tag_as
(
pat_shape
~
push
c
m
acc
p
)
|
Por
(
p
,
q
)
->
...
...
@@ -112,7 +114,7 @@ let rec t_shape ~version ~(push:string->'a->'a) c m (acc:'a) t : 'a =
push
x
(
push
tag_var
acc
)
|
Tapp
(
s
,
l
)
->
List
.
fold_left
fn
(
push
(
s
.
ls_name
.
Ident
.
id_string
)
(
push
tag_app
acc
))
(
ident_shape
~
push
s
.
ls_name
(
push
tag_app
acc
))
l
|
Tif
(
f
,
t1
,
t2
)
->
fn
(
fn
(
fn
(
push
tag_if
acc
)
f
)
t1
)
t2
|
Tcase
(
t1
,
bl
)
->
...
...
@@ -185,17 +187,17 @@ let pr_shape_list fmt t =
(* shape of a task *)
let
param_decl_shape
~
(
push
:
string
->
'
a
->
'
a
)
(
acc
:
'
a
)
ls
:
'
a
=
push
(
ls
.
ls_name
.
Ident
.
id_string
)
acc
ident_shape
~
push
ls
.
ls_name
acc
let
logic_decl_shape
~
version
~
(
push
:
string
->
'
a
->
'
a
)
(
acc
:
'
a
)
(
ls
,
def
)
:
'
a
=
let
acc
=
push
(
ls
.
ls_name
.
Ident
.
id_string
)
acc
in
let
acc
=
ident_shape
~
push
ls
.
ls_name
acc
in
let
vl
,
t
=
Decl
.
open_ls_defn
def
in
let
c
=
ref
(
-
1
)
in
let
m
=
vl_rename_alpha
c
Mvs
.
empty
vl
in
t_shape
~
version
~
push
c
m
acc
t
let
logic_ind_decl_shape
~
version
~
(
push
:
string
->
'
a
->
'
a
)
(
acc
:
'
a
)
(
ls
,
cl
)
:
'
a
=
let
acc
=
push
(
ls
.
ls_name
.
Ident
.
id_string
)
acc
in
let
acc
=
ident_shape
~
push
ls
.
ls_name
acc
in
List
.
fold_right
(
fun
(
_
,
t
)
acc
->
t_shape
~
version
~
push
(
ref
(
-
1
))
Mvs
.
empty
acc
t
)
cl
acc
...
...
@@ -208,16 +210,21 @@ let propdecl_shape ~version ~(push:string->'a->'a) (acc:'a) (k,n,t) : 'a =
|
Decl
.
Pskip
->
tag_Pskip
in
let
acc
=
push
tag
acc
in
let
acc
=
push
n
.
Decl
.
pr_name
.
Ident
.
id_string
acc
in
let
acc
=
ident_shape
~
push
n
.
Decl
.
pr_name
acc
in
t_shape
~
version
~
push
(
ref
(
-
1
))
Mvs
.
empty
acc
t
let
constructor_shape
~
push
(
ls
,
_
)
acc
=
ident_shape
~
push
ls
.
ls_name
acc
let
data_decl_shape
~
push
(
tys
,
cl
)
acc
=
List
.
fold_right
(
constructor_shape
~
push
)
cl
(
ident_shape
~
push
tys
.
Ty
.
ts_name
acc
)
let
decl_shape
~
version
~
(
push
:
string
->
'
a
->
'
a
)
(
acc
:
'
a
)
d
:
'
a
=
match
d
.
Decl
.
d_node
with
|
Decl
.
Dtype
_ts
->
push
tag_Dtype
acc
|
Decl
.
Ddata
tyl
->
List
.
fold_right
(
fun
_ty
acc
->
acc
)
List
.
fold_right
(
data_decl_shape
~
push
)
tyl
(
push
tag_Ddata
acc
)
|
Decl
.
Dparam
ls
->
param_decl_shape
~
push
(
push
tag_Dparam
acc
)
ls
...
...
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