programs: refactoring of typing (in progress)

parent fd81ec38
......@@ -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
......
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"
......
......@@ -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 }
......
......@@ -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 ->
......
......@@ -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;
......
......@@ -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:
*)
......@@ -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
......
......@@ -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) =
......
......@@ -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
......
This diff is collapsed.
......@@ -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
......
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
......
......@@ -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:
......
......@@ -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
......
......@@ -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:
......
......@@ -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 () = {
......
......@@ -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;
......
......@@ -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