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
15
Merge Requests
15
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
bddf7fdd
Commit
bddf7fdd
authored
Aug 22, 2015
by
Andrei Paskevich
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Typing: a record constructor may not exist as an lsymbol
parent
19b6b500
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
17 additions
and
18 deletions
+17
-18
src/core/decl.ml
src/core/decl.ml
+8
-8
src/core/decl.mli
src/core/decl.mli
+2
-2
src/core/pretty.ml
src/core/pretty.ml
+2
-2
src/parser/typing.ml
src/parser/typing.ml
+5
-6
No files found.
src/core/decl.ml
View file @
bddf7fdd
...
...
@@ -394,8 +394,8 @@ exception BadLogicDecl of lsymbol * lsymbol
exception
BadConstructor
of
lsymbol
exception
BadRecordField
of
lsymbol
exception
RecordFieldMissing
of
lsymbol
*
lsymbol
exception
DuplicateRecordField
of
lsymbol
*
lsymbol
exception
RecordFieldMissing
of
lsymbol
exception
DuplicateRecordField
of
lsymbol
exception
EmptyDecl
exception
EmptyAlgDecl
of
tysymbol
...
...
@@ -420,21 +420,21 @@ let create_data_decl tdl =
if
tdl
=
[]
then
raise
EmptyDecl
;
let
add
s
(
ts
,_
)
=
Sts
.
add
ts
s
in
let
tss
=
List
.
fold_left
add
Sts
.
empty
tdl
in
let
check_proj
cs
tyv
s
tya
ls
=
match
ls
with
let
check_proj
tyv
s
tya
ls
=
match
ls
with
|
None
->
s
|
Some
({
ls_args
=
[
ptyv
];
ls_value
=
Some
ptya
;
ls_constr
=
0
}
as
ls
)
->
ty_equal_check
tyv
ptyv
;
ty_equal_check
tya
ptya
;
Sls
.
add_new
(
DuplicateRecordField
(
cs
,
ls
)
)
ls
s
Sls
.
add_new
(
DuplicateRecordField
ls
)
ls
s
|
Some
ls
->
raise
(
BadRecordField
ls
)
in
let
check_constr
tys
ty
cll
pjs
(
syms
,
news
)
(
fs
,
pl
)
=
ty_equal_check
ty
(
Opt
.
get_exn
(
BadConstructor
fs
)
fs
.
ls_value
);
let
fs_pjs
=
try
List
.
fold_left2
(
check_proj
fs
ty
)
Sls
.
empty
fs
.
ls_args
pl
try
List
.
fold_left2
(
check_proj
ty
)
Sls
.
empty
fs
.
ls_args
pl
with
Invalid_argument
_
->
raise
(
BadConstructor
fs
)
in
if
not
(
Sls
.
equal
pjs
fs_pjs
)
then
raise
(
RecordFieldMissing
(
fs
,
Sls
.
choose
(
Sls
.
diff
pjs
fs_pjs
)));
raise
(
RecordFieldMissing
(
Sls
.
choose
(
Sls
.
diff
pjs
fs_pjs
)));
if
fs
.
ls_constr
<>
cll
then
raise
(
BadConstructor
fs
);
let
vs
=
ty_freevars
Stv
.
empty
ty
in
let
rec
check
seen
ty
=
match
ty
.
ty_node
with
...
...
@@ -779,12 +779,12 @@ let parse_record kn fll =
let
pjs
=
List
.
fold_left
(
fun
s
pj
->
Sls
.
add
pj
s
)
Sls
.
empty
pjl
in
let
flm
=
List
.
fold_left
(
fun
m
(
pj
,
v
)
->
if
not
(
Sls
.
mem
pj
pjs
)
then
raise
(
BadRecordField
pj
)
else
Mls
.
add_new
(
DuplicateRecordField
(
cs
,
pj
)
)
pj
v
m
)
Mls
.
empty
fll
in
Mls
.
add_new
(
DuplicateRecordField
pj
)
pj
v
m
)
Mls
.
empty
fll
in
cs
,
pjl
,
flm
let
make_record
kn
fll
ty
=
let
cs
,
pjl
,
flm
=
parse_record
kn
fll
in
let
get_arg
pj
=
Mls
.
find_exn
(
RecordFieldMissing
(
cs
,
pj
)
)
pj
flm
in
let
get_arg
pj
=
Mls
.
find_exn
(
RecordFieldMissing
pj
)
pj
flm
in
fs_app
cs
(
List
.
map
get_arg
pjl
)
ty
let
make_record_update
kn
t
fll
ty
=
...
...
src/core/decl.mli
View file @
bddf7fdd
...
...
@@ -138,8 +138,8 @@ exception EmptyIndDecl of lsymbol
exception
BadConstructor
of
lsymbol
exception
BadRecordField
of
lsymbol
exception
RecordFieldMissing
of
lsymbol
*
lsymbol
exception
DuplicateRecordField
of
lsymbol
*
lsymbol
exception
RecordFieldMissing
of
lsymbol
exception
DuplicateRecordField
of
lsymbol
(** {2 Utilities} *)
...
...
src/core/pretty.ml
View file @
bddf7fdd
...
...
@@ -574,9 +574,9 @@ let () = Exn_printer.register
fprintf
fmt
"Bad constructor: %a"
print_ls
ls
|
Decl
.
BadRecordField
ls
->
fprintf
fmt
"Not a record field: %a"
print_ls
ls
|
Decl
.
RecordFieldMissing
(
_cs
,
ls
)
->
|
Decl
.
RecordFieldMissing
ls
->
fprintf
fmt
"Field %a is missing"
print_ls
ls
|
Decl
.
DuplicateRecordField
(
_cs
,
ls
)
->
|
Decl
.
DuplicateRecordField
ls
->
fprintf
fmt
"Field %a is used twice in the same constructor"
print_ls
ls
|
Decl
.
IllegalTypeAlias
ts
->
fprintf
fmt
...
...
src/parser/typing.ml
View file @
bddf7fdd
...
...
@@ -339,9 +339,9 @@ let rec dterm tuc gvars at denv {term_desc = desc; term_loc = loc} =
let
e1
=
dterm
e1
in
DTquant
(
q
,
qvl
,
trl
,
e1
)
|
Ptree
.
Trecord
fl
->
let
get_val
cs
pj
=
function
let
get_val
_
cs
pj
=
function
|
Some
e
->
dterm
tuc
gvars
at
denv
e
|
None
->
Loc
.
error
~
loc
(
RecordFieldMissing
(
cs
,
pj
)
)
in
|
None
->
Loc
.
error
~
loc
(
RecordFieldMissing
pj
)
in
let
cs
,
fl
=
parse_record
~
loc
tuc
get_val
fl
in
DTapp
(
cs
,
fl
)
|
Ptree
.
Tupdate
(
e1
,
fl
)
->
...
...
@@ -396,7 +396,7 @@ let parse_record muc fll =
|
_
->
raise
(
BadRecordField
(
ls_of_rs
rs
))
in
let
pjs
=
Srs
.
of_list
itd
.
itd_fields
in
let
flm
=
List
.
fold_left
(
fun
m
(
pj
,
v
)
->
if
Srs
.
mem
pj
pjs
then
Mrs
.
add_new
(
DuplicateRecordField
(
ls_of_rs
cs
,
ls_of_rs
pj
))
pj
v
m
Mrs
.
add_new
(
DuplicateRecordField
(
ls_of_rs
pj
))
pj
v
m
else
raise
(
BadRecordField
(
ls_of_rs
pj
)))
Mrs
.
empty
fll
in
cs
,
itd
.
itd_fields
,
flm
...
...
@@ -607,9 +607,8 @@ let rec dexpr muc denv {expr_desc = desc; expr_loc = loc} =
|
Ptree
.
Erecord
fl
->
let
ls_of_rs
rs
=
match
rs
.
rs_logic
with
|
RLls
ls
->
ls
|
_
->
assert
false
in
let
get_val
cs
pj
=
function
|
None
->
Loc
.
error
~
loc
(
Decl
.
RecordFieldMissing
(
ls_of_rs
cs
,
ls_of_rs
pj
))
let
get_val
_cs
pj
=
function
|
None
->
Loc
.
error
~
loc
(
Decl
.
RecordFieldMissing
(
ls_of_rs
pj
))
|
Some
e
->
dexpr
muc
denv
e
in
let
cs
,
fl
=
parse_record
~
loc
muc
get_val
fl
in
expr_app
loc
(
DErs
cs
)
fl
...
...
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