Commits

camlspotter committed d35e105 Merge

ported from trunk

Comments (0)

Files changed (16)

 - Unix.{file, mkdtemp, with_dtemp} added
 - Unix.mkdir is overridden
 * Renamed Unix.find to Added Unix.Find.find with poly record interface
+- Added Format.to_string
+- Added URL
 
 2.1.2
 ------------
    dllist
 #   channel
    tuple
+   URL
    spot
 
 LIB = spotlib
+open Base
+
+let encode s =
+  let len = String.length s in
+  let b = Buffer.create & len * 2 in
+  for i = 0 to len - 1 do
+    match String.unsafe_get s i with
+    | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '.' | '_' | '~' as c -> Buffer.add_char b c
+    | c -> Buffer.add_string b & Printf.sprintf "%%%02x" (Char.code c)
+  done;
+  Buffer.contents b
+
+let make_query kvs =
+  String.concat "&" 
+  & List.map (fun (k,v) ->
+      let b = Buffer.create 100 in
+      Buffer.add_string b & encode k; 
+      Buffer.add_char b '=';
+      Buffer.add_string b & encode v;
+      Buffer.contents b) kvs
+val encode : string -> string
+(** encode "Today's special" = "Today%27s%20special" *)
+
+val make_query : (string * string) list -> string
+(** make_query ["k", "v"; "k2", "v2"] = "k=v&k2=v2" *)
 external (|>) : 'a -> ('a -> 'b) -> 'b =  "%revapply"
 
 let ( ** ) f g = fun x -> f (g x)
+let ( *< ) = ( ** )
 let ( *> ) f g = fun x -> g (f x)
 external power : float -> float -> float = "caml_power_float" "pow" "float"
 
 (** Functional composition. Haskell's (.) 
     Use [power] if you want to use the original [( ** )].
 *)
+val ( *< ) : ('b -> 'c) -> ('a -> 'b) -> ('a -> 'c)
+(** Same as ( ** ) *)
+
 val ( *> ) : ('a -> 'b) -> ('b -> 'c) -> ('a -> 'c)
 (** Functional composition in swapped order. Haskell's (>>>) *)
 
 let mem = Hashtbl.mem
 let find = Hashtbl.find
 let find_opt t k = try Some (Hashtbl.find t k) with Not_found -> None
+
+let find_or_add t k = 
+  try Hashtbl.find t k with Not_found -> 
+    add t k; k
+    
 let iter f = Hashtbl.iter (fun v _ -> f v)
 let fold f = Hashtbl.fold (fun v _ st -> f v st)
 let elements = Hashtbl.length
 (** Poorman's hashset by Hashtbl *)
 
+(* CR jfuruse: It is mainly for hash consing but it wastes memory... Self contradiction. *)
 type 'a t
 val create : ?random:bool -> int -> 'a t
 val add : 'a t -> 'a -> unit
 val find_opt : 'a t -> 'a -> 'a option 
 (** [find] and [find_opt] finds the 'same' element in the set. Good for hash consing *)
 
+val find_or_add : 'a t -> 'a -> 'a
+
 val iter : ('a -> unit) -> 'a t -> unit
 val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
 val elements : 'a t -> int
 module Pervasives = struct
   let from_Some = function
     | Some v -> v
-    | _ -> invalid_arg "Optino.from_Some"
+    | _ -> invalid_arg "Option.from_Some"
+        (* This should report the caller's location,
+           but it is not possible...
+        *)
 end
 
 include Pervasives
   include Printexc
   include Xprintexc
 end
+
+module URL = URL
   if Xlazy.is_val v then p ppf (Xlazy.(!!) v)
   else Format.fprintf ppf "lazy"
 
+let to_string f v =
+  let buf = Buffer.create 100 in
+  let ppf = formatter_of_buffer buf in
+  f ppf v;
+  flush ppf; 
+  Buffer.contents buf
+
 let sprintf fmt =
   let buf = Buffer.create 100 in
   let ppf = formatter_of_buffer buf in
 val set_formatter_tag_functions : t -> formatter_tag_functions -> unit
 val formatter_tag_functions : t -> unit -> formatter_tag_functions
 
+val to_string : (Format.formatter -> 'a -> unit) -> 'a -> string
+
 val sprintf : ('a, t, unit, string) format4 -> 'a
   (** [sprintf] with a better type than the orignal *)
 
   map 0 l
 
 let from_to f t =
+  (* CR jfuruse: we should build from 'to' *)
   let rec from_to st f t =
     if f > t then rev st
     else from_to (f::st) (f+1) t
         | `Stop acc -> acc
   in
   scan acc 0 xs
+
+let fold_left1 f = function
+  | [] -> invalid_arg "fold_left1" (* check the stack trace to see the use site *)
+  | x::xs -> List.fold_left f x xs
+
+let sum xs = List.fold_left (+) 0 xs
+
+module Infix = struct
+  let (--) = (--)
+end
+
+
   (int -> 'a -> 'b -> [< `Continue of 'a | `Stop of 'a ]) 
   -> 'a -> 'b list -> 'a
   (** [foldl] but stoppable *)
+
+val fold_left1 : ('a -> 'a -> 'a) -> 'a list -> 'a
+(** List must be non-empty. 
+    Otherwise, it raises [Invalid_argment "fold_left1"]. *)
+
+val sum : int list -> int
+
+module Infix : sig
+  val (--) : int -> int -> int list
+  (** [same as from_to. [f--t = [f..t]] ] *)
+end
+
+
     assert (postfix 5 "hello world" = "world")
 ;;
 
-let contains ?from:(pos=0) ~needle:sub str =
-  let str_len = String.length str in
-  let sub_len = String.length sub in
-  if pos + sub_len > str_len then false
-  else 
-    let rec iter i = 
-      if str.[pos + i] <> sub.[i] then false
-      else 
-        let i' = i + 1 in
-        if i' = sub_len then true
-        else iter i'
-    in
-    iter 0
-
-TEST_UNIT "Xstring.contains" = 
-    assert (contains ~needle:"hello" "hello world")
-    assert (contains ~needle:"hello" "bye world" = false)
-;;    
-
 let is_prefix' ?(from=0) sub str =
   let sublen = String.length sub in
   try 
     assert (is_prefix "hello" "hello world")
 ;;
 
+let contains ?from:(pos=0) ~needle:sub str =
+  let str_len = String.length str in
+  let sub_len = String.length sub in
+  if pos + sub_len > str_len then false
+  else 
+    let rec iter pos = 
+      if pos + sub_len > str_len then false
+      else if is_prefix ~from:pos sub str then true
+      else iter (pos+1)
+    in
+    iter pos
+
+TEST_UNIT "Xstring.contains" = 
+    assert (contains ~needle:"hello" "hello world")
+    assert (contains ~needle:"hello" "bye world" = false)
+    assert (contains ~needle:"shindanmaker.com" "http://shindanmaker.com/341161")
+;;    
+
 let is_postfix sub str =
   let sublen = String.length sub in
   try postfix sublen str = sub with _ -> false
                      | `Ok of string ]
 (** Execute "file path" *)
 
-val gen_timed : (unit -> 't) -> ('t -> 't -> 't) -> ('a -> 'b) -> 'a -> 'b * 't
-
-val timed : ('a -> 'b) -> 'a -> 'b * float
+val timed : ('a -> 'b) -> 'a -> 'b * float (* in sec *)
 
 module Process_times : sig
   type t = process_times