Commits

"Jun...@gmail.com>"  committed 7106bce

moved things from ocamloscope

  • Participants
  • Parent commits b5f043a

Comments (0)

Files changed (15)

+To 2.4.1 or 2.4.2?
+---------------
+
+- Added String.split1
+- Added Filename.is_root
+- Added Base.(+=) and Base.(-=)
+- Added Base.find_by_iter and Base.find_in_tree
+* Type change from exn to `Exn of exn at Exn.catch and the other exn result error types 
+- Added Option.to_result
+
 2.4.1
 ---------------
 
 let flip f x y = f y x
 let (~~) g ~f = g f
 let flipf = (~~)
+
+let (+=) r v = r := !r + v
+let (-=) r v = r := !r - v
+
+let find_by_iter iter p col =
+  let result = ref None in
+  try
+    iter (fun e ->
+      if p e then begin
+        result := Some e;
+        raise Exit
+      end) col;
+    None
+  with
+  | Exit -> !result
+
+let find_in_tree visit p col =
+  let rec loop = function
+    | [] -> None
+    | x::xs ->
+        match p x with
+        | Some v -> Some v
+        | None -> loop (visit x @ xs)
+  in
+  loop [col]

File lib/base.mli

 val time : ('a -> 'b) -> 'a -> 'b * float
 (** simple profiling *)
 
+val (+=) : int ref -> int -> unit
+val (-=) : int ref -> int -> unit
+
+
+val find_by_iter : (('a -> unit) -> 'collection -> unit) -> ('a -> bool) -> 'collection -> 'a option
+(** find the first element where [predicate] holds by iteration [find_by_iter iterator predicate colleciton] *)
+
+val find_in_tree : ('a -> 'a list) -> ('a -> 'res option) -> 'a -> 'res option
+(** [find_in_tree get_subs p a] visits [a] and finds the first sub node 
+    in which [p] holds. [get_subs] returns the sub nodes of a node. *)
   in
   res, finally v
 
-let catch f v = try `Ok (f v) with e -> `Error e
+let catch f v = try `Ok (f v) with e -> `Error (`Exn e)
 
 let try_ignore f v = try f v with _ -> ()
 
 val protect_with : ('a -> 'b) -> 'a -> finally: ('a -> 'c) -> 'b * 'c
 (** It raises an exception [Finally (org, final)] when [finally] cannot recover the error. *)
  
-val catch       : ('a -> 'b) -> 'a -> [> ('b, exn) Result.t ]
+val catch       : ('a -> 'b) -> 'a -> [> ('b, [> `Exn of exn]) Result.t ]
 val try_ignore  : ('a -> unit) -> 'a -> unit
 val try_or      : ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b
 val try_bool    : ('a -> 'b) -> 'a -> bool
 
 val protect_      : (unit -> 'b) -> finally: (unit -> unit) -> 'b
 val protect_with_ : (unit -> 'b) -> finally: (unit -> 'c) -> 'b * 'c
-val catch_        : (unit -> 'b) -> [> ('b, exn) Result.t ]
+val catch_        : (unit -> 'b) -> [> ('b, [> `Exn of exn]) Result.t ]
 val try_ignore_   : (unit -> unit) -> unit
 val try_or_       : (unit -> 'b) -> (unit -> 'b) -> 'b
 val try_bool_     : (unit -> 'b) -> bool

File lib/exn.mli~

 (** {6 Printf style errors } *)
 
 val failwithf    : ('a, unit, string, 'b) format4 -> 'a
+
 val invalid_argf : ('a, unit, string, 'b) format4 -> 'a
 
 (** {6 Exception handling } *)
 
 exception Finally of exn * exn
 
-val protect'     : (unit -> 'a) -> finally: (unit -> unit) -> 'a
-val catch'       : (unit -> 'a) -> [> ('a, exn) result ]
-val try_ignore'  : (unit -> unit) -> unit
-val try_default' : default: (unit -> 'a) -> (unit -> 'a) -> 'a
-val try_bool'    : (unit -> unit) -> bool (* success/fail *)
+val protect     : ('a -> 'b) -> 'a -> finally: ('a -> unit) -> 'b
+(** It raises an exception [Finally (org, final)] when [finally] cannot recover the error. *)
+ 
+val protect_with : ('a -> 'b) -> 'a -> finally: ('a -> 'c) -> 'b * 'c
+(** It raises an exception [Finally (org, final)] when [finally] cannot recover the error. *)
+ 
+val catch       : ('a -> 'b) -> 'a -> [> ('b, exn) Result.t ]
+val try_ignore  : ('a -> unit) -> 'a -> unit
+val try_or      : ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b
+val try_bool    : ('a -> 'b) -> 'a -> bool
 (** [true] at success *)
+
+val protect_      : (unit -> 'b) -> finally: (unit -> unit) -> 'b
+val protect_with_ : (unit -> 'b) -> finally: (unit -> 'c) -> 'b * 'c
+val catch_        : (unit -> 'b) -> [> ('b, exn) Result.t ]
+val try_ignore_   : (unit -> unit) -> unit
+val try_or_       : (unit -> 'b) -> (unit -> 'b) -> 'b
+val try_bool_     : (unit -> 'b) -> bool
+
+
+val tee : ('a -> 'b) -> 'a -> handler:(exn -> unit) -> 'b
+(** [tee f v ~handler]. If [f v] raises an exception [e], 
+    [handler e] is executed, then [e] is reraised.
+*)
+
+(* Printexc + alpha *)
+
+val to_string : exn -> string
+val format : Format.formatter -> exn -> unit
+val print_backtrace : out_channel -> unit
+val get_backtrace : unit -> string
+val register_printer : (exn -> string option) -> unit
 let invalid_argf fmt = Printf.kprintf invalid_arg fmt
 
 exception Finally of exn * exn
-;;
 
 (* CR jfuruse: looks lousy... *)
-let protect ~f v ~(finally : 'a -> unit) =
+let protect f v ~(finally : 'a -> unit) =
   let res =
     try f v
     with exn ->
   in
   finally v;
   res
-;;
 
-let catch ~f v = try `Ok (f v) with e -> `Error e;;
-let try_ignore ~f v = try f v with _ -> ();;
-let try_default ~default ~f v = try f v with _ -> default v;;
-let try_bool ~f v = try ignore (f v); true with _ -> false
-
-let protect' f ~(finally : unit -> unit) =
+let protect_with f v ~finally =
   let res =
-    try f ()
+    try f v
     with exn ->
-      (try finally () with final_exn -> raise (Finally (exn, final_exn)));
+      (try finally v with final_exn -> raise (Finally (exn, final_exn)));
       raise exn
   in
-  finally ();
-  res
-;;
+  res, finally v
 
-let catch' f = try `Ok (f ()) with e -> `Error e
-let try_ignore' f = try f () with _ -> ()
-let try_default' ~default f = try f () with _ -> default ();;
-let try_bool' f = try ignore (f ()); true with _ -> false
+let catch f v = try `Ok (f v) with e -> `Error e
 
-let with_final v f final =
-  match try `Ok (f v) with e -> `Error e with
-  | `Ok res -> final v; res
-  | `Error e -> try_ignore ~f:final v; raise e
+let try_ignore f v = try f v with _ -> ()
+
+let try_or f g v = try f v with _ -> g v
+
+let try_bool f v = try f v; true with _ -> false
+
+let protect_ f = protect f ()
+let protect_with_ f = protect_with f ()
+let catch_ f = catch f ()
+let try_ignore_ f = try_ignore f ()
+let try_or_ f g = try_or f g ()
+let try_bool_ f = try_bool f ()
+
+let tee f v ~handler = try f v with e -> handler e; raise e
+
+(* Printexc 
+
+   Printexc has a very bad name. Printexc for exn ?
+*)
+let to_string        = Printexc.to_string
+let format ppf t     = Format.pp_print_string ppf (Printexc.to_string t)
+let print_backtrace  = Printexc.print_backtrace
+let get_backtrace    = Printexc.get_backtrace
+let register_printer = Printexc.register_printer

File lib/file.mli

 val iter_lines_exn : string -> (string -> 'a) -> unit
 (** [iter_lines_exn filename f] iters [f] over lines of contets of [filename] *)
 
-val iter_lines : string -> (string -> unit) -> (unit, exn) result
+val iter_lines : string -> (string -> unit) -> (unit, [> `Exn of exn]) result
 (** [iter_lines filename f] iters [f] over lines of contets of [filename] *)
 
-val to_lines : string -> (string list, exn) result
+val to_lines : string -> (string list, [> `Exn of exn]) result
 (** [iter_lines filename f] iters [f] over lines of contets of [filename] *)
 
-val to_string : string -> (string, exn) result
+val to_string : string -> (string, [> `Exn of exn]) result
 (** [to_string filename] returns the contens of the file *)
 
 val open_out : string -> (out_channel -> 'a) -> 'a

File lib/option.ml

   let fail () = raise Error.Error in
   try Some (f ~fail) with Error.Error -> None
 
+let to_result = function
+  | Some v -> `Ok v
+  | None -> `Error `None
+
 let catch_exn f = catch (fun ~fail -> try f () with _ -> fail ())
 
 let format f ppf = function

File lib/option.mli

 val catch : (fail:(unit -> 'exn) -> 'a) -> 'a option
 val catch_exn : (unit -> 'a) -> 'a option
 
+val to_result : 'a option -> ('a, [> `None]) Result.t
+
 val from_Some : 'a option -> 'a
 (** may raise [Invalid_argument] *)
 

File lib/xfilename.ml

   with
   | Invalid_argument _ -> s, ""
 
+let is_root d = not (is_relative d) && dirname d = d
+
 module Pervasives = struct
   let (^/) p1 p2 =
     if Filename.is_relative p2 then Filename.concat p1 p2 else p2

File lib/xfilename.mli

     [split_extension "hello_world" = "hello_world", ""]
 *)
 
+val is_root : string -> bool
+
 module Pervasives : sig
   val (^/) : string -> string -> string
   (** Filename concatenation. If the second argument is absolute,

File lib/xstring.ml

     split_at 3 "hello world" = ("hel", "lo world")
 ;;
 
+let find s pos f =
+  let len = length s in
+  let rec scan pos =
+    if pos >= len then None
+    else if f (unsafe_get s pos) then Some pos else scan (pos + 1)
+  in
+  scan pos
+
+let split1 ?(from=0) f str =
+  match find str from f with
+  | None -> None
+  | Some pos -> Some (sub str 0 pos, sub str (pos+1) (length str - pos - 1))
+
 let take len str = String.sub str 0 len
 let prefix = take
 let drop len str = String.sub str len (String.length str - len)
   assert (sub' "hello" 3 4 = "lo");
   assert (sub' "hello" 5 5 = "")
 
-let find s pos f =
-  let len = length s in
-  let rec scan pos =
-    if pos >= len then None
-    else if f (unsafe_get s pos) then Some pos else scan (pos + 1)
-  in
-  scan pos
-
 let replace_chars from to_ s =
   let s' = copy s in
   iteri (fun p -> function

File lib/xstring.mli

 (** [make1 = String.make 1] *) 
 
 val lines : string -> (string * string) list
-(** [lines "hello\nworld\r\ngood\rday" = ["hello", "\n"; "world", "\r\n"; "good", "\r"; "day", ""]  *)
+(** [lines "hello\nworld\r\ngood\rday" = ["hello", "\n"; "world", "\r\n"; "good", "\r"; "day", ""]]  *)
 
 val split : (char -> bool) -> string -> string list
-(** [split (function ' ' -> true | _ -> false) "hello      world" = ["hello"; "world"] *) 
+(** [split (function ' ' -> true | _ -> false) "hello      world" = ["hello"; "world"]] *) 
 
 module Set : Xset.S with type elt = String.t
 
+val split1 : ?from:int -> (char -> bool) -> string -> (string * string) option
+(** Same as [split] but do the split only once *)
+
 (** Haskelish string sub *)
 val split_at : int -> string -> string * string
 val take : int -> string -> string

File lib/xunix.ml

 let with_chdir ?(at_failure=(fun exn -> raise exn)) dir f =
   let cwd = Unix.getcwd () in
   match Exn.catch Unix.chdir dir with
-  | `Error exn -> at_failure exn
+  | `Error (`Exn exn) -> at_failure exn
   | `Ok () ->
       Exn.protect f () ~finally:(fun () -> Unix.chdir cwd)