Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
a49e7de5
Commit
a49e7de5
authored
Jun 24, 2010
by
Jean-Christophe Filliâtre
Browse files
programs: Pgm_types renamed into Pgm_env; the main control flow is now in Pgm_main.type_and_wp
parent
7b1638e1
Changes
9
Hide whitespace changes
Inline
Side-by-side
Makefile.in
View file @
a49e7de5
...
...
@@ -208,7 +208,7 @@ PGMGENERATED = src/programs/pgm_parser.mli src/programs/pgm_parser.ml \
src/programs/pgm_parser.output src/programs/pgm_lexer.ml
PGM_FILES
=
pgm_ttree pgm_ptree pgm_parser pgm_lexer pgm_effect
\
pgm_
types
pgm_typing pgm_wp pgm_main
pgm_
env
pgm_typing pgm_wp pgm_main
PGMMODULES
=
$(
addprefix
src/programs/,
$(PGM_FILES)
)
...
...
src/programs/pgm_
types
.ml
→
src/programs/pgm_
env
.ml
View file @
a49e7de5
File moved
src/programs/pgm_
types
.mli
→
src/programs/pgm_
env
.mli
View file @
a49e7de5
File moved
src/programs/pgm_main.ml
View file @
a49e7de5
...
...
@@ -21,28 +21,7 @@
open
Format
open
Why
(****
let files = ref []
let parse_only = ref false
let type_only = ref false
let debug = ref false
let loadpath = ref []
let prover = ref None
let () =
Arg.parse
["--parse-only", Arg.Set parse_only, "stops after parsing";
"--type-only", Arg.Set type_only, "stops after type-checking";
"--debug", Arg.Set debug, "sets the debug flag";
"-L", Arg.String (fun s -> loadpath := s :: !loadpath),
"<dir> adds dir to the loadpath";
"-P", Arg.String (fun s -> prover := Some s),
"<prover> proves the verification conditions";
]
(fun f -> files := f :: !files)
"usage: whyl [options] files..."
***)
open
Pgm_env
let
rec
report
fmt
=
function
|
Lexer
.
Error
e
->
...
...
@@ -66,31 +45,38 @@ let rec report fmt = function
|
e
->
raise
e
open
Pgm_ptree
let
parse_only
_env
file
c
=
let
lb
=
Lexing
.
from_channel
c
in
Loc
.
set_file
file
lb
;
ignore
(
Pgm_lexer
.
parse_file
lb
)
let
type_and_wp
?
(
type_only
=
false
)
env
gl
dl
=
let
decl
gl
d
=
if
type_only
then
gl
else
Pgm_wp
.
decl
gl
d
in
let
add
gl
d
=
let
gl
,
dl
=
Pgm_typing
.
decl
env
gl
d
in
List
.
fold_left
decl
gl
dl
in
List
.
fold_left
add
gl
dl
let
read_channel
?
(
debug
=
false
)
?
(
parse_only
=
false
)
?
(
type_only
=
false
)
env
file
c
=
Pgm_typing
.
debug
:=
debug
;
Pgm_wp
.
debug
:=
debug
;
let
lb
=
Lexing
.
from_channel
c
in
Loc
.
set_file
file
lb
;
let
p
=
Pgm_lexer
.
parse_file
lb
in
let
dl
=
Pgm_lexer
.
parse_file
lb
in
if
parse_only
then
Theory
.
Mnm
.
empty
else
begin
let
uc
=
Theory
.
create_theory
(
Ident
.
id_fresh
"Pgm"
)
in
let
th
=
Env
.
find_theory
env
[
"programs"
]
"Prelude"
in
let
uc
=
Theory
.
use_export
uc
th
in
let
uc
,
dl
=
Pgm_typing
.
file
env
uc
p
in
let
gl
=
empty_env
uc
in
let
gl
=
type_and_wp
~
type_only
env
gl
dl
in
if
type_only
then
Theory
.
Mnm
.
empty
else
begin
let
th
=
Pgm_wp
.
file
uc
dl
in
let
th
=
Theory
.
close_theory
gl
.
uc
in
Theory
.
Mnm
.
add
"Pgm"
th
Theory
.
Mnm
.
empty
end
end
...
...
src/programs/pgm_ttree.ml
View file @
a49e7de5
...
...
@@ -105,15 +105,15 @@ type variant = Term.term * Term.lsymbol
type
reference
=
Pgm_effect
.
reference
type
pre
=
Pgm_
types
.
pre
type
pre
=
Pgm_
env
.
pre
type
post
=
Pgm_
types
.
post
type
post
=
Pgm_
env
.
post
type
type_v
=
Pgm_
types
.
type_v
type
type_v
=
Pgm_
env
.
type_v
type
type_c
=
Pgm_
types
.
type_c
type
type_c
=
Pgm_
env
.
type_c
type
binder
=
Pgm_
types
.
binder
type
binder
=
Pgm_
env
.
binder
type
loop_annotation
=
{
loop_invariant
:
Term
.
fmla
option
;
...
...
src/programs/pgm_typing.ml
View file @
a49e7de5
...
...
@@ -28,7 +28,7 @@ open Denv
open
Ptree
open
Pgm_effect
open
Pgm_ttree
open
Pgm_
types
open
Pgm_
env
module
E
=
Pgm_effect
let
debug
=
ref
false
...
...
@@ -963,51 +963,43 @@ let add_exception loc x ty gl =
errorm
~
loc
"clash with previous exception %s"
x
;
add_exception
(
id_user
x
loc
)
ty
gl
let
file
env
uc
dl
=
let
gl
=
empty_env
uc
in
let
gl
,
dl
=
List
.
fold_left
(
fun
(
gl
,
acc
)
d
->
match
d
with
|
Pgm_ptree
.
Dlogic
dl
->
let
dl
=
logic_list0_decl
dl
in
let
add1
gl
d
=
Pgm_types
.
add_pdecl
env
d
gl
in
let
gl
=
List
.
fold_left
add1
gl
dl
in
gl
,
acc
|
Pgm_ptree
.
Dlet
(
id
,
e
)
->
let
e
=
type_expr
gl
e
in
(* if !debug then *)
(* eprintf "@[--typing %s-----@\n %a@]@." id.id print_expr e; *)
let
ls
,
gl
=
add_global
id
.
id_loc
id
.
id
e
.
expr_type_v
gl
in
gl
,
Dlet
(
ls
,
e
)
::
acc
|
Pgm_ptree
.
Dletrec
dl
->
let
denv
=
create_denv
gl
in
let
_
,
dl
=
dletrec
denv
dl
in
let
_
,
dl
=
iletrec
gl
Mstr
.
empty
dl
in
let
one
gl
(
v
,
bl
,
var
,
t
)
=
let
loc
=
loc_of_id
v
.
vs_name
in
let
id
=
v
.
vs_name
.
id_string
in
let
t
,
c
=
triple
gl
t
in
let
tyv
=
Tarrow
(
bl
,
c
)
in
let
ls
,
gl
=
add_global
loc
id
tyv
gl
in
gl
,
(
ls
,
(
v
,
bl
,
var
,
t
))
in
let
gl
,
dl
=
map_fold_left
one
gl
dl
in
gl
,
Dletrec
dl
::
acc
|
Pgm_ptree
.
Dparam
(
id
,
tyv
)
->
let
denv
=
create_denv
gl
in
let
tyv
=
dtype_v
denv
tyv
in
let
tyv
=
type_v
gl
Mstr
.
empty
tyv
in
let
ls
,
gl
=
add_global
id
.
id_loc
id
.
id
tyv
gl
in
let
gl
=
add_global_if_pure
gl
ls
in
gl
,
Dparam
(
ls
,
tyv
)
::
acc
|
Pgm_ptree
.
Dexn
(
id
,
ty
)
->
let
ty
=
option_map
(
type_type
gl
)
ty
in
let
_
,
gl
=
add_exception
id
.
id_loc
id
.
id
ty
gl
in
gl
,
acc
)
(
gl
,
[]
)
dl
in
gl
.
uc
,
List
.
rev
dl
let
decl
env
gl
=
function
|
Pgm_ptree
.
Dlogic
dl
->
let
dl
=
logic_list0_decl
dl
in
let
add1
gl
d
=
Pgm_env
.
add_pdecl
env
d
gl
in
let
gl
=
List
.
fold_left
add1
gl
dl
in
gl
,
[]
|
Pgm_ptree
.
Dlet
(
id
,
e
)
->
let
e
=
type_expr
gl
e
in
(* if !debug then *)
(* eprintf "@[--typing %s-----@\n %a@]@." id.id print_expr e; *)
let
ls
,
gl
=
add_global
id
.
id_loc
id
.
id
e
.
expr_type_v
gl
in
gl
,
[
Dlet
(
ls
,
e
)]
|
Pgm_ptree
.
Dletrec
dl
->
let
denv
=
create_denv
gl
in
let
_
,
dl
=
dletrec
denv
dl
in
let
_
,
dl
=
iletrec
gl
Mstr
.
empty
dl
in
let
one
gl
(
v
,
bl
,
var
,
t
)
=
let
loc
=
loc_of_id
v
.
vs_name
in
let
id
=
v
.
vs_name
.
id_string
in
let
t
,
c
=
triple
gl
t
in
let
tyv
=
Tarrow
(
bl
,
c
)
in
let
ls
,
gl
=
add_global
loc
id
tyv
gl
in
gl
,
(
ls
,
(
v
,
bl
,
var
,
t
))
in
let
gl
,
dl
=
map_fold_left
one
gl
dl
in
gl
,
[
Dletrec
dl
]
|
Pgm_ptree
.
Dparam
(
id
,
tyv
)
->
let
denv
=
create_denv
gl
in
let
tyv
=
dtype_v
denv
tyv
in
let
tyv
=
type_v
gl
Mstr
.
empty
tyv
in
let
ls
,
gl
=
add_global
id
.
id_loc
id
.
id
tyv
gl
in
let
gl
=
add_global_if_pure
gl
ls
in
gl
,
[
Dparam
(
ls
,
tyv
)]
|
Pgm_ptree
.
Dexn
(
id
,
ty
)
->
let
ty
=
option_map
(
type_type
gl
)
ty
in
let
_
,
gl
=
add_exception
id
.
id_loc
id
.
id
ty
gl
in
gl
,
[]
(*
Local Variables:
...
...
src/programs/pgm_typing.mli
View file @
a49e7de5
...
...
@@ -26,11 +26,12 @@ type error
exception
Error
of
error
val
errorm
:
?
loc
:
Loc
.
position
->
(
'
a
,
Format
.
formatter
,
unit
,
'
b
)
format4
->
'
a
val
report
:
Format
.
formatter
->
error
->
unit
val
file
:
Env
.
env
->
theory_uc
->
Pgm_ptree
.
file
->
theory_uc
*
Pgm_ttree
.
file
(*
val
errorm : ?loc:Loc.position -> ('a, Format.formatter, unit, 'b) format4 -> 'a *)
val
decl
:
Env
.
env
->
Pgm_env
.
env
->
Pgm_ptree
.
decl
->
Pgm_env
.
env
*
Pgm_ttree
.
decl
list
(* TODO: move elsewhere? *)
val
reference_of_term
:
Term
.
term
->
Pgm_effect
.
reference
src/programs/pgm_wp.ml
View file @
a49e7de5
...
...
@@ -28,7 +28,7 @@ open Theory
open
Pretty
open
Pgm_ttree
open
Pgm_typing
open
Pgm_
types
open
Pgm_
env
module
E
=
Pgm_effect
...
...
@@ -388,13 +388,9 @@ let decl env = function
env
in
List
.
fold_left
add_one
env
dl
|
Pgm_ttree
.
Dparam
(
_ls
,
_v
)
->
|
Pgm_ttree
.
Dparam
_
->
env
let
file
uc
dl
=
let
env
=
List
.
fold_left
decl
(
empty_env
uc
)
dl
in
Theory
.
close_theory
env
.
uc
(*
Local Variables:
compile-command: "unset LANG; make -C ../.. testl"
...
...
src/programs/pgm_wp.mli
View file @
a49e7de5
...
...
@@ -22,7 +22,7 @@ open Theory
val
debug
:
bool
ref
val
file
:
theory_uc
->
Pgm_ttree
.
file
->
theory
val
decl
:
Pgm_env
.
env
->
Pgm_ttree
.
decl
->
Pgm_env
.
env
(** takes as input the result of [Pgm_typing.file] and produces
a theory containing the verification conditions as goals,
one for each function *)
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