You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
gentoo-overlay/dev-ml/obrowser/files/obrowser-1.1.1-ocaml41.patch

216 lines
7.0 KiB

Index: obrowser-1.1.1/rt/caml/pervasives.ml
===================================================================
--- obrowser-1.1.1.orig/rt/caml/pervasives.ml
+++ obrowser-1.1.1/rt/caml/pervasives.ml
@@ -24,6 +24,11 @@ let invalid_arg s = raise(Invalid_argume
exception Exit
+(* Composition operators *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
(* Comparisons *)
external (=) : 'a -> 'a -> bool = "%equal"
Index: obrowser-1.1.1/rt/caml/pervasives.mli
===================================================================
--- obrowser-1.1.1.orig/rt/caml/pervasives.mli
+++ obrowser-1.1.1/rt/caml/pervasives.mli
@@ -137,6 +137,19 @@ external ( || ) : bool -> bool -> bool =
external ( or ) : bool -> bool -> bool = "%sequor"
(** @deprecated {!Pervasives.( || )} should be used instead.*)
+(** {6 Composition operators} *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** Reverse-application operator: [x |> f |> g] is exactly equivalent
+ to [g (f (x))].
+ @since 4.01
+*)
+
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Application operator: [g @@ f @@ x] is exactly equivalent to
+ [g (f (x))].
+ @since 4.01
+*)
(** {6 Integer arithmetic} *)
Index: obrowser-1.1.1/rt/caml/printexc.ml
===================================================================
--- obrowser-1.1.1.orig/rt/caml/printexc.ml
+++ obrowser-1.1.1/rt/caml/printexc.ml
@@ -78,6 +78,11 @@ let catch fct arg =
eprintf "Uncaught exception: %s\n" (to_string x);
exit 2
+type raw_backtrace
+
+external get_raw_backtrace:
+ unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
+
type loc_info =
| Known_location of bool (* is_raise *)
* string (* filename *)
@@ -86,8 +91,13 @@ type loc_info =
* int (* end char *)
| Unknown_location of bool (*is_raise*)
-external get_exception_backtrace:
- unit -> loc_info array option = "caml_get_exception_backtrace"
+(* to avoid warning *)
+let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
+
+type backtrace = loc_info array
+
+external convert_raw_backtrace:
+ raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
let format_loc_info pos li =
let is_raise =
@@ -108,8 +118,8 @@ let format_loc_info pos li =
sprintf "%s unknown location"
info
-let print_backtrace outchan =
- match get_exception_backtrace() with
+let print_exception_backtrace outchan backtrace =
+ match backtrace with
| None ->
fprintf outchan
"(Program not linked with -g, cannot print stack backtrace)\n"
@@ -119,8 +129,15 @@ let print_backtrace outchan =
fprintf outchan "%s\n" (format_loc_info i a.(i))
done
-let get_backtrace () =
- match get_exception_backtrace() with
+let print_raw_backtrace outchan raw_backtrace =
+ print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named: prints the global current backtrace *)
+let print_backtrace outchan =
+ print_raw_backtrace outchan (get_raw_backtrace ())
+
+let backtrace_to_string backtrace =
+ match backtrace with
| None ->
"(Program not linked with -g, cannot print stack backtrace)\n"
| Some a ->
@@ -131,8 +148,22 @@ let get_backtrace () =
done;
Buffer.contents b
+let raw_backtrace_to_string raw_backtrace =
+ backtrace_to_string (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named:
+ returns the *string* corresponding to the global current backtrace *)
+let get_backtrace () =
+ (* we could use the caml_get_exception_backtrace primitive here, but
+ we hope to deprecate it so it's better to just compose the
+ raw stuff *)
+ backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
+
external record_backtrace: bool -> unit = "caml_record_backtrace"
external backtrace_status: unit -> bool = "caml_backtrace_status"
let register_printer fn =
printers := fn :: !printers
+
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
Index: obrowser-1.1.1/rt/caml/printexc.mli
===================================================================
--- obrowser-1.1.1.orig/rt/caml/printexc.mli
+++ obrowser-1.1.1/rt/caml/printexc.mli
@@ -79,3 +79,33 @@ val register_printer: (exn -> string opt
generic printer).
@since 3.11.2
*)
+
+(** {6 Raw backtraces} *)
+
+type raw_backtrace
+
+(** The abstract type [backtrace] stores exception backtraces in
+ a low-level format, instead of directly exposing them as string as
+ the [get_backtrace()] function does.
+
+ This allows to pay the performance overhead of representation
+ conversion and formatting only at printing time, which is useful
+ if you want to record more backtrace than you actually print.
+*)
+
+val get_raw_backtrace: unit -> raw_backtrace
+val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+val raw_backtrace_to_string: raw_backtrace -> string
+
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+
+(** [Printexc.get_callstack n] returns a description of the top of the
+ call stack on the current program point (for the current thread),
+ with at most [n] entries. (Note: this function is not related to
+ exceptions at all, despite being part of the [Printexc] module.)
+
+ @since 4.01.0
+*)
Index: obrowser-1.1.1/rt/caml/list.ml
===================================================================
--- obrowser-1.1.1.orig/rt/caml/list.ml
+++ obrowser-1.1.1/rt/caml/list.ml
@@ -73,6 +73,18 @@ let rec fold_left f accu l =
[] -> accu
| a::l -> fold_left f (f accu a) l
+let rec mapi i f = function
+ [] -> []
+ | a::l -> let r = f i a in r :: mapi (i + 1) f l
+
+let mapi f l = mapi 0 f l
+
+let rec iteri i f = function
+ [] -> ()
+ | a::l -> f i a; iteri (i + 1) f l
+
+let iteri f l = iteri 0 f l
+
let rec fold_right f l accu =
match l with
[] -> accu
Index: obrowser-1.1.1/rt/caml/list.mli
===================================================================
--- obrowser-1.1.1.orig/rt/caml/list.mli
+++ obrowser-1.1.1/rt/caml/list.mli
@@ -75,11 +75,25 @@ val iter : ('a -> unit) -> 'a list -> un
[a1; ...; an]. It is equivalent to
[begin f a1; f a2; ...; f an; () end]. *)
+val iteri : (int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+ the element as first argument (counting from 0), and the element
+ itself as second argument.
+ @since 4.00.0
+*)
+
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 mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+ the element as first argument (counting from 0), and the element
+ itself as second argument. Not tail-recursive.
+ @since 4.00.0
+*)
+
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