X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fextlib%2FhExtlib.ml;h=523913cbfcda4e6e2e501103d068d1462ff9232e;hb=ee242468b221c64b25c99b52110fe00380f4eebe;hp=fe0f417cdf88521a401a54d0ebbf41ba79ef0b58;hpb=ff5d621723a60609c67152c110b8386f7902c1ff;p=helm.git diff --git a/helm/software/components/extlib/hExtlib.ml b/helm/software/components/extlib/hExtlib.ml index fe0f417cd..523913cbf 100644 --- a/helm/software/components/extlib/hExtlib.ml +++ b/helm/software/components/extlib/hExtlib.ml @@ -164,6 +164,23 @@ let rec list_forall_default3 f l1 l2 def l3 = | a::ta, b::tb, [] -> f a b def && list_forall_default3 f ta tb def [] ;; +exception FailureAt of int;; + +let list_forall_default3_var f l1 l2 def l3 = + let rec aux f l1 l2 def l3 i = + match l1,l2,l3 with + | [], [], _ -> true + | [], _, _ + | _, [], _ -> raise (Invalid_argument "list_forall_default3") + | a::ta, b::tb, c::tc -> + if f a b c then aux f ta tb def tc (i+1) + else raise (FailureAt i) + | a::ta, b::tb, [] -> + if f a b def then aux f ta tb def [] (i+1) + else raise (FailureAt i) + in aux f l1 l2 def l3 0 +;; + let sharing_map f l = let unchanged = ref true in let rec aux b = function @@ -222,14 +239,14 @@ let list_concat ?(sep = []) = aux [] let rec list_findopt f l = - let rec aux = function + let rec aux k = function | [] -> None | x::tl -> - (match f x with - | None -> aux tl + (match f x k with + | None -> aux (succ k) tl | Some _ as rc -> rc) in - aux l + aux 0 l let split_nth n l = let rec aux acc n l = @@ -447,7 +464,7 @@ let loc_of_floc floc = Stdpp.first_pos floc, Stdpp.last_pos floc;; let floc_of_loc (loc_begin, loc_end) = Stdpp.make_loc (loc_begin, loc_end) -let dummy_floc = floc_of_loc (-1, -1) +let dummy_floc = floc_of_loc (0, 0) let raise_localized_exception ~offset floc exn = let x, y = loc_of_floc floc in @@ -522,6 +539,7 @@ let rec mk_list x = function ;; let list_seq start stop = + if start > stop then [] else let rec aux pos = if pos = stop then [] else pos :: (aux (pos+1)) @@ -529,3 +547,10 @@ let list_seq start stop = aux start ;; +let rec list_skip n l = + match n,l with + | 0,_ -> l + | n,_::l -> list_skip (n-1) l + | _, [] -> assert false +;; +