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

Diff of /types/types.ml

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

revision 18 by abate, Tue Jul 10 16:58:28 2007 UTC revision 19 by abate, Tue Jul 10 16:58:37 2007 UTC
# Line 382  Line 382 
382    let other d = { d with times = empty.times }    let other d = { d with times = empty.times }
383    let is_product d = is_empty (other d)    let is_product d = is_empty (other d)
384    
385      let need_second = function _::_::_ -> true | _ -> false
386    
387    let get d =    let get d =
388      let line accu (left,right) =      let line accu (left,right) =
389        let rec aux accu d1 d2 = function        let rec aux accu d1 d2 = function
# Line 437  Line 439 
439      List.map (!) !res      List.map (!) !res
440    
441    let any = { empty with times = any.times }    let any = { empty with times = any.times }
442      let is_empty d = d = []
443  end  end
444    
445    
# Line 701  Line 704 
704    
705  module Arrow =  module Arrow =
706  struct  struct
707      let check_simple left s1 s2 =
708        let rec aux accu1 accu2 = function
709          | (t1,t2)::left ->
710              let accu1' = diff_t accu1 t1 in
711              if not (empty_rec accu1') then aux accu1 accu2 left;
712              let accu2' = cap_t accu2 t2 in
713              if not (empty_rec accu2') then aux accu1 accu2 left
714          | [] -> raise NotEmpty
715        in
716        let accu1 = descr s1 in
717        (is_empty accu1) ||
718        (try aux accu1 (diff any (descr s2)) left; true with NotEmpty -> false)
719    
720      let check_strenghten t s =
721        let left = match t.arrow with [ (p,[]) ] -> p | _ -> assert false in
722        let rec aux = function
723          | [] -> raise Not_found
724          | (p,n) :: rem ->
725              if (List.for_all (fun (a,b) -> check_simple left a b) p) &&
726                (List.for_all (fun (a,b) -> not (check_simple left a b)) n) then
727                  { empty with arrow = [ (SortedList.cup left p, n) ] }
728              else aux rem
729        in
730        aux s.arrow
731    
732    type t = descr * (descr * descr) list list    type t = descr * (descr * descr) list list
733    
734    let get t =    let get t =
# Line 742  Line 770 
770    let apply (_,arr) t =    let apply (_,arr) t =
771      List.fold_left (apply_simple t) empty arr      List.fold_left (apply_simple t) empty arr
772    
773      let need_arg (dom, arr) =
774        List.exists (function [_] -> false | _ -> true) arr
775    
776      let apply_noarg (_,arr) =
777        List.fold_left
778          (fun accu ->
779             function
780               | [(t,s)] -> cup accu s
781               | _ -> assert false
782          )
783          empty arr
784    
785    let any = { empty with arrow = any.arrow }    let any = { empty with arrow = any.arrow }
786      let is_empty (_,arr) = arr = []
787  end  end
788    
789    

Legend:
Removed from v.18  
changed lines
  Added in v.19

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