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

Diff of /types/types.ml

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

revision 187 by abate, Tue Jul 10 17:13:28 2007 UTC revision 188 by abate, Tue Jul 10 17:13:41 2007 UTC
# Line 293  Line 293 
293    
294  exception NotEmpty  exception NotEmpty
295    
 let nb_rec = ref 0 and nb_norec = ref 0  
   
296  let rec empty_rec d =  let rec empty_rec d =
297    if Assumptions.mem d !cache_false then false    if Assumptions.mem d !cache_false then false
298    else if Assumptions.mem d !memo then true    else if Assumptions.mem d !memo then true
# Line 303  Line 301 
301    else if not (Chars.is_empty d.chars) then false    else if not (Chars.is_empty d.chars) then false
302    else (    else (
303      let backup = !memo in      let backup = !memo in
304      if is_recurs_descr d then      memo := Assumptions.add d backup;
     (incr nb_rec; memo := Assumptions.add d backup)  
     else incr nb_norec;  
305      if      if
306        (empty_rec_times d.times) &&        (empty_rec_times d.times) &&
307        (empty_rec_times d.xml) &&        (empty_rec_times d.xml) &&
# Line 1001  Line 997 
997    
998    let restrict_label_absent t l =    let restrict_label_absent t l =
999      Boolean.compute_bool      Boolean.compute_bool
1000        (fun (o,r) as x ->        (fun ((o,r) as x) ->
1001           try           try
1002             let (lo,_) = List.assoc l r in             let (lo,_) = List.assoc l r in
1003             if lo then atom (o,SortedMap.diff r [l])             if lo then atom (o,SortedMap.diff r [l])
# Line 1014  Line 1010 
1010      (* Is it correct ?  Do we need to keep track of "first component"      (* Is it correct ?  Do we need to keep track of "first component"
1011         (value of l) as in label_present, then filter at the end ... ? *)         (value of l) as in label_present, then filter at the end ... ? *)
1012      Boolean.compute_bool      Boolean.compute_bool
1013        (fun (o,r) as x ->        (fun ((o,r) as x) ->
1014           try           try
1015             let (lo,lt) = List.assoc l r in             let (lo,lt) = List.assoc l r in
1016             if (not lo) && (is_empty (cap d (descr lt))) then Boolean.empty             if (not lo) && (is_empty (cap d (descr lt))) then Boolean.empty
# Line 1029  Line 1025 
1025    let label_present (t:t) l : (descr * t) list =    let label_present (t:t) l : (descr * t) list =
1026      let x =      let x =
1027        Boolean.compute_bool        Boolean.compute_bool
1028          (fun (o,r) as x ->          (fun ((o,r) as x) ->
1029             try             try
1030               let (_,lt) = List.assoc l r in               let (_,lt) = List.assoc l r in
1031               Boolean.atom (descr lt, atom (o, SortedMap.diff r [l]))               Boolean.atom (descr lt, atom (o, SortedMap.diff r [l]))
# Line 1042  Line 1038 
1038    
1039    let restrict_label_present t l =    let restrict_label_present t l =
1040      Boolean.compute_bool      Boolean.compute_bool
1041        (fun (o,r) as x ->        (fun ((o,r) as x) ->
1042           try           try
1043             Boolean.atom (o, SortedMap.change_exists l (fun (_,lt) -> (false,lt)) r)             Boolean.atom (o, SortedMap.change_exists l (fun (_,lt) -> (false,lt)) r)
1044           with Not_found ->           with Not_found ->
# Line 1440  Line 1436 
1436  end  end
1437    
1438  let print_stat ppf =  let print_stat ppf =
1439    Format.fprintf ppf "nb_rec = %i@." !nb_rec;  (*  Format.fprintf ppf "nb_rec = %i@." !nb_rec;
1440    Format.fprintf ppf "nb_norec = %i@." !nb_norec;    Format.fprintf ppf "nb_norec = %i@." !nb_norec;
1441    *)
1442    ()    ()
1443    
1444  (*  (*
Legend:
Removed from v.187  
changed lines
  Added in v.188
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5