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
87ab5b5f
Commit
87ab5b5f
authored
Apr 29, 2015
by
Mário Pereira
Browse files
Merge branch 'master' of
git+ssh://scm.gforge.inria.fr//gitroot/why3/why3
parents
f9f0325d
7f2d940d
Changes
14
Expand all
Hide whitespace changes
Inline
Side-by-side
configure.in
View file @
87ab5b5f
...
...
@@ -495,8 +495,10 @@ else
COQVERSION=`$COQC -v | sed -n -e 's|.*version* *\([[^ ]]*\) .*$|\1|p' `
#Even if the name of the variable is CAMLP4 the value can be camlp5
COQCAMLP=$(eval `coqtop -config`; echo ${CAMLP4BIN}${CAMLP4}o)
COQCAMLPLIB=$(eval `coqtop -config`; echo ${CAMLP4LIB})
CAMLP4BIN=`coqtop -config | sed -n -e 's/CAMLP4BIN=\(.*\)$/\1/p'`
CAMLP4=`coqtop -config | sed -n -e 's/CAMLP4=\(.*\)$/\1/p'`
COQCAMLPLIB=`coqtop -config | sed -n -e 's/CAMLP4LIB=\(.*\)$/\1/p'`
COQCAMLP=${CAMLP4BIN}${CAMLP4}o
case $COQVERSION in
8.4*)
...
...
examples/vstte12_ring_buffer.mlw
View file @
87ab5b5f
...
...
@@ -139,3 +139,85 @@ module Harness
let h = pop b in assert { h = z }
end
(** With sequences instead of lists *)
module RingBufferSeq
use import int.Int
use import seq.Seq as S
use import array.Array
type buffer 'a = {
mutable first: int;
mutable len : int;
data : array 'a;
ghost mutable sequence: S.seq 'a;
}
invariant {
let size = Array.length self.data in
0 <= self.first < size /\
0 <= self.len <= size /\
self.len = S.length self.sequence /\
forall i: int. 0 <= i < self.len ->
(self.first + i < size ->
S.([]) self.sequence i = self.data[self.first + i]) /\
(0 <= self.first + i - size ->
S.([]) self.sequence i = self.data[self.first + i - size])
}
(* total capacity of the buffer *)
function size (b: buffer 'a) : int = Array.length b.data
(* length = number of elements *)
function length (b: buffer 'a) : int = b.len
(* code *)
let create (n: int) (dummy: 'a) : buffer 'a
requires { n > 0 }
ensures { size result = n }
ensures { result.sequence = S.empty }
= { first = 0; len = 0; data = make n dummy; sequence = S.empty }
let length (b: buffer 'a) : int
ensures { result = length b }
= b.len
let clear (b: buffer 'a) : unit
writes { b.len, b.sequence }
ensures { length b = 0 }
ensures { b.sequence = S.empty }
= ghost b.sequence <- S.empty;
b.len <- 0
let push (b: buffer 'a) (x: 'a) : unit
requires { length b < size b }
writes { b.data.elts, b.len, b.sequence }
ensures { length b = (old (length b)) + 1 }
ensures { b.sequence = S.snoc (old b.sequence) x }
= ghost b.sequence <- S.snoc b.sequence x;
let i = b.first + b.len in
let n = Array.length b.data in
b.data[if i >= n then i - n else i] <- x;
b.len <- b.len + 1
let head (b: buffer 'a) : 'a
requires { length b > 0 }
ensures { result = S.([]) b.sequence 0 }
= b.data[b.first]
let pop (b: buffer 'a) : 'a
requires { length b > 0 }
writes { b.first, b.len, b.sequence }
ensures { length b = (old (length b)) - 1 }
ensures { result = S.([]) (old b.sequence) 0 }
ensures { b.sequence = (old b.sequence)[1 ..] }
= ghost b.sequence <- b.sequence[1 ..];
let r = b.data[b.first] in
b.len <- b.len - 1;
let n = Array.length b.data in
b.first <- b.first + 1;
if b.first = n then b.first <- 0;
r
end
examples/vstte12_ring_buffer/why3session.xml
View file @
87ab5b5f
This diff is collapsed.
Click to expand it.
examples/vstte12_ring_buffer/why3shapes.gz
View file @
87ab5b5f
No preview for this file type
src/mlw/dexpr.ml
View file @
87ab5b5f
This diff is collapsed.
Click to expand it.
src/mlw/dexpr.mli
View file @
87ab5b5f
...
...
@@ -97,7 +97,8 @@ and dexpr_node =
|
DElet
of
dlet_defn
*
dexpr
|
DErec
of
drec_defn
*
dexpr
|
DEnot
of
dexpr
|
DElazy
of
lazy_op
*
dexpr
*
dexpr
|
DEand
of
dexpr
*
dexpr
|
DEor
of
dexpr
*
dexpr
|
DEif
of
dexpr
*
dexpr
*
dexpr
|
DEcase
of
dexpr
*
(
dpattern
*
dexpr
)
list
|
DEassign
of
(
dexpr
*
rsymbol
*
dexpr
)
list
...
...
@@ -157,4 +158,4 @@ val drec_defn : denv -> pre_fun_defn list -> denv * drec_defn
val
expr
:
?
keep_loc
:
bool
->
dexpr
->
expr
val
let_defn
:
?
keep_loc
:
bool
->
dlet_defn
->
let_defn
val
rec_defn
:
?
keep_loc
:
bool
->
drec_defn
->
rec
_defn
val
rec_defn
:
?
keep_loc
:
bool
->
drec_defn
->
let
_defn
src/mlw/expr.ml
View file @
87ab5b5f
This diff is collapsed.
Click to expand it.
src/mlw/expr.mli
View file @
87ab5b5f
...
...
@@ -19,7 +19,6 @@ open Ity
type
rsymbol
=
private
{
rs_name
:
ident
;
rs_cty
:
cty
;
rs_ghost
:
bool
;
rs_logic
:
rs_logic
;
rs_field
:
pvsymbol
option
;
}
...
...
@@ -64,6 +63,8 @@ val create_field : preid -> itysymbol -> pvsymbol -> rsymbol
val
restore_rs
:
lsymbol
->
rsymbol
(** raises [Not_found] if the argument is not a [rs_logic] *)
val
rs_ghost
:
rsymbol
->
bool
(** {2 Program patterns} *)
type
prog_pattern
=
private
{
...
...
@@ -86,8 +87,6 @@ val create_prog_pattern :
(** {2 Program expressions} *)
type
lazy_op
=
Eand
|
Eor
type
assertion_kind
=
Assert
|
Assume
|
Check
type
for_direction
=
To
|
DownTo
...
...
@@ -100,130 +99,119 @@ type variant = term * lsymbol option (** tau * (tau -> tau -> prop) *)
type
assign
=
pvsymbol
*
rsymbol
*
pvsymbol
(* region * field * value *)
type
vty
=
|
VtyI
of
ity
|
VtyC
of
cty
type
val_decl
=
|
ValV
of
pvsymbol
|
ValS
of
rsymbol
type
expr
=
private
{
e_node
:
expr_node
;
e_vty
:
vty
;
e_ghost
:
bool
;
e_ity
:
ity
;
e_effect
:
effect
;
e_vars
:
Spv
.
t
;
e_syms
:
Srs
.
t
;
e_label
:
Slab
.
t
;
e_loc
:
Loc
.
position
option
;
}
and
expr_node
=
private
|
Evar
of
pvsymbol
|
Esym
of
rsymbol
|
Econst
of
Number
.
constant
|
E
app
of
exp
r
*
pvsymbol
list
*
cty
|
E
fun
of
expr
|
E
exec
of
c
exp
|
E
assign
of
assign
list
|
Elet
of
let_defn
*
expr
|
Erec
of
rec_defn
*
expr
|
Enot
of
expr
|
Elazy
of
lazy_op
*
expr
*
expr
|
Eif
of
expr
*
expr
*
expr
|
Ecase
of
expr
*
(
prog_pattern
*
expr
)
list
|
Eassign
of
assign
list
|
Ewhile
of
expr
*
invariant
list
*
variant
list
*
expr
|
Efor
of
pvsymbol
*
for_bounds
*
invariant
list
*
expr
|
Etry
of
expr
*
(
xsymbol
*
pvsymbol
*
expr
)
list
|
Eraise
of
xsymbol
*
expr
|
Eghost
of
expr
|
Eassert
of
assertion_kind
*
term
|
Epure
of
term
|
Eabsurd
|
Etrue
|
Efalse
|
Eany
and
let_defn
=
private
{
let_sym
:
val_decl
;
let_expr
:
expr
;
and
cexp
=
private
{
c_node
:
cexp_node
;
c_cty
:
cty
;
}
and
cexp_node
=
private
|
Capp
of
rsymbol
*
pvsymbol
list
|
Cfun
of
expr
|
Cany
and
let_defn
=
private
|
LDvar
of
pvsymbol
*
expr
|
LDsym
of
rsymbol
*
cexp
|
LDrec
of
rec_defn
list
and
rec_defn
=
private
{
rec_defn
:
fun_defn
list
;
rec_decr
:
lsymbol
option
;
rec_sym
:
rsymbol
;
(* exported symbol *)
rec_rsym
:
rsymbol
;
(* internal symbol *)
rec_fun
:
cexp
;
(* Cfun *)
rec_varl
:
variant
list
;
}
and
fun_defn
=
{
fun_sym
:
rsymbol
;
(* exported symbol *)
fun_rsym
:
rsymbol
;
(* internal symbol *)
fun_expr
:
expr
;
(* Efun *)
fun_varl
:
variant
list
;
}
(** {2 Expressions} *)
val
e_label
:
?
loc
:
Loc
.
position
->
Slab
.
t
->
expr
->
expr
val
e_label_add
:
label
->
expr
->
expr
val
e_label_copy
:
expr
->
expr
->
expr
exception
ItyExpected
of
expr
exception
CtyExpected
of
expr
val
e_ghost
:
expr
->
bool
val
c_ghost
:
cexp
->
bool
val
ity_of_expr
:
expr
->
ity
val
c
ty_of_expr
:
exp
r
->
c
ty
val
e_ghostify
:
bool
->
expr
->
expr
val
c
_ghostify
:
bool
->
c
exp
->
c
exp
val
check_expr
:
expr
->
unit
(** [check_expr e] verifies that [e] does not perform bad
ghost writes nor contains stale (i.e., reset) regions.
This function must be called for any expression which
is used outside of an [Efun]-closure. *)
(** {2 Definitions} *)
val
e_fold
:
(
'
a
->
expr
->
'
a
)
->
'
a
->
expr
->
'
a
val
let_var
:
preid
->
?
ghost
:
bool
->
expr
->
let_defn
*
pvsymbol
val
e_find_minimal
:
(
expr
->
bool
)
->
expr
->
expr
(** [e_find_minimal pr e] looks for a minimal sub-expression
of [e] satisfying [pr], raises [Not_found] if none found. *)
val
let_sym
:
preid
->
?
ghost
:
bool
->
?
kind
:
rs_kind
->
cexp
->
let_defn
*
rsymbol
val
proxy_label
:
label
val
let_rec
:
(
rsymbol
*
cexp
*
variant
list
*
rs_kind
)
list
->
let_defn
*
rec_defn
list
(** {2
Smart constructor
s} *)
(** {2
Callable expression
s} *)
val
e_var
:
pvsymbol
->
expr
val
e_sym
:
rsymbol
->
expr
val
c_app
:
rsymbol
->
pvsymbol
list
->
ity
list
->
ity
->
cexp
val
e_const
:
Number
.
constant
->
expr
val
e_nat_const
:
in
t
->
expr
val
c_fun
:
pvsymbol
list
->
pre
list
->
post
list
->
post
list
Mexn
.
t
->
expr
->
cexp
val
create_let_defn_pv
:
preid
->
?
ghost
:
bool
->
expr
->
let_defn
*
pvsymbol
val
c_any
:
cty
->
cexp
type
ext_cexp
=
let_defn
list
*
cexp
val
create_let_defn_rs
:
preid
->
?
ghost
:
bool
->
?
kind
:
rs_kind
->
expr
->
let_defn
*
rsymbol
val
ext_c_sym
:
rsymbol
->
ext_cexp
val
create_let_defn
:
preid
->
?
ghost
:
bool
->
?
kind
:
rs_kind
->
expr
->
let_defn
val
ext_c_app
:
ext_cexp
->
expr
list
->
ity
list
->
ity
->
ext_cexp
val
create_rec_defn
:
(
rsymbol
*
expr
(* Efun *)
*
variant
list
*
rs_kind
)
list
->
rec_defn
(** {2 Expression constructors} *)
val
e_fun
:
pvsymbol
list
->
pre
list
->
post
list
->
post
list
Mexn
.
t
->
expr
->
expr
val
e_var
:
pvsymbol
->
expr
val
e_const
:
Number
.
constant
->
expr
val
e_nat_const
:
int
->
expr
val
e_exec
:
cexp
->
expr
val
e_app
:
rsymbol
->
expr
list
->
ity
list
->
ity
->
expr
val
e_let
:
let_defn
->
expr
->
expr
val
e_rec
:
rec_defn
->
expr
->
expr
val
e_app
:
expr
->
expr
list
->
ity
list
->
ity
->
expr
exception
FieldExpected
of
rsymbol
val
e_assign
:
(
expr
*
rsymbol
*
expr
)
list
->
expr
val
e_ghost
:
expr
->
expr
val
e_ghostify
:
expr
->
expr
val
e_if
:
expr
->
expr
->
expr
->
expr
val
e_lazy
:
lazy_op
->
expr
->
expr
->
expr
val
e_and
:
expr
->
expr
->
expr
val
e_or
:
expr
->
expr
->
expr
val
e_not
:
expr
->
expr
val
e_true
:
expr
val
e_true
:
expr
val
e_false
:
expr
val
is_e_true
:
expr
->
bool
val
is_e_false
:
expr
->
bool
val
e_raise
:
xsymbol
->
expr
->
ity
->
expr
val
e_try
:
expr
->
(
xsymbol
*
pvsymbol
*
expr
)
list
->
expr
...
...
@@ -232,8 +220,8 @@ val e_case : expr -> (prog_pattern * expr) list -> expr
val
e_while
:
expr
->
invariant
list
->
variant
list
->
expr
->
expr
val
e_for
:
pvsymbol
->
expr
->
for_direction
->
expr
->
invariant
list
->
expr
->
expr
val
e_for
:
pvsymbol
->
expr
->
for_direction
->
expr
->
invariant
list
->
expr
->
expr
val
e_pure
:
term
->
expr
...
...
@@ -241,15 +229,21 @@ val e_assert : assertion_kind -> term -> expr
val
e_absurd
:
ity
->
expr
val
e_any
:
cty
->
expr
(** {2 Expression manipulation tools} *)
(** {2 Built-in symbols} *)
val
e_fold
:
(
'
a
->
expr
->
'
a
)
->
'
a
->
expr
->
'
a
(** [e_fold] does not descend into Cfun *)
val
e_locate_effect
:
(
effect
->
bool
)
->
expr
->
Loc
.
position
option
(** [e_locate_effect pr e] looks for a minimal sub-expression of
[e] whose effect satisfies [pr] and returns its location *)
val
rs_bool_true
:
rsymbol
val
rs_bool_false
:
rsymbol
val
proxy_label
:
label
(** {2 Built-in symbols} *)
val
e_bool
_true
:
expr
val
e_bool
_false
:
expr
val
rs
_true
:
rsymbol
val
rs
_false
:
rsymbol
val
rs_tuple
:
int
->
rsymbol
val
e_tuple
:
expr
list
->
expr
...
...
@@ -257,6 +251,7 @@ val e_tuple : expr list -> expr
val
rs_void
:
rsymbol
val
e_void
:
expr
val
is_e_void
:
expr
->
bool
val
is_rs_tuple
:
rsymbol
->
bool
val
rs_func_app
:
rsymbol
...
...
@@ -268,8 +263,7 @@ val e_func_app_l : expr -> expr list -> expr
val
forget_rs
:
rsymbol
->
unit
(* flush id_unique for a program symbol *)
val
print_rs
:
Format
.
formatter
->
rsymbol
->
unit
(* program symbol *)
val
print_expr
:
Format
.
formatter
->
expr
->
unit
(* expression *)
val
print_val_decl
:
Format
.
formatter
->
val_decl
->
unit
val
print_let_defn
:
Format
.
formatter
->
let_defn
->
unit
val
print_rec_defn
:
Format
.
formatter
->
rec_defn
->
unit
src/mlw/ity.ml
View file @
87ab5b5f
This diff is collapsed.
Click to expand it.
src/mlw/ity.mli
View file @
87ab5b5f
...
...
@@ -13,7 +13,7 @@ open Ident
open
Ty
open
Term
(** {2 Individual types (first-order types w
/o
effects)} *)
(** {2 Individual types (first-order types w
ithout
effects)} *)
type
itysymbol
=
private
{
its_ts
:
tysymbol
;
(** pure "snapshot" type symbol *)
...
...
@@ -256,40 +256,55 @@ val create_xsymbol : preid -> ity -> xsymbol
(** {2 Effects} *)
exception
IllegalAlias
of
region
exception
AssignPrivate
of
region
exception
StaleVariable
of
pvsymbol
*
region
exception
BadGhostWrite
of
pvsymbol
*
region
exception
DuplicateField
of
region
*
pvsymbol
exception
WriteImmutable
of
region
*
pvsymbol
exception
GhostDivergence
type
effect
=
private
{
eff_writes
:
Spv
.
t
Mreg
.
t
;
eff_resets
:
Sreg
.
t
Mreg
.
t
;
eff_raises
:
Sexn
.
t
;
eff_diverg
:
bool
;
eff_reads
:
Spv
.
t
;
(* known variables *)
eff_writes
:
Spv
.
t
Mreg
.
t
;
(* modifications to specific fields *)
eff_covers
:
Sreg
.
t
Mreg
.
t
;
(* confinement of regions to covers *)
eff_taints
:
Sreg
.
t
;
(* ghost modifications *)
eff_raises
:
Sexn
.
t
;
(* raised exceptions *)
eff_oneway
:
bool
;
(* non-termination *)
eff_ghost
:
bool
;
(* ghost status *)
}
val
eff_empty
:
effect
val
eff_equal
:
effect
->
effect
->
bool
val
eff_union
:
effect
->
effect
->
effect
val
eff_
is_empty
:
effect
->
bool
val
eff_
is_
pure
:
effect
->
bool
val
eff_
equal
:
effect
->
effect
->
bool
val
eff_pure
:
effect
->
bool
exception
AssignPrivate
of
region
exception
DuplicateField
of
region
*
pvsymbol
exception
WriteImmutable
of
region
*
pvsymbol
val
eff_read
:
Spv
.
t
->
effect
val
eff_write
:
Spv
.
t
->
Spv
.
t
Mreg
.
t
->
effect
(* drops writes outside reads *)
val
eff_assign
:
(
pvsymbol
*
pvsymbol
*
pvsymbol
)
list
->
effect
(* r,field,v *)
val
eff_write
:
effect
->
region
->
Spv
.
t
->
effect
val
eff_raise
:
effect
->
xsymbol
->
effect
val
eff_catch
:
effect
->
xsymbol
->
effect
val
eff_reset
:
effect
->
region
->
effect
val
eff_read_pre
:
Spv
.
t
->
effect
->
effect
(* no stale-variable check *)
val
eff_read_post
:
effect
->
Spv
.
t
->
effect
(* checks for stale variables *)
val
eff_bind
:
Spv
.
t
->
effect
->
effect
(* removes variables from reads *)
val
eff_diverge
:
effect
->
effect
val
eff_read_single
:
pvsymbol
->
effect
val
eff_read_single_pre
:
pvsymbol
->
effect
->
effect
val
eff_read_single_post
:
effect
->
pvsymbol
->
effect
val
eff_bind_single
:
pvsymbol
->
effect
->
effect
val
eff_assign
:
effect
->
(
region
*
pvsymbol
*
ity
)
list
->
effect
val
eff_reset
:
effect
->
region
->
effect
(* confine to an empty cover *)
val
eff_strong
:
effect
->
effect
(* confine all subregions under writes *)
val
refresh_of_effect
:
effect
->
effect
val
eff_raise
:
effect
->
xsymbol
->
effect
val
eff_catch
:
effect
->
xsymbol
->
effect
exception
IllegalAlias
of
region
val
eff_diverge
:
effect
->
effect
(* forbidden if ghost *)
val
eff_ghostify
:
bool
->
effect
->
effect
(* forbidden if diverges *)
val
eff_
full_inst
:
ity_subst
->
effect
->
effect
val
eff_
contagious
:
effect
->
bool
(* ghost and raising exceptions *)
val
eff_stale_region
:
effect
->
ity
->
bool
val
eff_union_seq
:
effect
->
effect
->
effect
(* checks for stale variables *)
val
eff_union_par
:
effect
->
effect
->
effect
(* no stale-variable check *)
(** {2 Computation types (higher-order types with effects)} *)
...
...
@@ -304,57 +319,52 @@ type cty = private {
cty_pre
:
pre
list
;
cty_post
:
post
list
;
cty_xpost
:
post
list
Mexn
.
t
;
cty_reads
:
Spv
.
t
;
cty_effect
:
effect
;
cty_result
:
ity
;
cty_freeze
:
ity_subst
;
}
val
create_cty
:
pvsymbol
list
->
pre
list
->
post
list
->
post
list
Mexn
.
t
->
Spv
.
t
->
effect
->
ity
->
cty
(** [create_cty args pre post xpost
reads
effect result] creates a cty.
pre
list
->
post
list
->
post
list
Mexn
.
t
->
effect
->
ity
->
cty
(** [create_cty args pre post xpost effect result] creates a cty.
The [cty_xpost] field does not have to cover all raised exceptions.
The
[cty_
reads] field contains all unbound variables from the spec
.
The
[cty_freeze]
field
freezes every pvsymbol in [cty_reads].
The [cty_effect] field is filtered wrt [cty_reads] and [args]
.
[cty_
effect.eff_reads] is completed wrt the specification and [args]
.
[cty_freeze] freezes every
unbound
pvsymbol in [cty_
effect.eff_
reads].
All effects on regions outside [cty_effect.eff_reads] are removed
.
Fresh regions in [result] are reset. Every type variable in [pre],
[post], and [xpost] must come from [cty_reads], [args] or [result]. *)
val
cty_apply
:
?
ghost
:
bool
->
cty
->
pvsymbol
list
->
ity
list
->
ity
->
bool
*
cty
(** [cty_apply ?(ghost=false) cty pvl rest res] instantiates [cty]
up to the types in [pvl], [rest] and [res], then applies it to
the arguments in [pvl], and returns the ghost status and the
computation type of the result, [rest -> res], with every type
variable and region in [pvl] freezed. Typecasts into a mapping
type are allowed for total effectless computations.
*)
val
cty_apply
:
cty
->
pvsymbol
list
->
ity
list
->
ity
->
cty
(** [cty_apply cty pvl rest res] instantiates [cty] up to the types in
[pvl], [rest] and [res], then applies it to the arguments in [pvl],
and returns the computation type of the result, [rest -> res],
with every type variable and region in [pvl] being frozen. *)
val
cty_ghost
:
cty
->
bool
(** [cty_ghost cty] returns [cty.cty_effect.eff_ghost]
*)
val
cty_r_visible
:
cty
->
Sreg
.
t
(** [cty_r_visible cty] returns the set of regions which are visible
from the non-ghost read dependencies and arguments of [cty]. *)
val
cty_ghostify
:
bool
->
cty
->
cty
(** [cty_ghostify ghost cty] ghostifies the effect of [cty]. *)
val
cty_ghost_writes
:
bool
->
cty
->
Spv
.
t
Mreg
.
t
(** [cty_ghost_writes ghost cty] returns the subset of the write effect
of [cty] which corresponds to ghost writes into visible fields of
the ghost read dependencies and arguments of [cty]. *)
val
cty_reads
:
cty
->
Spv
.
t
(** [cty_reads cty] returns the set of external dependencies of [cty]. *)
val
cty_add_reads
:
cty
->
Spv
.
t
->
cty
(** [cty_add_reads cty pvs] adds variables in [pvs] to [cty.cty_reads].
This function performs capture: if some variables in [pvs] occur in
[cty.cty_args], they are removed from [pvs], and the corresponding
type variables and regions are not frozen. *)
(** [cty_add_reads cty pvs] adds [pvs] to [cty.cty_effect.eff_reads].
This function performs capture: if some variables in [pvs] occur
in [cty.cty_args], they are not frozen. *)
val
cty_add_pre
:
cty
->
pre
list
->
cty
(** [cty_add_pre cty
fl
] appends pre-conditions in [fl] to [cty.cty_pre].
val
cty_add_pre
:
pre
list
->
cty
->
cty
(** [cty_add_pre
fl
cty] appends pre-conditions in [fl] to [cty.cty_pre].
This function performs capture: the formulas in [fl] may refer to
the variables in [cty.cty_args]. Only the new external dependencies
in [fl] are added to [cty.cty_reads] and frozen. *)
in [fl] are added to [cty.cty_
effect.eff_
reads] and frozen. *)
val
cty_add_post
:
cty
->
post
list
->
cty
(** [cty_add_post cty fl] appends post-conditions in [fl] to [cty.cty_post].
This function performs capture: the formulas in [fl] may refer to the
variables in [cty.cty_args]. Only the new external dependencies in [fl]
are added to [cty.cty_reads] and frozen. *)
are added to [cty.cty_
effect.eff_
reads] and frozen. *)
(** {2 Pretty-printing} *)
...
...
@@ -371,5 +381,6 @@ val print_pv : Format.formatter -> pvsymbol -> unit (* program variable *)
val
print_pvty
:
Format
.
formatter
->
pvsymbol
->
unit
(* pvsymbol : type *)
val
print_cty
:
Format
.
formatter
->
cty
->
unit
(* computation type *)
val
print_spec
:
pvsymbol
list
->
pre
list
->
post
list
->
post
list
Mexn
.
t
->
Spv
.
t
->
effect
->
Format
.
formatter
->
ity
option
->
unit
(* piecemeal cty *)
val
print_spec
:
pvsymbol
list
->
pre
list
->
post
list
->
post
list
Mexn
.
t
->
effect
->
Format
.
formatter
->
ity
option
->
unit
(* piecemeal cty *)
src/parser/parser.mly
View file @
87ab5b5f
...
...
@@ -762,6 +762,12 @@ expr_sub:
{
Eidapp
(
get_op
$
startpos
(
$
2
)
$
endpos
(
$
2
)
,
[
$
1
;
$
3
])
}
|
expr_arg
LEFTSQ
expr
LARROW
expr
RIGHTSQ
{
Eidapp
(
set_op
$
startpos
(
$
2
)
$
endpos
(
$
2
)
,
[
$
1
;
$
3
;
$
5
])
}
|
expr_arg
LEFTSQ
expr
DOTDOT
expr
RIGHTSQ
{
Eidapp
(
sub_op
$
startpos
(
$
2
)
$
endpos
(
$
2
)
,
[
$
1
;
$
3
;
$
5
])
}
|
expr_arg
LEFTSQ
expr
DOTDOT
RIGHTSQ
{
Eidapp
(
above_op
$
startpos
(
$
2
)
$
endpos
(
$
2
)
,
[
$
1
;
$
3
])
}
|
expr_arg
LEFTSQ
DOTDOT
expr
RIGHTSQ
{
Eidapp
(
below_op
$
startpos
(
$
2
)
$
endpos
(
$
2
)
,
[
$
1
;
$
4
])
}
loop_annotation
:
|
(* epsilon *)
...
...
src/printer/smtv2.ml
View file @
87ab5b5f
...
...
@@ -57,7 +57,8 @@ let ident_printer =
"concat"
;
"bvnot"
;
"bvand"
;
"bvor"
;
"bvneg"
;
"bvadd"
;
"bvmul"
;
"bvudiv"
;
"bvurem"
;
"bvshl"
;
"bvlshr"
;
"bvult"
;
"bvnand"
;
"bvnor"
;
"bvxor"
;
"bvcomp"
;
"bvsub"
;
"bvsdiv"
;
"bvsrem"
;
"bvsmod"
;
"bvashr"
;
"bvule"
;
"bvugt"
;
"bvuge"
;
"bvslt"
;
"bvsle"
;
"bvsgt"
;
"bvsge"
;
"rotate_left"
;
"rotate_right"
;
"bvugt"
;
"bvuge"
;
"bvslt"
;
"bvsle"
;
"bvsgt"
;
"bvsge"
;
"rotate_left"
;
"rotate_right"
;
"cos"
;
"sin"
;
"tan"
;
"atan"
;
"pi"
;
...
...
@@ -129,12 +130,10 @@ let print_var_list info fmt vsl =
let
model_label
=
Ident
.
create_label
"model"
let
collect_model_ls
info
ls
=
if
ls
.
ls_args
=
[]
&&
Slab
.
mem
model_label
ls
.
ls_name
.
id_label
then
begin
let
t
=
t_app
ls
[]
ls
.
ls_value
in
info
.
info_model
<-
(
t_label
?
loc
:
ls
.
ls_name
.
id_loc
ls
.
ls_name
.
id_label
t
)
::
info
.
info_model
end
if
ls
.
ls_args
=
[]
&&
Slab
.
mem
model_label
ls
.
ls_name
.
id_label
then
let
t
=
t_app
ls
[]
ls
.
ls_value
in
info
.
info_model
<-
(
t_label
?
loc
:
ls
.
ls_name
.
id_loc
ls
.
ls_name
.
id_label
t
)
::
info
.
info_model
(** expr *)
let
rec
print_term
info
fmt
t
=
...
...
@@ -320,15 +319,16 @@ let print_param_decl info fmt ls =