### 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 *) ... ... @@ -182,8 +182,8 @@ let cardinal ( RBtree('a) -> Int ) (* better type: [] -> 0, Any\[] -> [1--*] * raise "impossible" | <(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) ) | [] -> ... ... @@ -206,5 +206,4 @@ let remove(x : 'a)(t : RBtree('a) ) : RBtree('a) = let tree = <(c) elem=z>[ ll r] in if d then bubble_left tree else (tree, `false) in let (sol,_) = remove_aux t in sol *) 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 ... ... @@ -98,9 +97,9 @@ module Make(X : Custom.T) = struct let hash l = hash 1 l let rec compare l1 l2 = if l1 == l2 then 0 if l1 == l2 then 0 else match (l1,l2) with | x1::l1, x2::l2 -> | x1::l1, x2::l2 -> let c = Elem.compare x1 x2 in if c <> 0 then c else compare l1 l2 | [],_ -> -1 ... ... @@ -116,7 +115,7 @@ module Make(X : Custom.T) = struct external get: t -> Elem.t list = "%identity" let singleton x = [ x ] let pick = function x::_ -> Some x | _ -> None let pick = function x::_ -> Some x | _ -> None let choose = function x::_ -> x | _ -> raise Not_found let length = List.length ... ... @@ -126,13 +125,13 @@ module Make(X : Custom.T) = struct let rec disjoint l1 l2 = if l1 == l2 then l1 == [] else match (l1,l2) with | (t1::q1, t2::q2) -> | (t1::q1, t2::q2) -> let c = Elem.compare t1 t2 in if c < 0 then disjoint q1 l2 else if c > 0 then disjoint l1 q2 else false | _ -> true let rec cup l1 l2 = if l1 == l2 then l1 else match (l1,l2) with ... ... @@ -145,7 +144,7 @@ module Make(X : Custom.T) = struct | (l1,[]) -> l1 let add x l = cup [x] l let rec split l1 l2 = match (l1,l2) with | (t1::q1, t2::q2) -> ... ... @@ -154,8 +153,8 @@ module Make(X : Custom.T) = struct else if c < 0 then let (l1,i,l2) = split q1 l2 in (t1::l1,i,l2) else let (l1,i,l2) = split l1 q2 in (l1,i,t2::l2) | _ -> (l1,[],l2) let rec diff l1 l2 = if l1 == l2 then [] else match (l1,l2) with ... ... @@ -178,7 +177,7 @@ module Make(X : Custom.T) = struct else cap l1 q2 | _ -> [] let rec subset l1 l2 = (l1 == l2) || match (l1,l2) with ... ... @@ -197,8 +196,8 @@ module Make(X : Custom.T) = struct else if c < 0 then false else subset l1 q2 | [],_ -> true | _ -> false let from_list l = let from_list l = let rec initlist = function | [] -> [] | e::rest -> [e] :: initlist rest in ... ... @@ -210,14 +209,14 @@ module Make(X : Custom.T) = struct | [l] -> l | llist -> mergeall (merge2 llist) in mergeall (initlist l) let map f l = from_list (List.map f l) let rec mem l x = match l with | [] -> false | t::q -> | t::q -> let c = Elem.compare x t in (c = 0) || ((c > 0) && (mem q x)) ... ... @@ -248,7 +247,7 @@ module Make(X : Custom.T) = struct let rec assoc_remove_aux v r = function | ((x,y) as a)::l -> let c = Elem.compare x v in if c = 0 then (r := Some y; l) if c = 0 then (r := Some y; l) else if c < 0 then a :: (assoc_remove_aux v r l) else raise Not_found | [] -> raise Not_found ... ... @@ -324,7 +323,7 @@ module Make(X : Custom.T) = struct let rec mem x l = match l with | [] -> false | (t,_)::q -> | (t,_)::q -> let c = Elem.compare x t in (c = 0) || ((c > 0) && (mem x q)) ... ... @@ -346,7 +345,7 @@ module Make(X : Custom.T) = struct else restrict l1 q2 | _ -> [] let from_list f l = let from_list f l = let rec initlist = function | [] -> [] | e::rest -> [e] :: initlist rest in ... ... @@ -359,7 +358,7 @@ module Make(X : Custom.T) = struct | llist -> mergeall (merge2 llist) in mergeall (initlist l) let from_list_disj l = let from_list_disj l = let rec initlist = function | [] -> [] | e::rest -> [e] :: initlist rest in ... ... @@ -375,7 +374,7 @@ module Make(X : Custom.T) = struct let rec map_from_slist f = function | x::l -> (x,f x)::(map_from_slist f l) | [] -> [] let rec collide f l1 l2 = match (l1,l2) with | (_,y1)::l1, (_,y2)::l2 -> f y1 y2; collide f l1 l2 ... ... @@ -411,14 +410,10 @@ 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 if c = 0 then y if c = 0 then y else if c < 0 then assoc v l else raise Not_found | [] -> raise Not_found ... ... @@ -431,7 +426,7 @@ module Make(X : Custom.T) = struct | [] -> assert false let rec compare f l1 l2 = if l1 == l2 then 0 if l1 == l2 then 0 else match (l1,l2) with | (x1,y1)::l1, (x2,y2)::l2 -> let c = Elem.compare x1 x2 in if c <> 0 then c ... ... @@ -453,13 +448,13 @@ module Make(X : Custom.T) = struct let rec check f = function | (x,a)::((y,b)::_ as tl) -> | (x,a)::((y,b)::_ as tl) -> Elem.check x; f a; assert (Elem.compare x y < 0); check f tl | [x,a] -> Elem.check x; f a | _ -> () end (* Map *) end (* Map *) module MakeMap(Y : Custom.T) = struct ... ... @@ -469,10 +464,10 @@ module Make(X : Custom.T) = struct in types.ml... *) let hash x = Map.hash Y.hash x let compare x y = Map.compare Y.compare x y let equal x y = Map.equal Y.equal x y let equal x y = Map.equal Y.equal x y let check l = Map.check Y.check l let dump ppf l = let dump ppf l = List.iter (fun (x,y) -> Format.fprintf ppf "(%a->%a)" Elem.dump x Y.dump y) l ... ... @@ -512,7 +507,7 @@ module FiniteCofinite(X : Custom.T) = struct let compare l1 l2 = match (l1,l2) with | Finite l1, Finite l2 | Finite l1, Finite l2 | Cofinite l1, Cofinite l2 -> SList.compare l1 l2 | Finite _, Cofinite _ -> -1 | _ -> 1 ... ... @@ -560,11 +555,11 @@ module FiniteCofinite(X : Custom.T) = struct let neg = function | Finite s -> Cofinite s | Cofinite s -> Finite s let contains x = function | Finite s -> SList.mem s x | Cofinite s -> not (SList.mem s x) let disjoint s t = match (s,t) with | (Finite s, Finite t) -> SList.disjoint s t ... ... @@ -586,79 +581,79 @@ struct let sample = function | Cofinite _ -> None | Finite l -> (match T.get l with | Finite l -> (match T.get l with | [] -> raise Not_found | (x,y)::_ -> Some (x, SymbolSet.sample y)) let get = function | Finite l -> `Finite (T.get l) | Cofinite l -> `Cofinite (T.get l) let check = function | Finite l | Cofinite l -> TMap.check l let dump ppf = function | Finite s -> Format.fprintf ppf "Finite[%a]" TMap.dump s | Cofinite s -> Format.fprintf ppf "Cofinite[%a]" TMap.dump s let empty = Finite T.empty let any = Cofinite T.empty let any_in_ns ns = Finite (T.singleton ns SymbolSet.any) let finite l = let l = T.filter let l = T.filter (fun _ x -> match x with SymbolSet.Finite [] -> false | _ -> true) l in Finite l let cofinite l = let l = T.filter let l = T.filter (fun _ x -> match x with SymbolSet.Finite [] -> false | _ -> true) l in Cofinite l let atom (ns,x) = Finite (T.singleton ns (SymbolSet.atom x)) let cup s t = match (s,t) with | (Finite s, Finite t) -> finite (T.merge SymbolSet.cup s t) | (Finite s, Cofinite t) -> cofinite (T.sub SymbolSet.diff t s) | (Cofinite s, Finite t) -> cofinite (T.sub SymbolSet.diff s t) | (Cofinite s, Cofinite t) -> cofinite (T.cap SymbolSet.cap s t) let cap s t = match (s,t) with | (Finite s, Finite t) -> finite (T.cap SymbolSet.cap s t) | (Finite s, Cofinite t) -> finite (T.sub SymbolSet.diff s t) | (Cofinite s, Finite t) -> finite (T.sub SymbolSet.diff t s) | (Cofinite s, Cofinite t) -> cofinite (T.merge SymbolSet.cup s t) let diff s t = match (s,t) with | (Finite s, Cofinite t) -> finite (T.cap SymbolSet.cap s t) | (Finite s, Finite t) -> finite (T.sub SymbolSet.diff s t) | (Cofinite s, Cofinite t) -> finite (T.sub SymbolSet.diff t s) | (Cofinite s, Finite t) -> cofinite (T.merge SymbolSet.cup s t) let is_empty = function | Finite l -> T.is_empty l | _ -> false | _ -> false let hash = function | Finite l -> 1 + 17 * (TMap.hash l) | Cofinite l -> 2 + 17 * (TMap.hash l) let compare l1 l2 = match (l1,l2) with | Finite l1, Finite l2 | Finite l1, Finite l2 | Cofinite l1, Cofinite l2 -> TMap.compare l1 l2 | Finite _, Cofinite _ -> -1 | _ -> 1 let equal t1 t2 = let equal t1 t2 = compare t1 t2 = 0 let symbol_set ns = function ... ... @@ -668,12 +663,12 @@ struct (try SymbolSet.neg (T.assoc ns s) with Not_found -> SymbolSet.any) let contains (ns,x) = function | Finite s -> | Finite s -> (try SymbolSet.contains x (T.assoc ns s) with Not_found -> false) | Cofinite s -> | Cofinite s -> (try not (SymbolSet.contains x (T.assoc ns s)) with Not_found -> true) let disjoint s t = let disjoint s t = is_empty (cap t s) (* TODO: OPT *) end
 ... ... @@ -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 ... ... @@ -104,7 +103,7 @@ module FiniteCofinite(X : Custom.T) : FiniteCofinite with type elem = X.t module FiniteCofiniteMap(X : Custom.T)(SymbolSet : FiniteCofinite) : sig include Custom.T val empty: t val any: t val any_in_ns: X.t -> t ... ... @@ -118,7 +117,7 @@ sig val contains: X.t * SymbolSet.elem -> t -> bool val disjoint: t -> t -> bool val get: t -> [ `Finite of (X.t * SymbolSet.t) list val get: t -> [ `Finite of (X.t * SymbolSet.t) list | `Cofinite of (X.t * SymbolSet.t) list ] val sample: t -> (X.t * SymbolSet.elem option) option ... ...
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!