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
121
Issues
121
List
Boards
Labels
Service Desk
Milestones
Merge Requests
17
Merge Requests
17
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
dde1e0cd
Commit
dde1e0cd
authored
Jul 18, 2018
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Ident: handle tight prefix symbols inside Ident
parent
cb870251
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
36 additions
and
62 deletions
+36
-62
src/core/ident.ml
src/core/ident.ml
+23
-38
src/core/ident.mli
src/core/ident.mli
+11
-14
src/core/pretty.ml
src/core/pretty.ml
+1
-6
src/mlw/expr.ml
src/mlw/expr.ml
+1
-4
No files found.
src/core/ident.ml
View file @
dde1e0cd
...
...
@@ -50,9 +50,10 @@ let attr_compare a1 a2 = Pervasives.compare a1.attr_tag a2.attr_tag
(** Naming convention *)
type
notation
=
|
SNword
of
string
|
SNinfix
of
string
|
SNprefix
of
string
|
SNword
of
string
(* plus *)
|
SNinfix
of
string
(* + *)
|
SNtight
of
string
(* ! *)
|
SNprefix
of
string
(* -_ *)
|
SNget
of
string
(* [] *)
|
SNset
of
string
(* []<- *)
|
SNupdate
of
string
(* [<-] *)
...
...
@@ -71,35 +72,24 @@ let op_cut s = "mixfix [..]" ^ s
let
op_lcut
s
=
"mixfix [.._]"
^
s
let
op_rcut
s
=
"mixfix [_..]"
^
s
let
op_equ
=
op_infix
"="
let
op_neq
=
op_infix
"<>"
let
sn_encode
=
function
|
SNinfix
s
->
op_infix
s
|
SNprefix
s
->
op_prefix
s
|
SNget
s
->
op_get
s
|
SNset
s
->
op_set
s
|
SNupdate
s
->
op_update
s
|
SNcut
s
->
op_cut
s
|
SNlcut
s
->
op_lcut
s
|
SNrcut
s
->
op_rcut
s
|
SNword
s
->
s
let
op_equ
=
op_infix
"="
let
op_neq
=
op_infix
"<>"
let
op_tight
=
op_prefix
let
print_sn
fmt
w
=
let
lspace
p
=
if
p
.
[
0
]
=
'
*
'
then
" "
else
""
in
let
rspace
p
=
if
p
.
[
String
.
length
p
-
1
]
=
'
*
'
then
" "
else
""
in
match
w
with
(* infix/prefix never empty, mixfix never have stars *)
|
SNinfix
p
->
Format
.
fprintf
fmt
"(%s%s%s)"
(
lspace
p
)
p
(
rspace
p
)
|
SNprefix
p
when
p
.
[
0
]
=
'
!
'
||
p
.
[
0
]
=
'
?
'
->
Format
.
fprintf
fmt
"(%s%s)"
p
(
rspace
p
)
match
w
with
(* infix/prefix never empty, mixfix cannot have stars *)
|
SNinfix
p
->
Format
.
fprintf
fmt
"(%s%s%s)"
(
lspace
p
)
p
(
rspace
p
)
|
SNtight
p
->
Format
.
fprintf
fmt
"(%s%s)"
p
(
rspace
p
)
|
SNprefix
p
->
Format
.
fprintf
fmt
"(%s%s_)"
(
lspace
p
)
p
|
SNget
p
->
Format
.
fprintf
fmt
"([]%s)"
p
|
SNset
p
->
Format
.
fprintf
fmt
"([]%s<-)"
p
|
SNget
p
->
Format
.
fprintf
fmt
"([]%s)"
p
|
SNset
p
->
Format
.
fprintf
fmt
"([]%s<-)"
p
|
SNupdate
p
->
Format
.
fprintf
fmt
"([<-]%s)"
p
|
SNcut
p
->
Format
.
fprintf
fmt
"([..]%s)"
p
|
SNlcut
p
->
Format
.
fprintf
fmt
"([.._]%s)"
p
|
SNrcut
p
->
Format
.
fprintf
fmt
"([_..]%s)"
p
|
SNword
p
->
Format
.
pp_print_string
fmt
p
|
SNcut
p
->
Format
.
fprintf
fmt
"([..]%s)"
p
|
SNlcut
p
->
Format
.
fprintf
fmt
"([.._]%s)"
p
|
SNrcut
p
->
Format
.
fprintf
fmt
"([_..]%s)"
p
|
SNword
p
->
Format
.
pp_print_string
fmt
p
(* The function below recognizes the following strings as notations:
"infix " (opchar+ [']* as p) (['_] [^'_] .* as q)
...
...
@@ -132,8 +122,10 @@ let sn_decode s =
if
i
=
l
||
s
.
[
i
]
=
'
_'
then
i
else
pred
i
in
let
m
=
skip_quote
l
in
if
l
=
k
&&
k
<
8
then
SNword
s
(* null infix/prefix *)
else
let
w
=
if
k
=
6
then
SNinfix
(
String
.
sub
s
6
(
m
-
6
))
else
if
k
=
7
then
SNprefix
(
String
.
sub
s
7
(
m
-
7
))
else
let
w
=
if
k
=
6
then
SNinfix
(
String
.
sub
s
6
(
m
-
6
))
else
if
k
=
7
then
let
op
=
String
.
sub
s
7
(
m
-
7
)
in
if
s
.
[
7
]
=
'
!
'
||
s
.
[
7
]
=
'
?
'
then
SNtight
op
else
SNprefix
op
else
let
p
=
if
l
<
m
then
String
.
sub
s
l
(
m
-
l
)
else
""
in
match
String
.
sub
s
8
(
l
-
8
)
with
|
"]"
->
SNget
p
|
"]<-"
->
SNset
p
|
"<-]"
->
SNupdate
p
...
...
@@ -224,19 +216,12 @@ let find_unique indices name =
let
specname
ind
=
(* If the symbol is infix/prefix *and* the name has not been
sanitized for provers, we don't want to disambiguate with
a number but with a symbol: "+" becomes "+'" "+''" etc.
a number but with a
quote
symbol: "+" becomes "+'" "+''" etc.
This allows to parse the ident again (for transformations). *)
if
ind
<=
0
then
name
else
match
sn_decode
name
with
|
SNinfix
s
->
op_infix
(
s
^
String
.
make
ind
'\''
)
|
SNprefix
s
->
op_prefix
(
s
^
String
.
make
ind
'\''
)
|
SNget
s
->
op_get
(
s
^
String
.
make
ind
'\''
)
|
SNset
s
->
op_set
(
s
^
String
.
make
ind
'\''
)
|
SNupdate
s
->
op_update
(
s
^
String
.
make
ind
'\''
)
|
SNcut
s
->
op_cut
(
s
^
String
.
make
ind
'\''
)
|
SNlcut
s
->
op_lcut
(
s
^
String
.
make
ind
'\''
)
|
SNrcut
s
->
op_rcut
(
s
^
String
.
make
ind
'\''
)
|
SNword
_
->
name
^
string_of_int
ind
in
|
SNword
_
->
name
^
string_of_int
ind
|
_
->
name
^
String
.
make
ind
'\''
in
let
testname
ind
=
Hstr
.
mem
indices
(
specname
ind
)
in
let
rec
advance
ind
=
if
testname
ind
then
advance
(
succ
ind
)
else
ind
in
...
...
src/core/ident.mli
View file @
dde1e0cd
...
...
@@ -32,9 +32,10 @@ val list_attributes : unit -> string list
(** {2 Naming convention} *)
type
notation
=
|
SNword
of
string
|
SNinfix
of
string
|
SNprefix
of
string
|
SNword
of
string
(* plus *)
|
SNinfix
of
string
(* + *)
|
SNtight
of
string
(* ! *)
|
SNprefix
of
string
(* -_ *)
|
SNget
of
string
(* [] *)
|
SNset
of
string
(* []<- *)
|
SNupdate
of
string
(* [<-] *)
...
...
@@ -42,18 +43,8 @@ type notation =
|
SNlcut
of
string
(* [.._] *)
|
SNrcut
of
string
(* [_..] *)
val
sn_encode
:
notation
->
string
(* encode the symbol name as a string *)
val
sn_decode
:
string
->
notation
(* decode the string as a symbol name *)
val
print_decoded
:
Format
.
formatter
->
string
->
unit
(* decode the string as a symbol name and pretty-print it *)
(* specialized encoders *)
val
op_infix
:
string
->
string
val
op_tight
:
string
->
string
val
op_prefix
:
string
->
string
val
op_get
:
string
->
string
val
op_set
:
string
->
string
...
...
@@ -64,6 +55,12 @@ val op_rcut : string -> string
val
op_equ
:
string
val
op_neq
:
string
val
sn_decode
:
string
->
notation
(* decode the string as a symbol name *)
val
print_decoded
:
Format
.
formatter
->
string
->
unit
(* decode the string as a symbol name and pretty-print it *)
(** {2 Identifiers} *)
type
ident
=
private
{
...
...
src/core/pretty.ml
View file @
dde1e0cd
...
...
@@ -131,11 +131,6 @@ let print_vs fmt vs =
let
forget_var
vs
=
forget_id
iprinter
vs
.
vs_name
(* pretty-print infix and prefix logic symbols *)
let
tight_op
s
=
s
<>
""
&&
(
let
c
=
String
.
get
s
0
in
c
=
'
!
'
||
c
=
'
?
'
)
(* theory names always start with an upper case letter *)
let
print_th
fmt
th
=
let
sanitizer
=
Strings
.
capitalize
in
...
...
@@ -256,7 +251,7 @@ and print_app pri ls fmt tl =
if
tl
=
[]
then
print_ls
fmt
ls
else
let
s
=
id_unique
iprinter
ls
.
ls_name
in
match
Ident
.
sn_decode
s
,
tl
with
|
Ident
.
SN
prefix
s
,
[
t1
]
when
tight_op
s
->
|
Ident
.
SN
tight
s
,
[
t1
]
->
fprintf
fmt
(
protect_on
(
pri
>
8
)
"@[%s%a@]"
)
s
(
print_lterm
8
)
t1
|
Ident
.
SNprefix
s
,
[
t1
]
->
...
...
src/mlw/expr.ml
View file @
dde1e0cd
...
...
@@ -1171,9 +1171,6 @@ let forget_let_defn = function
|
LDsym
(
s
,_
)
->
forget_rs
s
|
LDrec
rdl
->
List
.
iter
(
fun
fd
->
forget_rs
fd
.
rec_sym
)
rdl
let
tight_op
s
=
s
<>
""
&&
(
let
c
=
String
.
get
s
0
in
c
=
'
!
'
||
c
=
'
?
'
)
let
print_rs
fmt
s
=
match
s
.
rs_logic
with
|
RLnone
|
RLlemma
->
Ident
.
print_decoded
fmt
(
id_unique
sprinter
s
.
rs_name
)
...
...
@@ -1231,7 +1228,7 @@ let print_capp pri s fmt vl =
if
vl
=
[]
then
print_rs
fmt
s
else
let
p
=
id_unique
sprinter
s
.
rs_name
in
match
Ident
.
sn_decode
p
,
vl
with
|
Ident
.
SN
prefix
o
,
[
t1
]
when
tight_op
o
->
|
Ident
.
SN
tight
o
,
[
t1
]
->
fprintf
fmt
(
protect_on
(
pri
>
7
)
"%s%a"
)
o
print_pv
t1
|
Ident
.
SNprefix
o
,
[
t1
]
->
fprintf
fmt
(
protect_on
(
pri
>
4
)
"%s %a"
)
o
print_pv
t1
...
...
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