programs: the type-checker is back and the bug in vacid_0_sparse_array is now...

programs: the type-checker is back and the bug in vacid_0_sparse_array is now fixed; make bench is back

Makefile.in

@@ -504,8 +504,7 @@ clean::
 
 .PHONY: bench test
 
-# bench:: bin/why.@OCAMLBEST@ bin/whyml.@OCAMLBEST@ $(TOOLS) $(DRIVERS)
-bench:: bin/why.@OCAMLBEST@ $(TOOLS) $(DRIVERS)
+bench:: bin/why.@OCAMLBEST@ bin/whyml.@OCAMLBEST@ $(TOOLS) $(DRIVERS)
 	sh bench/bench \
 	    "bin/why.@OCAMLBEST@" \
 	    "bin/whyml.@OCAMLBEST@"

examples/programs/vacid_0_sparse_array.mlw

@@ -57,12 +57,12 @@ back  +-+-+-+-------------------+
     0 <= n <= sz <= maxlen and
     forall i : int. 0 <= i < n -> 0 <= back#i < sz and idx#(back#i) = i
 
-(* 
+  (* 
     The following definitions and the axiom Dirichlet 
     (provable by natural induction) are necessary to
     prove the lemma Inter6, which is sufficient for
     the proof of WPs for the function [set] below.
-*)
+  *)
 
   logic permutation (n : int, a : int array) =
     (forall i : int. 0 <= i < n -> 0 <= a#i < n) and
@@ -96,15 +96,11 @@ parameter create :
   { sa_sz !result = sz and forall i:int. model !result i = default }
 *)
 
-(* BUG
 parameter malloc : n:int -> {} 'a array { A.length result = n }
-*)
-parameter malloc_elt : n:int -> {} elt array { A.length result = n }
-parameter malloc_int : n:int -> {} int array { A.length result = n }
 
 let create sz =
   { 0 <= sz <= maxlen } 
-  ref ((malloc_elt sz, malloc_int sz, malloc_int sz, sz, 0) : sparse_array)
+  ref ((malloc sz, malloc sz, malloc sz, sz, 0) : sparse_array)
   { invariant !result and 
     sa_sz !result = sz and forall i:int. model !result i = default }
 

src/programs/pgm_effect.ml

@@ -40,6 +40,11 @@ let ref_equal r1 r2 = match r1, r2 with
   | Rglobal ls1, Rglobal ls2 -> ls_equal ls1 ls2
   | _ -> false
 
+let reference_of_term t = match t.t_node with
+  | Term.Tvar vs -> Rlocal vs
+  | Term.Tapp (ls, []) -> Rglobal ls
+  | _ -> assert false
+
 module Reference = struct
   
   type t = reference
@@ -79,6 +84,9 @@ let add_read  r t = { t with reads  = Sref.add r t.reads  }
 let add_write r t = { t with writes = Sref.add r t.writes }
 let add_raise e t = { t with raises = E.add e t.raises }
 
+let remove_reference r t = 
+  { t with reads = Sref.remove r t.reads; writes = Sref.remove r t.writes }
+
 let remove_raise e t = { t with raises = E.remove e t.raises }
 
 let union t1 t2 =

src/programs/pgm_effect.mli

@@ -27,6 +27,7 @@ type reference =
 val name_of_reference : reference -> Ident.ident
 val type_of_reference : reference -> Ty.ty
 val ref_equal : reference -> reference -> bool
+val reference_of_term : Term.term -> reference
 
 module Sref : Set.S with type elt = reference
 module Mref : Map.S with type key = reference
@@ -43,6 +44,8 @@ val add_read  : reference -> t -> t
 val add_write : reference -> t -> t
 val add_raise : lsymbol -> t -> t
 
+val remove_reference : reference -> t -> t
+
 val remove_raise : lsymbol -> t -> t
 
 val union : t -> t -> t

src/programs/pgm_ttree.ml

@@ -28,7 +28,7 @@ type assertion_kind = Pgm_ptree.assertion_kind
 type lazy_op = Pgm_ptree.lazy_op
 
 (*****************************************************************************)
-(* phase 1: destructive typing *)
+(* phase 1: introduction of destructive types *)
 
 type dreference = 
   | DRlocal  of string
@@ -78,9 +78,7 @@ and dexpr_desc =
   | DEapply of dexpr * dexpr
   | DEfun of dbinder list * dtriple
   | DElet of string * dexpr * dexpr
-  | DEletrec of 
-      ((string * Denv.dty) * dbinder list * dvariant option * dtriple) list * 
-      dexpr
+  | DEletrec of drecfun list * dexpr
 
   | DEsequence of dexpr * dexpr
   | DEif of dexpr * dexpr * dexpr
@@ -96,10 +94,12 @@ and dexpr_desc =
   | DElabel of string * dexpr
   | DEany of dtype_c
 
+and drecfun = (string * Denv.dty) * dbinder list * dvariant option * dtriple
+
 and dtriple = dpre * dexpr * dpost
 
 (*****************************************************************************)
-(* phase 2: typing annotations *)
+(* phase 2: removal of destructive types *)
 
 type variant = Term.term * Term.lsymbol
 
@@ -158,7 +158,7 @@ and itriple = pre * iexpr * post
 
 
 (*****************************************************************************)
-(* phase 3: inferring effects *)
+(* phase 3: effect inference *)
 
 type expr = {
   expr_desc  : expr_desc;

src/programs/pgm_typing.mli

@@ -28,10 +28,6 @@ exception Error of error
 
 val report : Format.formatter -> error -> unit
 
-(* 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

@@ -27,7 +27,6 @@ open Decl
 open Theory
 open Pretty
 open Pgm_ttree
-open Pgm_typing
 open Pgm_env
 
 module E = Pgm_effect
@@ -97,7 +96,7 @@ let rec unref env r v f =
 
 and unref_term env r v t = match t.t_node with
   | Tapp (ls, [u]) when ls_equal ls env.ls_bang ->
-      let rt = reference_of_term u in
+      let rt = E.reference_of_term u in
       if E.ref_equal rt r then t_var v else t
   | Tapp (ls, _) when ls_equal ls env.ls_old ->
       assert false

tests/test-pgm-jcf.mlw

 
-{ 
-  type 'a t
-}
-
-parameter malloc : int -> {} 'a t { result=result }
-
-let foo () = malloc 1 : int t
+let rec f (x:int) =
+  if x = 0 then 0 else f (x-1)
 
 (*
 Local Variables: