programs: refactoring of typing (in progress)

Makefile.in

@@ -355,6 +355,9 @@ clean::
 %.gui: %.mlw bin/why3ide.opt
 	bin/why3ide.opt $*.mlw
 
+%.type: %.mlw bin/why3ide.opt
+	bin/why3ml.opt --type-only $*.mlw
+
 install_no_local::
 	cp -f bin/why3ml.@OCAMLBEST@ $(BINDIR)/why3ml
 

bin/db

 set arguments ../tests/test-pgm-jcf.mlw
 dir ..
 dir ../src
+dir ../src/util
+dir ../src/core
 dir ../src/programs
 load_printer "str.cma"
 load_printer "nums.cma"

examples/programs/course.mlw

@@ -5,13 +5,13 @@ module M
 
   (* preliminaries *)
 
-  use array.Array as A
+  use map.Map as M
 
-  type array 'a = A.t int 'a
+  type array 'a = M.map int 'a
 
   logic injective (n:int) (m:int) (a:array 'a) =
     forall i j:int. n <= i <= m -> n <= j <= m ->
-       A.get a i = A.get a j -> i = j
+       M.get a i = M.get a j -> i = j
 
   type string
 
@@ -19,14 +19,14 @@ module M
 
   type pointer = int
 
-  type region 'a = A.t pointer 'a
+  type region 'a = M.map pointer 'a
 
   type first_free_addr = int
 
   logic valid (a:first_free_addr) (p:pointer) = p < a
 
   logic valid_array (a:first_free_addr) (n:int) (m:int) (r:array pointer) =
-     forall i:int. n <= i <= m -> valid a (A.get r i)
+     forall i:int. n <= i <= m -> valid a (M.get r i)
 
 parameter alloc : ref first_free_addr
 
@@ -76,7 +76,7 @@ end
   axiom MarkSumNonEmpty :
     forall r:region student, i j:int, a : array pointer.
       i <= j ->
-        let (_,mark) = A.get r (A.get a j) in
+        let (_,mark) = M.get r (M.get a j) in
         markSum r i j a = markSum r i (j-1) a  + mark
 
 (*
@@ -92,13 +92,13 @@ end
   lemma MarkSum_set_array_outside :
      forall r:region student, i j k:int, a: array pointer, p:pointer.
      not (i <= k <= j) ->
-     markSum r i j (A.set a k p) = markSum r i j a
+     markSum r i j (M.set a k p) = markSum r i j a
 
 
   lemma MarkSum_set_region_outside :
      forall r:region student, i j:int, a: array pointer, p:pointer, s:student.
-     (forall k:int. i <= k <= j -> A.get a k <> p) ->
-     markSum (A.set r p s) i j a = markSum r i j a
+     (forall k:int. i <= k <= j -> M.get a k <> p) ->
+     markSum (M.set r p s) i j a = markSum r i j a
 
 
 
@@ -128,9 +128,9 @@ fun CreateCourse(R:[Course]): [R]
 let createCourse (r: (ref (region course))) : pointer =
   { }
     let c = new_pointer () in
-    let (rStud,student,count,sum) = A.get !r c in
+    let (rStud,student,count,sum) = M.get !r c in
     let newc = (rStud,student,0,0) in
-    r := A.set !r c newc;
+    r := M.set !r c newc;
     assert { invCourse alloc newc };
     c
   { valid alloc result }
@@ -152,12 +152,12 @@ fun RegisterStudent(R:[Course], c: [R], name: string): [R.Rstud]
 
 let registerStudent
     (r: (ref (region course))) (c:pointer) (name:string) : pointer =
-{ valid alloc c and invCourse alloc (A.get r c) }
+{ valid alloc c and invCourse alloc (M.get r c) }
   let s = new_pointer () in
-  let (rStud,student,count,sum) = A.get !r c in
+  let (rStud,student,count,sum) = M.get !r c in
   let newstud = (name,0) in
-  let newc = (A.set rStud s newstud,A.set student count s,count+1,sum) in
-  r := A.set !r c newc;
+  let newc = (M.set rStud s newstud,M.set student count s,count+1,sum) in
+  r := M.set !r c newc;
   assert { invCourse alloc newc };
   s
 { valid alloc result }

examples/programs/dijkstra.mlw

@@ -3,18 +3,18 @@ module M
   use import int.Int
   use import module stdlib.Ref
   use set.Fset as S
-  use array.Array as M
+  use map.Map as M
 
 (* iteration on a set *)
 
 parameter set_has_next : 
-  s:ref (S.t 'a) -> 
+  s:ref (S.set 'a) -> 
     {} 
     bool reads s 
     { if result=True then S.is_empty s else not S.is_empty s }
 
 parameter set_next :
-  s:ref (S.t 'a) -> 
+  s:ref (S.set 'a) -> 
     { not S.is_empty s }
     'a writes s 
     { S.mem result (old s) and s = S.remove result (old s) }
@@ -23,9 +23,9 @@ parameter set_next :
 
 type vertex
 
-logic v : S.t vertex
+logic v : S.set vertex
 
-logic g_succ(vertex) : S.t vertex
+logic g_succ(vertex) : S.set vertex
 
 axiom G_succ_sound : 
   forall x:vertex. S.subset (g_succ x) v
@@ -40,18 +40,18 @@ parameter eq_vertex :
 
 (* visited vertices *)
 
-parameter visited : ref (S.t vertex)
+parameter visited : ref (S.set vertex)
 
 parameter visited_add : 
   x:vertex -> {} unit writes visited { visited = S.add x (old visited) }
 
 (* current distances *)
 
-parameter d : ref (M.t vertex int)
+parameter d : ref (M.map vertex int)
 
 (* priority queue *)
 
-parameter q : ref (S.t vertex)
+parameter q : ref (S.set vertex)
 
 parameter q_is_empty : 
   unit -> 
@@ -88,7 +88,7 @@ let relax u v =
     (not S.mem v visited and not S.mem v (old q) and q = S.add v (old q) and
         d = M.set (old d) v (M.get (old d) u + weight u v)) }	
 
-logic min (m:vertex) (q:S.t vertex) (d:M.t vertex int) =
+logic min (m:vertex) (q:S.set vertex) (d:M.map vertex int) =
   S.mem m q and 
   forall x:vertex. S.mem x q -> M.get d m <= M.get d x
 
@@ -134,7 +134,7 @@ lemma Main_lemma :
     shortest_path src v' d' and S.mem v (g_succ v') and d' + weight v' v < d
 
 lemma Completeness_lemma :
-  forall s:S.t vertex. forall src:vertex. forall dst:vertex. forall d:int. 
+  forall s:S.set vertex. forall src:vertex. forall dst:vertex. forall d:int. 
   (* if s is closed under g_succ *)
   (forall v:vertex. 
      S.mem v s -> forall w:vertex. S.mem w (g_succ v) -> S.mem w s) ->
@@ -145,10 +145,10 @@ lemma Completeness_lemma :
 
 (* definitions used in loop invariants *)
 
-logic inv_src (src:vertex) (s q:S.t vertex) =
+logic inv_src (src:vertex) (s q:S.set vertex) =
   S.mem src s or S.mem src q
 
-logic inv (src:vertex) (s q:S.t vertex) (d:M.t vertex int) =
+logic inv (src:vertex) (s q:S.set vertex) (d:M.map vertex int) =
   inv_src src s q
   (* S,Q are contained in V *)
   and S.subset s v and S.subset q v
@@ -167,13 +167,13 @@ logic inv (src:vertex) (s q:S.t vertex) (d:M.t vertex int) =
      forall x:vertex. forall dx:int. shortest_path src x dx -> 
        dx < M.get d m -> S.mem x s) 
 
-logic inv_succ (src:vertex) (s q : S.t vertex) =
+logic inv_succ (src:vertex) (s q : S.set vertex) =
   (* successors of vertices in S are either in S or in Q *)
   (forall x:vertex. S.mem x s -> 
      forall y:vertex. S.mem y (g_succ x) -> S.mem y s or S.mem y q)
 
-logic inv_succ2 (src:vertex) (s q : S.t vertex)
-                (u:vertex) (su:S.t vertex) =
+logic inv_succ2 (src:vertex) (s q : S.set vertex)
+                (u:vertex) (su:S.set vertex) =
   (* successors of vertices in S are either in S or in Q,
      unless they are successors of u still in su *)
   (forall x:vertex. S.mem x s -> 

examples/programs/distance.mlw

@@ -61,18 +61,18 @@ module Distance
   logic min_dist (w1 w2:word) (n:int) =
     dist w1 w2 n and forall m:int. dist w1 w2 m -> n <= m
 
-  logic suffix (map a) int : word
+  logic suffix (array a) int : word
 
   axiom suffix_def_1: 
-    forall m: map a. suffix m (length m) = Nil
+    forall m: array a. suffix m (length m) = Nil
   axiom suffix_def_2:
-    forall m: map a, i: int.
+    forall m: array a, i: int.
     0 <= i < length m -> suffix m i = Cons m[i] (suffix m (i+1))
 
-  logic min_suffix (w1 w2: map a) (i j n: int) =
+  logic min_suffix (w1 w2: array a) (i j n: int) =
     min_dist (suffix w1 i) (suffix w2 j) n
 
-  logic word_of_array (m: map a) : word = suffix m 0
+  logic word_of_array (m: array a) : word = suffix m 0
 
   (* The code. *)
 
@@ -83,14 +83,14 @@ module Distance
       for i = 0 to n2 do
         invariant { length t = n2+1 and
                     forall j:int. 0 <= j < i -> t[j] = n2-j }
-        t[i <- n2 - i]
+        set t i (n2 - i)
       done;
       (* loop over w1 *)
       for i = n1-1 downto 0 do
         invariant { length t = n2+1
            and forall j:int. 0 <= j <= n2 -> min_suffix w1 w2 (i+1) j t[j] }
         o := t[n2];
-        t[n2 <- t[n2] + 1];
+        set t n2 (t[n2] + 1);
         (* loop over w2 *)
         for j = n2-1 downto 0 do
           invariant { length t = n2+1
@@ -101,9 +101,9 @@ module Distance
       	    let temp = !o in
             o := t[j];
 	    if w1[i] = w2[j] then
-	      t[j <- temp]
+	      set t j temp
 	    else
-	      t[j <- (min t[j] t[j+1]) + 1]
+	      set t j ((min t[j] t[j+1]) + 1)
           end
         done
       done;

examples/programs/fib_memo.mlw

@@ -12,18 +12,18 @@ module M
 
   type option 'a = None | Some 'a
 
-  use array.Array as A
+  use map.Map as M
 
-  type table = A.t int (option int)
+  type table = M.map int (option int)
 
   logic inv (t : table) =
-    forall x y : int. A.get t x = Some y -> y = fib x
+    forall x y : int. M.get t x = Some y -> y = fib x
 
   parameter table : ref table
 
   parameter add : 
     x:int -> y:int -> 
-      {} unit writes table { table = A.set (old table) x (Some y) }
+      {} unit writes table { table = M.set (old table) x (Some y) }
 
   exception Not_found
 
@@ -31,8 +31,8 @@ module M
     x:int -> 
      {} 
      int reads table raises Not_found 
-     { A.get table x = Some result } 
-     | Not_found -> { A.get table x = None }
+     { M.get table x = Some result } 
+     | Not_found -> { M.get table x = None }
   
   let rec fibo n =
     { 0 <= n and inv table }
@@ -52,6 +52,6 @@ end
 
 (*
 Local Variables: 
-compile-command: "unset LANG; make -C ../.. examples/programs/fib"
+compile-command: "unset LANG; make -C ../.. examples/programs/fib_memo"
 End: 
 *)

examples/programs/flag.mlw

@@ -5,19 +5,19 @@ module Flag
   use import int.Int
   use import module stdlib.Ref
   use import module stdlib.Array
-  use import array.ArrayPermut
+  use import module stdlib.ArrayPermut
 
   type color = Blue | White | Red
 
-  logic monochrome (a:map color) (i:int) (j:int) (c:color) =
+  logic monochrome (a:array color) (i:int) (j:int) (c:color) =
     forall k:int. i<=k<j -> a[k]=c
 
   let swap (a:array color) (i:int) (j:int) =
     { 0 <= i < length a and 0 <= j < length a }
     let v = a[i] in
     begin
-      a[i <- a[j]];
-      a[j <- v]
+      set a i a[j];
+      set a j v
     end
     { exchange a (old a) i j }
 
@@ -33,7 +33,7 @@ module Flag
   	         monochrome a b i White and 
   	         monochrome a r n Red and
   		 length a = n and
-  	         permut a (at a Init) 0 (n-1) }
+  	         permut_sub a (at a Init) 0 (n-1) }
        variant { r - i }
        match a[!i] with
        | Blue ->
@@ -51,7 +51,7 @@ module Flag
         monochrome a 0 b Blue and 
         monochrome a b r White and 
         monochrome a r n Red)
-      and permut a (old a) 0 (n-1) }
+      and permut_sub a (old a) 0 (n-1) }
 
 end
 

examples/programs/list_rev.mlw

@@ -9,25 +9,25 @@ module M
 
   logic null : pointer
 
-  parameter value : ref (t pointer int)
-  parameter next : ref (t pointer pointer)
+  parameter value : ref (map pointer int)
+  parameter next : ref (map pointer pointer)
 
-  inductive is_list (next : t pointer pointer) (p : pointer) =
+  inductive is_list (next : map pointer pointer) (p : pointer) =
     | is_list_null: 
-        forall next : t pointer pointer, p : pointer. 
+        forall next : map pointer pointer, p : pointer. 
         p = null -> is_list next p
     | is_list_next: 
-        forall next : t pointer pointer, p : pointer. 
+        forall next : map pointer pointer, p : pointer. 
         p <> null -> is_list next (get next p) -> is_list next p
 
-  logic sep_list_list (next : t pointer pointer) (p1 p2 : pointer)
+  logic sep_list_list (next : map pointer pointer) (p1 p2 : pointer)
 
   axiom sep_list_list_p_null:
-    forall next : t pointer pointer, p : pointer. 
+    forall next : map pointer pointer, p : pointer. 
     sep_list_list next p null
 
   axiom sep_list_list_null_p:
-    forall next : t pointer pointer, p : pointer. 
+    forall next : map pointer pointer, p : pointer. 
     sep_list_list next null p
 
   let list_rev (p : ref pointer) =

examples/programs/muller.mlw

@@ -5,22 +5,22 @@ module Muller
   use import module stdlib.Refint
   use import module stdlib.Array
 
-  type param = map int
-  logic pr (a : param) (n : int) = a[n] <> 0
+  type param = M.map int int
+  logic pr (a : param) (n : int) = M.get a n <> 0
   clone import int.NumOfParam with type param = param, logic pr = pr
 
   let compact (a : array int) =
     let count = ref 0 in
     for i = 0 to length a - 1 do 
-      invariant { 0 <= count = num_of a 0 i <= i}
+      invariant { 0 <= count = num_of a.elts 0 i <= i}
       if a[i] <> 0 then incr count
     done;
     let u = make !count 0 in
     count := 0;
     for i = 0 to length a - 1 do
-      invariant { 0 <= count = num_of a 0 i <= i and 
-                  length u = num_of a 0 (length a) }
-      if a[i] <> 0 then begin u[!count <- a[i]]; incr count end
+      invariant { 0 <= count = num_of a.elts 0 i <= i and 
+                  length u = num_of a.elts 0 (length a) }
+      if a[i] <> 0 then begin set u !count a[i]; incr count end
     done
 
 end

examples/programs/quicksort.mlw

@@ -10,15 +10,16 @@ module Quicksort
   use import int.Int
   use import module stdlib.Ref
   use import module stdlib.Array
-  clone import array.ArraySorted with type elt = int, logic le = (<=)
-  use import array.ArrayPermut
+  use import module stdlib.ArraySorted
+  use import module stdlib.ArrayPermut
+  use import module stdlib.ArrayEq
 
   let swap (t:array int) (i:int) (j:int) =
     { 0 <= i < length t and 0 <= j < length t }
-    let v = t[i] in
+    let v = get t i in
     begin
-      t[i <- t[j]];
-      t[j <- v]
+      set t i (get t j);
+      set t j v
     end
     { exchange t (old t) i j }
 
@@ -31,7 +32,7 @@ module Quicksort
       for i = l + 1 to r do
 	invariant { (forall j:int. l < j <= m -> t[j] < v) and
                     (forall j:int. m < j <  i -> t[j] >= v) and
-                    permut t (at t L) l r and
+                    permut_sub t (at t L) l r and
                     t[l] = v and l <= m < i }
         if t[i] < v then begin m := !m + 1; swap t i !m end
       done;
@@ -39,13 +40,13 @@ module Quicksort
       quick_rec t l (!m - 1);
       quick_rec t (!m + 1) r
     end end
-    { (l <= r and sorted_sub t l r and permut t (old t) l r) or
+    { (l <= r and sorted_sub t l r and permut_sub t (old t) l r) or
       (l > r and array_eq t (old t)) }
 
   let quicksort (t : array int) =
     {} 
     quick_rec t 0 (length t - 1)
-    { sorted t and permutation t (old t) }
+    { sorted t and permut t (old t) }
 
 end
 

examples/programs/ropes.mlw

-module M
 
-  use import int.Int
+theory String
 
   type char
-  clone array.ArrayRich as S
-  type string = S.t int char
+  clone export map.Map
+  type string = map int char
+
+  logic create int : string  
+  logic length string : int
+  logic sub string int int : string
+  logic app string string : string
+end
+
+module M
+
+  use import int.Int
+  use import String 
 
   type rope =
     | Str string int  (len: int)
@@ -12,24 +22,24 @@ module M
 
   logic inv (r: rope) = match r with
     | Str s ofs len -> 
-        len = 0 or 0 <= ofs < S.length s and ofs + len <= S.length s
+        len = 0 or 0 <= ofs < length s and ofs + len <= length s
     | App l r _ ->
         0 < len l and inv l and 0 < len r and inv r
   end
 
   logic model (r: rope) : string = match r with
-    | Str s ofs len -> S.sub s ofs len
-    | App l r _     -> S.app (model l) (model r)
+    | Str s ofs len -> sub s ofs len
+    | App l r _     -> app (model l) (model r)
   end
 
   logic eq (s1 s2: string) =
-    S.length s1 = S.length s2 and
-    forall i:int. 0 <= i < S.length s1 -> S.get s1 i = S.get s2 i
+    length s1 = length s2 and
+    forall i:int. 0 <= i < length s1 -> get s1 i = get s2 i
 
   let empty () = 
     {} 
-    Str (S.create_length 0) 0 0 
-    { len result = 0 and inv result and eq (model result) (S.create_length 0) }
+    Str (create 0) 0 0 
+    { len result = 0 and inv result and eq (model result) (create 0) }
   
   let length r = 
     {} 
@@ -40,12 +50,12 @@ module M
     { inv r and 0 <= i < len r }
     match r with
     | Str s ofs len -> 
-        S.get s (ofs + i)
+        get s (ofs + i)
     | App l r   _   -> 
         let n = length l in
         if i < n then get l i else get r (i - n)
     end
-    { result = S.get (model r) i }
+    { result = get (model r) i }
   
 end
 

examples/programs/sf.mlw

@@ -13,7 +13,7 @@ module HoareLogic
 
   (* Example: Slow Subtraction *)
 
-  let slow_subtraction x z =
+  let slow_subtraction (x: ref int) (z: ref int) =
     { x >= 0 }
     label Init:
     while !x <> 0 do
@@ -25,14 +25,14 @@ module HoareLogic
 
   (* Example: Reduce to Zero *)
 
-  let reduce_to_zero x =
+  let reduce_to_zero (x: ref int) =
     { x >= 0 }
     while !x <> 0 do invariant { x >= 0 } variant { x } x := !x - 1 done
     { x = 0 }
 
   (* Exercise: Slow Addition *)
 
-  let slow_addition x z =
+  let slow_addition (x: ref int) (z: ref int) =
     { x >= 0 }
     label Init:
     while !x <> 0 do
@@ -50,7 +50,7 @@ module HoareLogic
 
   lemma even_not_odd : forall x:int. even x -> even (x+1) -> false
 
-  let parity x y =
+  let parity (x: ref int) (y: ref int) =
     { x >= 0 }
     y := 0;
     label Init:
@@ -65,7 +65,7 @@ module HoareLogic
 
   (* Example: Finding Square Roots *)
 
-  let sqrt x z =
+  let sqrt (x: ref int) (z: ref int) =
     { x >= 0 }
     z := 0;
     while (!z + 1) * (!z + 1) <= !x do
@@ -80,7 +80,7 @@ module HoareLogic
   axiom fact_0 : fact 0 = 1
   axiom fact_n : forall n:int. 0 < n -> fact n = n * fact (n-1)
 
-  let factorial x y z =
+  let factorial (x: ref int) (y: ref int) (z: ref int) =
     { x >= 0 }
     y := 1;
     z := !x;
@@ -109,7 +109,7 @@ module MoreHoareLogic
   parameter head : l:list 'a -> { l<>Nil } 'a { Some result = hd l }
   parameter tail : l:list 'a -> { l<>Nil } list 'a { Some result = tl l }
 
-  let list_sum l y =
+  let list_sum (l: ref (list int)) (y: ref int) =
     {}
     y := 0;
     label Init:
@@ -126,7 +126,7 @@ module MoreHoareLogic
   use import list.Append
 
   (* note: we avoid the use of an existential quantifier in the invariant *)
-  let list_member (x : ref (list 'a)) y z =
+  let list_member (x : ref (list 'a)) (y: 'a) (z: ref int) =
     {}
     z := 0;
     label Init:

examples/programs/vacid_0_build_maze.mlw

@@ -75,8 +75,10 @@ theory Graph
   type graph
 
   inductive path graph vertex vertex =
-    | Path_refl : forall g:graph, x:vertex. path g x x
-    | Path_sym  : forall g:graph, x y:vertex. path g x y -> path g y x
+    | Path_refl : 
+        forall g:graph, x:vertex. path g x x
+    | Path_sym  : 
+        forall g:graph, x y:vertex. path g x y -> path g y x
     | Path_trans:
         forall g:graph, x y z:vertex. path g x y -> path g y z -> path g x z
 

modules/stdlib.mlw

@@ -100,12 +100,12 @@ end
 module ArraySorted
 
   use import module Array
-  clone import map.MapSorted as M
+  clone import map.MapSorted as M with type elt = int
 
-  logic sorted_sub (a : array elt) (l u : int) =
+  logic sorted_sub (a : array int) (l u : int) =
     M.sorted_sub a.elts l u
 
-  logic sorted (a : array elt) =
+  logic sorted (a : array int) =
     M.sorted_sub a.elts 0 a.length
 
 end
@@ -113,7 +113,7 @@ end
 module ArrayEq
 
   use import module Array
-  clone import map.MapEq as M
+  use import map.MapEq as M
 
   logic array_eq_sub (a1 a2: array 'a) (l u: int) =
     map_eq_sub a1.elts a2.elts l u
@@ -129,6 +129,9 @@ module ArrayPermut
   use import module Array
   clone import map.MapPermut as M
 
+  logic exchange (a1 a2: array 'a) (i j: int) =
+    M.exchange a1.elts a2.elts i j
+
   logic permut_sub (a1 a2: array 'a) (l u: int) =
     M.permut_sub a1.elts a2.elts l u
 
@@ -137,6 +140,7 @@ module ArrayPermut
 
 end
 
+(***
 module TestArray
 
   use import int.Int
@@ -171,6 +175,7 @@ module TestArray
     assert { a2[24] = False }
 
 end
+***)
 
 (*
 Local Variables:

src/parser/typing.ml

@@ -125,7 +125,7 @@ let unify_raise ~loc ty1 ty2 =
 
 type denv = {
   utyvars : (string, type_var) Hashtbl.t; (* user type variables *)
-  dvars : dty Mstr.t; (* local variables, to be bound later *)
+  dvars   : dty Mstr.t;    (* local variables, to be bound later *)
 }
 
 let create_denv () = {

src/programs/pgm_ttree.ml

@@ -18,6 +18,8 @@
 (**************************************************************************)
 
 open Why
+open Denv
+open Ty
 open Pgm_types
 open Pgm_types.T
 
@@ -36,6 +38,7 @@ type for_direction = Ptree.for_direction
 (*****************************************************************************)
 (* phase 1: introduction of destructive types *)
 
+(***
 type dregion = { 
   dr_tv : Denv.type_var;
   dr_ty : Denv.dty;
@@ -47,7 +50,6 @@ type deffect = {
   de_raises : esymbol list;
 }
 
-(* specialized type_v *)
 type dtype_v =
   | DTpure  of Denv.dty
   | DTarrow of dbinder list * dtype_c
@@ -60,6 +62,7 @@ and dtype_c =
                      (Term.lsymbol * (Denv.dty option * Denv.dfmla)) list; }
 
 and dbinder = ident * Denv.dty * dtype_v
+***)
 
 (* user type_v *)
 
@@ -95,7 +98,6 @@ type dloop_annotation = {
 
 type dexpr = {
   dexpr_desc : dexpr_desc;
-(*   dexpr_denv : Typing.denv; *)
   dexpr_type : Denv.dty;
   dexpr_loc  : loc;
 }
@@ -103,7 +105,7 @@ type dexpr = {
 and dexpr_desc =
   | DEconstant of constant
   | DElocal of string * Denv.dty
-  | DEglobal of psymbol * dtype_v
+  | DEglobal of psymbol * type_v * type_var Htv.t
   | DElogic of Term.lsymbol
   | DEapply of dexpr * dexpr
   | DEfun of dubinder list * dtriple
@@ -159,7 +161,7 @@ type ieffect = {
 }
 
 type itype_v =
-  | ITpure  of Ty.ty
+  | ITpure  of ty
   | ITarrow of ibinder list * itype_c
 
 and itype_c =
@@ -188,14 +190,14 @@ and ipat_node =
 
 type iexpr = {
   iexpr_desc : iexpr_desc;
-  iexpr_type : Ty.ty;
+  iexpr_type : ty;
   iexpr_loc  : loc;
 }
 
 and iexpr_desc =
   | IElogic of Term.term (* pure *)
   | IElocal of ivsymbol
-  | IEglobal of psymbol * itype_v
+  | IEglobal of psymbol * type_v
   | IEapply of iexpr * ivsymbol
   | IEapply_var of iexpr * ivsymbol
   | IEapply_glob of iexpr * pvsymbol
@@ -247,7 +249,7 @@ and ppat_node =
 
 type expr = {
   expr_desc  : expr_desc;
-  expr_type  : Ty.ty;
+  expr_type  : ty;
   expr_type_v: type_v;
   expr_effect: E.t;
   expr_loc   : loc;

src/programs/pgm_types.ml

@@ -46,14 +46,14 @@ let create_mtsymbol ~impure ~effect ~pure ~singleton =
   mt
 
 let is_mutable_ts ts = 
-  try (Hts.find mtypes ts).mt_regions > 0 with Not_found -> assert false
+  try (Hts.find mtypes ts).mt_regions > 0 with Not_found -> false
 
 let is_mutable_ty ty = match ty.ty_node with
   | Ty.Tyapp (ts, _) -> is_mutable_ts ts
   | Ty.Tyvar _ -> false
 
 let is_singleton_ts ts = 
-  try (Hts.find mtypes ts).mt_singleton with Not_found -> assert false
+  try (Hts.find mtypes ts).mt_singleton with Not_found -> false
 
 let is_singleton_ty ty = match ty.ty_node with
   | Ty.Tyapp (ts, _) -> is_singleton_ts ts
@@ -195,8 +195,8 @@ module rec T : sig
   (* operations on program types *)
     
   val apply_type_v_var : type_v -> pvsymbol -> type_c
-(*   val apply_type_v_sym : type_v -> psymbol  -> type_c *)
-(*   val apply_type_v_ref : type_v -> R.t      -> type_c *)
+
+  val subst_type_v : ty Mtv.t -> term Mvs.t -> type_v -> type_v
     
   val occur_type_v : R.t -> type_v -> bool
     
@@ -361,12 +361,13 @@ end = struct
       Mvs.add vs (t_var vs') s, vs'
 	
   let subst_post ts s ((v, q), ql) =
-    let vq = let s, v = subst_var ~pure:true ts s v in v, f_ty_subst ts s q in