/[svn]/types/types.ml
ViewVC logotype

Diff of /types/types.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 332 by abate, Tue Jul 10 17:25:57 2007 UTC revision 355 by abate, Tue Jul 10 17:27:46 2007 UTC
# Line 656  Line 656 
656    
657    let need_second = function _::_::_ -> true | _ -> false    let need_second = function _::_::_ -> true | _ -> false
658    
659    let normal_aux d =    let normal_aux = function
660        | ([] | [ _ ]) as d -> d
661        | d ->
662    
663      let res = ref [] in      let res = ref [] in
664    
665      let add (t1,t2) =      let add (t1,t2) =
# Line 759  Line 762 
762    
763    module Memo = Map.Make(struct type t = descr BoolPair.t let compare = BoolPair.compare end)    module Memo = Map.Make(struct type t = descr BoolPair.t let compare = BoolPair.compare end)
764    
765      (* TODO: try with an hashtable *)
766      (* Also, avoid lookup for simple products (t1,t2) *)
767    let memo = ref Memo.empty    let memo = ref Memo.empty
768    let normal ?(kind=`Normal) d =    let normal ?(kind=`Normal) d =
769      let d = match kind with `Normal -> d.times | `XML -> d.xml in      let d = match kind with `Normal -> d.times | `XML -> d.xml in
# Line 773  Line 777 
777            memo := Memo.add d n !memo;            memo := Memo.add d n !memo;
778            n            n
779    
780      let constraint_on_2 n t1 =
781        List.fold_left
782          (fun accu (d1,d2) ->
783             if is_empty (cap d1 t1) then accu else cap accu d2)
784          any
785          n
786    
787    let any = { empty with times = any.times }    let any = { empty with times = any.times }
788    and any_xml = { empty with xml = any.xml }    and any_xml = { empty with xml = any.xml }
789    let is_empty d = d == []    let is_empty d = d == []

Legend:
Removed from v.332  
changed lines
  Added in v.355

CVS Admin">CVS Admin
ViewVC Help
Powered by ViewVC 1.1.5