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
119
Issues
119
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
644ef011
Commit
644ef011
authored
Feb 18, 2010
by
Jean-Christophe Filliâtre
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
distinction lident/uident a la Caml
parent
64abfa8a
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
70 additions
and
48 deletions
+70
-48
src/lexer.mll
src/lexer.mll
+9
-5
src/parser.mly
src/parser.mly
+27
-13
src/ptree.mli
src/ptree.mli
+1
-1
src/test.why
src/test.why
+11
-11
src/typing.ml
src/typing.ml
+19
-15
src/typing.mli
src/typing.mli
+3
-3
No files found.
src/lexer.mll
View file @
644ef011
...
...
@@ -127,10 +127,12 @@
let
newline
=
'\n'
let
space
=
[
'
'
'\t'
'\r'
]
let
alpha
=
[
'
a'
-
'
z'
'
A'
-
'
Z'
]
let
letter
=
alpha
|
'
_'
let
lalpha
=
[
'
a'
-
'
z'
'
_'
]
let
ualpha
=
[
'
A'
-
'
Z'
]
let
alpha
=
lalpha
|
ualpha
let
digit
=
[
'
0
'
-
'
9
'
]
let
ident
=
letter
(
letter
|
digit
|
'\''
)
*
let
lident
=
lalpha
(
alpha
|
digit
|
'\''
)
*
let
uident
=
ualpha
(
alpha
|
digit
|
'\''
)
*
let
hexadigit
=
[
'
0
'
-
'
9
'
'
a'
-
'
f'
'
A'
-
'
F'
]
(*
let hexafloat = '0' ['x' 'X'] (hexadigit* '.' hexadigit+ | hexadigit+ '.' hexadigit* ) ['p' 'P'] ['-' '+']? digit+
...
...
@@ -144,8 +146,10 @@ rule token = parse
{
newline
lexbuf
;
token
lexbuf
}
|
space
+
{
token
lexbuf
}
|
ident
as
id
{
try
Hashtbl
.
find
keywords
id
with
Not_found
->
IDENT
id
}
|
lident
as
id
{
try
Hashtbl
.
find
keywords
id
with
Not_found
->
LIDENT
id
}
|
uident
as
id
{
UIDENT
id
}
|
digit
+
as
s
{
INTEGER
s
}
|
(
digit
+
as
i
)
(
""
as
f
)
[
'
e'
'
E'
]
([
'
-
'
'
+
'
]
?
digit
+
as
e
)
...
...
src/parser.mly
View file @
644ef011
...
...
@@ -87,7 +87,7 @@
/*
Tokens
*/
%
token
<
string
>
IDENT
%
token
<
string
>
LIDENT
U
IDENT
%
token
<
string
>
INTEGER
%
token
<
Ptree
.
real_constant
>
FLOAT
%
token
<
string
>
STRING
...
...
@@ -168,12 +168,26 @@ list0_decl:
;
ident
:
|
IDENT
{
{
id
=
$
1
;
id_loc
=
loc
()
}
}
|
LIDENT
{
{
id
=
$
1
;
id_loc
=
loc
()
}
}
|
UIDENT
{
{
id
=
$
1
;
id_loc
=
loc
()
}
}
;
qualid
:
|
ident
{
Qident
$
1
}
|
ident
DOT
ident
{
Qdot
(
$
1
,
$
3
)
}
lident
:
|
LIDENT
{
{
id
=
$
1
;
id_loc
=
loc
()
}
}
;
uident
:
|
UIDENT
{
{
id
=
$
1
;
id_loc
=
loc
()
}
}
;
lqualid
:
|
lident
{
Qident
$
1
}
|
uqualid
DOT
lident
{
Qdot
(
$
1
,
$
3
)
}
;
uqualid
:
|
uident
{
Qident
$
1
}
|
uqualid
DOT
uident
{
Qdot
(
$
1
,
$
3
)
}
;
decl
:
...
...
@@ -277,11 +291,11 @@ primitive_type:
*/
|
type_var
{
PPTvarid
$
1
}
|
qualid
|
l
qualid
{
PPTexternal
([]
,
$
1
)
}
|
primitive_type
qualid
|
primitive_type
l
qualid
{
PPTexternal
([
$
1
]
,
$
2
)
}
|
LEFTPAR
primitive_type
COMMA
list1_primitive_type_sep_comma
RIGHTPAR
qualid
|
LEFTPAR
primitive_type
COMMA
list1_primitive_type_sep_comma
RIGHTPAR
l
qualid
{
PPTexternal
(
$
2
::
$
4
,
$
6
)
}
/*
|
LEFTPAR
list1_primitive_type_sep_comma
RIGHTPAR
...
...
@@ -360,9 +374,9 @@ lexpr:
{
infix_pp
$
1
PPmod
$
3
}
|
MINUS
lexpr
%
prec
uminus
{
prefix_pp
PPneg
$
2
}
|
qualid
|
l
qualid
{
mk_pp
(
PPvar
$
1
)
}
|
qualid
LEFTPAR
list1_lexpr_sep_comma
RIGHTPAR
|
l
qualid
LEFTPAR
list1_lexpr_sep_comma
RIGHTPAR
{
mk_pp
(
PPapp
(
$
1
,
$
3
))
}
/***
|
qualid_ident
LEFTSQ
lexpr
RIGHTSQ
...
...
@@ -412,8 +426,8 @@ match_case:
;
pattern
:
|
qualid
{
(
$
1
,
[]
,
loc
()
)
}
|
qualid
LEFTPAR
list1_ident_sep_comma
RIGHTPAR
{
(
$
1
,
$
3
,
loc
()
)
}
|
u
qualid
{
(
$
1
,
[]
,
loc
()
)
}
|
u
qualid
LEFTPAR
list1_ident_sep_comma
RIGHTPAR
{
(
$
1
,
$
3
,
loc
()
)
}
;
triggers
:
...
...
@@ -462,7 +476,7 @@ qualid_ident:
***/
ident_or_string
:
|
IDENT
{
$
1
}
|
ident
{
$
1
.
id
}
|
STRING
{
$
1
}
;
...
...
src/ptree.mli
View file @
644ef011
...
...
@@ -40,7 +40,7 @@ type ident = { id : string; id_loc : loc }
type
qualid
=
|
Qident
of
ident
|
Qdot
of
ident
*
ident
|
Qdot
of
qualid
*
ident
type
ppure_type
=
(*
...
...
src/test.why
View file @
644ef011
(* test file *)
theory
i
nt
theory
I
nt
type int
end
theory
l
ist
theory
L
ist
uses
i
nt
uses
I
nt
type 'a list
...
...
@@ -19,11 +19,11 @@ theory list
logic is_nil : 'a list -> prop
logic length : 'a list ->
i
nt.int
logic length : 'a list ->
I
nt.int
end
theory
e
q
theory
E
q
logic eq : 'a, 'a -> prop
...
...
@@ -31,30 +31,30 @@ end
theory set
uses
e
q
uses
E
q
type elt
type t
logic
In
: elt, t -> prop
logic
in_
: elt, t -> prop
logic empty : t
axiom empty_def1 : forall x:elt, not
In
(x, empty)
axiom empty_def1 : forall x:elt, not
in_
(x, empty)
logic add : elt, t -> t
axiom add_def1 : forall x,y:elt, forall s:t,
In(x, add(y, s)) <-> (eq.eq(x, y) or In
(x, s))
in_(x, add(y, s)) <-> (Eq.eq(x, y) or in_
(x, s))
end
theory test
uses
eq, l
ist
uses
Eq, L
ist
axiom a : forall x : 'a, not
eq.eq(list.nil, list.cons(list.nil, l
ist.nil))
axiom a : forall x : 'a, not
Eq.eq(List.nil, List.cons(List.nil, L
ist.nil))
end
src/typing.ml
View file @
644ef011
...
...
@@ -23,6 +23,7 @@ open Ptree
(** errors *)
type
error
=
|
Message
of
string
|
ClashType
of
string
|
BadTypeArity
of
string
|
UnboundType
of
qualid
...
...
@@ -43,11 +44,13 @@ let error ?loc e = match loc with
|
None
->
raise
(
Error
e
)
|
Some
loc
->
raise
(
Loc
.
Located
(
loc
,
Error
e
))
let
print_qualid
fmt
=
function
let
rec
print_qualid
fmt
=
function
|
Qident
s
->
fprintf
fmt
"%s"
s
.
id
|
Qdot
(
m
,
s
)
->
fprintf
fmt
"%
s.%s"
m
.
id
s
.
id
|
Qdot
(
m
,
s
)
->
fprintf
fmt
"%
a.%s"
print_qualid
m
s
.
id
let
report
fmt
=
function
|
Message
s
->
fprintf
fmt
"%s"
s
|
ClashType
s
->
fprintf
fmt
"clash with previous type %s"
s
|
BadTypeArity
s
->
...
...
@@ -99,9 +102,9 @@ let is_empty env =
M
.
is_empty
env
.
fsymbols
&&
M
.
is_empty
env
.
psymbols
let
find_tysymbol
s
env
=
M
.
find
s
env
.
tysymbols
let
find_fsymbol
s
env
=
M
.
find
s
env
.
fsymbols
let
find_psymbol
s
env
=
M
.
find
s
env
.
psymbols
let
find_tysymbol
s
env
=
M
.
find
s
.
id
env
.
tysymbols
let
find_fsymbol
s
env
=
M
.
find
s
.
id
env
.
fsymbols
let
find_psymbol
s
env
=
M
.
find
s
.
id
env
.
psymbols
let
add_tysymbol
x
ty
env
=
{
env
with
tysymbols
=
M
.
add
x
ty
env
.
tysymbols
}
...
...
@@ -226,16 +229,17 @@ let rec specialize env t = match t.Ty.ty_node with
|
Ty
.
Tyapp
(
s
,
tl
)
->
Tyapp
(
s
,
List
.
map
(
specialize
env
)
tl
)
let
find_local_theory
t
env
=
let
find_local_theory
t
env
=
try
M
.
find
t
.
id
env
.
theories
with
Not_found
->
error
~
loc
:
t
.
id_loc
(
UnboundTheory
t
.
id
)
let
find
f
q
env
=
match
q
with
|
Qident
x
->
f
x
.
id
env
|
Qdot
(
m
,
x
)
->
let
env
=
find_local_theory
m
env
in
f
x
.
id
env
let
rec
find_theory
q
env
=
match
q
with
|
Qident
t
->
find_local_theory
t
env
|
Qdot
(
q
,
t
)
->
let
env
=
find_theory
q
env
in
find_local_theory
t
env
let
rec
find
f
q
env
=
match
q
with
|
Qident
x
->
f
x
env
|
Qdot
(
m
,
x
)
->
let
env
=
find_theory
m
env
in
f
x
env
let
specialize_tysymbol
x
env
=
let
s
=
find
find_tysymbol
x
env
.
env
in
...
...
@@ -255,9 +259,9 @@ let specialize_psymbol x env =
(** Typing types *)
let
qloc
=
function
let
rec
qloc
=
function
|
Qident
x
->
x
.
id_loc
|
Qdot
(
m
,
x
)
->
Loc
.
join
m
.
id_loc
x
.
id_loc
|
Qdot
(
m
,
x
)
->
Loc
.
join
(
qloc
m
)
x
.
id_loc
(* parsed types -> intermediate types *)
let
rec
dty
env
=
function
...
...
@@ -267,7 +271,7 @@ let rec dty env = function
let
loc
=
qloc
x
in
let
s
,
tv
=
try
specialize_tysymbol
x
env
with
Not_found
->
error
~
loc
:
loc
(
UnboundType
x
)
;
with
Not_found
->
error
~
loc
:
loc
(
UnboundType
x
)
in
let
np
=
List
.
length
p
in
let
a
=
List
.
length
tv
in
...
...
src/typing.mli
View file @
644ef011
...
...
@@ -22,9 +22,9 @@ type env
val
empty
:
env
val
find_tysymbol
:
string
->
env
->
tysymbol
val
find_fsymbol
:
string
->
env
->
fsymbol
val
find_psymbol
:
string
->
env
->
psymbol
val
find_tysymbol
:
Ptree
.
ident
->
env
->
tysymbol
val
find_fsymbol
:
Ptree
.
ident
->
env
->
fsymbol
val
find_psymbol
:
Ptree
.
ident
->
env
->
psymbol
(** typing *)
...
...
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