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 ] -> ([ 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