Make the comparison and hashing functions of variables less expensive.

Makefile.distrib

@@ -466,7 +466,7 @@ parser/parser.cmx: PACKAGES += camlp4.extend
 .PHONY: make_buildflags
 
 make_buildflags:
-	$(HIDE) echo DEBUG=$(DEBUG) NATIVE=$(NATIVE) ML_INTERFACE=$(ML_INTERFACE) PXP=$(PXP) EXPAT=$(EXPAT) \
+	$(HIDE) echo echo PROFILE=$(PROFILE) DEBUG=$(DEBUG) NATIVE=$(NATIVE) ML_INTERFACE=$(ML_INTERFACE) PXP=$(PXP) EXPAT=$(EXPAT) \
                CURL=$(CURL) NETCLIENT=$(NETCLIENT) NETCLIENT4=$(NETCLIENT4) NETSTRING=$(NETSTRING) \
                CGI=$(CGI) PXP_WLEX=$(PXP_WLEX) STD_LIBDIR=$(STD_LIBDIR) > .buildflags.new
 

types/sortedList.ml

@@ -74,6 +74,7 @@ sig
     val hash: ('a -> int) -> 'a map -> int
     val equal: ('a -> 'a -> bool) -> 'a map -> 'a map -> bool
     val remove_min : 'a map -> (Elem.t * 'a) * 'a map
+    val subset_keys : 'a map -> 'a map -> bool
   end
   module MakeMap(Y : Custom.T) : sig
     include Custom.T with type t = Y.t Map.map
@@ -181,24 +182,26 @@ module Make(X : Custom.T) = struct
       | _ -> []
 
 
-  let rec subset l1 l2 =
+  let rec subset_gen comp l1 l2 =
     (l1 == l2) ||
     match (l1,l2) with
       | (t1::q1, t2::q2) ->
-        let c = Elem.compare t1 t2 in
+        let c = comp t1 t2 in
         if c = 0 then (
   (* inlined: subset q1 q2 *)
           (q1 == q2) || match (q1,q2) with
             | (t1::qq1, t2::qq2) ->
-              let c = Elem.compare t1 t2 in
-              if c = 0 then subset qq1 qq2
+              let c = comp t1 t2 in
+              if c = 0 then subset_gen comp qq1 qq2
               else if c < 0 then false
-              else subset q1 qq2
+              else subset_gen comp q1 qq2
             | [],_ -> true | _ -> false
         )
         else if c < 0 then false
-        else subset l1 q2
+        else subset_gen comp l1 q2
       | [],_ -> true | _ -> false
+			    
+  let subset l1 l2 = subset_gen Elem.compare l1 l2
 
   let from_list l =
     let rec initlist = function
@@ -269,6 +272,9 @@ module Make(X : Custom.T) = struct
         else if c < 0 then a :: (remove v rem)
         else l
       | [] -> []
+    let compare_keys (k1, _) (k2, _) = Elem.compare k1 k2
+    let subset_keys l1 l2 =
+      subset_gen compare_keys l1 l2
 
     let rec merge f l1 l2 =
       match (l1,l2) with

types/sortedList.mli

@@ -74,7 +74,8 @@ sig
     val hash: ('a -> int) -> 'a map -> int
     val equal: ('a -> 'a -> bool) -> 'a map -> 'a map -> bool
     val remove_min : 'a map -> (Elem.t * 'a) * 'a map
-  end
+    val subset_keys : 'a map -> 'a map -> bool
+    end
   module MakeMap(Y : Custom.T) : sig
     include Custom.T with type t = Y.t Map.map
   end

types/type_tallying.ml

@@ -49,6 +49,7 @@ module Line = struct
        there exists i2 <= v <= s2 in m2 such that i1 <= i2 <= v <= s2 <= s1
     *)
   let subsumes map1 map2 =
+    Var.Map.subset_keys map1 map2 && 
     List.for_all (fun (v,(i1, s1)) ->
       try let i2, s2 = Var.Map.assoc v map2 in
           subtype i1 i2 && subtype s2 s1
@@ -77,7 +78,7 @@ module Line = struct
     in
     Var.Map.replace v (new_i, new_s) map
 
-  let join map1 map2 = Var.Map.fold add map1 map2
+   let join map1 map2 = Var.Map.fold add map1 map2
   let fold = Var.Map.fold
   let empty = Var.Map.empty
   let for_all f m = List.for_all (fun (k,v) -> f k v) (Var.Map.get m)

types/var.ml

@@ -19,19 +19,16 @@ module V = struct
 
     let c = compare_kind x.kind y.kind in
     if c == 0 then
-      let c = Ident.U.compare x.name y.name in
-      if c == 0 then Pervasives.compare x.id y.id else
-	c
-    (*
-      let c = Pervasives.compare x.id y.id in
+      let c = x.id - y.id in
       if c == 0 then Ident.U.compare x.name y.name
-      else c *)
+      else
+	c
     else c
 
   let equal x y =
     x == y || (x.kind == y.kind && x.id == y.id && Ident.U.equal x.name y.name)
 
-  let hash x = Hashtbl.hash (x.id,x.name,x.kind)
+  let hash x = x.id + 17 * (if x.kind == Source then 1 else 3) + 253 * Hashtbl.hash x.name
 
   let check x = assert (x.id >= 0)