[r2006-04-21 09:17:50 by afrisch] Optimizations

Original author: afrisch
Date: 2006-04-21 09:17:50+00:00

types/sequence.ml

@@ -18,6 +18,15 @@ module V = Types.Positive
 module H = Map.Make(Types)
 module H2 = Map.Make(Custom.Pair(Types)(Types))
 
+let memoize f =
+  let memo = ref H.empty in
+  fun t ->
+    try H.find t !memo
+    with Not_found ->
+      let z = f t in
+      memo := H.add t z !memo;
+      z
+
 let mapping f t queue =
   let memo = ref H.empty in
   let rec aux t =
@@ -32,16 +41,18 @@ let mapping f t queue =
       v
   in
   aux t
-  
 
 let aux_concat = mapping (fun t v -> V.times (V.ty t) v)
 let aux_flatten t = mapping aux_concat t (V.ty nil_type)
-let aux_map f t = mapping (fun t v -> V.times (V.ty (f t)) v) t (V.ty nil_type)
+let aux_map f t = 
+  let f = memoize f in
+  mapping (fun t v -> V.times (V.ty (f t)) v) t (V.ty nil_type)
 
 let solve x = Types.descr (V.solve x)
 
+
 let concat t1 t2 = solve (aux_concat t1 (V.ty t2))
-let flatten t = solve (aux_flatten t)
+let flatten t = let t = Types.normalize t in solve (aux_flatten t)
 let map f t = solve (aux_map f t)
 
 

typing/typer.ml

@@ -839,6 +839,7 @@ let flatten arg constr precise =
     let t = arg sconstr' true in
     verify_noloc (Sequence.flatten t) constr
 
+
 let rec type_check env e constr precise = 
   let d = type_check' e.exp_loc env e.exp_descr constr precise in
   let d = if precise then d else constr in