Commit 496c41bd authored by Kim Nguyễn's avatar Kim Nguyễn

Revert "Implement a cache for the positive equation solver (partial results are stored in nodes)"

This reverts commit a8ba6ab6.

This commit introduces a regression where suprious type variables are introduced in the final type.
parent a8ba6ab6
......@@ -41,7 +41,7 @@ let balance ( Unbalanced('a) -> Rtree('a) ; 'b & RBtree('a) -> 'b & RBtree('a) )
| x -> x
;;
let [] = []
(* *)
(* Version 2: restrict the first branch to Unbalanced trees whatever *)
(* type it contains *)
......@@ -183,7 +183,7 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] *
| <(c) elem=e>[ l r ] ->
(<black elem=e>[ l (balance (redify r)) ], (c = `black))
(*
let remove(x : 'a)(t : RBtree('a) ) : RBtree('a) =
let remove_aux(RBtree('a) -> (RBtree('a),Bool) )
| [] ->
......@@ -207,4 +207,3 @@ let remove(x : 'a)(t : RBtree('a) ) : RBtree('a) =
if d then bubble_left tree else (tree, `false)
in
let (sol,_) = remove_aux t in sol
\ No newline at end of file
*)
......@@ -64,7 +64,6 @@ sig
val mapi: (Elem.t -> 'a -> 'b) -> 'a map -> 'b map
val constant: 'a -> t -> 'a map
val num: int -> t -> int map
val init : (Elem.t -> 'a) -> t -> 'a map
val map_to_list: ('a -> 'b) -> 'a map -> 'b list
val mapi_to_list: (Elem.t -> 'a -> 'b) -> 'a map -> 'b list
val assoc: Elem.t -> 'a map -> 'a
......@@ -411,10 +410,6 @@ module Make(X : Custom.T) = struct
| (x,y)::l -> (f y)::(map_to_list f l)
| [] -> []
let rec init f = function
[] -> []
| x :: l -> (x, f x) :: (init f l)
let rec assoc v = function
| (x,y)::l ->
let c = Elem.compare x v in
......
......@@ -64,7 +64,6 @@ sig
val mapi: (Elem.t -> 'a -> 'b) -> 'a map -> 'b map
val constant: 'a -> t -> 'a map
val num: int -> t -> int map
val init : (Elem.t -> 'a) -> t -> 'a map
val map_to_list: ('a -> 'b) -> 'a map -> 'b list
val mapi_to_list: (Elem.t -> 'a -> 'b) -> 'a map -> 'b list
val assoc: Elem.t -> 'a map -> 'a
......
This diff is collapsed.
......@@ -155,16 +155,13 @@ module Positive : sig
val xml: v -> v -> v
val solve: v -> Node.t
val substitute : t -> (Var.var * t) -> t
val substitute_list : t -> (Var.var * t) list -> t
val solve_rectype : t -> Var.var -> t
val substitute_free : Var.Set.t -> t -> t
val clean_type : Var.Set.t -> t -> t
end
module Substitution :
sig
val apply : t -> (Var.var * t) list -> t
val apply_single : t -> (Var.var * t) -> t
val refresh_type : Var.Set.t -> t -> t
val solve_fixpoint : t -> Var.var -> t
end
(** Normalization **)
module Product : sig
......
......@@ -548,7 +548,7 @@ module IType = struct
(Printf.sprintf "Wrong number of parameters for parametric type %s" (U.to_string id));
| Error s -> raise_loc_generic loc s
in
mk_type ((*Types.Positive.substitute_list*) Types.Substitution.apply t l)
mk_type (Types.Positive.substitute_list t l)
with Not_found ->
assert (rest == []);
if args != [] then
......@@ -618,20 +618,15 @@ module IType = struct
raise_loc_generic loc
(Printf.sprintf "Definition of type %s contains unbound type variables"
(Ident.to_string v));
let nargs = List.map (fun x ->
let v = (Var.mk (U.to_string x)) in v, Types.var v
) args in
(*
Not needed ?
let vars_mapping = (* create a sequence 'a -> 'a_0 for all variables *)
List.map (fun v -> let vv = Var.mk (U.to_string v) in vv, Var.fresh vv) args
in
let sub_list = List.map (fun (v,vt) -> v, Types.var vt) vars_mapping in
let t_rhs =
(*Types.Positive.substitute_list t_rhs*)Types.Substitution.apply t_rhs sub_list
Types.Positive.substitute_list t_rhs sub_list
in
let nargs = List.map2 (fun (_, v) (_, vt) -> v, vt) vars_mapping sub_list
in *)
in
(v,t_rhs,nargs)
) (List.rev b)
in
......@@ -667,7 +662,7 @@ module IType = struct
current_params := (idx,params,map);
type_defs env b
) env b in
clean_params ();r
clean_params (); r
with exn -> clean_on_err (); raise exn
let typ env t =
......@@ -1145,8 +1140,8 @@ and type_check' loc env ed constr precise = match ed with
(fun v ->
let open Types in
match v with
| Val t -> Val (Substitution.refresh_type env.delta t)
| EVal (a,b,t) -> EVal (a,b,Substitution.refresh_type env.delta t)
| Val t -> Val (Positive.substitute_free env.delta t)
| EVal (a,b,t) -> EVal (a,b,Positive.substitute_free env.delta t)
| x -> x)
env.ids }
in
......@@ -1222,7 +1217,7 @@ and type_check' loc env ed constr precise = match ed with
| Apply (e1,e2) ->
let t1 = type_check env e1 Types.Arrow.any true in
let t1arrow = Types.Arrow.get t1 in
let t1 = Types.Substitution.refresh_type env.delta t1 in
let t1 = Types.Positive.substitute_free env.delta t1 in
(* t [_delta 0 -> 1 *)
begin try
ignore(Types.Tallying.tallying env.delta [(t1,Types.Arrow.any)])
......@@ -1232,7 +1227,7 @@ and type_check' loc env ed constr precise = match ed with
let dom = Types.Arrow.domain(t1arrow) in
let t2 = type_check env e2 Types.any true in
let t2 = Types.Substitution.refresh_type env.delta t2 in
let t2 = Types.Positive.substitute_free env.delta t2 in
let (sl,res) =
if not (Types.no_var dom) ||
not (Types.no_var t2) then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment