diff --git a/src/array2.ml b/src/array2.ml deleted file mode 100644 index 6fb10d76bf..0000000000 --- a/src/array2.ml +++ /dev/null @@ -1,70 +0,0 @@ -include ExtArray.Array - -exception Different_array_size - -let zip a b = - if length a <> length b - then raise Different_array_size - else init (length a) (fun i -> a.(i), b.(i)) - -let unzip ab = (map fst ab, map snd ab) - -let of_idx_array idxa default = - let max_idx = fold_left (fun max (idx,_) -> if max > idx then max else idx) (-1) idxa in - let ans = make (max_idx + 1) default in - for i = 0 to Array.length idxa - 1 do - let (idx,v) = idxa.(i) in ans.(idx) <- v - done; - ans - -let of_list2 ll = map of_list (of_list ll) -let to_list2 aa = to_list (map to_list aa) - -let for_alli f a = - let len = length a in - let rec helper i = - if i >= len then true - else if f i (get a i) then helper (i+1) - else false - in - helper 0 - -let existsi f a = - let len = length a in - let rec helper i = - if i >= len then false - else if f i (get a i) then true - else helper (i+1) - in - helper 0 - -let find_helper f a = - let len = length a in - let rec helper i = - if i >= len then raise Not_found - else if f i (get a i) then (i, get a i) - else helper (i+1) - in - helper 0 - -let find' f a = snd (find_helper f a) -let findi' f a = fst (find_helper f a) - -let unique cmp a = - let a = copy a in (* don't mess with input *) - let _ = sort cmp a in - let len = length a in - let rec adjEq i = - if len - i <= 1 then false - else (cmp (get a i) (get a (i+1)) = 0) || (adjEq (i+1)) - in - not (adjEq 0) - -let is_rectangular d = - if length d <= 1 then - true - else - let allLengths = map length d in - let firstLength = get allLengths 0 in - let lengthEqualsFirstLength k = k = firstLength in - for_all lengthEqualsFirstLength allLengths diff --git a/src/array2.mli b/src/array2.mli deleted file mode 100644 index 210e1ad9a8..0000000000 --- a/src/array2.mli +++ /dev/null @@ -1,286 +0,0 @@ -(** Arrays. Extension of ExtLib's ExtArray, which itself extends Standard Library's Array. *) - -exception Different_array_size - (** Raised by functions taking two or more arrays that should have same length but are given arrays of different length. Analagous to ExtLib's Different_list_size. *) - -external length : 'a array -> int = "%array_length" - (** Return the length (number of elements) of the given array. *) - -external get : 'a array -> int -> 'a = "%array_safe_get" - (** [Array.get a n] returns the element number [n] of array [a]. - The first element has number 0. - The last element has number [Array.length a - 1]. - You can also write [a.(n)] instead of [Array.get a n]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(Array.length a - 1)]. *) - -external set : 'a array -> int -> 'a -> unit = "%array_safe_set" - (** [Array.set a n x] modifies array [a] in place, replacing - element number [n] with [x]. - You can also write [a.(n) <- x] instead of [Array.set a n x]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [Array.length a - 1]. *) - - -(** {6 Constructors} *) - -external make : int -> 'a -> 'a array = "caml_make_vect" - (** [Array.make n x] returns a fresh array of length [n], - initialized with [x]. - All the elements of this new array are initially - physically equal to [x] (in the sense of the [==] predicate). - Consequently, if [x] is mutable, it is shared among all elements - of the array, and modifying [x] through one of the array entries - will modify all other entries at the same time. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the value of [x] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2].*) - -val init : int -> (int -> 'a) -> 'a array - (** [Array.init n f] returns a fresh array of length [n], - with element number [i] initialized to the result of [f i]. - In other terms, [Array.init n f] tabulates the results of [f] - applied to the integers [0] to [n-1]. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the return type of [f] is [float], then the maximum - size is only [Sys.max_array_length / 2].*) - -val make_matrix : int -> int -> 'a -> 'a array array - (** [Array.make_matrix dimx dimy e] returns a two-dimensional array - (an array of arrays) with first dimension [dimx] and - second dimension [dimy]. All the elements of this new matrix - are initially physically equal to [e]. - The element ([x,y]) of a matrix [m] is accessed - with the notation [m.(x).(y)]. - - Raise [Invalid_argument] if [dimx] or [dimy] is negative or - greater than [Sys.max_array_length]. - If the value of [e] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2]. *) - -val append : 'a array -> 'a array -> 'a array - (** [Array.append v1 v2] returns a fresh array containing the - concatenation of the arrays [v1] and [v2]. *) - -val concat : 'a array list -> 'a array - (** Same as [Array.append], but concatenates a list of arrays. *) - -val sub : 'a array -> int -> int -> 'a array - (** [Array.sub a start len] returns a fresh array of length [len], - containing the elements number [start] to [start + len - 1] - of array [a]. - - Raise [Invalid_argument "Array.sub"] if [start] and [len] do not - designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. *) - -val copy : 'a array -> 'a array - (** [Array.copy a] returns a copy of [a], that is, a fresh array - containing the same elements as [a]. *) - -val fill : 'a array -> int -> int -> 'a -> unit - (** [Array.fill a ofs len x] modifies the array [a] in place, - storing [x] in elements number [ofs] to [ofs + len - 1]. - - Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not - designate a valid subarray of [a]. *) - -val blit : 'a array -> int -> 'a array -> int -> int -> unit - (** [Array.blit v1 o1 v2 o2 len] copies [len] elements - from array [v1], starting at element number [o1], to array [v2], - starting at element number [o2]. It works correctly even if - [v1] and [v2] are the same array, and the source and - destination chunks overlap. - - Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not - designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. *) - -val of_idx_array : (int * 'a) array -> 'a -> 'a array - (** [of_idx_array idxa default] treats [idxa] as an association of indices with values. Return a fresh array where the [i]th value is set to [v] if the input has a pair [(i,v)]. Size of returned array will be maximum index in input + 1. Indices not given a value in [idxa] will be set to [default] value. If there are duplicate indices in [idxa], the last value will override former ones. *) - - -(** {6 Converters} *) - -val rev : 'a array -> 'a array - (** Array reversal. *) - -val rev_in_place : 'a array -> unit - (** In-place array reversal. The array argument is updated. *) - -val to_list : 'a array -> 'a list - (** Convert an array to a list. *) - -val of_list : 'a list -> 'a array - (** Convert a list to an array. *) - -val of_list2 : 'a list list -> 'a array array -val to_list2 : 'a array array -> 'a list list - -val zip : 'a array -> 'b array -> ('a * 'b) array - (** [zip a b] pairs up values in [a] and [b]. Order of elements is preserved. Raise {!Different_array_size} if [a] and [b] do not have the same length. *) - -val unzip : ('a * 'b) array -> ('a array * 'b array) - (** [unzip ab] returns two arrays [a] and [b], where [a] has all the first elements of the pairs in [ab], and [b] has the second elements. Order of elements is preserved. *) - -val enum : 'a array -> 'a Enum.t - (** Returns an enumeration of the elements of an array. *) - -val of_enum : 'a Enum.t -> 'a array - (** Build an array from an enumeration. *) - - -(** {6 Iterators} *) - -val iter : ('a -> unit) -> 'a array -> unit - (** [Array.iter f a] applies function [f] in turn to all - the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) - -val map : ('a -> 'b) -> 'a array -> 'b array - (** [Array.map f a] applies function [f] to all the elements of [a], - and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) - -val iteri : (int -> 'a -> unit) -> 'a array -> unit - (** Same as {!Array.iter}, but the - function is applied to the index of the element as first argument, - and the element itself as second argument. *) - -val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array - (** Same as {!Array.map}, but the - function is applied to the index of the element as first argument, - and the element itself as second argument. *) - -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a - (** [Array.fold_left f x a] computes - [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], - where [n] is the length of the array [a]. *) - -val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a - (** [Array.fold_right f a x] computes - [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], - where [n] is the length of the array [a]. *) - - -(** {6 Scanning} *) - -val mem : 'a -> 'a array -> bool - (** [mem m a] is true if and only if [m] is equal to an element of [a]. *) - -val memq : 'a -> 'a array -> bool - (** Same as {!Array.mem} but uses physical equality instead of - structural equality to compare array elements. - *) - -val for_all : ('a -> bool) -> 'a array -> bool - (** [for_all p [a1; ...; an]] checks if all elements of the array - satisfy the predicate [p]. That is, it returns - [ (p a1) && (p a2) && ... && (p an)]. - *) - -val for_alli : (int -> 'a -> bool) -> 'a array -> bool - -val exists : ('a -> bool) -> 'a array -> bool - (** [exists p [a1; ...; an]] checks if at least one element of - the array satisfies the predicate [p]. That is, it returns - [ (p a1) || (p a2) || ... || (p an)]. - *) - -val existsi : (int -> 'a -> bool) -> 'a array -> bool - -val find : ('a -> bool) -> 'a array -> 'a - (** [find p a] returns the first element of array [a] - that satisfies the predicate [p]. - Raise [Not_found] if there is no value that satisfies [p] in the - array [a]. - *) - -val unique : ('a -> 'a -> int) -> 'a array -> bool - (** [unique comp t] returns true if no two items in the array are equal as determined by [comp]. *) - -val is_rectangular : 'a array array -> bool - (** [is_rectangular a] returns true if length of every a.(i) is the same. *) - - -(** {6 Searching} *) - -val findi : ('a -> bool) -> 'a array -> int - (** [findi p a] returns the index of the first element of array [a] - that satisfies the predicate [p]. - Raise [Not_found] if there is no value that satisfies [p] in the - array [a]. - *) - -val find' : (int -> 'a -> bool) -> 'a array -> 'a -val findi' : (int -> 'a -> bool) -> 'a array -> int - (** similar to ExtLib's [find] and [findi], but the predicate can also employ the index of the item. *) - -val filter : ('a -> bool) -> 'a array -> 'a array - (** [filter p a] returns all the elements of the array [a] - that satisfy the predicate [p]. The order of the elements - in the input array is preserved. *) - -val find_all : ('a -> bool) -> 'a array -> 'a array - (** [find_all] is another name for {!Array.filter}. *) - -val partition : ('a -> bool) -> 'a array -> 'a array * 'a array - (** [partition p a] returns a pair of arrays [(a1, a2)], where - [a1] is the array of all the elements of [a] that - satisfy the predicate [p], and [a2] is the array of all the - elements of [a] that do not satisfy [p]. - The order of the elements in the input array is preserved. *) - -(** {6 Sorting} *) - -val sort : ('a -> 'a -> int) -> 'a array -> unit - (** Sort an array in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see below for a - complete specification). For example, {!Pervasives.compare} is - a suitable comparison function, provided there are no floating-point - NaN values in the data. After calling [Array.sort], the - array is sorted in place in increasing order. - [Array.sort] is guaranteed to run in constant heap space - and (at most) logarithmic stack space. - - The current implementation uses Heap Sort. It runs in constant - stack space. - - Specification of the comparison function: - Let [a] be the array and [cmp] the comparison function. The following - must be true for all x, y, z in a : - - [cmp x y] > 0 if and only if [cmp y x] < 0 - - if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 - - When [Array.sort] returns, [a] contains the same elements as before, - reordered in such a way that for all i and j valid indices of [a] : - - [cmp a.(i) a.(j)] >= 0 if and only if i >= j - *) - -val stable_sort : ('a -> 'a -> int) -> 'a array -> unit - (** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. - elements that compare equal are kept in their original order) and - not guaranteed to run in constant heap space. - - The current implementation uses Merge Sort. It uses [n/2] - words of heap space, where [n] is the length of the array. - It is usually faster than the current implementation of {!Array.sort}. - *) - -val fast_sort : ('a -> 'a -> int) -> 'a array -> unit - (** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster - on typical input. - *) - - -(**/**) -(** {6 Undocumented functions} *) - -external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" diff --git a/src/char2.ml b/src/char2.ml deleted file mode 100644 index 08454f9e3d..0000000000 --- a/src/char2.ml +++ /dev/null @@ -1,27 +0,0 @@ -include Char - -(* check if ascii code of c lies between n1 and n2 *) -let in_code_range c n1 n2 = - let c = code c - in n1 <= c && c <= n2 - -let is_digit c = in_code_range c 48 57 -let is_hex_digit c = in_code_range c 48 57 || in_code_range c 97 102 || in_code_range c 65 70 -let is_oct_digit c = in_code_range c 48 55 -let is_lower c = in_code_range c 97 122 -let is_upper c = in_code_range c 65 90 -let is_letter c = is_lower c || is_upper c -let is_alpha_num c = is_letter c || is_digit c -let is_ascii c = in_code_range c 0 127 - -let to_string c = String.make 1 c - -let to_int c = - if is_digit c then (code c) - (code '0') - else raise (Invalid_argument ("cannot convert character " ^ (to_string c) ^ " to int")) - -let from_int k = - if k >= 0 && k <= 9 then chr (code '0' + k) - else raise (Invalid_argument ("cannot convert int " ^ (string_of_int k) ^ " to char")) - -let is_space = String.contains " \t\r\n" diff --git a/src/char2.mli b/src/char2.mli deleted file mode 100644 index 1f26824faf..0000000000 --- a/src/char2.mli +++ /dev/null @@ -1,53 +0,0 @@ -(** Characters. Designed with only ASCII character set in mind. Extension of Standard Library's Char. *) - -type t = char - (** An alias for the type of characters. *) - -external code : char -> int = "%identity" - (** Return the ASCII code of the argument. *) - -val chr : int -> char - (** Return the character with the given ASCII code. - Raise [Invalid_argument "Char.chr"] if the argument is - outside the range 0--255. *) - -val escaped : char -> string - (** Return a string representing the given character, - with special characters escaped following the lexical conventions - of Objective Caml. *) - -val lowercase : char -> char - (** Convert the given character to its equivalent lowercase character. *) - -val uppercase : char -> char - (** Convert the given character to its equivalent uppercase character. *) - -val compare: t -> t -> int - (** The comparison function for characters, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [Char] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - -val is_digit : char -> bool -val is_hex_digit : char -> bool -val is_oct_digit : char -> bool -val is_lower : char -> bool -val is_upper : char -> bool -val is_letter : char -> bool -val is_alpha_num : char -> bool -val is_ascii : char -> bool - -val is_space : char -> bool - (** [is_space c] returns true if [c] is in the string " \t\r\n". *) - -val to_string : char -> string - -val to_int : char -> int - (** [to_int c] returns int corresponding to [c]. Raise [Invalid_argument] if [c] is not a digit. Do not confuse this with [code]. *) - -val from_int : int -> char - (** [from_int k] returns char corresponding to k. Raise [Invalid_argument] if k not between 0 and 9 (inclusive). Do not confuse this with [chr]. *) - -(**/**) - -external unsafe_chr : int -> char = "%identity" diff --git a/src/dynArray2.ml b/src/dynArray2.ml deleted file mode 100644 index b59a58b97e..0000000000 --- a/src/dynArray2.ml +++ /dev/null @@ -1,10 +0,0 @@ -include DynArray - -let pad_set darr idx v default = - let pad_size = idx - DynArray.length darr + 1 in - if pad_size <= 0 then - DynArray.set darr idx v - else - (DynArray.append (DynArray.init pad_size (fun _ -> default)) darr; - DynArray.set darr idx v) - diff --git a/src/dynArray2.mli b/src/dynArray2.mli deleted file mode 100644 index d987d3a30a..0000000000 --- a/src/dynArray2.mli +++ /dev/null @@ -1,266 +0,0 @@ -(** Dynamic arrays. - - A dynamic array is equivalent to a OCaml array that will resize itself - when elements are added or removed, except that floats are boxed and - that no initialization element is required. - - Extension of ExtLib's DynArray. -*) - - -type 'a t - -exception Invalid_arg of int * string * string - (** When an operation on an array fails, [Invalid_arg] is raised. The - integer is the value that made the operation fail, the first string - contains the function name that has been called and the second string - contains the parameter name that made the operation fail. - *) - -(** {6 Array creation} *) - -val create : unit -> 'a t - (** [create()] returns a new empty dynamic array. *) - -val make : int -> 'a t - (** [make count] returns an array with some memory already allocated so - up to [count] elements can be stored into it without resizing. *) - -val init : int -> (int -> 'a) -> 'a t - (** [init n f] returns an array of [n] elements filled with values - returned by [f 0 , f 1, ... f (n-1)]. *) - -(** {6 Array manipulation functions} *) - -val empty : 'a t -> bool - (** Return true if the number of elements in the array is 0. *) - -val length : 'a t -> int - (** Return the number of elements in the array. *) - -val get : 'a t -> int -> 'a - (** [get darr idx] gets the element in [darr] at index [idx]. If [darr] has - [len] elements in it, then the valid indexes range from [0] to [len-1]. *) - -val last : 'a t -> 'a - (** [last darr] returns the last element of [darr]. *) - -val set : 'a t -> int -> 'a -> unit - (** [set darr idx v] sets the element of [darr] at index [idx] to value - [v]. The previous value is overwritten. *) - -val pad_set : 'a t -> int -> 'a -> 'a -> unit - (** [pad_set darr idx v default] is like {!set} but okay for [idx] to be beyond end of array. Array is first padded with as many elements as needed with value [default], and then final item, of index [idx], is set to [v]. *) - -val insert : 'a t -> int -> 'a -> unit - (** [insert darr idx v] inserts [v] into [darr] at index [idx]. All elements - of [darr] with an index greater than or equal to [idx] have their - index incremented (are moved up one place) to make room for the new - element. *) - -val add : 'a t -> 'a -> unit - (** [add darr v] appends [v] onto [darr]. [v] becomes the new - last element of [darr]. *) - -val append : 'a t -> 'a t -> unit - (** [append src dst] adds all elements of [src] to the end of [dst]. *) - -val delete : 'a t -> int -> unit - (** [delete darr idx] deletes the element of [darr] at [idx]. All elements - with an index greater than [idx] have their index decremented (are - moved down one place) to fill in the hole. *) - -val delete_last : 'a t -> unit - (** [delete_last darr] deletes the last element of [darr]. This is equivalent - of doing [delete darr ((length darr) - 1)]. *) - -val delete_range : 'a t -> int -> int -> unit - (** [delete_range darr p len] deletes [len] elements starting at index [p]. - All elements with an index greater than [p+len] are moved to fill - in the hole. *) - -val clear : 'a t -> unit - (** remove all elements from the array and resize it to 0. *) - -val blit : 'a t -> int -> 'a t -> int -> int -> unit - (** [blit src srcidx dst dstidx len] copies [len] elements from [src] - starting with index [srcidx] to [dst] starting at [dstidx]. *) - -val compact : 'a t -> unit - (** [compact darr] ensures that the space allocated by the array is minimal.*) - -(** {6 Array copy and conversion} *) - -val to_list : 'a t -> 'a list - (** [to_list darr] returns the elements of [darr] in order as a list. *) - -val to_array : 'a t -> 'a array - (** [to_array darr] returns the elements of [darr] in order as an array. *) - -val enum : 'a t -> 'a Enum.t - (** [enum darr] returns the enumeration of [darr] elements. *) - -val of_list : 'a list -> 'a t - (** [of_list lst] returns a dynamic array with the elements of [lst] in - it in order. *) - -val of_array : 'a array -> 'a t - (** [of_array arr] returns an array with the elements of [arr] in it - in order. *) - -val of_enum : 'a Enum.t -> 'a t - (** [of_enum e] returns an array that holds, in order, the elements of [e]. *) - -val copy : 'a t -> 'a t - (** [copy src] returns a fresh copy of [src], such that no modification of - [src] affects the copy, or vice versa (all new memory is allocated for - the copy). *) - -val sub : 'a t -> int -> int -> 'a t - (** [sub darr start len] returns an array holding the subset of [len] - elements from [darr] starting with the element at index [idx]. *) - -(** {6 Array functional support} *) - -val iter : ('a -> unit) -> 'a t -> unit - (** [iter f darr] calls the function [f] on every element of [darr]. It - is equivalent to [for i = 0 to length darr - 1 do f (get darr i) done;] *) - -val iteri : (int -> 'a -> unit) -> 'a t -> unit - (** [iter f darr] calls the function [f] on every element of [darr]. It - is equivalent to [for i = 0 to length darr - 1 do f i (get darr i) done;] - *) - -val map : ('a -> 'b) -> 'a t -> 'b t - (** [map f darr] applies the function [f] to every element of [darr] - and creates a dynamic array from the results - similar to [List.map] or - [Array.map]. *) - -val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t - (** [mapi f darr] applies the function [f] to every element of [darr] - and creates a dynamic array from the results - similar to [List.mapi] or - [Array.mapi]. *) - -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a - (** [fold_left f x darr] computes - [f ( ... ( f ( f (get darr 0) x) (get darr 1) ) ... ) (get darr n-1)], - similar to [Array.fold_left] or [List.fold_left]. *) - -val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b - (** [fold_right f darr x] computes - [ f (get darr 0) (f (get darr 1) ( ... ( f (get darr n-1) x ) ... ) ) ] - similar to [Array.fold_right] or [List.fold_right]. *) - -val index_of : ('a -> bool) -> 'a t -> int - (** [index_of f darr] returns the index of the first element [x] in darr such - as [f x] returns [true] or raise [Not_found] if not found. *) - -val filter : ('a -> bool) -> 'a t -> unit - -(** {6 Array resizers} *) - -type resizer_t = currslots:int -> oldlength:int -> newlength:int -> int - (** The type of a resizer function. - - Resizer functions are called whenever elements are added to - or removed from the dynamic array to determine what the current number of - storage spaces in the array should be. The three named arguments - passed to a resizer are the current number of storage spaces in - the array, the length of the array before the elements are - added or removed, and the length the array will be after the - elements are added or removed. If elements are being added, newlength - will be larger than oldlength, if elements are being removed, - newlength will be smaller than oldlength. If the resizer function - returns exactly oldlength, the size of the array is only changed when - adding an element while there is not enough space for it. - - By default, all dynamic arrays are created with the [default_resizer]. - When a dynamic array is created from another dynamic array (using [copy], - [map] , etc. ) the resizer of the copy will be the same as the original - dynamic array resizer. To change the resizer, use the [set_resizer] - function. - *) - -val set_resizer : 'a t -> resizer_t -> unit - (** Change the resizer for this array. *) - -val get_resizer : 'a t -> resizer_t - (** Get the current resizer function for a given array *) - -val default_resizer : resizer_t - (** The default resizer function the library is using - in this version - of DynArray, this is the [exponential_resizer] but should change in - next versions. *) - -val exponential_resizer : resizer_t - (** The exponential resizer- The default resizer except when the resizer - is being copied from some other darray. - - [exponential_resizer] works by doubling or halving the number of - slots until they "fit". If the number of slots is less than the - new length, the number of slots is doubled until it is greater - than the new length (or Sys.max_array_size is reached). - - If the number of slots is more than four times the new length, - the number of slots is halved until it is less than four times the - new length. - - Allowing darrays to fall below 25% utilization before shrinking them - prevents "thrashing". Consider the case where the caller is constantly - adding a few elements, and then removing a few elements, causing - the length to constantly cross above and below a power of two. - Shrinking the array when it falls below 50% would causing the - underlying array to be constantly allocated and deallocated. - A few elements would be added, causing the array to be reallocated - and have a usage of just above 50%. Then a few elements would be - remove, and the array would fall below 50% utilization and be - reallocated yet again. The bulk of the array, untouched, would be - copied and copied again. By setting the threshold at 25% instead, - such "thrashing" only occurs with wild swings- adding and removing - huge numbers of elements (more than half of the elements in the array). - - [exponential_resizer] is a good performing resizer for most - applications. A list allocates 2 words for every element, while an - array (with large numbers of elements) allocates only 1 word per - element (ignoring unboxed floats). On insert, [exponential_resizer] - keeps the amount of wasted "extra" array elements below 50%, meaning - that less than 2 words per element are used. Even on removals - where the amount of wasted space is allowed to rise to 75%, that - only means that darray is using 4 words per element. This is - generally not a significant overhead. - - Furthermore, [exponential_resizer] minimizes the number of copies - needed- appending n elements into an empty darray with initial size - 0 requires between n and 2n elements of the array be copied- O(n) - work, or O(1) work per element (on average). A similar argument - can be made that deletes from the end of the array are O(1) as - well (obviously deletes from anywhere else are O(n) work- you - have to move the n or so elements above the deleted element down). - - *) - -val step_resizer : int -> resizer_t - (** The stepwise resizer- another example of a resizer function, this - time of a parameterized resizer. - - The resizer returned by [step_resizer step] returns the smallest - multiple of [step] larger than [newlength] if [currslots] is less - then [newlength]-[step] or greater than [newlength]. - - For example, to make an darray with a step of 10, a length - of len, and a null of null, you would do: - [make] ~resizer:([step_resizer] 10) len null - *) - -val conservative_exponential_resizer : resizer_t - (** [conservative_exponential_resizer] is an example resizer function - which uses the oldlength parameter. It only shrinks the array - on inserts- no deletes shrink the array, only inserts. It does - this by comparing the oldlength and newlength parameters. Other - than that, it acts like [exponential_resizer]. - *) - -(** {6 Unsafe operations} **) - -val unsafe_get : 'a t -> int -> 'a -val unsafe_set : 'a t -> int -> 'a -> unit diff --git a/src/list2.ml b/src/list2.ml deleted file mode 100644 index e79ae38092..0000000000 --- a/src/list2.ml +++ /dev/null @@ -1,89 +0,0 @@ -include List (* ExtList.List does not include all functions from standard List *) -include ExtList.List - -let zip = combine -let unzip = split - -let zip3 al bl cl = - let rec loop ans al bl cl = - match (al,bl,cl) with - | ([], [], []) -> ans - | (a::al, b::bl, c::cl) -> loop ((a,b,c)::ans) al bl cl - | _ -> raise (Different_list_size "zip3") - in rev (loop [] al bl cl) - -let zip4 al bl cl dl = - let rec loop ans al bl cl dl = - match (al,bl,cl,dl) with - | ([], [], [], []) -> ans - | (a::al, b::bl, c::cl, d::dl) -> loop ((a,b,c,d)::ans) al bl cl dl - | _ -> raise (Different_list_size "zip4") - in rev (loop [] al bl cl dl) - -let unzip3 abcl = - let rec loop (al,bl,cl) abcl = - match abcl with - | [] -> (al,bl,cl) - | (a,b,c)::abcl -> loop (a::al, b::bl, c::cl) abcl - in - let (al,bl,cl) = loop ([],[],[]) abcl in - rev al, rev bl, rev cl - -let unzip4 abcdl = - let rec loop (al,bl,cl,dl) abcdl = - match abcdl with - | [] -> (al,bl,cl,dl) - | (a,b,c,d)::abcdl -> loop (a::al, b::bl, c::cl, d::dl) abcdl - in - let (al,bl,cl,dl) = loop ([],[],[],[]) abcdl in - rev al, rev bl, rev cl, rev dl - -let npartition eq l = - let insertl ll a = - let rec loop prefix ll = - match ll with - | [] -> rev ([a]::prefix) - | l::ll -> - if eq a (hd l) - then (rev ((a::l)::prefix)) @ ll - else loop (l::prefix) ll - in loop [] ll - in map rev (fold_left insertl [] l) - -let interleave al1 al2 = - let rec iter ans al1 al2 = - match (al1,al2) with - (_,[]) -> ans @ al1 - | ([],_) -> ans @ al2 - | (a1::al1, a2::al2) -> iter (ans @ [a1;a2]) al1 al2 - in iter [] al1 al2 - -let to_string f l = - "[" ^ (String.concat "; " (List.map f l)) ^ "]" - -let elements_unique ?(cmp = (=)) l = - length l = length (unique ~cmp l) - -let first_repeat ?(cmp = (=)) l = - let rec loop prev rest = - match rest with - | [] -> raise Not_found - | r::rest -> if exists (cmp r) prev then r else loop (r::prev) rest - in loop [] l - -let set_assoc_with f a l = - let rec loop prevl l = - match l with - | [] -> rev ((a, f None)::prevl) - | (a',b')::l -> - if a = a' - then (rev prevl) @ ((a, f (Some b'))::l) - else loop ((a',b')::prevl) l - in loop [] l - -let is_sorted ?(cmp = Pervasives.compare) l = - let rec loop l = - match l with - | [] | _::[] -> true - | x::y::l -> if cmp x y <= 0 then loop (y::l) else false - in loop l diff --git a/src/list2.mli b/src/list2.mli deleted file mode 100644 index bca4fe226b..0000000000 --- a/src/list2.mli +++ /dev/null @@ -1,373 +0,0 @@ -(** Lists. Extension of ExtLib's ExtList, which itself extends Standard Library's List. *) - -val length : 'a list -> int - (** Return the length (number of elements) of the given list. *) - -val hd : 'a list -> 'a - (** Return the first element of the given list. Raise - [Failure "hd"] if the list is empty. *) - -val tl : 'a list -> 'a list - (** Return the given list without its first element. Raise - [Failure "tl"] if the list is empty. *) - -val nth : 'a list -> int -> 'a - (** Return the [n]-th element of the given list. - The first element (head of the list) is at position 0. - Raise [Failure "nth"] if the list is too short. - Raise [Invalid_argument "List.nth"] if [n] is negative. *) - -val first : 'a list -> 'a - (** Returns the first element of the list, or raise [Empty_list] if - the list is empty (similar to [hd]). *) - -val last : 'a list -> 'a - (** Returns the last element of the list, or raise [Empty_list] if - the list is empty. This function takes linear time. *) - - -(** {6 Constructors} *) - -val init : int -> (int -> 'a) -> 'a list - (** Similar to [Array.init], [init n f] returns the list containing - the results of (f 0),(f 1).... (f (n-1)). - Raise [Invalid_arg "ExtList.init"] if n < 0.*) - -val make : int -> 'a -> 'a list - (** Similar to [String.make], [make n x] returns a - * list containing [n] elements [x]. - *) - -val append : 'a list -> 'a list -> 'a list - (** Catenate two lists. Same function as the infix operator [@]. - Not tail-recursive (length of the first argument). The [@] - operator is not tail-recursive either. *) - -val rev_append : 'a list -> 'a list -> 'a list - (** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. - This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is - tail-recursive and more efficient. *) - -val concat : 'a list list -> 'a list - (** Concatenate a list of lists. The elements of the argument are all - concatenated together (in the same order) to give the result. - Not tail-recursive - (length of the argument + length of the longest sub-list). *) - -val flatten : 'a list list -> 'a list - (** Same as [concat]. Not tail-recursive - (length of the argument + length of the longest sub-list). *) - -val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list - (** Merge two lists: - Assuming that [l1] and [l2] are sorted according to the - comparison function [cmp], [merge cmp l1 l2] will return a - sorted list containting all the elements of [l1] and [l2]. - If several elements compare equal, the elements of [l1] will be - before the elements of [l2]. - Not tail-recursive (sum of the lengths of the arguments). - *) - - -(** {6 Converters} *) - -val zip : 'a list -> 'b list -> ('a * 'b) list -val zip3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list -val zip4 : 'a list -> 'b list -> 'c list -> 'd list -> ('a * 'b * 'c * 'd) list - -val unzip : ('a * 'b) list -> ('a list * 'b list) -val unzip3 : ('a * 'b * 'c) list -> ('a list * 'b list * 'c list) -val unzip4 : ('a * 'b * 'c * 'd) list -> ('a list * 'b list * 'c list * 'd list) - -val rev : 'a list -> 'a list - (** List reversal. *) - -val split : ('a * 'b) list -> 'a list * 'b list - (** Transform a list of pairs into a pair of lists: - [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. - Not tail-recursive. - *) - -val combine : 'a list -> 'b list -> ('a * 'b) list - (** Transform a pair of lists into a list of pairs: - [combine [a1; ...; an] [b1; ...; bn]] is - [[(a1,b1); ...; (an,bn)]]. - Raise [Invalid_argument] if the two lists - have different lengths. Not tail-recursive. *) - -val take : int -> 'a list -> 'a list - (** [take n l] returns up to the [n] first elements from list [l], if - available. *) - -val drop : int -> 'a list -> 'a list - (** [drop n l] returns [l] without the first [n] elements, or the empty - list if [l] have less than [n] elements. *) - -val takewhile : ('a -> bool) -> 'a list -> 'a list - (** [takewhile f xs] returns the first elements of list [xs] - which satisfy the predicate [f]. *) - -val dropwhile : ('a -> bool) -> 'a list -> 'a list - (** [dropwhile f xs] returns the list [xs] with the first - elements satisfying the predicate [f] dropped. *) - -val interleave : 'a list -> 'a list -> 'a list -val to_string : ('a -> string) -> 'a list -> string - -val enum : 'a list -> 'a Enum.t - (** Returns an enumeration of the elements of a list. *) - -val of_enum : 'a Enum.t -> 'a list - (** Build a list from an enumeration. *) - - -(** {6 Iterators} *) - -val iter : ('a -> unit) -> 'a list -> unit - (** [List.iter f [a1; ...; an]] applies function [f] in turn to - [a1; ...; an]. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. *) - -val map : ('a -> 'b) -> 'a list -> 'b list - (** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], - and builds the list [[f a1; ...; f an]] - with the results returned by [f]. Not tail-recursive. *) - -val iteri : (int -> 'a -> 'b) -> 'a list -> unit - (** [iteri f l] will call [(f 0 a0);(f 1 a1) ... (f n an)] where - [a0..an] are the elements of the list [l]. *) - -val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list - (** [mapi f l] will build the list containing - [(f 0 a0);(f 1 a1) ... (f n an)] where [a0..an] are the elements of - the list [l]. *) - -val rev_map : ('a -> 'b) -> 'a list -> 'b list - (** [List.rev_map f l] gives the same result as - {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and - more efficient. *) - -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a - (** [List.fold_left f a [b1; ...; bn]] is - [f (... (f (f a b1) b2) ...) bn]. *) - -val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b - (** [List.fold_right f [a1; ...; an] b] is - [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) - -val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit - (** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn - [f a1 b1; ...; f an bn]. - Raise [Invalid_argument] if the two lists have - different lengths. *) - -val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - (** [List.map2 f [a1; ...; an] [b1; ...; bn]] is - [[f a1 b1; ...; f an bn]]. - Raise [Invalid_argument] if the two lists have - different lengths. Not tail-recursive. *) - -val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list - (** [List.rev_map2 f l1 l2] gives the same result as - {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and - more efficient. *) - -val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a - (** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is - [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. - Raise [Invalid_argument] if the two lists have - different lengths. *) - -val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c - (** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is - [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. - Raise [Invalid_argument] if the two lists have - different lengths. Not tail-recursive. *) - - -(** {6 Scanning} *) - -val for_all : ('a -> bool) -> 'a list -> bool - (** [for_all p [a1; ...; an]] checks if all elements of the list - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. *) - -val exists : ('a -> bool) -> 'a list -> bool - (** [exists p [a1; ...; an]] checks if at least one element of - the list satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. *) - -val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool - (** Same as {!List.for_all}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists have - different lengths. *) - -val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool - (** Same as {!List.exists}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists have - different lengths. *) - -val mem : 'a -> 'a list -> bool - (** [mem a l] is true if and only if [a] is equal - to an element of [l]. *) - -val memq : 'a -> 'a list -> bool - (** Same as {!List.mem}, but uses physical equality instead of structural - equality to compare list elements. *) - -val elements_unique : ?cmp:('a -> 'a -> bool) -> 'a list -> bool - (** Return true if elements in list are unique. Default [cmp] is =. *) - -(** {6 Searching} *) - -val find : ('a -> bool) -> 'a list -> 'a - (** [find p l] returns the first element of the list [l] - that satisfies the predicate [p]. - Raise [Not_found] if there is no value that satisfies [p] in the - list [l]. *) - -val filter : ('a -> bool) -> 'a list -> 'a list - (** [filter p l] returns all the elements of the list [l] - that satisfy the predicate [p]. The order of the elements - in the input list is preserved. *) - -val find_all : ('a -> bool) -> 'a list -> 'a list - (** [find_all] is another name for {!List.filter}. *) - -val rfind : ('a -> bool) -> 'a list -> 'a - (** [rfind p l] returns the last element [x] of [l] such as [p x] returns - [true] or raises [Not_found] if such element as not been found. *) - -val find_exc : ('a -> bool) -> exn -> 'a list -> 'a - (** [find_exc p e l] returns the first element of [l] such as [p x] - returns [true] or raises [e] if such element as not been found. *) - -val findi : (int -> 'a -> bool) -> 'a list -> (int * 'a) - (** [findi p e l] returns the first element [ai] of [l] along with its - index [i] such that [p i ai] is true, or raises [Not_found] if no - such element has been found. *) - -val unique : ?cmp:('a -> 'a -> bool) -> 'a list -> 'a list - (** [unique cmp l] returns the list [l] without any duplicate element. - Default comparator ( = ) is used if no comparison function specified. *) - -val filter_map : ('a -> 'b option) -> 'a list -> 'b list - (** [filter_map f l] call [(f a0) (f a1).... (f an)] where [a0..an] are - the elements of [l]. It returns the list of elements [bi] such as - [f ai = Some bi] (when [f] returns [None], the corresponding element of - [l] is discarded). *) - -val split_nth : int -> 'a list -> 'a list * 'a list - (** [split_nth n l] returns two lists [l1] and [l2], [l1] containing the - first [n] elements of [l] and [l2] the others. Raise [Invalid_index] if - [n] is outside of [l] size bounds. *) - -val remove : 'a list -> 'a -> 'a list - (** [remove l x] returns the list [l] without the first element [x] found - or returns [l] if no element is equal to [x]. Elements are compared - using ( = ). *) - -val remove_if : ('a -> bool) -> 'a list -> 'a list - (** [remove_if cmp l] is similar to [remove], but with [cmp] used - instead of ( = ). *) - -val remove_all : 'a list -> 'a -> 'a list - (** [remove_all l x] is similar to [remove] but removes all elements that - are equal to [x] and not only the first one. *) - -val partition : ('a -> bool) -> 'a list -> 'a list * 'a list - (** [partition p l] returns a pair of lists [(l1, l2)], where - [l1] is the list of all the elements of [l] that - satisfy the predicate [p], and [l2] is the list of all the - elements of [l] that do not satisfy [p]. - The order of the elements in the input list is preserved. *) - -val npartition : ('a -> 'a -> bool) -> 'a list -> 'a list list - (** [npartition eq l] paritions input list [l] into lists [\[l1; l2; ...; ln\]], such that elements within each [li] are equal according to [eq], and any two elements from two different lists are not equal. Within each returned list, order of elements in original list is preserved. *) - -val first_repeat : ?cmp:('a -> 'a -> bool) -> 'a list -> 'a - (** Return first repeated item in given list, or raise [Not_found] if all elements unique. Default [cmp] is [(=)]. *) - -(** {6 Association lists} *) - -val assoc : 'a -> ('a * 'b) list -> 'b - (** [assoc a l] returns the value associated with key [a] in the list of - pairs [l]. That is, - [assoc a [ ...; (a,b); ...] = b] - if [(a,b)] is the leftmost binding of [a] in list [l]. - Raise [Not_found] if there is no value associated with [a] in the - list [l]. *) - -val assq : 'a -> ('a * 'b) list -> 'b - (** Same as {!List.assoc}, but uses physical equality instead of structural - equality to compare keys. *) - -val mem_assoc : 'a -> ('a * 'b) list -> bool - (** Same as {!List.assoc}, but simply return true if a binding exists, - and false if no bindings exist for the given key. *) - -val mem_assq : 'a -> ('a * 'b) list -> bool - (** Same as {!List.mem_assoc}, but uses physical equality instead of - structural equality to compare keys. *) - -val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list - (** [remove_assoc a l] returns the list of - pairs [l] without the first pair with key [a], if any. - Not tail-recursive. *) - -val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list - (** Same as {!List.remove_assoc}, but uses physical equality instead - of structural equality to compare keys. Not tail-recursive. *) - -val set_assoc_with : ('b option -> 'b) -> 'a -> ('a * 'b) list -> ('a * 'b) list - (** [set_assoc_with f a l] searches [l] for the first item with key [a]. If found, it replaces the value [b] with [f (Some b)]. If there is no item with key [a], the new association [(a, f None)] is inserted at the end. Key comparison uses [=]. *) - - -(** {6 Sorting} *) - -val is_sorted : ?cmp:('a -> 'a -> int) -> 'a list -> bool - (** Return true if list is sorted according to [cmp] (default is {!Pervasives.compare}). *) - -val sort : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list - (** Sort a list in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see Array.sort for - a complete specification). For example, - {!Pervasives.compare} is a suitable comparison function. - The resulting list is sorted in increasing order. - [List.sort] is guaranteed to run in constant heap space - (in addition to the size of the result list) and logarithmic - stack space. - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. - *) - -val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list - (** Same as {!List.sort}, but the sorting algorithm is guaranteed to - be stable (i.e. elements that compare equal are kept in their - original order) . - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. - *) - -val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list - (** Same as {!List.sort} or {!List.stable_sort}, whichever is faster - on typical input. *) - - -(** {6 Exceptions} *) - -exception Empty_list - (** [Empty_list] is raised when an operation applied on an empty list - is invalid : [hd] for example. *) - -exception Invalid_index of int - (** [Invalid_index] is raised when an indexed access on a list is - out of list bounds. *) - -exception Different_list_size of string - (** [Different_list_size] is raised when applying functions such as - [iter2] on two lists having different size. *) diff --git a/src/map2.ml b/src/map2.ml deleted file mode 100644 index 8c14268ffa..0000000000 --- a/src/map2.ml +++ /dev/null @@ -1,62 +0,0 @@ -module Array = Array2 -module List = List2 - -module type OrderedType = Map.OrderedType - -module type S = sig - type key - type (+'a) t - val is_empty : 'a t -> bool - val size : 'a t -> int - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val empty : 'a t - val add: key -> 'a -> 'a t -> 'a t - val remove: key -> 'a t -> 'a t - val of_array : (key * 'a) array -> 'a t - val of_list : (key * 'a) list -> 'a t - val to_array : 'a t -> (key * 'a) array - val to_list : 'a t -> (key * 'a) list - val iter: (key -> 'a -> unit) -> 'a t -> unit - val map: ('a -> 'b) -> 'a t -> 'b t - val map2: ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t - val map2i: (key -> 'a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val find: key -> 'a t -> 'a - val mem: key -> 'a t -> bool - val first : 'a t -> key * 'a -end - -module Make (Ord:OrderedType) = struct - include (Map.Make(Ord) : Map.S with type key = Ord.t) - - let size t = fold (fun _ _ ans -> ans + 1) t 0 - - let of_array a = Array.fold_left (fun ans (k,a) -> add k a ans) empty a - let of_list l = List.fold_left (fun ans (k,a) -> add k a ans) empty l - - let to_list t = List.rev (fold (fun k a ans -> (k,a)::ans) t []) - let to_array t = Array.of_list (to_list t) - - let map2i f m n = - if size m <> size n then failwith "domains not equal in size"; - let mn = List.zip (to_list m) (to_list n) in - let f ans ((k1,a),(k2,b)) = - if Ord.compare k1 k2 = 0 - then add k1 (f k1 a b) ans - else failwith "domains contain different keys" - in - List.fold_left f empty mn - - let map2 f m n = map2i (fun _ a b -> f a b) m n - - let first m = - let ans = ref None in - try - iter (fun k x -> ans := Some(k,x); raise Exit) m; - raise Not_found - with - Exit -> match !ans with None -> raise Not_found | Some kx -> kx - -end diff --git a/src/map2.mli b/src/map2.mli deleted file mode 100644 index 0199c2be45..0000000000 --- a/src/map2.mli +++ /dev/null @@ -1,130 +0,0 @@ -(** Association tables over ordered types. - - This module implements applicative association tables, also known as - finite maps or dictionaries, given a total ordering function - over the keys. - All operations over maps are purely applicative (no side-effects). - The implementation uses balanced binary trees, and therefore searching - and insertion take time logarithmic in the size of the map. - - Extension of Standard Library's Map. -*) - -module type OrderedType = -sig - type t - (** The type of the map keys. *) - - val compare : t -> t -> int - (** A total ordering function over the keys. - This is a two-argument function [f] such that - [f e1 e2] is zero if the keys [e1] and [e2] are equal, - [f e1 e2] is strictly negative if [e1] is smaller than [e2], - and [f e1 e2] is strictly positive if [e1] is greater than [e2]. - Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) -end - (** Input signature of the functor {!Map.Make}. *) - -module type S = -sig - type key - (** The type of the map keys. *) - - type (+'a) t - (** The type of maps from type [key] to type ['a]. *) - - val is_empty: 'a t -> bool - (** Test whether a map is empty or not. *) - - val size : 'a t -> int - (** Retrun number of bindings in the map. *) - - val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - (** Total ordering between maps. The first argument is a total ordering - used to compare data associated with equal keys in the two maps. *) - - val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are - equal, that is, contain equal keys and associate them with - equal data. [cmp] is the equality predicate used to compare - the data associated with the keys. *) - - - (** {6 Constructors and Modifiers} *) - - val empty: 'a t - (** The empty map. *) - - val add: key -> 'a -> 'a t -> 'a t - (** [add x y m] returns a map containing the same bindings as - [m], plus a binding of [x] to [y]. If [x] was already bound - in [m], its previous binding disappears. *) - - val remove: key -> 'a t -> 'a t - (** [remove x m] returns a map containing the same bindings as - [m], except for [x] which is unbound in the returned map. *) - - - (** {6 Convertors} *) - - val of_array : (key * 'a) array -> 'a t - val of_list : (key * 'a) list -> 'a t - (** Construct map from array/list of (key,value) pairs. If there are duplicate keys in input, the last item is the one inserted. *) - - val to_array : 'a t -> (key * 'a) array - val to_list : 'a t -> (key * 'a) list - (** Returned array/list has the (key,value) pairs in given map. Items will be in ascending order by key. *) - - - (** {6 Iterators} *) - - val iter: (key -> 'a -> unit) -> 'a t -> unit - (** [iter f m] applies [f] to all bindings in map [m]. - [f] receives the key as first argument, and the associated value - as second argument. The bindings are passed to [f] in increasing - order with respect to the ordering over the type of the keys. - Only current bindings are presented to [f]: - bindings hidden by more recent bindings are not passed to [f]. *) - - val map: ('a -> 'b) -> 'a t -> 'b t - (** [map f m] returns a map with same domain as [m], where the - associated value [a] of all bindings of [m] has been - replaced by the result of the application of [f] to [a]. - The bindings are passed to [f] in increasing order - with respect to the ordering over the type of the keys. *) - - val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - (** [map2 f m n] is like [map] but operates on two maps. Raise [Failure] if the domains of maps [m] and [n] are not equal. *) - - val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t - (** Same as {!Map.S.map}, but the function receives as arguments both the - key and the associated value for each binding of the map. *) - - val map2i : (key -> 'a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - (** Like [map2] but the function also receives the key as an argument. *) - - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], - where [k1 ... kN] are the keys of all bindings in [m] - (in increasing order), and [d1 ... dN] are the associated data. *) - - - (** {6 Scanning} *) - - val find: key -> 'a t -> 'a - (** [find x m] returns the current binding of [x] in [m], - or raises [Not_found] if no such binding exists. *) - - val mem: key -> 'a t -> bool - (** [mem x m] returns [true] if [m] contains a binding for [x], - and [false] otherwise. *) - - val first : 'a t -> key * 'a - (** Return the minimum key and its associated value, or [Not_found] if map is empty. *) - -end - (** Output signature of the functor {!Map.Make}. *) - -module Make (Ord : OrderedType) : S with type key = Ord.t - (** Functor building an implementation of the map structure given a totally ordered type. *) diff --git a/src/msg.ml b/src/msg.ml deleted file mode 100644 index cadf4db957..0000000000 --- a/src/msg.ml +++ /dev/null @@ -1,25 +0,0 @@ -open Lib2 - -let msg ?(pre="MSG") ?pos msg = - match pos with - | None -> pre ^ ": " ^ msg - | Some p -> pre ^ "[" ^ Pos.to_string p ^ "] " ^ msg - -let err = msg ~pre:"ERROR" -let warn = msg ~pre:"WARNING" -let bug = msg ~pre:"BUG" - -let print_msg ?pre ?pos m = - print_endline( - match pre,pos with - | (None, None) -> msg m - | (Some pre, None) -> msg ~pre m - | (None, Some pos) -> msg ~pos m - | (Some pre, Some pos) -> msg ~pre ~pos m - ) - -let print_err = print_msg ~pre:"ERROR" -let print_warn = print_msg ~pre:"WARNING" -let print_bug = print_msg ~pre:"BUG" - -let max_array_length_error = "Out of memory, possibly because trying to construct array of size greater than " ^ (string_of_int Sys.max_array_length) diff --git a/src/msg.mli b/src/msg.mli deleted file mode 100644 index aa3dddc122..0000000000 --- a/src/msg.mli +++ /dev/null @@ -1,13 +0,0 @@ -(** Consistent printing of errors, warnings, and bugs. An error is a user mistake that prevents continuing program execution, a warning is a milder problem that the program continues to execute through, and a bug is a mistake in the software. *) - -val err : ?pos:Pos.t -> string -> string -val warn : ?pos:Pos.t -> string -> string -val bug : ?pos:Pos.t -> string -> string - (** Create a string communicating an error, warning, or bug. First optional arugment is position where problem ocurred. Second argument is a string explaining the problem. *) - -val print_err : ?pos:Pos.t -> string -> unit -val print_warn : ?pos:Pos.t -> string -> unit -val print_bug : ?pos:Pos.t -> string -> unit - (** Print an error, warning, or bug. First optional arugment is position where problem ocurred. Second argument is a string explaining the problem. *) - -val max_array_length_error : string diff --git a/src/pMap2.ml b/src/pMap2.ml deleted file mode 100644 index 5421251d11..0000000000 --- a/src/pMap2.ml +++ /dev/null @@ -1,3 +0,0 @@ -include PMap - -let size t = Enum.count (enum t) diff --git a/src/pMap2.mli b/src/pMap2.mli deleted file mode 100644 index 4bf72151ed..0000000000 --- a/src/pMap2.mli +++ /dev/null @@ -1,77 +0,0 @@ -(** Polymorphic Map. - - This is a polymorphic map, similar to standard library [Map] module - but in a defunctorized style. - - Extension of ExtLib's PMap. -*) - -type ('a, 'b) t - -val empty : ('a, 'b) t - (** The empty map, using [compare] as key comparison function. *) - -val is_empty : ('a, 'b) t -> bool - (** returns true if the map is empty. *) - -val size : ('a, 'b) t -> int - (** Number of bindings in given map. *) - -val create : ('a -> 'a -> int) -> ('a, 'b) t - (** creates a new empty map, using the provided function for key comparison.*) - -val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t - (** [add x y m] returns a map containing the same bindings as - [m], plus a binding of [x] to [y]. If [x] was already bound - in [m], its previous binding disappears. *) - -val find : 'a -> ('a, 'b) t -> 'b - (** [find x m] returns the current binding of [x] in [m], - or raises [Not_found] if no such binding exists. *) - -val remove : 'a -> ('a, 'b) t -> ('a, 'b) t - (** [remove x m] returns a map containing the same bindings as - [m], except for [x] which is unbound in the returned map. *) - -val mem : 'a -> ('a, 'b) t -> bool - (** [mem x m] returns [true] if [m] contains a binding for [x], - and [false] otherwise. *) - -val exists : 'a -> ('a, 'b) t -> bool - (** same as [mem]. *) - -val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit - (** [iter f m] applies [f] to all bindings in map [m]. - [f] receives the key as first argument, and the associated value - as second argument. The order in which the bindings are passed to - [f] is unspecified. Only current bindings are presented to [f]: - bindings hidden by more recent bindings are not passed to [f]. *) - -val map : ('b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - (** [map f m] returns a map with same domain as [m], where the - associated value [a] of all bindings of [m] has been - replaced by the result of the application of [f] to [a]. - The order in which the associated values are passed to [f] - is unspecified. *) - -val mapi : ('a -> 'b -> 'c) -> ('a, 'b) t -> ('a, 'c) t - (** Same as [map], but the function receives as arguments both the - key and the associated value for each binding of the map. *) - -val fold : ('b -> 'c -> 'c) -> ('a , 'b) t -> 'c -> 'c - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], - where [k1 ... kN] are the keys of all bindings in [m], - and [d1 ... dN] are the associated data. - The order in which the bindings are presented to [f] is - unspecified. *) - -val foldi : ('a -> 'b -> 'c -> 'c) -> ('a , 'b) t -> 'c -> 'c - (** Same as [fold], but the function receives as arguments both the - key and the associated value for each binding of the map. *) - -val enum : ('a, 'b) t -> ('a * 'b) Enum.t - (** creates an enumeration for this map. *) - -val of_enum : ?cmp:('a -> 'a -> int) -> ('a * 'b) Enum.t -> ('a, 'b) t - (** creates a map from an enumeration, using the specified function - for key comparison or [compare] by default. *) diff --git a/src/pervasives2.ml b/src/pervasives2.ml deleted file mode 100644 index 35580eaaa7..0000000000 --- a/src/pervasives2.ml +++ /dev/null @@ -1,26 +0,0 @@ -include Pervasives - -let (@) = ExtList.(@) -let identity x = x -let (<<-) f g x = f (g x) -let (->>) f g x = g (f x) -let (&) f x = f x -let flip f b a = f a b -let open_out_safe = open_out_gen [Open_wronly; Open_creat; Open_excl; Open_text] 0o666 -let output_endline cout s = output_string cout s; output_string cout "\n" -let eps_float v = ldexp epsilon_float (snd (frexp v) - 1) - -let try_finally f g x = - match try `V(f x) with e -> `E e with - | `V f_x -> g x; f_x - | `E e -> (try g x with _ -> ()); raise e - -let string_of_float v = - let ans = string_of_float v in - if ans.[String.length ans - 1] = '.' then ans ^ "0" else ans - -let print_float = print_string <<- string_of_float - -let float_of_stringi s = - try float_of_int (int_of_string s) - with Failure _ -> float_of_string s diff --git a/src/pervasives2.mli b/src/pervasives2.mli deleted file mode 100644 index 3426f33481..0000000000 --- a/src/pervasives2.mli +++ /dev/null @@ -1,40 +0,0 @@ -(** Generally useful operations. *) - -val ( @ ) : 'a list -> 'a list -> 'a list - (** ExtLib's new append operator. *) - -val identity : 'a -> 'a - (** The identity function. *) - -val (<<-) : ('b -> 'c) -> ('a -> 'b) -> ('a -> 'c) - (** Function composition in normal direction as used in mathematics, [(f <<- g) x = f(g x)]. *) - -val (->>) : ('a -> 'b) -> ('b -> 'c) -> ('a -> 'c) - (** Function composition in reverse direction, [(f ->> g) x = g(f x)]. *) - -val (&) : ('a -> 'b) -> 'a -> 'b - (** Function application operator. Can be used to reduce number of parentheses. For example, can write [f & g x] instead of [f(g x)]. *) - -val flip : ('a -> 'b -> 'c) -> ('b -> 'a -> 'c) - (** [flip f] returns a function that takes its arguments in opposite order of [f]. *) - -val open_out_safe : string -> out_channel - (** Like [Pervasives.open_out] but raise [Sys_error] if file already exists. *) - -val output_endline : out_channel -> string -> unit - (** Write string on given output channel followed by a newline. The buffer is not necessarily flushed as in [print_endline] and [prerr_endline]. *) - -val eps_float : float -> float - (** [eps_float v] returns nearly the smallest (or perhaps the actual smallest) positive number [x] such that [v +. x <> v]. (Courtesty of Christophe Troestler and Mathias Kende, posted on OCaml Beginners List.) *) - -val try_finally : ('a -> 'b) -> ('a -> unit) -> 'a -> 'b - (** [try_finally f g x] returns [f x] after executing [g x]. If both [f] and [g] raise exceptions, it will be [f]'s exception that is raised by [try_finally]. Example: [try_finally input_line close_in (open_in "file.txt")] will read a line from "file.txt", assuring that opened channel is closed. (Courtesy of Jon Harrop, posted on OCaml Beginners List.) *) - -val string_of_float : float -> string - (** Like Standard Library's [string_of_float] but decimal value included even when 0, e.g. will generate "1.0" instead of "1.". *) - -val print_float : float -> unit - (** Like Standard Library's [print_float] but decimal value included even when 0, e.g. will generate "1.0" instead of "1.". *) - -val float_of_stringi : string -> float - (** [float_of_stringi s] returns a float if [s] represents either an int or float. *) diff --git a/src/pos.ml b/src/pos.ml deleted file mode 100644 index 33a1226158..0000000000 --- a/src/pos.ml +++ /dev/null @@ -1,54 +0,0 @@ -open Lib2 - -type t = {file:string option; line:int option; col:int option} - -exception Bad of string -let raise_bad msg = raise (Bad msg) - -exception Undefined - -let assert_well_formed t = - if Option.is_some t.col && not (Option.is_some t.line) then raise_bad "cannot set column number without line number" - -let f s = {file=Some s; line=None; col=None} -let l k = {file=None; line=Some k; col=None} -let fl s k = {file=Some s; line=Some k; col=None} -let lc k1 k2 = {file=None; line=Some k1; col=Some k2} -let flc s k1 k2 = {file=Some s; line=Some k1; col=Some k2} -let unknown = {file=None; line=None; col=None} - -let file_exn t = match t.file with Some s -> s | None -> raise Undefined -let line_exn t = match t.line with Some s -> s | None -> raise Undefined -let col_exn t = match t.col with Some s -> s | None -> raise Undefined - -let set_file t s = let ans = {t with file = Some s} in assert_well_formed ans; ans -let set_line t k = let ans = {t with line = Some k} in assert_well_formed ans; ans -let set_col t k = let ans = {t with col = Some k} in assert_well_formed ans; ans - -let incrl t k = - match t.line with - None -> raise Undefined - | Some l -> {t with line = Some (l+k)} - -let to_string t = - if Option.is_none t.file && Option.is_none t.line && Option.is_none t.col then - "unknown_position" - else - let f = - match t.file with - None -> "" - | Some s -> (match t.line with None -> s | Some _ -> s ^ ":") - in - - let l = - match t.line with - None -> "" - | Some k -> (match t.col with None -> string_of_int k | Some _ -> string_of_int k ^ ".") - in - - let c = - match t.col with - None -> "" - | Some k -> string_of_int k - in - f ^ l ^ c diff --git a/src/pos.mli b/src/pos.mli deleted file mode 100644 index 55a7a083bd..0000000000 --- a/src/pos.mli +++ /dev/null @@ -1,39 +0,0 @@ -(** File positions. *) - -type t = private { - file:string option; (** file name *) - line:int option; (** line number *) - col:int option; (** column number, can be defined only if line number is too *) -} - -exception Bad of string - -exception Undefined - (** Raised when asking for undefined position information. *) - -val f : string -> t -val l : int -> t -val fl : string -> int -> t -val lc : int -> int -> t -val flc : string -> int -> int -> t - (** Methods for creating a position. [f] stands for file name, [l] for line number, and [c] for column number. The arguments required correspond to the function name. There is no [fc] nor [c] function because a line number is required when a column number is given. *) - -val unknown : t - (** Represents an unknown position. Use sparingly. *) - -val file_exn : t -> string -val line_exn : t -> int -val col_exn : t -> int - (** Return the file name, line number, or column number. Raise {!Undefined} if given position does not have requested information. *) - -val set_file : t -> string -> t -val set_line : t -> int -> t -val set_col : t -> int -> t - (** Set the file name, line number, or column number. Raise [Bad] if resulting [t] would be ill-formed. *) - -val incrl : t -> int -> t - (** [incrl pos k] increments the line number of [pos] by [k]. *) - -val to_string : t -> string - (** String representation of a position. Intended for human legibility, no particular format guaranteed. *) - diff --git a/src/set2.ml b/src/set2.ml deleted file mode 100644 index 68e7b936c7..0000000000 --- a/src/set2.ml +++ /dev/null @@ -1,14 +0,0 @@ -module type OrderedType = Set.OrderedType - -module type S = sig - include Set.S - val of_list : elt list -> t - val to_list : t -> elt list -end - -module Make (Ord:OrderedType) = struct - include (Set.Make(Ord) : Set.S with type elt = Ord.t) - - let of_list el = List.fold_left (fun ans e -> add e ans) empty el - let to_list t = List.rev (fold (fun e ans -> e::ans) t []) -end diff --git a/src/set2.mli b/src/set2.mli deleted file mode 100644 index 5399b7d25c..0000000000 --- a/src/set2.mli +++ /dev/null @@ -1,147 +0,0 @@ -(** Sets over ordered types. - - This module implements the set data structure, given a total ordering - function over the set elements. All operations over sets - are purely applicative (no side-effects). - The implementation uses balanced binary trees, and is therefore - reasonably efficient: insertion and membership take time - logarithmic in the size of the set, for instance. - - Extension of Standard Library's Set. -*) - -module type OrderedType = -sig - type t - (** The type of the set elements. *) - val compare : t -> t -> int - (** A total ordering function over the set elements. - This is a two-argument function [f] such that - [f e1 e2] is zero if the elements [e1] and [e2] are equal, - [f e1 e2] is strictly negative if [e1] is smaller than [e2], - and [f e1 e2] is strictly positive if [e1] is greater than [e2]. - Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) -end - (** Input signature of the functor {!Set.Make}. *) - -module type S = -sig - type elt - (** The type of the set elements. *) - - type t - (** The type of sets. *) - - val empty: t - (** The empty set. *) - - val is_empty: t -> bool - (** Test whether a set is empty or not. *) - - val mem: elt -> t -> bool - (** [mem x s] tests whether [x] belongs to the set [s]. *) - - val add: elt -> t -> t - (** [add x s] returns a set containing all elements of [s], - plus [x]. If [x] was already in [s], [s] is returned unchanged. *) - - val singleton: elt -> t - (** [singleton x] returns the one-element set containing only [x]. *) - - val remove: elt -> t -> t - (** [remove x s] returns a set containing all elements of [s], - except [x]. If [x] was not in [s], [s] is returned unchanged. *) - - val union: t -> t -> t - (** Set union. *) - - val inter: t -> t -> t - (** Set intersection. *) - - (** Set difference. *) - val diff: t -> t -> t - - val compare: t -> t -> int - (** Total ordering between sets. Can be used as the ordering function - for doing sets of sets. *) - - val equal: t -> t -> bool - (** [equal s1 s2] tests whether the sets [s1] and [s2] are - equal, that is, contain equal elements. *) - - val subset: t -> t -> bool - (** [subset s1 s2] tests whether the set [s1] is a subset of - the set [s2]. *) - - val iter: (elt -> unit) -> t -> unit - (** [iter f s] applies [f] in turn to all elements of [s]. - The elements of [s] are presented to [f] in increasing order - with respect to the ordering over the type of the elements. *) - - val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a - (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], - where [x1 ... xN] are the elements of [s], in increasing order. *) - - val for_all: (elt -> bool) -> t -> bool - (** [for_all p s] checks if all elements of the set - satisfy the predicate [p]. *) - - val exists: (elt -> bool) -> t -> bool - (** [exists p s] checks if at least one element of - the set satisfies the predicate [p]. *) - - val filter: (elt -> bool) -> t -> t - (** [filter p s] returns the set of all elements in [s] - that satisfy predicate [p]. *) - - val partition: (elt -> bool) -> t -> t * t - (** [partition p s] returns a pair of sets [(s1, s2)], where - [s1] is the set of all the elements of [s] that satisfy the - predicate [p], and [s2] is the set of all the elements of - [s] that do not satisfy [p]. *) - - val cardinal: t -> int - (** Return the number of elements of a set. *) - - val elements: t -> elt list - (** Return the list of all elements of the given set. - The returned list is sorted in increasing order with respect - to the ordering [Ord.compare], where [Ord] is the argument - given to {!Set.Make}. *) - - val min_elt: t -> elt - (** Return the smallest element of the given set - (with respect to the [Ord.compare] ordering), or raise - [Not_found] if the set is empty. *) - - val max_elt: t -> elt - (** Same as {!Set.S.min_elt}, but returns the largest element of the - given set. *) - - val choose: t -> elt - (** Return one element of the given set, or raise [Not_found] if - the set is empty. Which element is chosen is unspecified, - but equal elements will be chosen for equal sets. *) - - val split: elt -> t -> t * bool * t - (** [split x s] returns a triple [(l, present, r)], where - [l] is the set of elements of [s] that are - strictly less than [x]; - [r] is the set of elements of [s] that are - strictly greater than [x]; - [present] is [false] if [s] contains no element equal to [x], - or [true] if [s] contains an element equal to [x]. *) - - val of_list : elt list -> t - (** Create a set from the given elements. *) - - val to_list : t -> elt list - (** Return elements of given set, in increasing order. Synonym for {!elements}. *) - -end - (** Output signature of the functor {!Set.Make}. *) - -module Make (Ord : OrderedType) : S with type elt = Ord.t - (** Functor building an implementation of the set structure - given a totally ordered type. *) diff --git a/src/stream2.ml b/src/stream2.ml deleted file mode 100644 index a12b127b11..0000000000 --- a/src/stream2.ml +++ /dev/null @@ -1,103 +0,0 @@ -include Stream - -let lines_of_chars cstr = - let f _ = - match peek cstr with - | None -> None - | Some _ -> - let ans = Buffer.create 100 in - let rec loop () = - try - let c = next cstr in - if c <> '\n' then (Buffer.add_char ans c; loop()) - with Failure -> () - in - loop(); - Some (Buffer.contents ans) - in - from f - -let lines_of_channel cin = - let f _ = - try Some (input_line cin) - with End_of_file -> None - in Stream.from f - -let is_empty s = - match peek s with None -> true | Some _ -> false - -let keep_whilei pred s = - let f _ = - match peek s with - | None -> None - | Some a -> - if pred (count s) a - then (junk s; Some a) - else None - in from f - -let keep_while pred = keep_whilei (fun _ a -> pred a) -let truncate k = keep_whilei (fun j _ -> j < k) - -let rec skip_whilei pred s = - match peek s with - | None -> () - | Some a -> - if pred (count s) a - then (junk s; skip_whilei pred s) - else () - -let skip_while pred = skip_whilei (fun _ a -> pred a) - -let one f s = - match peek s with - None -> raise Failure - | Some a -> if f a then (junk s; a) else raise Failure - -let many f s = - let rec started s = - match peek s with - None -> [] - | Some a -> if f a then (junk s; a::(started s)) else [] - in - match peek s with - None -> raise Failure - | Some a -> if f a then started s else raise Failure - -let rec fold f accum s = - match peek s with - None -> accum - | Some a -> (junk s; fold f (f accum a) s) - -let map f s = - let f _ = - try Some (f (next s)) - with Failure -> None - in from f - -let sub_stream mk stop sa = - let should_junk sa = - match peek sa with - | Some a -> stop a - | None -> false - in - - let consume sa = while should_junk sa do junk sa done in - - let make_stream (_:int) = - let f al a = a::al in - if is_empty sa then None - else - let sa = keep_while (fun a -> not (stop a)) sa in - let ans = List.rev (fold f [] sa) in - (consume sa; Some (mk ans)) - in - from make_stream - -let to_array t = - let ans = DynArray.create () in - let _ = iter (DynArray.add ans) t in - DynArray.to_array ans - -let to_list t = - List.rev (fold (fun l b -> b::l) [] t) diff --git a/src/stream2.mli b/src/stream2.mli deleted file mode 100644 index e5745c5dfd..0000000000 --- a/src/stream2.mli +++ /dev/null @@ -1,139 +0,0 @@ -(** Streams. Extension of Standard Library's Stream. *) - -type 'a t = 'a Stream.t - (** The type of streams holding values of type ['a]. *) - -exception Failure - (** Raised by parsers when none of the first components of the stream - patterns is accepted. *) - -exception Error of string - (** Raised by parsers when the first component of a stream pattern is - accepted, but one of the following components is rejected. *) - -val peek : 'a t -> 'a option - (** Return [Some] of "the first element" of the stream, or [None] if - the stream is empty. *) - -val junk : 'a t -> unit - (** Remove the first element of the stream, possibly unfreezing - it before. *) - -val count : 'a t -> int - (** Return the current count of the stream elements, i.e. the number - of the stream elements discarded. *) - -val npeek : int -> 'a t -> 'a list - (** [npeek n] returns the list of the [n] first elements of - the stream, or all its remaining elements if less than [n] - elements are available. *) - - -(** {6 Constructors} - - Warning: these functions create streams with fast access; it is illegal - to mix them with streams built with [[< >]]; would raise [Failure] - when accessing such mixed streams. -*) - -val from : (int -> 'a option) -> 'a t - (** [Stream.from f] returns a stream built from the function [f]. - To create a new stream element, the function [f] is called with - the current stream count. The user function [f] must return either - [Some ] for a value or [None] to specify the end of the - stream. *) - -val of_list : 'a list -> 'a t - (** Return the stream holding the elements of the list in the same - order. *) - -val of_string : string -> char t - (** Return the stream of the characters of the string parameter. *) - -val of_channel : in_channel -> char t - (** Return the stream of the characters read from the input channel. *) - -val lines_of_chars : char t -> string t - (** Split input char stream on '\n' characters. *) - -val lines_of_channel : in_channel -> string t - (** [lines_of_channel cin] is equivalent to [lines_of_chars (of_channel cin)]. *) - - -(** {6 Converters} *) - -val truncate : int -> 'a t -> 'a t - (** [truncate k s] returns the same stream as [s] but with at most [k] items. *) - -val to_array : 'a t -> 'a array - (** Return stream elements in an array. *) - -val to_list : 'a t -> 'a list - (** Return stream elements in a list. *) - -val sub_stream : ('a list -> 'b) -> ('a -> bool) -> 'a t -> 'b t - (** [sub_stream mk stop sa] creates a stream [sb] composed of sub-items of [sa]. Function [mk] specifies how the composition is to be done and [stop] specifies when to stop including items. Items in [sa] are included until first item satisfying [stop]. These are passed to [mk]. But also, any other items of [sa] satisfying [stop] are junked until the first one not satisfying [stop] (otherwise [sa] would not advance on subsequent calls to [next sb]. Note that [count] of input stream will also change even if you directly consume only [sb]. *) - - -(** {6 Iterators} *) - -val iter : ('a -> unit) -> 'a t -> unit - (** [Stream.iter f s] scans the whole stream s, applying function [f] - in turn to each stream element encountered. *) - -val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b - (** Like [List.fold_left]. *) - -val keep_while : ('a -> bool) -> 'a t -> 'a t - (** [keep_while pred s] returns a stream [s'] whose final element is just before the first one in [s] not satisfying [pred]. *) - -val keep_whilei : (int -> 'a -> bool) -> 'a t -> 'a t - (** Like {!keep_while} but the predicate is also given the stream count. *) - -val skip_while : ('a -> bool) -> 'a t -> unit - (** [skip_while pred s] advances [s] to the first element not satisfying [pred]. *) - -val skip_whilei : (int -> 'a -> bool) -> 'a t -> unit - (** Like {!skip_while} but the predicate is also given the stream count. *) - -val map : ('a -> 'b) -> 'a t -> 'b t - (** Convert a stream of [a]'s into a stream of [b]'s. *) - - -(** {6 Scanning} *) - -val is_empty : 'a t -> bool - (** True if stream is empty *) - - -(** {6 Predefined parsers} *) - -val next : 'a t -> 'a - (** Return the first element of the stream and remove it from the - stream. Raise Stream.Failure if the stream is empty. *) - -val empty : 'a t -> unit - (** Return [()] if the stream is empty, else raise [Stream.Failure]. *) - -val one : ('a -> bool) -> 'a t -> 'a - (** [one f s] returns the first element of [s] if it satisfies [f], and increments the stream position. Raise [Failure] otherwise, and stream position unaltered. *) - -val many : ('a -> bool) -> 'a t -> 'a list - (** [many f s] returns as many elements of [s] as match [f] in succession. Stream position set to first element not satisfying [f]. Raise [Failure] if first element does not satisfy [f]. *) - -(**/**) - -(** {6 For system use only, not for the casual user} *) - -val iapp : 'a t -> 'a t -> 'a t -val icons : 'a -> 'a t -> 'a t -val ising : 'a -> 'a t - -val lapp : (unit -> 'a t) -> 'a t -> 'a t -val lcons : (unit -> 'a) -> 'a t -> 'a t -val lsing : (unit -> 'a) -> 'a t - -val sempty : 'a t -val slazy : (unit -> 'a t) -> 'a t - -val dump : ('a -> unit) -> 'a t -> unit diff --git a/src/string2.ml b/src/string2.ml deleted file mode 100644 index ffc6609f97..0000000000 --- a/src/string2.ml +++ /dev/null @@ -1,40 +0,0 @@ -include ExtString.String - -let count f s = - let f ans c = if f c then ans + 1 else ans in - fold_left f 0 s - -let to_index s n = sub s 0 (n+1) -let from_index s n = sub s n (length s - n) - -let exists' f s = - fold_left (fun ans c -> f c || ans) false s - -let for_all f s = - fold_left (fun ans c -> f c && ans) true s - -let stripl ?(chars=" \t\r\n") s = - let p = ref 0 in - let l = length s in - while !p < l && contains chars (unsafe_get s !p) do - incr p; - done; - let p = !p in - let l = ref (l - 1) in - sub s p (!l - p + 1) - -let stripr ?(chars=" \t\r\n") s = - let p = ref 0 in - let l = length s in - let p = !p in - let l = ref (l - 1) in - while !l >= p && contains chars (unsafe_get s !l) do - decr l; - done; - sub s p (!l - p + 1) - -let strip_final_cr s = - let l = String.length s - 1 in - if l > 0 && s.[l] = '\r' - then String.sub s 0 l - else s diff --git a/src/string2.mli b/src/string2.mli deleted file mode 100644 index 16b9ca5d37..0000000000 --- a/src/string2.mli +++ /dev/null @@ -1,300 +0,0 @@ -(** Strings. Extension of ExtLib's ExtString, which itself extends Standard Library's String. *) - -type t = string - (** An alias for the type of strings. *) - -val length : string -> int - (** Return the length (number of characters) of the given string. *) - -val get : string -> int -> char - (** [String.get s n] returns character number [n] in string [s]. - The first character is character number 0. - The last character is character number [String.length s - 1]. - You can also write [s.[n]] instead of [String.get s n]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(String.length s - 1)]. *) - -val set : string -> int -> char -> unit - (** [String.set s n c] modifies string [s] in place, - replacing the character number [n] by [c]. - You can also write [s.[n] <- c] instead of [String.set s n c]. - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(String.length s - 1)]. *) - -val compare: t -> t -> int - (** The comparison function for strings, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [String] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - - -(** {6 Constructors} *) - -val create : int -> string - (** [String.create n] returns a fresh string of length [n]. - The string initially contains arbitrary characters. - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_string_length]. - *) - -val make : int -> char -> string - (** [String.make n c] returns a fresh string of length [n], - filled with the character [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.*) - -val init : int -> (int -> char) -> string - (** [init l f] returns the string of length [l] with the chars - f 0 , f 1 , f 2 ... f (l-1). *) - -val copy : string -> string - (** Return a copy of the given string. *) - -val to_index : string -> int -> string - (** [get_to s n] returns the substring of [s] from first char to index [n] (inclusive). *) - -val from_index : string -> int -> string - (** [get_from s n] returns the substring of [s] from index [n] to final char (inclusive). *) - - -(** {6 Converters} *) - -val sub : string -> int -> int -> string - (** [String.sub s start len] returns a fresh string of length [len], - containing the characters number [start] to [start + len - 1] - of string [s]. - Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]; that is, if [start < 0], - or [len < 0], or [start + len > ]{!String.length}[ s]. *) - -val fill : string -> int -> int -> char -> unit - (** [String.fill s start len c] modifies string [s] in place, - replacing the characters number [start] to [start + len - 1] - by [c]. - Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]. *) - -val blit : string -> int -> string -> int -> int -> unit - (** [String.blit src srcoff dst dstoff len] copies [len] characters - from string [src], starting at character number [srcoff], to - string [dst], starting at character number [dstoff]. It works - correctly even if [src] and [dst] are the same string, - and the source and destination chunks overlap. - Raise [Invalid_argument] if [srcoff] and [len] do not - designate a valid substring of [src], or if [dstoff] and [len] - do not designate a valid substring of [dst]. *) - -val concat : string -> string list -> string - (** [String.concat sep sl] concatenates the list of strings [sl], - inserting the separator string [sep] between each. *) - -val escaped : string -> string - (** Return a copy of the argument, with special characters - represented by escape sequences, following the lexical - conventions of Objective Caml. If there is no special - character in the argument, return the original string itself, - not a copy. *) - -val uppercase : string -> string - (** Return a copy of the argument, with all lowercase letters - translated to uppercase, including accented letters of the ISO - Latin-1 (8859-1) character set. *) - -val lowercase : string -> string - (** Return a copy of the argument, with all uppercase letters - translated to lowercase, including accented letters of the ISO - Latin-1 (8859-1) character set. *) - -val capitalize : string -> string - (** Return a copy of the argument, with the first character set to uppercase. *) - -val uncapitalize : string -> string - (** Return a copy of the argument, with the first character set to lowercase. *) - -val replace_chars : (char -> string) -> string -> string - (** [replace_chars f s] returns a string where all chars [c] of [s] have been - replaced by the string returned by [f c]. *) - -val replace : str:string -> sub:string -> by:string -> bool * string - (** [replace ~str ~sub ~by] returns a tuple constisting of a boolean - and a string where the first occurrence of the string [sub] - within [str] has been replaced by the string [by]. The boolean - is true if a subtitution has taken place. *) - -val strip : ?chars:string -> string -> string - (** Returns the string without the chars if they are at the beginning or - at the end of the string. By default chars are " \t\r\n". *) - -val stripl : ?chars:string -> string -> string - (** Returns the string without the chars if they are at the beginning of the string. By default chars are " \t\r\n". *) - -val stripr : ?chars:string -> string -> string - (** Returns the string without the chars if they are at the end of the string. By default chars are " \t\r\n". *) - -val strip_final_cr : string -> string - (** Strip final carriage return if there is one. *) - -val split : string -> string -> string * string - (** [split s sep] splits the string [s] between the first - occurrence of [sep]. - raises [Invalid_string] if the separator is not found. *) - -val nsplit : string -> string -> string list - (** [nsplit s sep] splits the string [s] into a list of strings - which are separated by [sep]. *) - -val join : string -> string list -> string - (** Same as [concat] *) - -val slice : ?first:int -> ?last:int -> string -> string - (** [slice ?first ?last s] returns a "slice" of the string - which corresponds to the characters [s.[first]], - [s.[first+1]], ..., [s[last-1]]. Note that the character at - index [last] is {b not} included! If [first] is omitted it - defaults to the start of the string, i.e. index 0, and if - [last] is omitted is defaults to point just past the end of - [s], i.e. [length s]. Thus, [slice s] is equivalent to - [copy s]. - - Negative indexes are interpreted as counting from the end of - the string. For example, [slice ~last:-2 s] will return the - string [s], but without the last two characters. - - This function {b never} raises any exceptions. If the - indexes are out of bounds they are automatically clipped. - *) - -val lchop : string -> string - (** Returns the same string but without the first character. - does nothing if the string is empty. *) - -val rchop : string -> string - (** Returns the same string but without the last character. - does nothing if the string is empty. *) - -val of_int : int -> string - (** Returns the string representation of an int. *) - -val of_float : float -> string - (** Returns the string representation of an float. *) - -val of_char : char -> string - (** Returns a string containing one given character. *) - -val to_int : string -> int - (** Returns the integer represented by the given string or - raises [Invalid_string] if the string does not represent an integer.*) - -val to_float : string -> float - (** Returns the float represented by the given string or - raises Invalid_string if the string does not represent a float. *) - -val enum : string -> char Enum.t - (** Returns an enumeration of the characters of a string.*) - -val of_enum : char Enum.t -> string - (** Creates a string from a character enumeration. *) - -val explode : string -> char list - (** [explode s] returns the list of characters in the string [s]. *) - -val implode : char list -> string - (** [implode cs] returns a string resulting from concatenating - the characters in the list [cs]. *) - - -(** {6 Iterators} *) - -val iter : (char -> unit) -> string -> unit - (** [String.iter f s] applies function [f] in turn to all - the characters of [s]. It is equivalent to - [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *) - -val map : (char -> char) -> string -> string - (** [map f s] returns a string where all characters [c] in [s] have been - replaced by [f c]. **) - -val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a - (** [fold_left f a s] is - [f (... (f (f a s.[0]) s.[1]) ...) s.[n-1]] *) - -val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a - (** [fold_right f s b] is - [f s.[0] (f s.[1] (... (f s.[n-1] b) ...))] *) - - -(** {6 Scanning} *) - -val contains : string -> char -> bool - (** [String.contains s c] tests if character [c] - appears in the string [s]. *) - -val contains_from : string -> int -> char -> bool - (** [String.contains_from s start c] tests if character [c] - appears in the substring of [s] starting from [start] to the end - of [s]. - Raise [Invalid_argument] if [start] is not a valid index of [s]. *) - -val rcontains_from : string -> int -> char -> bool - (** [String.rcontains_from s stop c] tests if character [c] - appears in the substring of [s] starting from the beginning - of [s] to index [stop]. - Raise [Invalid_argument] if [stop] is not a valid index of [s]. *) - -val count : (char -> bool) -> string -> int - (** [count f s] returns the number of characters in [s] that [f] is true for. *) - -val exists : string -> string -> bool - (** [exists str sub] returns true if [sub] is a substring of [str] or - false otherwise. *) - -val exists' : (char -> bool) -> string -> bool - (** [exists' f s] returns true if [f] is true for any of the chars in [s]. So named because [exists] unfortunately used by ExtLib with different meaning. *) - -val for_all : (char -> bool) -> string -> bool - (** [for_all f s] returns true if [f] is true for all chars in [s]. *) - -val ends_with : string -> string -> bool - (** [ends_with s x] returns true if the string [s] is ending with [x]. *) - -val starts_with : string -> string -> bool - (** [starts_with s x] return true if [s] is starting with [x]. *) - - -(** {6 Searching} *) - -val index : string -> char -> int - (** [String.index s c] returns the position of the leftmost - occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. *) - -val rindex : string -> char -> int - (** [String.rindex s c] returns the position of the rightmost - occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. *) - -val index_from : string -> int -> char -> int - (** Same as {!String.index}, but start - searching at the character position given as second argument. - [String.index s c] is equivalent to [String.index_from s 0 c].*) - -val rindex_from : string -> int -> char -> int - (** Same as {!String.rindex}, but start - searching at the character position given as second argument. - [String.rindex s c] is equivalent to - [String.rindex_from s (String.length s - 1) c]. *) - -val find : string -> string -> int - (** [find s x] returns the starting index of the string [x] - within the string [s] or raises [Invalid_string] if [x] - is not a substring of [s]. *) - - -(**/**) - -external unsafe_get : string -> int -> char = "%string_unsafe_get" -external unsafe_set : string -> int -> char -> unit = "%string_unsafe_set" -external unsafe_blit : - string -> int -> string -> int -> int -> unit = "caml_blit_string" "noalloc" -external unsafe_fill : - string -> int -> int -> char -> unit = "caml_fill_string" "noalloc" - diff --git a/src/tuple.ml b/src/tuple.ml deleted file mode 100644 index db0a7cdf4e..0000000000 --- a/src/tuple.ml +++ /dev/null @@ -1,50 +0,0 @@ -module Pr = struct - let make a b = (a,b) - let prj1 (a,_) = a - let prj2 (_,b) = b - let map fa fb (a,b) = (fa a, fb b) - let map1 f (a,b) = (f a, b) - let map2 f (a,b) = (a, f b) - let curry f a b = f(a,b) - let uncurry f (a,b) = f a b -end - -module Tr = struct - let make a b c = (a,b,c) - let prj1 (a,_,_) = a - let prj2 (_,b,_) = b - let prj3 (_,_,c) = c - let prj12 (a,b,_) = (a,b) - let prj13 (a,_,c) = (a,c) - let prj23 (_,b,c) = (b,c) - let map fa fb fc (a,b,c) = (fa a, fb b, fc c) - let map1 f (a,b,c) = (f a, b, c) - let map2 f (a,b,c) = (a, f b, c) - let map3 f (a,b,c) = (a, b, f c) - let curry f a b c = f(a, b, c) - let uncurry f (a,b,c) = f a b c -end - -module Fr = struct - let make a b c d = (a,b,c,d) - let prj1 (a,_,_,_) = a - let prj2 (_,b,_,_) = b - let prj3 (_,_,c,_) = c - let prj4 (_,_,_,d) = d - let prj12 (a,b,_,_) = (a,b) - let prj13 (a,_,c,_) = (a,c) - let prj14 (a,_,_,d) = (a,d) - let prj23 (_,b,c,_) = (b,c) - let prj24 (_,b,_,d) = (b,d) - let prj34 (_,_,c,d) = (c,d) - let prj123 (a,b,c,_) = (a,b,c) - let prj124 (a,b,_,d) = (a,b,d) - let prj234 (_,b,c,d) = (b,c,d) - let map fa fb fc fd (a,b,c,d) = (fa a, fb b, fc c, fd d) - let map1 f (a,b,c,d) = (f a, b, c, d) - let map2 f (a,b,c,d) = (a, f b, c, d) - let map3 f (a,b,c,d) = (a, b, f c, d) - let map4 f (a,b,c,d) = (a, b, c, f d) - let curry f a b c d = f(a,b,c,d) - let uncurry f (a,b,c,d) = f a b c d -end diff --git a/src/tuple.mli b/src/tuple.mli deleted file mode 100644 index 3b3862d22d..0000000000 --- a/src/tuple.mli +++ /dev/null @@ -1,65 +0,0 @@ -(** Tuples. Functions for making, extracting elements from, mapping, and (un)currying Pairs, Triples, and Quadruples. Function names are consistent across modules. - - Function documentation: - - [make] construct a tuple - - [prjn] project [n]th item from a tuple - - [prjmn..] project [m]th, [n]th, ... items from a tuple - - [map] apply functions to every item of a tuple - - [mapn] apply a function to the [n]th item of a tuple - - [curry] convert a function taking a tuple into curried form - - [uncurry] convert a curried function into one taking a tuple -*) - -(** Pairs *) -module Pr : sig - val make : 'a -> 'b -> ('a * 'b) - val prj1 : ('a * 'b) -> 'a - val prj2 : ('a * 'b) -> 'b - val map : ('a -> 'c) -> ('b -> 'd) -> ('a * 'b) -> ('c * 'd) - val map1 : ('a -> 'c) -> ('a * 'b) -> ('c * 'b) - val map2 : ('b -> 'c) -> ('a * 'b) -> ('a * 'c) - val curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c - val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c -end - -(** Triples *) -module Tr : sig - val make : 'a -> 'b -> 'c -> ('a * 'b * 'c) - val prj1 : ('a * 'b * 'c) -> 'a - val prj2 : ('a * 'b * 'c) -> 'b - val prj3 : ('a * 'b * 'c) -> 'c - val prj12 : ('a * 'b * 'c) -> ('a * 'b) - val prj13 : ('a * 'b * 'c) -> ('a * 'c) - val prj23 : ('a * 'b * 'c) -> ('b * 'c) - val map : ('a -> 'd) -> ('b -> 'e) -> ('c -> 'f) -> ('a * 'b * 'c) -> ('d * 'e * 'f) - val map1 : ('a -> 'd) -> ('a * 'b * 'c) -> ('d * 'b * 'c) - val map2 : ('b -> 'd) -> ('a * 'b * 'c) -> ('a * 'd * 'c) - val map3 : ('c -> 'd) -> ('a * 'b * 'c) -> ('a * 'b * 'd) - val curry : ('a * 'b * 'c -> 'd) -> 'a -> 'b -> 'c -> 'd - val uncurry : ('a -> 'b -> 'c -> 'd) -> 'a * 'b * 'c -> 'd -end - -(** Quadruples *) -module Fr : sig - val make : 'a -> 'b -> 'c -> 'd -> ('a * 'b * 'c * 'd) - val prj1 : ('a * 'b * 'c * 'd) -> 'a - val prj2 : ('a * 'b * 'c * 'd) -> 'b - val prj3 : ('a * 'b * 'c * 'd) -> 'c - val prj4 : ('a * 'b * 'c * 'd) -> 'd - val prj12 : ('a * 'b * 'c * 'd) -> ('a * 'b) - val prj13 : ('a * 'b * 'c * 'd) -> ('a * 'c) - val prj14 : ('a * 'b * 'c * 'd) -> ('a * 'd) - val prj23 : ('a * 'b * 'c * 'd) -> ('b * 'c) - val prj24 : ('a * 'b * 'c * 'd) -> ('b * 'd) - val prj34 : ('a * 'b * 'c * 'd) -> ('c * 'd) - val prj123 : ('a * 'b * 'c * 'd) -> ('a * 'b * 'c) - val prj124 : ('a * 'b * 'c * 'd) -> ('a * 'b * 'd) - val prj234 : ('a * 'b * 'c * 'd) -> ('b * 'c * 'd) - val map : ('a -> 'e) -> ('b -> 'f) -> ('c -> 'g) -> ('d -> 'h) -> ('a * 'b * 'c * 'd) -> ('e * 'f * 'g * 'h) - val map1 : ('a -> 'e) -> ('a * 'b * 'c * 'd) -> ('e * 'b * 'c * 'd) - val map2 : ('b -> 'e) -> ('a * 'b * 'c * 'd) -> ('a * 'e * 'c * 'd) - val map3 : ('c -> 'e) -> ('a * 'b * 'c * 'd) -> ('a * 'b * 'e * 'd) - val map4 : ('d -> 'e) -> ('a * 'b * 'c * 'd) -> ('a * 'b * 'c * 'e) - val curry : ('a * 'b * 'c * 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e - val uncurry : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a * 'b * 'c * 'd -> 'e -end diff --git a/src/tylesBase.ml b/src/tylesBase.ml deleted file mode 100644 index dd0b31b6f2..0000000000 --- a/src/tylesBase.ml +++ /dev/null @@ -1,17 +0,0 @@ -(** Intended usage is to do "open TylesBase", which replaces several third-party modules with modified versions, and provides some new modules. *) - -module Array = Array2 -module Char = Char2 -module DynArray = DynArray2 -module List = List2 -module Map = Map2 -module PMap = PMap2 -module Set = Set2 -module Stream = Stream2 -module String = String2 - -module Msg = Msg -module Pos = Pos -module Tuple = Tuple - -include Pervasives2