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

Diff of /types/types.ml

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

revision 276 by abate, Tue Jul 10 17:21:39 2007 UTC revision 281 by abate, Tue Jul 10 17:22:16 2007 UTC
# Line 225  Line 225 
225    let accu = if a.absent then accu+5 else accu in    let accu = if a.absent then accu+5 else accu in
226    accu    accu
227    
228    (* TODO: optimize disjoint check for boolean combinations *)
229    let trivially_disjoint a b =
230      (Chars.disjoint a.chars b.chars) &&
231      (Intervals.disjoint a.ints b.ints) &&
232      (Atoms.disjoint a.atoms b.atoms) &&
233      (BoolPair.trivially_disjoint a.times b.times) &&
234      (BoolPair.trivially_disjoint a.xml b.xml) &&
235      (BoolPair.trivially_disjoint a.arrow b.arrow) &&
236      (BoolRec.trivially_disjoint a.record b.record)
237    
238    
239  module Descr =  module Descr =
240  struct  struct
# Line 372  Line 382 
382    s.notify <- Nothing;    s.notify <- Nothing;
383    raise NotEmpty    raise NotEmpty
384    
385    let count_slot = ref 0
386  let rec big_conj f l n =  let rec big_conj f l n =
387    match l with    match l with
388      | [] -> set n      | [] -> set n
# Line 396  Line 407 
407            (not d.absent)) then slot_not_empty            (not d.absent)) then slot_not_empty
408    else try DescrHash.find memo d    else try DescrHash.find memo d
409    with Not_found ->    with Not_found ->
410        (*    incr count_slot;
411        Printf.eprintf "%i;" !count_slot; *)
412  (*    Format.fprintf Format.std_formatter "Empty:%a@\n" !print_descr d; *)  (*    Format.fprintf Format.std_formatter "Empty:%a@\n" !print_descr d; *)
413      let s = { status = Maybe; active = false; notify = Nothing } in      let s = { status = Maybe; active = false; notify = Nothing } in
414      DescrHash.add memo d s;      DescrHash.add memo d s;
415      (try      (try
416    (*       Format.fprintf Format.std_formatter "check_times_bool:@[%a@]@\n"
417             BoolPair.dump d.times;  *)
418    (*       check_times_bool any any d.times s; *)
419         iter_s s check_times (BoolPair.get d.times);         iter_s s check_times (BoolPair.get d.times);
420         iter_s s check_times (BoolPair.get d.xml);         iter_s s check_times (BoolPair.get d.xml);
421         iter_s s check_arrow (BoolPair.get d.arrow);         iter_s s check_arrow (BoolPair.get d.arrow);
# Line 414  Line 430 
430    flush stderr;  *)    flush stderr;  *)
431    let rec aux accu1 accu2 right s = match right with    let rec aux accu1 accu2 right s = match right with
432      | (t1,t2)::right ->      | (t1,t2)::right ->
433          if trivially_empty (cap_t accu1 t1) ||          let t1 = descr t1 and t2 = descr t2 in
434             trivially_empty (cap_t accu2 t2) then (          if trivially_disjoint accu1 t1 ||
435               trivially_disjoint accu2 t2 then (
436               aux accu1 accu2 right s )               aux accu1 accu2 right s )
437          else (          else (
438            let accu1' = diff_t accu1 t1 in guard accu1' (aux accu1' accu2 right) s;            let accu1' = diff accu1 t1 in
439            let accu2' = diff_t accu2 t2 in guard accu2' (aux accu1 accu2' right) s            guard accu1' (aux accu1' accu2 right) s;
440    
441              let accu2' = diff accu2 t2 in
442                guard accu2' (aux accu1 accu2' right) s
443    (*        let accu1 = cap accu1 t1 in (* TODO: approximation of cap ... *)
444              let accu2' = diff accu2 t2 in
445              guard accu1 (guard accu2' (aux accu1 accu2' right)) s *)
446    
447          )          )
448      | [] -> set s      | [] -> set s
449    in    in
450  (*    let (accu1,accu2) = cap_product left in
451    if List.length right > 6 then (  (*  if List.length right > 6 then (
452      Printf.eprintf "HEURISTIC\n"; flush stderr;      Printf.eprintf "HEURISTIC\n"; flush stderr;
453      let (n1,n2) = cup_product right in      let (n1,n2) = cup_product right in
454      let n1 = diff accu1 n1 and n2 = diff accu2 n2 in      let n1 = diff accu1 n1 and n2 = diff accu2 n2 in
# Line 432  Line 456 
456      guard n2 set s;      guard n2 set s;
457      Printf.eprintf "HEURISTIC failed\n"; flush stderr;      Printf.eprintf "HEURISTIC failed\n"; flush stderr;
458    ); *)    ); *)
   let (accu1,accu2) = cap_product left in  
459    guard accu1 (guard accu2 (aux accu1 accu2 right)) s    guard accu1 (guard accu2 (aux accu1 accu2 right)) s
460    
461    
462    (*
463    and check_times_bool accu1 accu2 b s =
464      match b with
465        | BoolPair.True -> guard accu1 (guard accu2 set) s
466        | BoolPair.False -> ()
467        | BoolPair.Split (_, (t1,t2), p,i,n) ->
468            check_times_bool accu1 accu2 i s;
469            let t1 = descr t1 and t2 = descr t2 in
470            if (trivially_disjoint accu1 t1 || trivially_disjoint accu2 t2)
471            then check_times_bool accu1 accu2 n s else
472              (
473                if p <> BoolPair.False then
474                  (let accu1 = cap accu1 t1
475                   and accu2 = cap accu2 t2 in
476                   if not (trivially_empty accu1 || trivially_empty accu2) then
477                     check_times_bool accu1 accu2 p s);
478    
479                if n <> BoolPair.False then
480                  (let accu1' = diff accu1 t1 in
481                   check_times_bool accu1' accu2 n s;
482                   let accu2' = diff accu2 t2 in
483                   check_times_bool accu1 accu2' n s)
484              )
485    *)
486    
487    
488  and check_arrow (left,right) s =  and check_arrow (left,right) s =
489    let single_right (s1,s2) s =    let single_right (s1,s2) s =
490      let rec aux accu1 accu2 left s = match left with      let rec aux accu1 accu2 left s = match left with
# Line 453  Line 503 
503      | [] -> set s      | [] -> set s
504      | (oright,right)::rights ->      | (oright,right)::rights ->
505          let next =          let next =
506            (oleft && (not oright)) || (* ggg... why ???  check this line *)            (oleft && (not oright)) ||
507            exists (Array.length left)            exists (Array.length left)
508              (fun i ->              (fun i -> trivially_disjoint left.(i) right.(i))
                trivially_empty (cap left.(i) right.(i)))  
509          in          in
510          if next then aux rights s          if next then aux rights s
511          else          else
Legend:
Removed from v.276  
changed lines
  Added in v.281
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5