aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/cArray.ml29
-rw-r--r--lib/cArray.mli20
-rw-r--r--lib/cList.ml36
-rw-r--r--lib/cList.mli23
-rw-r--r--lib/clib.mllib1
-rw-r--r--lib/dAst.ml41
-rw-r--r--lib/dAst.mli28
-rw-r--r--lib/flags.ml3
-rw-r--r--lib/flags.mli5
-rw-r--r--lib/option.ml11
-rw-r--r--lib/option.mli8
11 files changed, 179 insertions, 26 deletions
diff --git a/lib/cArray.ml b/lib/cArray.ml
index bb1e335468..013585735c 100644
--- a/lib/cArray.ml
+++ b/lib/cArray.ml
@@ -53,8 +53,12 @@ sig
('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
val map_left : ('a -> 'b) -> 'a array -> 'b array
val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
- val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+ val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+ val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+ val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+ val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
val fold_map2' :
('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
val distinct : 'a array -> bool
@@ -283,8 +287,7 @@ let rev_of_list = function
let () = set (len - 1) l in
ans
-let map_to_list f v =
- List.map f (Array.to_list v)
+let map_to_list = CList.map_of_array
let map_of_list f l =
let len = List.length l in
@@ -331,7 +334,7 @@ let smartmap f (ar : 'a array) =
Array.unsafe_set ans !i v;
incr i;
while !i < len do
- let v = Array.unsafe_get ar !i in
+ let v = Array.unsafe_get ans !i in
let v' = f v in
if v != v' then Array.unsafe_set ans !i v';
incr i
@@ -434,7 +437,7 @@ let iter2 f v1 v2 =
let pure_functional = false
-let fold_map' f v e =
+let fold_right_map f v e =
if pure_functional then
let (l,e) =
Array.fold_right
@@ -446,18 +449,28 @@ else
let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in
(v',!e')
-let fold_map f e v =
+let fold_map' = fold_right_map
+
+let fold_left_map f e v =
let e' = ref e in
let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in
(!e',v')
-let fold_map2' f v1 v2 e =
+let fold_map = fold_left_map
+
+let fold_right2_map f v1 v2 e =
let e' = ref e in
let v' =
map2 (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2
in
(v',!e')
+let fold_map2' = fold_right2_map
+
+let fold_left2_map f e v1 v2 =
+ let e' = ref e in
+ let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in
+ (!e',v')
let distinct v =
let visited = Hashtbl.create 23 in
@@ -514,7 +527,7 @@ struct
Array.unsafe_set ans !i v;
incr i;
while !i < len do
- let v = Array.unsafe_get ar !i in
+ let v = Array.unsafe_get ans !i in
let v' = f arg v in
if v != v' then Array.unsafe_set ans !i v';
incr i
diff --git a/lib/cArray.mli b/lib/cArray.mli
index 7e5c93b5da..325ff8edcc 100644
--- a/lib/cArray.mli
+++ b/lib/cArray.mli
@@ -96,10 +96,28 @@ sig
val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
(** Iter on two arrays. Raise [Invalid_argument "Array.iter2"] if sizes differ. *)
- val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+ (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]]
+ where [(e_i,k_i)=f e_{i-1} l_i] *)
+
+ val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+ (** Same, folding on the right *)
+
+ val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+ (** Same with two arrays, folding on the left *)
+
+ val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+ (** Same with two arrays, folding on the left *)
+
val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+ (** @deprecated Same as [fold_left_map] *)
+
+ val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
+ (** @deprecated Same as [fold_right_map] *)
+
val fold_map2' :
('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+ (** @deprecated Same as [fold_right2_map] *)
val distinct : 'a array -> bool
(** Return [true] if every element of the array is unique (for default
diff --git a/lib/cList.ml b/lib/cList.ml
index c8283e3c71..ca69628af7 100644
--- a/lib/cList.ml
+++ b/lib/cList.ml
@@ -49,6 +49,7 @@ sig
(int -> 'a -> bool) -> 'a list -> 'a list
val partitioni :
(int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+ val map_of_array : ('a -> 'b) -> 'a array -> 'b list
val smartfilter : ('a -> bool) -> 'a list -> 'a list
val extend : bool list -> 'a -> 'a list -> 'a list
val count : ('a -> bool) -> 'a list -> int
@@ -91,6 +92,10 @@ sig
val map_append : ('a -> 'b list) -> 'a list -> 'b list
val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list
val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
+ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+ val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+ val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+ val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
@@ -159,6 +164,21 @@ let map2 f l1 l2 = match l1, l2 with
cast c
| _ -> invalid_arg "List.map2"
+let rec map_of_array_loop f p a i l =
+ if Int.equal i l then ()
+ else
+ let c = { head = f (Array.unsafe_get a i); tail = [] } in
+ p.tail <- cast c;
+ map_of_array_loop f c a (i + 1) l
+
+let map_of_array f a =
+ let l = Array.length a in
+ if Int.equal l 0 then []
+ else
+ let c = { head = f (Array.unsafe_get a 0); tail = [] } in
+ map_of_array_loop f c a 1 l;
+ cast c
+
let rec append_loop p tl = function
| [] -> p.tail <- tl
| x :: l ->
@@ -745,13 +765,15 @@ let share_tails l1 l2 =
in
shr_rev [] (List.rev l1, List.rev l2)
-let rec fold_map f e = function
+let rec fold_left_map f e = function
| [] -> (e,[])
| h::t ->
let e',h' = f e h in
- let e'',t' = fold_map f e' t in
+ let e'',t' = fold_left_map f e' t in
e'',h'::t'
+let fold_map = fold_left_map
+
(* (* tail-recursive version of the above function *)
let fold_map f e l =
let g (e,b') h =
@@ -763,9 +785,17 @@ let fold_map f e l =
*)
(* The same, based on fold_right, with the effect accumulated on the right *)
-let fold_map' f l e =
+let fold_right_map f l e =
List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
+let fold_map' = fold_right_map
+
+let fold_left2_map f e l l' =
+ List.fold_left2 (fun (e,l) x x' -> let (e,y) = f e x x' in (e,y::l)) (e,[]) l l'
+
+let fold_right2_map f l l' e =
+ List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e)
+
let map_assoc f = List.map (fun (x,a) -> (x,f a))
let rec assoc_f f a = function
diff --git a/lib/cList.mli b/lib/cList.mli
index bc8749b4f8..8cb07da79c 100644
--- a/lib/cList.mli
+++ b/lib/cList.mli
@@ -53,7 +53,7 @@ sig
[Invalid_argument "List.make"] if [n] is negative. *)
val assign : 'a list -> int -> 'a -> 'a list
- (** [assign l i x] set the [i]-th element of [l] to [x], starting from [0]. *)
+ (** [assign l i x] sets the [i]-th element of [l] to [x], starting from [0]. *)
val distinct : 'a list -> bool
(** Return [true] if all elements of the list are distinct. *)
@@ -91,6 +91,9 @@ sig
val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
+ val map_of_array : ('a -> 'b) -> 'a array -> 'b list
+ (** [map_of_array f a] behaves as [List.map f (Array.to_list a)] *)
+
val smartfilter : ('a -> bool) -> 'a list -> 'a list
(** [smartfilter f [a1...an] = List.filter f [a1...an]] but if for all i
[f ai = true], then [smartfilter f l == l] *)
@@ -195,11 +198,25 @@ sig
val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list
- val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
- (** [fold_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
+ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+ (** [fold_left_map f e_0 [l_1...l_n] = e_n,[k_1...k_n]]
where [(e_i,k_i)=f e_{i-1} l_i] *)
+ val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+ (** Same, folding on the right *)
+
+ val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
+ (** Same with two lists, folding on the left *)
+
+ val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
+ (** Same with two lists, folding on the right *)
+
+ val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+ (** @deprecated Same as [fold_left_map] *)
+
val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
+ (** @deprecated Same as [fold_right_map] *)
+
val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b
val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list
diff --git a/lib/clib.mllib b/lib/clib.mllib
index d5c938fe54..5c1f7d9af8 100644
--- a/lib/clib.mllib
+++ b/lib/clib.mllib
@@ -19,6 +19,7 @@ Flags
Control
Loc
CAst
+DAst
CList
CString
Deque
diff --git a/lib/dAst.ml b/lib/dAst.ml
new file mode 100644
index 0000000000..0fe323d013
--- /dev/null
+++ b/lib/dAst.ml
@@ -0,0 +1,41 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+open CAst
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+let map_thunk (type s) f : (_, s) thunk -> (_, s) thunk = function
+| Value x -> Value (f x)
+| Thunk k -> Thunk (lazy (f (Lazy.force k)))
+
+let get_thunk (type s) : ('a, s) thunk -> 'a = function
+| Value x -> x
+| Thunk k -> Lazy.force k
+
+let get x = get_thunk x.v
+
+let make ?loc v = CAst.make ?loc (Value v)
+
+let delay ?loc v = CAst.make ?loc (Thunk (Lazy.from_fun v))
+
+let map f n = CAst.map (fun x -> map_thunk f x) n
+
+let map_with_loc f n =
+ CAst.map_with_loc (fun ?loc x -> map_thunk (fun x -> f ?loc x) x) n
+
+let map_from_loc f (loc, x) =
+ make ?loc (f ?loc x)
+
+let with_val f n = f (get n)
+
+let with_loc_val f n = f ?loc:n.CAst.loc (get n)
diff --git a/lib/dAst.mli b/lib/dAst.mli
new file mode 100644
index 0000000000..5b51677fc6
--- /dev/null
+++ b/lib/dAst.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(** Lazy AST node wrapper. Only used for [glob_constr] as of today. *)
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+val get : ('a, 'b) t -> 'a
+val get_thunk : ('a, 'b) thunk -> 'a
+
+val make : ?loc:Loc.t -> 'a -> ('a, 'b) t
+val delay : ?loc:Loc.t -> (unit -> 'a) -> ('a, [ `thunk ]) t
+
+val map : ('a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_with_loc : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_from_loc : (?loc:Loc.t -> 'a -> 'b) -> 'a Loc.located -> ('b, 'c) t
+
+val with_val : ('a -> 'b) -> ('a, 'c) t -> 'b
+val with_loc_val : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> 'b
diff --git a/lib/flags.ml b/lib/flags.ml
index 027ba16f0e..d4be81c61a 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -87,8 +87,6 @@ let in_toplevel = ref false
let profile = false
-let xml_export = ref false
-
let ide_slave = ref false
let ideslave_coqtop_flags = ref None
@@ -96,7 +94,6 @@ let time = ref false
let raw_print = ref false
-
let univ_print = ref false
let we_are_parsing = ref false
diff --git a/lib/flags.mli b/lib/flags.mli
index 5af563b46e..3024c60396 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -56,11 +56,6 @@ val stm_debug : bool ref
val profile : bool
-(* Legacy flags *)
-
-(* -xml option: xml hooks will be called *)
-val xml_export : bool ref
-
(* -ide_slave: printing will be more verbose, will affect stm caching *)
val ide_slave : bool ref
val ideslave_coqtop_flags : string option ref
diff --git a/lib/option.ml b/lib/option.ml
index 7cedffef08..98b1680354 100644
--- a/lib/option.ml
+++ b/lib/option.ml
@@ -121,12 +121,19 @@ let fold_right f x a =
| Some y -> f y a
| _ -> a
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
-let fold_map f a x =
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+let fold_left_map f a x =
match x with
| Some y -> let a, z = f a y in a, Some z
| _ -> a, None
+let fold_right_map f x a =
+ match x with
+ | Some y -> let z, a = f y a in Some z, a
+ | _ -> None, a
+
+let fold_map = fold_left_map
+
(** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *)
let cata f a = function
| Some c -> f c
diff --git a/lib/option.mli b/lib/option.mli
index c4d1ebc3a7..66f05023f7 100644
--- a/lib/option.mli
+++ b/lib/option.mli
@@ -85,7 +85,13 @@ val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> 'c option -> 'a
(** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *)
val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b
-(** [fold_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *)
+val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
+
+(** Same as [fold_left_map] on the right *)
+val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a
+
+(** @deprecated Same as [fold_left_map] *)
val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
(** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *)
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-09 07:15:05 +0000