(* -*- caml -*- *)

(* @@PLEAC@@_NAME *)
(* @@SKIP@@ Objective CAML @@SKIP@@ *)

(* @@PLEAC@@_WEB *)
(* @@SKIP@@ http://www.ocaml.org/ @@SKIP@@ *)

(* @@PLEAC@@_APPENDIX *)
open Printf

let sort_ l = List.sort compare l

let rec uniq = function
  | [] -> []
  | e::l -> if List.mem e l then uniq l else e :: uniq l

let rec filter_some = function
  | [] -> []
  | Some e :: l -> e :: filter_some l
  | None :: l -> filter_some l

let rec all_assoc e = function
  | [] -> []
  | (e',v) :: l when e=e' -> v :: all_assoc e l
  | _ :: l -> all_assoc e l

(* fold_left alike. note that it is tail recursive *)
let rec fold_lines f init chan =
  match
    try Some (input_line chan)
    with End_of_file -> None
  with
  | Some line -> fold_lines f (f init line) chan
  | None -> init

let iter_lines f chan = fold_lines (fun _ line -> f line) () chan  
let readlines chan = List.rev (fold_lines (fun l e -> e::l) [] chan)
;;
(* @@PLEAC@@_1.0 *)
(*---------------------------*)
let string = "\\n"                  (* two characters, \ and an n*)
let string = "Jon 'Maddog' Orwant"  (* literal single quotes*)
(*---------------------------*)
let string = "\n"                     (* a "newline" character *)
let string = "Jon \"Maddog\" Orwant"  (* literal double quotes *)

let a = "
    This is a multiline here document
    terminated by one  double quote
    "
(* @@PLEAC@@_1.1 *)
let value = String.sub string offset count
let value = String.sub string offset (String.length string - offset)
(* or *)
let value = sub_end string offset
(* using *)
let sub_end string offset = String.sub string offset (String.length string - offset)

(*-----------------------------*)
(* get a 5-byte string, skip 3, then grab 2 8-byte strings, then the rest*)

(* split at 'sz' byte boundaries *)
let rec split_every_n_chars sz = function
  | "" -> []
  | s -> 
      try
        let (beg, rest) = String.sub s 0 sz, sub_end s sz in
        beg :: split_every_n_chars sz rest
      with _ -> [s]

let fivers = split_every_n_chars 5 string

(* chop string into individual characters *)
let chars = List.map (fun x -> x.[0]) (split_every_n_chars 1 string)

(*-----------------------------*)
let string = "This is what you have";;
(* Indexes are left to right. There is no possibility to index *)
(* directly from right to left *)
(* "T" *)
let first  = String.sub string 0 1   
(* "is" *)
let start  = String.sub string 5 2 
(* "you have" *)
let rest   = String.sub string 13 (String.length string - 13)   
(* "e" *)
let last   = String.sub string (String.length string - 1) 1
(* "have" *)
let theend = String.sub string (String.length string - 4) 4  
(* "you" *)
let piece  = String.sub string (String.length string - 8) 3
(*-----------------------------*)
let string = "This is what you have";;
Printf.printf "%s" string ;
(*This is what you have*)

(* Change "is" to "wasn't"*)
let string = (String.sub string 0 5) ^ "wasn't" ^ sub_end string 7
(*This wasn't what you have *)   

(*This wasn't wonderous *)
let string = (String.sub string 0 (String.length string -12)) ^
   "ondrous";;

(* delete first character *)
let string = String.sub string 1 (String.length string - 1)
(*his wasn't wondrous*)

(* delete last 10 characters *)
let string = String.sub string 0 (String.length string -10)
(*his wasn'*)
(*-----------------------------*)

(* @@PLEAC@@_1.2 *)

(* Because OCaml doesn't have the same notion of truth or definedness as Perl,
 * most of these examples just can't be done as they are in Perl.  Some can be
 * approximated via the use of options, but remember, unbound variables are not
 * automatically assigned the value of None -- the variable has to have been
 * explicitly bound to None (or Some x) beforehand.
*)

(* use b if b is not None, else use c *)
let a = match b with None -> c | _ -> b;;

(* set x to y if x is currently None *)
let x = match x with None -> y | _ -> x;;

(* Note that these are much closer to Perls notion of definedness than truth *)

(* We can set foo to either bar or "DEFAULT VALUE" in one of two ways *)
(* keep foo as a string option *)
let foo = match bar with Some x -> bar | _ -> Some "DEFAULT VALUE";;

(* Use foo as a string *)
let foo = match bar with Some x -> x | _ -> "DEFAULT VALUE";;

let dir = if Array.length Sys.argv > 1 then argv.(1) else "/tmp";;

(* None of the other examples really make sense in OCaml terms... *)

(* @@PLEAC@@_1.3 *)
(*-----------------------------*)
let var1, var2 = var2, var1
(*-----------------------------*)
let temp    = a
let a       = b
let b       = temp
(*-----------------------------*)
let a       = "alpha"
let b       = "omega"
let a, b = b, a      (* the first shall be last -- and versa vice *)
(*-----------------------------*)
let alpha, beta, production = "January", "March", "August"
(* move beta       to alpha,
 * move production to beta,
 * move alpha      to production *)
let alpha, beta, production = beta, production, alpha
(*-----------------------------*)

(* @@PLEAC@@_1.4 *)
(*-----------------------------*)
let num  = Char.code char
let char = Char.chr num
(*-----------------------------*)
(* char and int are distinct datatypes in OCaml *)
printf "Number %d is character %c\n" num (Char.chr num)
(* Number 101 is character e *)
(*-----------------------------*)
(* convert string to list of chars *)
let explode s =
  let rec f acc = function
    | -1 -> acc
    | k -> f (s.[k] :: acc) (k - 1)
  in f [] (String.length s - 1)

(* convert list of chars to string *)
let implode l =
  let s = String.create (List.length l) in
  let rec f n = function
    | x :: xs -> s.[n] <- x; f (n + 1) xs
    | [] -> s
  in f 0 l

(* ascii is list of ints. *)
let ascii = List.map Char.code (explode string)
let string = implode (List.map Char.ord ascii)
(*-----------------------------*)
let ascii_value = Char.code 'e'    (* now 101 *)
let character   = Char.chr 101     (* now 'e' *)
(*-----------------------------*)
printf "Number %d is character %c\n" 101 (Char.chr 101)
(*-----------------------------*)
let ascii_character_numbers = List.map Char.code (explode "sample");;
List.iter (printf "%d ") ascii_character_numbers;
printf "\n"
115 97 109 112 108 101

let word = implode (List.map Char.chr ascii_character_numbers)
let word = implode (List.map Char.chr [115; 97; 109; 112; 108; 101]);; (* same *)
printf "%s\n" word
sample
(*-----------------------------*)
let hal = "HAL"
let ascii = List.map Char.code (explode hal)
let ascii = List.map (( + ) 1) ascii  (* add one to each ASCII value *)
let ibm = implode (List.map Char.chr ascii);;
printf "%s\n" ibm             (* prints "IBM" *)
(*-----------------------------*)

(* @@PLEAC@@_1.5 *)

(* One can split a string into an array of character, or corresponding ASCII
 * codes as follows, but this is not necessary to process the strings a
 * character at a time: *)

let array_of_chars = Array.init (String.length s) (fun i -> s.[i]);;
let array_of_codes = Array.init (String.length s) (fun i -> Char.code s.[i]);;

(* or one can just use String.iter *)
String.iter 
  (fun i -> (*do something with s.[i], the ith char of the string*)) s;;

(* The following function can be used to return a list of all unique keys in a
 * hashtable *)

let keys h =
  let k = Hashtbl.fold (fun k v b -> k::b) h [] in
  (* filter out duplicates *)
  List.fold_left (fun b x -> if List.mem x b then b else x::b) [] k;;

(* and this function is a shorthand for adding a key,value pair to a hashtable
*)

let ( <<+ ) h (k,v) = Hashtbl.add h k v;;

let seen = Hashtbl.create 13;;
let s = "an apple a day";;
let array_of_chars = Array.init (String.length s) (fun i -> s.[i]);;
Array.iter (fun x -> seen <<+ (x,1)) array_of_chars;
print_string "unique chars are:\t";
List.iter print_char (List.sort compare (keys seen));
print_newline ();;

(* or, without the unnecessary and innefficient step of converting the string
 * into an array of chars *)
let seen = Hashtbl.create 13;;
let s = "an apple a day";;
String.iter (fun x -> seen <<+ (x,1)) s;
print_string "unique chars are:\t";
List.iter print_char (List.sort compare (keys seen));
print_newline ();;

(* To compute the simple 31-bit checksum of a string *)
let cksum s =
  let sum = ref 0 in
  String.iter (fun x -> sum := !sum + (Char.code x)) s;
  !sum;;
(*
# cksum "an apple a day";;
- : int = 1248
*)

(* to emulate the SysV 16-bit checksum, we will first write two routines sort of
 * similar to Perl's (<>), that will return the contents of a file either as a
 * list of strings or as a single string - not that the list of strings version
 * throws away the \n at the end of each line *)

let slurp_to_list filename =
  let ic = open_in filename and
  l = ref [] in
  let rec loop () =
    let line = input_line ic in
    l := line::!l;
    loop () in
  try loop () with End_of_file -> close_in ic; List.rev !l;;

let slurp_to_string filename =
  let ic = open_in filename and
  buf = Buffer.create 4096 in
  let rec loop () =
    let line = input_line ic in
    Buffer.add_string buf line;
    Buffer.add_string buf "\n";
    loop () in
  try loop () with End_of_file -> close_in ic; Buffer.contents buf;;

let cksum16 fn =
  let addString sum s =
    let sm = ref sum in
    String.iter (fun c -> sm := !sm + (Char.code c)) (s ^ "\n"); 
    !sm mod 65537 (* 2^16 - 1 *)in
  List.fold_left addString 0 (slurp_to_list fn);;

(* or *)
let cksum16 fn = 
  let sum = ref 0
  and s = slurp_to_string fn in
  String.iter (fun c -> sum := (!sum + (Char.code c)) mod 65537) s;
  !sum;;



(* Note: slowcat as written is meant to be run from the command line, not in the
 * toplevel *)

#!/usr/local/bin/ocaml
(* slowcat - emulate a   s l o w  line printer *)
(* usage: slowcat [-DELAY] [files ...] *)
#load "unix.cma";;

(* make sure you have the code for the slurp_to_string function in this file as
 * well... *)

let _ =
  let delay,fs = try (float_of_string Sys.argv.(1)),2 with Failure _ -> 1.,1 in
  let files = Array.sub Sys.argv fs (Array.length Sys.argv - fs) in
  let print_file f =
    let s = slurp_to_string f in
    String.iter 
      (fun c -> 
        print_char c;
        ignore(Unix.select [] [] [] (0.005 *. delay))) s in
  Array.iter print_file files;;

(* @@PLEAC@@_1.6 *)

(* To flip the characters of a string, we can use a for loop.
 * Note that this version does not destructively update the string *)

let reverse s = 
  let len = String.length s - 1 in
  let s' = String.create (len + 1) in
  for i = 0 to len do
    s'.[i] <- s.[len - i]
  done;
  s';;

(* to modify the string in place, we can use the following function *)
let reverse_in_place s =
  let len = String.length s - 1 in
  for i = 0 to (len + 1)/ 2 - 1 do
    let t = s.[i] in
    s.[i] <- s.[len - i];
    s.[len - i] <- t
  done;;

(* To reverse the words in a string, we can use String.concat, Str.split and
 * List.rev.  Note that this requires us to load in the Str module -- 
 * use `#load "str.cma"' in* the toplevel, or be sure to include str.cma in the
 * list of object files when compiling your code.  E.g.:
 *      ocamlc other options str.cma other files   -or-
 *      ocamlopt other options str.cmxa other files 
*)

let reverse_words s =
  String.concat " " (List.rev (Str.split (Str.regexp " ") s));;

let is_palindrome s = 
  s = reverse s;;

(* We do need to do a bit more work that Perl to find the big palindromes in
 * /usr/share/dict/words ... *)

let findBigPals () = 
  let words = open_in "/usr/share/dict/words" in
  let rec loop () =
    let w = input_line words in
    if String.length w > 5 && w = reverse w then
      print_endline w;
    loop () in
  try loop () with End_of_file -> close_in words;;

(* @@PLEAC@@_1.7 *)

let expand_tabs ?(spaces = 8) s =
  Str.global_replace (Str.regexp "\t") (String.make spaces ' ') s;;

let compress_tabs ?(spaces = 8) s = 
  Str.global_replace (Str.regexp (String.make spaces ' ')) "\t" s;;

(*
# let st = "\tyo baby!\n\t\tWhat the shizzle?\t(Mack)";;
val st : string = "\tyo baby!\n\t\tWhat the shizzle?\t(Mack)"
# let etst = expand_tabs st;;
val etst : string =
  "        yo baby!\n                What the shizzle?        (Mack)"
# let etst = expand_tabs ~spaces:4 st;;
val etst : string = "    yo baby!\n        What the shizzle?    (Mack)"
# let etst = expand_tabs ~spaces:8 st;;
val etst : string =
  "        yo baby!\n                What the shizzle?        (Mack)"
# let rest = compress_tabs etst;;
val rest : string = "\tyo baby!\n\t\tWhat the shizzle?\t(Mack)"
# let rest = compress_tabs ~spaces:4 etst;;
val rest : string = "\t\tyo baby!\n\t\t\t\tWhat the shizzle?\t\t(Mack)"
# let rest = compress_tabs ~spaces:3 etst;;
val rest : string =
  "\t\t  yo baby!\n\t\t\t\t\t What the shizzle?\t\t  (Mack)"
*)

(* @@PLEAC@@_1.8 *)
(* As far as I know there is no way to do this in OCaml due to
   type-safety contraints built into the OCaml compiler -- it may be
   feasible with *much* juju, but don't expect to see this anytime
   soon...

   If you don't mind supplying a data structure rather than capturing
   local variables, you can use Buffer.add_substitute to get a similar
   effect. *)

let buffer = Buffer.create 16
let vars = [("debt", "$700 billion")]
let () =
  Buffer.add_substitute buffer
    (fun name -> List.assoc name vars)
    "You owe $debt to me.";
  print_endline (Buffer.contents buffer)

(* @@PLEAC@@_1.9 *)

(* Just use the String module's uppercase, lowercase, capitalize and
 * uncapitalize *)

let big = String.uppercase little;;    (* "bo peep" -> "BO PEEP" *)
let little = String.lowercase big;;    (* "JOHN" -> "john" *)
let big = String.capitalize little;;   (* "bo" -> "Bo" *)
let little = String.uncapitalize big;; (* "BoPeep" -> "boPeep" *)

(* Capitalize each word's first character, downcase the rest *)
let text = "thIS is a loNG liNE";;
let text = String.capitalize (String.lowercase text);;
print_endline text;;

(*
This is a long line
*)

(* To do case insensitive comparisons *)
if String.uppercase a = String.uppercase b then
  print_endline "a and b are the same\n";;

let randcap fn =
  let s = slurp_to_string fn in
  for i = 0 to String.length s - 1 do
    if Random.int 100 < 20 then
      String.blit (String.capitalize (String.sub s i 1)) 0 s  i 1
  done;
  print_string s;;


(*
# randcap "/etc/passwd";;

##
# User DatAbAse
# 
# Note That this fIle is consuLTed wHen the sysTeM Is runninG In single-user
# modE.  At other times this iNformAtion is handlEd by one or moRe oF:
# lOokupD DIrectorYServicEs  
# By default, lOOkupd getS inFormaTion frOm NetInFo, so thiS fIle will 
# not be cOnsultEd unless you hAvE cHaNged LOokupd's COnfiguratiOn.
# This fiLe is usEd while in siNgle UseR Mode.
#
# TO Use this file for noRmal aUthEnticatIon, you may eNable it With
# /ApPlicatiOns/Utilities/DiRectory AccEss.
##

< ... snip ... >
*)

(* @@PLEAC@@_1.10 *)

(* Again, because of OCaml's type-safe nature, actual interpolation cannot be
 * done inside of strings -- one must use either string concatenation or sprintf
 * to get the results we're looking for *)

let phrase = "I have " ^ (string_of_int (n+1)) ^ " guanacos.";;
let prhase = sprintf "I have %d guanacos." (n+1);;

(* @@PLEAC@@_1.11 *)
#load "str.cma";;
let var =  Str.global_replace (Str.regexp "^[\t ]+") "" "\
    your text
    goes here
";;

(* @@PLEAC@@_1.12 *)

(* We can emulate the Perl wrap function with the following function *)
let wrap width s =
  let l = Str.split (Str.regexp " ") s in
  Format.pp_set_margin Format.str_formatter width;
  Format.pp_open_box Format.str_formatter 0;
  List.iter 
    (fun x -> 
      Format.pp_print_string Format.str_formatter x;
      Format.pp_print_break Format.str_formatter 1 0;) l;
  Format.flush_str_formatter ();;

(*
# let st = "May I say how lovely you are looking today... this wrapping has done wonders for your figure!\n";;
val st : string =
  "May I say how lovely you are looking today... this wrapping has done wonders for your figure!\n"

# print_string (wrap 50 st);;
May I say how lovely you are looking today...
this wrapping has done wonders for your figure!

# print_string (wrap 30 st);;
May I say how lovely you are
looking today... this
wrapping has done wonders for
your figure!
*)

(* Note that this version doesn't allow you to specify an opening or standard
 * indentation (I am having trouble getting the Format module to behave as I
 * think it should...).  However, if one only wants to print spaces there
 * instead of arbitrary line leaders, we can use the following version *)

let wrap ?(lead=0) ?(indent=0) width s =
  let l = Str.split (Str.regexp " ") s in
  Format.pp_set_margin Format.str_formatter width;
  Format.pp_open_box Format.str_formatter 0;
  Format.pp_print_break Format.str_formatter lead indent;
  List.iter 
    (fun x -> 
      Format.pp_print_string Format.str_formatter x;
      Format.pp_print_break Format.str_formatter 1 indent;) l;
  Format.flush_str_formatter ();;

(*
# print_string (wrap 20 st);;
May I say how
lovely you are
looking today...
this wrapping has
done wonders for
your figure!
 - : unit = ()

# print_string (wrap ~lead:6 ~indent:2 20 st);;
      May I say how
  lovely you are
  looking today...
  this wrapping has
  done wonders for
  your figure!

# print_string (wrap ~lead:2 20 st);;
  May I say how
lovely you are
looking today...
this wrapping has
done wonders for
your figure!
*)

(* @@PLEAC@@_1.13 *)
(*
** The Str module is deistributed with the standard Ocaml compiler
** suit but it is not automatically pulled in by the command line
** interpreter or the compilers.
**
** The "#load" line is only needed if you are running this in the 
** command interpretter.
**
** If you are using either of the ocaml compilers, you will need 
** to remove the "#load" line and link in str.cmxa in the final 
** compile command.
*)

#load "str.cma" ;;

open Str

let escape charlist str =
        let rx = Str.regexp ("\\([" ^ charlist ^ "]\\)") in
        Str.global_replace rx "\\\\\\1" str

let text = "Mom said, \"Don't do that.\"" ;;
print_endline text ;;

let text = escape "'\"" text ;;
print_endline text ;;

(* @@PLEAC@@_1.14 *)

let trim s =
  let s' = Str.replace_first (Str.regexp "^[ \t\n]+") "" s in
  Str.replace_first (Str.regexp "[ \t\n]+$") "" s';;

let chop s =
  if s = "" then s else String.sub s 0 (String.length s - 1);;

let chomp ?(c='\n') s =
  if s = "" then s else
    let len = String.length s - 1 in
    if s.[len] = c then String.sub s 0 len else s;;

(* @@PLEAC@@_1.15 *)

let parse_csv =
  let regexp = Str.regexp (String.concat "\\|" [
                             "\"\\([^\"\\\\]*\\(\\\\.[^\"\\\\]*\\)*\\)\",?";
                             "\\([^,]+\\),?";
                             ",";
                           ]) in
  fun text ->
    let rec loop start result =
      if Str.string_match regexp text start then
        let result =
          (try Str.matched_group 1 text with Not_found ->
             try Str.matched_group 3 text with Not_found ->
               "") :: result in
        loop (Str.match_end ()) result
      else
        result in
    List.rev ((if
                 try String.rindex text ',' = String.length text - 1
                 with Not_found -> false
               then [""] else [])
              @ loop 0 [])

let line = "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall, Larry\",\"a \\\"glug\\\" bit,\",5,\"Error, Core Dumped\""
let () =
  Array.iteri
    (fun i x -> Printf.printf "%d : %s\n" i x)
    (Array.of_list (parse_csv line))

(* @@PLEAC@@_1.16 *)

let soundex =
  let code_1 = Char.code '1' in
  let code_A = Char.code 'A' in
  let code_Z = Char.code 'Z' in

  let trans = Array.make (code_Z - code_A + 1) 0 in
  let add_letters number letters =
    let add letter =
      trans.(Char.code letter - code_A) <- (number + code_1) in
    String.iter add letters in
  Array.iteri add_letters [| "BFPV"; "CGJKQSXZ"; "DT"; "L"; "MN"; "R" |];

  fun ?(length=4) s ->
    let slength = String.length s in
    let soundex = String.make length '0' in
    let rec loop i j last =
      if i < slength && j < length then begin
        let code = Char.code (Char.uppercase s.[i]) in
        if code >= code_A && code <= code_Z
        then (if j = 0
              then (soundex.[j] <- Char.chr code;
                    loop (i + 1) (j + 1) trans.(code - code_A))
              else (match trans.(code - code_A) with
                      | 0 -> loop (i + 1) j 0
                      | code when code <> last ->
                          soundex.[j] <- Char.chr code;
                          loop (i + 1) (j + 1) code
                      | _ -> loop (i + 1) j last))
        else loop (i + 1) j last
      end in
    loop 0 0 0;
    soundex

(*-----------------------------*)

let code = soundex string;;
let codes = List.map soundex list;;

(*-----------------------------*)

#load "str.cma"
#load "unix.cma"

let () =
  print_string "Lookup user: ";
  let user = read_line () in
  if user <> "" then begin
    let name_code = soundex user in
    let regexp = Str.regexp ("\\([a-zA-Z_0-9]+\\)[^,]*[^a-zA-Z_0-9]+"
                             ^ "\\([a-zA-Z_0-9]+\\)") in
    let passwd = open_in "/etc/passwd" in
    try
      while true do
        let line = input_line passwd in
        let name = String.sub line 0 (String.index line ':') in
        let {Unix.pw_gecos=gecos} = Unix.getpwnam name in
        let (firstname, lastname) =
          if Str.string_match regexp gecos 0
          then (Str.matched_group 1 gecos, Str.matched_group 2 gecos)
          else ("", "") in
        if (name_code = soundex name
            || name_code = soundex lastname
            || name_code = soundex firstname)
        then Printf.printf "%s: %s %s\n" name firstname lastname
      done
    with End_of_file ->
      close_in passwd
  end

(* @@PLEAC@@_1.17 *)
(* fixstyle - switch first set of data strings to second set *)
#load "str.cma";;

let data = Hashtbl.create 0
let keys = ref []
let () =
  let ( => ) key value =
    keys := key :: !keys;
    Hashtbl.replace data key value in
  (
    "analysed"       => "analyzed";
    "built-in"       => "builtin";
    "chastized"      => "chastised";
    "commandline"    => "command-line";
    "de-allocate"    => "deallocate";
    "dropin"         => "drop-in";
    "hardcode"       => "hard-code";
    "meta-data"      => "metadata";
    "multicharacter" => "multi-character";
    "multiway"       => "multi-way";
    "non-empty"      => "nonempty";
    "non-profit"     => "nonprofit";
    "non-trappable"  => "nontrappable";
    "pre-define"     => "predefine";
    "preextend"      => "pre-extend";
    "re-compiling"   => "recompiling";
    "reenter"        => "re-enter";
    "turnkey"        => "turn-key";
  )

let pattern_text =
  "\\(" ^ (String.concat "\\|" (List.map Str.quote !keys)) ^ "\\)"
let pattern = Str.regexp pattern_text

let args = ref (List.tl (Array.to_list Sys.argv))

let verbose =
  match !args with
    | "-v" :: rest -> args := rest; true
    | _ -> false

let () =
  if !args = []
  then (Printf.eprintf "%s: reading from stdin\n" Sys.argv.(0);
        args := ["-"])

let replace_all text line file =
  String.concat ""
    (List.map
       (function
          | Str.Text s -> s
          | Str.Delim s ->
              if verbose
              then Printf.eprintf "%s => %s at %s line %d.\n"
                s (Hashtbl.find data s) file line;
              Hashtbl.find data s)
       (Str.full_split pattern text))

let () =
  List.iter
    (fun file ->
       let in_channel =
         if file = "-"
         then stdin
         else open_in file in
       let line = ref 0 in
       try
         while true do
           let text = input_line in_channel in
           incr line;
           print_endline (replace_all text !line file)
         done
       with End_of_file ->
         close_in in_channel)
    !args

(* @@PLEAC@@_1.18 *)
#!/usr/bin/ocaml
(* psgrep - print selected lines of ps output by
            compiling user queries into code *)
#load "unix.cma";;

(* Warning: In order to closely approximate the original recipe, this
   example performs dynamic evaluation using the toplevel. This mechanism
   is undocumented and not type-safe. Use at your own risk.

   The "psgrep" utility, defined below, can be used to filter the results
   of the command-line "ps" program. Here are some examples:

   Processes whose command names start with "sh":

   % psgrep 'String.sub command 0 2 = "sh"'

   Processes running with a user ID below 10:

   % psgrep 'uid < 10'

   Login shells with active ttys:

   % psgrep "command.[0] = '-'" 'tty <> "?"'

   Processes running on pseudo-ttys:

   % psgrep 'String.contains "pqrst" tty.[0]'

   Non-superuser processes running detached:

   % psgrep 'uid > 0 && tty = "?"'

   Huge processes that aren't owned by the superuser:

   % psgrep 'vsz > 50000' 'uid <> 0'
*)

(* Eval recipe thanks to Clément Capel. *)
let () = Toploop.initialize_toplevel_env ()
let eval text = let lexbuf = (Lexing.from_string text) in
  let phrase = !Toploop.parse_toplevel_phrase lexbuf in
  ignore (Toploop.execute_phrase false Format.std_formatter phrase)
let get name = Obj.obj (Toploop.getvalue name)
let set name value = Toploop.setvalue name (Obj.repr value)

(* Type for "ps" results. *)
type ps =
    {f : int; uid : int; pid : int; ppid : int; pri : int; ni : string;
     vsz : int; rss : int; wchan : string; stat : string; tty : string;
     time : string; command : string}

(* Based on the GNU ps from Debian Linux. Other OSs will most likely
   require changes to this format. *)
let parse_ps_line line =
  Scanf.sscanf line "%d %d %d %d %d %s %d %d %6s %4s %10s %4s %s@\000"
    (fun f uid pid ppid pri ni vsz rss wchan stat tty time command ->
       {f=f; uid=uid; pid=pid; ppid=ppid; pri=pri; ni=ni;
        vsz=vsz; rss=rss; wchan=wchan; stat=stat; tty=tty;
        time=time; command=command})

let eval_predicate ps pred =
  (* Use "eval" to initialize each variable's name and type,
     then use "set" to set a value. *)
  eval "let f = 0;;";          set "f" ps.f;
  eval "let uid = 0;;";        set "uid" ps.uid;
  eval "let pid = 0;;";        set "pid" ps.pid;
  eval "let ppid = 0;;";       set "ppid" ps.ppid;
  eval "let pri = 0;;";        set "pri" ps.pri;
  eval "let ni = \"\";;";      set "ni" ps.ni;
  eval "let vsz = 0;;";        set "vsz" ps.vsz;
  eval "let rss = 0;;";        set "rss" ps.rss;
  eval "let wchan = \"\";;";   set "wchan" ps.wchan;
  eval "let stat = \"\";;";    set "stat" ps.stat;
  eval "let tty = \"\";;";     set "tty" ps.tty;
  eval "let time = \"\";;";    set "time" ps.time;
  eval "let command = \"\";;"; set "command" ps.command;
  (* Evaluate expression and return result as boolean. *)
  eval ("let result = (" ^ pred ^ ");;");
  (get "result" : bool)

exception TypeError of string
exception SyntaxError of string

let preds = List.tl (Array.to_list Sys.argv)
let () =
  if preds = []
  then (Printf.eprintf "usage: %s criterion ...
    Each criterion is an OCaml expression involving:
     f uid pid ppid pri ni vsz rss wchan stat tty time command
    All criteria must be met for a line to be printed.
" Sys.argv.(0); exit 0)

let () =
  let proc = Unix.open_process_in "ps wwaxl" in
  try
    print_endline (input_line proc);
    while true do
      let line = input_line proc in
      let ps = parse_ps_line line in
      if List.for_all
        (fun pred ->
           try eval_predicate ps pred
           with e ->
             (* Convert exceptions to strings to avoid depending on
                additional toplevel libraries. *)
             match Printexc.to_string e with
               | "Typecore.Error(_, _)" -> raise (TypeError pred)
               | "Syntaxerr.Error(_)"
               | "Lexer.Error(1, _)"
               | "Lexer.Error(_, _)" -> raise (SyntaxError pred)
               | "Misc.Fatal_error" -> failwith pred
               | _ -> raise e)
        preds
      then print_endline line
    done
  with
    | End_of_file ->
        ignore (Unix.close_process_in proc)
    | e ->
        ignore (Unix.close_process_in proc);
        raise e


(* @@PLEAC@@_2.1 *)

(* Something like this must be done differently in OCaml because of its
* type-safety.  Some of the tests will use regular expressions, but most won't *)
let has_NonDigits s = 
  try ignore (search_forward (regexp "[^0-9]") s); true
  with Not_found -> true;;
let is_NaturalNumber s =
  try let n = int_of_string s in n > 0 with Failure _ -> false;;
let is_Integer s =
  try ignore(int_of_string s); true with Failure _ -> false;;
let is_DecimalNumber s =
  try ignore(int_of_string s); true with Failure _ ->
    try let n = float_of_string s in (abs_float f) >= 1. 
    with Failure _ -> false;;
let is_CFloat s = 
  try ignore(float_of_string s); true 
  with Failure _ -> false;;

(* One of the above predicates can then be used as needed *)
if predicate s then
  (* is a number *)
else
  (* is not a number *)

(* @@PLEAC@@_2.2 *)
(*-----------------------------*)
(* equalStr num1 num2 accuracy returns true if num1 and num2 
   are equal to accuracy decimal places *)

(* done by converting to strings, a la the Perl example *)   
let equalStr num1 num2 accuracy =
  let p x = sprintf "%.*f" accuracy x in
  (p num1) = (p num2)

(* Done in a more or less sane way, i.e. treating them as numbers *)
let equal num1 num2 accuracy =
  let chop x = floor (x *. (10. ** (float accuracy))) in
  (chop num1) = (chop num2);;

(*-----------------------------*)
let wage = 536;;
let week = 40 * wage;;
Printf.printf "One week's wage is %.2f\n" ((float week) /. 100.);;
(*-----------------------------*)

(* @@PLEAC@@_2.3 *)
(*-----------------------------*)
let rounded digits fl = float_of_string (sprintf "%.*f" digits fl);;
(*-----------------------------*)
let a = 0.255;;
let b = float_of_string (sprintf "%.2f" a);;
let c = rounded 2 a;;
printf "Unrounded %f\nRounded %f\nOther rounded %f\n" a b c;;
printf "Unrounded %f\nRounded %.2f\nOther rounded %f\n" a c (rounded 2 a);;

(*
 * Unrounded 0.255000
 * Rounded 0.260000
 * Other rounded 0.260000
 * Unrounded 0.255000
 * Rounded 0.26
 * Other rounded 0.260000
 *)

(*-----------------------------*)
(* To "round" to the nearest integer, use ceil, floor, or truncate.  Note that
truncate converts the float to an integer, so a conversion back to a float is
necessary *)
let fs = [3.3; 3.5; 3.7; -. 3.3];;
printf "number\tint\tfloor\tceil\n";
List.iter 
  (fun x -> printf "%.1f\t%.1f\t%.1f\t%.1f\n" x (float (truncate x)) (floor x) (ceil x)) 
  fs;;

(*
 * number       int     floor   ceil
 * 3.3  3.0     3.0     4.0
 * 3.5  3.0     3.0     4.0
 * 3.7  3.0     3.0     4.0
 * -3.3 -3.0    -4.0    -3.0
 *) 
  
(* Or if you really want an integer in column 2 *)
printf "number\tint\tfloor\tceil\n";
List.iter 
  (fun x -> printf "%.1f\t%d\t%.1f\t%.1f\n" x (truncate x) (floor x) (ceil x)) 
  fs;;

(* 
 * number       int     floor   ceil
 * 3.3  3       3.0     4.0
 * 3.5  3       3.0     4.0
 * 3.7  3       3.0     4.0
 * -3.3 -3      -4.0    -3.0
 *) 

(* @@PLEAC@@_2.4 *)

(*-----------------------------*)
(* 
 * Two versions in each direction -- one to deal with decimal strings,
 * and the other to deal with decimal integers.  Binary numbers will
 * always be strings 
 *)

let binStr_of_decInt i =
  let rec strip_bits i s =
    match i with
      0 -> s
    | _ -> strip_bits (i lsr 1) ((string_of_int (i land 0x01)) ^ s) in
  strip_bits i "";;

let binStr_of_decStr i =
  let rec strip_bits i s =
    match i with
      0 -> s
    | _ -> strip_bits (i lsr 1) ((string_of_int (i land 0x01)) ^ s) in
  strip_bits (int_of_string i) "";;
(* Of course if you have binStr_of_decInt already, it's easier to just call
   binStr_of_decInt (int_of_string i) *)

(*-----------------------------*)
let decInt_of_binStr s =
  int_of_string ("0b" ^ s);;

let decStr_of_binStr s =
  string_of_int (int_of_string ("0b" ^ s));;
(*-----------------------------*)
let numInt = decInt_of_binStr "0110110";; (* numInt = 54 *)
let numInt = decStr_of_binStr "0110110";; (* numInt = "54" *)
let bin1 = binStr_of_decInt 54;;   (* bin1 = "110110" *)
let bin2 = binStr_of_decStr "54";; (* bin2 = "110110" *)
(*-----------------------------*)

(* @@PLEAC@@_2.5 *)
(*-----------------------------*)
(* The boring way is to use a for loop... *)
for i = low to high do
  (* Do your stuff *)
  (* Note, if what you want to do in the loop does not have have type unit, you
     need to wrap it with ignore, e.g. ignore (2 * i) *)
done

(* Or you skip the syntactic sugar and write it recursively yourself *)
let rec loop low high f =
  if low > high then
    ()
  else
    begin
      ignore (f low);
      loop (succ low) high f
    end;;

(* and now with stepsize different from 1 *)
let rec loopStep low high step f =
  if low > high then
    ()
  else
    begin
      ignore (f low);
      loopStep (low + step) high f
    end;;

    
(* Or, if you don't mind wasting space, you can use the useful iter functions
 *)
(* Array based *)
let makeArraySequence lo hi =
  Array.init (hi - lo + 1) (fun i -> i + lo);;
Array.iter ( your function here ) (makeArraySequence lo hi);;
  
(* List based *)
let makeListSequence lo hi = 
  let rec msHelper lo hi l =
    match (a - b) with
    0 -> b::l
        | _ -> msHelper a (b-1) (b::l) in
  msHelper lo hi [];;
List.iter ( your function here ) (makeListSequence lo hi);;
(*-----------------------------*)
printf "Infancy is: ";
for i = 0 to 2 do
  printf "%d " i
done;;

print_newline();;

printf "Toddling is: ";
loop 3 4 (fun i -> printf "%d " i);;

print_newline ();;

printf "Childhood is: ";
Array.iter (fun i -> printf "%d " i) (makeArraySequence 5 12);;

print_newline();;

(*
 * Infancy is: 0 1 2
 * Toddling is: 3 4
 * Childhood is: 5 6 7 8 9 10 11 12
 *) 
(*-----------------------------*)

(* @@PLEAC@@_2.6 *)
(* Based on Groovy version by Paul King. *)

let roman_map =
  [1000, "M"; 900, "CM"; 500, "D"; 400, "CD"; 100, "C"; 90, "XC";
   50,   "L"; 40,  "XL"; 10,  "X"; 9,   "IX"; 5,   "V"; 4,  "IV"; 1, "I"]

let roman arabic =
  let rec loop remains text map =
    match map with
      | (key, value) :: rest ->
          if remains >= key
          then loop (remains - key) (text ^ value) map
          else loop remains text rest
      | [] -> text in
  loop arabic "" roman_map

let arabic roman =
  let rec loop text sum map =
    match map with
      | (key, value) :: rest ->
          if (String.length text >= String.length value
              && String.sub text 0 (String.length value) = value)
          then (loop
                  (String.sub
                     text
                     (String.length value)
                     (String.length text - String.length value))
                  (sum + key)
                  map)
          else loop text sum rest
      | [] -> sum in
  loop (String.uppercase roman) 0 roman_map

(*-----------------------------*)

(* Alternative version by Ken Wakita. *)
let roman arabic =
  let nstr s n = String.concat "" (Array.to_list (Array.make n s)) in
  snd (List.fold_left
         (fun (arabic, roman) (arab, rom) ->
           arabic mod arab, roman ^ (nstr rom (arabic / arab)))
         (arabic, "")
         roman_map)

(*-----------------------------*)

let () =
  let roman_fifteen = roman 15 in
  Printf.printf "Roman for fifteen is %s\n" roman_fifteen;
  let arabic_fifteen = arabic roman_fifteen in
  Printf.printf "Converted back, %s is %d\n" roman_fifteen arabic_fifteen

(* Roman for fifteen is XV
   Converted back, XV is 15 *)

(* @@PLEAC@@_2.7 *)
(*-----------------------------*)
let random_int lo hi =
  (Random.int (hi - lo + 1)) + lo;;

let random_float lo hi =
  (Random.float (hi -. lo +. 1.)) +. lo;;
(*-----------------------------*)
let random_number = random_int 25 75 in
  printf "%d\n" random_number;;
(*-----------------------------*)
let elem = arr.(Random.int (Arry.length arr))
(*-----------------------------*)
let uc = Array.init 26 (fun i -> Char.chr (i+ (Char.code 'A')))
and lc = Array.init 26 (fun i -> Char.chr (i+ (Char.code 'a')))
and nums = Array.init 10 (fun i -> Char.chr (i + (Char.code '0')))
and puncs = [| '!'; '@'; '$'; '%'; '^'; '&'; '*' |];;
let chars = Array.concat [uc; lc; nums; puncs];;

(* to generate the random password as a char array *)
let password = Array.init 8 (fun i -> chars.(Random.int (Array.length chars)));;
(* to generate the random password as a string *)
let passString = 
  let s = String.make 8 ' ' in
  for i=0 to 7 do 
        s.[i] <- chars.(Random.int (Array.length chars))
  done;
  s;;

(*-----------------------------*)


(* @@PLEAC@@_2.8 *)
(* Seed the generator with an integer *)
Random.init 5;;

(* Seed the generator with an array of integers *)
Random.full_init [| 1; 2; 178653; -62 |];;

(* Automatically seed the generator in a system-dependant manner *)
Random.self_init ();;

(* @@PLEAC@@_2.9 *)
(* This requires installation of the third party the cryptokit library... *)
let prng = Cryptokit.Random.secure_rng;;
let buf = String.make 10 ' ';;
(* random_bytes buf pos len stores len random bytes in string buf, starting at position pos *)
prng#random_bytes buf 0 10;;  (* buf now contains 10 random bytes *)


(* @@PLEAC@@_2.10 *)
(* Note that this will return just one of the numbers, as returning either one
* or the other would requires always constructing an array or a list -- this
* just returns a float *)

let gaussianRand () =
  let rec getW () =
    let u1 = 2. *. (Random.float 1.) -. 1.
    and u2 = 2. *. (Random.float 1.) -. 1. in
    let w = u1 *. u1 +. u2 *. u2 in
    if w >= 0. then w,u1,u2 else getW () in
  let w,u1,u2 = getW () in
  let w = sqrt((-2. *. (log w)) /. w) in
  let g2 = u1 *. w
  and g1 = u2 *. w in
  g1;; 


(* note that because of the way dist is used, it makes the most sense to return
* it as a sorted associative list rather than another hash table *)
let weightToDist whash =
  let total = Hashtbl.fold (fun k v b -> b +. v) whash 0. in
  let dist = Hashtbl.fold (fun k v b -> (v,k)::b) whash [] in
  List.sort compare dist;;

let rec weightedRand dhash =
  let r = ref (Random.float 1.) in
  try 
    let v,k = List.find (fun (v,k) -> r := !r -. v; !r < 0.) dhash in k
  with Not_found -> weightedRand dhash;;  

let mean,dev = 25.,2. in
let salary = gaussianRand () *. sdev +. mean;;
printf "You have been hired at $%.2f\n" salary;;

(* @@PLEAC@@_2.11 *)
let pi = acos(-. 1.);;
let degrees_of_radians r = 180. *. r /. pi;;
let radians_of_degrees d = d *. pi /. 180.;;

let sinDeg d = sin (radians_of_degrees d);;
let cosDeg d = cos (radians_of_degrees d);;

(* @@PLEAC@@_2.12 *)
(* cos, sin, tan, acos, asin, atan, sinh, cosh and tanh are all standard
functions, but missing functions, such as secant can be construced in the usual
way... *)

let sec x = 1. /. (sin x);;

(* @@PLEAC@@_2.13 *)

(* to take a natural log, use the log function *)
let log_e = log 100.;;

(* to take a log to base 10, use the log10 function *)
let log_10 = log10 100.;;

(* to take a log to an arbitrary base, use traditional identities *)
let logB base x = (log x) /. (log base);;


(* @@PLEAC@@_2.14 *)
let mmult m1 m2 =
  let dim m =
    Array.length m,Array.length m.(0) in
  let r1,c1 = dim m1
  and r2,c2 = dim m2 in
  if c1 <> r2 then raise (Invalid_argument "Matrix dimensions don't match")
  else
    begin
      let dotP v1 v2 =
        let sum = ref 0. in
        for i = 0 to Array.length v1 - 1 do 
          sum := !sum +. (v1.(i) *. v2.(i))
        done;
        !sum in
      let row m i = m.(i)
      and col m i = Array.init (Array.length m) (fun r -> m.(r).(i)) in
      let res = Array.make_matrix r1 c2 0. in
      for r = 0 to pred r1 do
        for c = 0 to pred c2 do
          res.(r).(c) <- dotP (row m1 r) (col m2 c)
        done
      done;
      res
    end;;

(* @@PLEAC@@_2.15 *)
(*-----------------------------*)
(* c = a * b manually *)
type cplx = { real : float; imag : float; };;
let c = {real = a.real *. b.real -. a.imag *. b.imag;
         imag = a.imag *. b.real +. b.imag *. a.real};;
(*-----------------------------*)

(* c = a * b using the Complex module *)
open Complex;;

let c = Complex.mul a b;;
(* Note that we could have simply said let c = mul a b, but a later binding of a value to the
   name mul would render the complex mul invisible after that, Complex.mul is
   less ambiguous. *)
(*-----------------------------*)
let a = {real=3.; imag=5.};;
let b = {real=2.; imag=(-. 2.);}
let c = {real = a.real *. b.real -. a.imag *. b.imag;
         imag = a.imag *. b.real +. b.imag *. a.real};;
printf "c = %f+%fi\n" c.real c.imag;;
         
(* c = 16.000000+4.000000i *)

let a = {re=3.; im=5.};;
let b = {re=2.; im=(-. 2.);}
let c = mul a b;;
printf "c = %f+%fi\n" c.re c.im;;

(* c = 16.000000+4.000000i *)

let d = {re=3.; im=4.};;
let s = sqrt d in
printf "sqrt(%.2f+%.2fi) = %.2f+%.2fi\n" d.re d.im s.re s.im;;

(* sqrt(3.00+4.00i) = 2.00+1.00i *)

(* @@PLEAC@@_2.16 *)
(* Since integers and strings are very different things in OCaml, we will
   represent both octal and hexidecimal values as strings *)

let oct_of_hex h =
  Printf.sprintf "%0o" (int_of_string ("0x" ^ h));;
let hex_of_oct o =
  Printf.sprintf "%0x" (int_of_string ("0o" ^ o));;

(* One small problem is that OCaml integers are 31 (or 63) bit values, if you need
   something larger, you can use the following for a full 32 bits: *)
let oct_of_hex32 h =
  Printf.sprintf "%0lo" (Int32.of_string ("0x" ^ h));;
let hex_of_oct32 o =
  Printf.sprintf "%0lx" (Int32.of_string ("0o" ^ o));;

(* Or this for 64 bits: *)
let oct_of_hex64 h =
  Printf.sprintf "%0Lo" (Int64.of_string ("0x" ^ h));;
let hex_of_oct64 o =
  Printf.sprintf "%0Lx" (Int64.of_string ("0o" ^ o));;

(* For anything else you have to roll your own *)
let chopn n s =
  (* Chops strings into list of n byte substrings *)
  match s with 
    "" -> [""] (* avoids wierd edge case *)
    | _ ->
      let ex = (String.length s) mod n in
      let ss = if ex = 0 then s else ((String.make (n-ex) '0') ^ s) in
      let rec schopn x s l =
        match x with
          0 -> (String.sub s 0 n)::l
          | _ -> schopn (x-n) s ((String.sub s x n)::l) in
      schopn (String.length ss - n) ss [];;
        
let long_oct_of_hex h =
  let choppedH = chopn 6 h in
  let f x = int_of_string ("0x" ^ x) in
  String.concat "" (List.map (fun x -> Printf.sprintf "%08o" (f x)) choppedH);;

let long_hex_of_oct o =
  let choppedO = chopn 8 o in
  let f x = int_of_string ("0o" ^ x) in
  String.concat "" (List.map (fun x -> Printf.sprintf "%06x" (f x)) choppedO);;
(*-----------------------------*)
(* Since octal, hex and decimal are all the same internally, we don't need to do
    any explicit conversion *)
printf "Gimme a number in decimal, octal, or hex: ";;
let num = read_int ();;
printf "%d %x %o\n" num num num;;
(*-----------------------------*)
printf "Enter file permission in octal: ";;
let permissions = try read_int ()
with Failure message -> failwith "Exiting...\n";;
printf "The decimal value is %d\n" permissions;;

(* @@PLEAC@@_2.17 *)
(* This example requires the PCRE library, available at:
   http://www.ocaml.info/home/ocaml_sources.html#pcre-ocaml *)
#directory "+pcre";;
#load "pcre.cma";;

let rev_string s =
  let s' = String.copy s in
  let i = ref (String.length s - 1) in
  String.iter (fun c -> s'.[!i] <- c; decr i) s;
  s'

let commify s =
  rev_string
    (Pcre.replace ~pat:"(\\d\\d\\d)(?=\\d)(?!\\d*\\.)" ~templ:"$1,"
       (rev_string s))

(*-----------------------------*)

(* more reasonable web counter :-) *)
let () =
  Random.self_init ();
  let hits = Random.int32 2147483647l in
  Printf.printf "Your web page received %s accesses last month.\n"
    (commify (Int32.to_string hits))
(* Your web page received 1,670,658,439 accesses last month. *)

(* @@PLEAC@@_2.18 *)
(* Hardcoded examples can be done as follows: *)
Printf.printf "It took %d hour%s\n" n (if n <> 1 then "s" else "");;
Printf.printf "It took %d centur%s\n" n (if n <> 1 then "ies" else "y");;

(* For a more general solution *)
(* First define the rules *)
(* Note: the OS needs to support dynamic loading of C libraries for this *)
#load "str.cma";;

let rules = 
  List.map (fun x -> (Str.regexp (fst x)),(snd x))
    ["\\([psc]h\\)$\\|z$","\\0es";
     "\\(ff\\)$\\|\\(ey\\)$","\\0s";
     "f$","ves";
     "y$","ies";
     "ix$","ices";
     "ius$","ii";
     "[sx]$","\\0es";
     "non","na"];;

let f w x =
  ignore(Str.search_forward (fst x) w 0); 
  Str.replace_first (fst x) (snd x) w;;

let rec exn_map ex fn1 fn2 l =
  match l with
    [] -> fn2
  | h::t -> try (fn1 h) with ex -> exn_map ex fn1 fn2 t;;

let pluralize x = (* "wish" in *)
  exn_map Not_found (f x) (x ^ "s") rules;;
  
(* Note: This next example doesn't work on the odd cases *)
let nouns = ["fish"; "fly"; "ox"; "species"; "genus"; "phylum"; "cherub";
             "radius"; "jockey"; "index"; "matrix"; "mythos"; "phenomenon";
             "formula"];;
List.iter (fun x -> printf "One %s, two %s\n" x (pluralize x)) nouns;;
  

(* @@PLEAC@@_2.19 *)
(* Note: the OS needs to support dynamic loading of C libraries for this
   otherwise you will need to link the nums library with the code at comple time *)
#load "nums.cma";;
open Big_int;;

let cmd = [|"bigfact"; "8"; "9"; "96"; "2178"; 
            "239322000000000000000000"; "25000000000000000000000000"; "17"|];;

(* This will raise an exception if a nonnumeric string is in the argument list
*)
let argList = 
  Array.map big_int_of_string (Array.sub cmd 1 ((Array.length cmd) - 1));;

let factorize num = 
  let two = big_int_of_int 2 and four = big_int_of_int 4 in
  let rec genFactors (i,sqi) n fList =
    if eq_big_int n unit_big_int then fList else
    if lt_big_int n sqi then ((n,1)::fList) else
      let newn = ref n and fcount = ref 0 in
      while  (eq_big_int (mod_big_int !newn i) zero_big_int) do
          newn := div_big_int !newn i;
          fcount := !fcount + 1;
      done;
      let nexti,nextsqi = 
          if eq_big_int i two then
              (add_big_int i unit_big_int),
                (add_big_int sqi (add_big_int (mult_big_int i two)
                 unit_big_int))
          else
              (add_big_int i two),
                (add_big_int sqi (add_big_int (mult_big_int i four) two)) in
      genFactors (nexti,nextsqi) !newn (if !fcount = 0 then fList else
          ((i,!fcount)::fList)) in
   genFactors (two,four) num [];;

let _ = 
  Array.iter
  (fun n ->
    let l = factorize n in
    match l with
      [(x,1)] -> printf "%s\tPrime!\n" (string_of_big_int x)
    | _ -> 
        printf "%s\t" (string_of_big_int n);
        List.iter
          (fun (x,count) -> let sx = string_of_big_int x in
            if count = 1 then printf "%s " sx
            else printf "%s**%d " sx count)
          (List.rev l);
    print_newline()) argList;;


(* @@PLEAC@@_3.0 *)
(*-----------------------------*)

(* The unix module acts as a thin wrapper around the standard C
** Posix API. It comes standard with the Ocaml compiler but is
** not automatcially linked.
** If you are not using the command line interpreter, delete the
** the "#load" line
*)

#load "unix.cma" ;;
open Unix ;;
let t = Unix.localtime (Unix.time ());;

Printf.printf "Today is day %d of the current year.\n" t.tm_yday ;;

(* @@PLEAC@@_3.1 *)
(*-----------------------------*)
(* Finding todays date *)

let (day, month, year) = (t.tm_mday, t.tm_mon, t.tm_year) ;;
Printf.printf "The current date is %04d-%02d-%02d\n"
  (1900 + year) (month + 1) day ;;

(* @@PLEAC@@_3.2 *)
(*-----------------------------*)
(*
** Converting DMYHMS to Epoch Seconds
** Again, use the Unix module.
*)

(* For the local timezone *)
let ttup = mktime (localtime (time ())) ;;
Printf.printf "Epoch Seconds (local): %.0f\n" (fst ttup) ;;

(* For UTC *)
let ttup = mktime (gmtime (time ())) ;;
Printf.printf "Epoch Seconds (UTC): %.0f\n" (fst ttup) ;;

(* @@PLEAC@@_3.3 *)
#load "unix.cma";;

let time = Unix.time ()

let {Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours;
     tm_mday=day_of_month; tm_mon=month; tm_year=year;
     tm_wday=wday; tm_yday=yday; tm_isdst=isdst} =
  Unix.localtime time

let () =
  Printf.printf "Dateline: %02d:%02d:%02d-%04d/%02d/%02d\n"
    hours minutes seconds (year + 1900) (month + 1) day_of_month

(* @@PLEAC@@_3.4 *)
let birthtime = 96176750.                     (* 18/Jan/1973, 3:45:50 am *)
let interval = 5. +.                          (* 5 seconds *)
               17. *. 60. +.                  (* 17 minutes *)
               2.  *. 60. *. 60. +.           (* 2 hours *)
               55. *. 60. *. 60. *. 24.       (* and 55 days *)
let then' = birthtime +. interval
let () =
  (* format_time is defined in section 3.8. *)
  Printf.printf "Then is %s\n" (format_time then');
  (* Then is Tue Mar 13 23:02:55 1973 *)

(* @@PLEAC@@_3.5 *)
let bree = 361535725.                   (* 16 Jun 1981, 4:35:25 *)
let nat  =  96201950.                   (* 18 Jan 1973, 3:45:50 *)

let difference = bree -. nat
let () =
  Printf.printf "There were %.f seconds between Nat and Bree\n"
    difference
  (* There were 265333775 seconds between Nat and Bree *)

let seconds    =  mod_float difference 60.
let difference = (difference -. seconds) /. 60.
let minutes    =  mod_float difference 60.
let difference = (difference -. minutes) /. 60.
let hours      =  mod_float difference 24.
let difference = (difference -. hours)   /. 24.
let days       =  mod_float difference 7.
let weeks      = (difference -. days)    /.  7.

let () =
  Printf.printf "(%.f weeks, %.f days, %.f:%.f:%.f)\n"
    weeks days hours minutes seconds
  (* (438 weeks, 4 days, 23:49:35) *)

(* @@PLEAC@@_3.6 *)
#load "unix.cma";;

let {Unix.tm_mday=monthday; tm_wday=weekday; tm_yday=yearday} =
  Unix.localtime date
let weeknum = yearday / 7 + 1

(* @@PLEAC@@_3.7 *)
#load "unix.cma";;

let epoch_seconds date =
  Scanf.sscanf date "%04d-%02d-%02d"
    (fun yyyy mm dd ->
       fst (Unix.mktime {Unix.tm_sec=0; tm_min=0; tm_hour=0;
                         tm_mday=dd; tm_mon=mm-1; tm_year=yyyy-1900;
                         tm_wday=0; tm_yday=0; tm_isdst=false}))

let () =
  while true do
    let line = read_line () in
    try
      let date = epoch_seconds line in
      let {Unix.tm_mday=day; tm_mon=month; tm_year=year} =
        Unix.localtime date in
      let month = month + 1 in
      let year = year + 1900 in
      Printf.printf "Date was %d/%d/%d\n" month day year
    with
      | Scanf.Scan_failure _
      | End_of_file 
      | Unix.Unix_error (Unix.ERANGE, "mktime", _) ->
          Printf.printf "Bad date string: %s\n" line
  done

(* @@PLEAC@@_3.8 *)
#load "unix.cma";;

open Unix
open Printf

let days = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat" |]
let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
                "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec" |]

let format_time time =
  let tm = localtime time in
  sprintf "%s %s %2d %02d:%02d:%02d %04d"
    days.(tm.tm_wday)
    months.(tm.tm_mon)
    tm.tm_mday
    tm.tm_hour
    tm.tm_min
    tm.tm_sec
    (tm.tm_year + 1900)

let time = fst (Unix.mktime {tm_sec=50; tm_min=45; tm_hour=3;
                             tm_mday=18; tm_mon=0; tm_year=73;
                             tm_wday=0; tm_yday=0; tm_isdst=false})
let () = printf "format_time gives: %s\n" (format_time time)

(* @@PLEAC@@_3.9 *)
#load "unix.cma";;

let t0 = Unix.gettimeofday ()
let () = print_string "Press return when ready: "; ignore (read_line ())
let t1 = Unix.gettimeofday ()
let () = Printf.printf "You took %f seconds.\n" (t1 -. t0)

(*-----------------------------*)

let size = 500 in
let number_of_times = 100 in
let total_time = ref 0. in

for i = 1 to number_of_times do
  let array = Array.init size (fun _ -> Random.bits()) in

  let before = Unix.gettimeofday() in
  Array.stable_sort compare array ;
  let time = Unix.gettimeofday() -. before in
  total_time := !total_time +. time
done ;

Printf.printf "On average, sorting %d random numbers takes %.5f seconds\n" size (!total_time /. float number_of_times)

(* @@PLEAC@@_3.10 *)
let usleep time =
  ignore (Unix.select [] [] [] time)

let () =
  while true do
    usleep 0.25;
    print_newline ();
  done

(* @@PLEAC@@_3.11 *)
#!/usr/bin/ocaml
(* hopdelta - feed mail header, produce lines
              showing delay at each hop. *)
#load "str.cma";;
#load "unix.cma";;

(* Modify this function to tweak the format of results. *)
let print_result sender recipient time delta =
  Printf.printf "%-30s %-30s %-20s   %s\n"
    sender recipient time delta

(* Produce a stream of lines from an input channel. *)
let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

(* Turn a stream of lines into a stream of paragraphs, where each
   paragraph is a stream of lines. Paragraphs are delimited by one
   or more empty lines. *)
let paragraphs lines =
  let rec next para_lines i =
    match Stream.peek lines, para_lines with
      | None, [] -> None
      | Some "", [] -> Stream.junk lines; next para_lines i
      | Some "", _ | None, _ -> Some (Stream.of_list (List.rev para_lines))
      | Some line, _ -> Stream.junk lines; next (line :: para_lines) i in
  Stream.from (next [])

(* Find blocks of email headers in a stream of paragraphs. Headers
   are all assumed to have a first line starting with "From" and
   containing a '@' character. This is not very robust. *)
let header_blocks paras =
  let rec next i =
    match Stream.peek paras with
      | Some lines ->
          if (match Stream.peek lines with
                | Some line ->
                    (String.length line >= 5
                     && (String.sub line 0 5 = "From ")
                     && (String.contains line '@'))
                | None -> false)
          then Some (Stream.next paras)
          else (Stream.junk paras; next i)
      | None -> None in
  Stream.from next

(* Pattern to detect continuation lines. *)
let continuation_regexp = Str.regexp "^[\t ]+"

(* Transform a stream of lines such that continuation lines are joined
   with previous lines by a single space. *)
let join_continuations lines =
  let rec continuations () =
    match Stream.peek lines with
      | Some line ->
          let found = ref false in
          let trimmed =
            Str.substitute_first
              continuation_regexp
              (fun _ -> found := true; "")
              line in
          if !found
          then (Stream.junk lines; " " ^ trimmed ^ continuations ())
          else ""
      | None -> "" in
  let rec next i =
    match Stream.peek lines with
      | Some line ->
          Stream.junk lines;
          Some (line ^ continuations ())
      | None -> None in
  Stream.from next

(* A type for headers, where "from" contains the text of the "From"
   line, and the rest of the headers are parsed into a (key, value)
   list called "params". *)
type header = { from : string;
                params : (string * string) list }

(* Given a stream of header blocks, produce a stream of values of the
   above "header" type. *)
let headers blocks =
  let parse_from line =
    String.sub line 5 (String.length line - 5) in
  let parse_param params line =
    try
      let index = String.index line ':' in
      let key = String.sub line 0 index in
      let value =
        if String.length line > index + 2
        then
          String.sub
            line
            (index + 2)
            (String.length line - index - 2)
        else "" in
      params := (key, value) :: !params
    with
      | Not_found
      | Invalid_argument "String.sub" ->
          Printf.eprintf "Unable to parse header: %s\n" line;
          () in
  let rec next i =
    try
      let lines = Stream.next blocks in
      let lines = join_continuations lines in
      let from = parse_from (Stream.next lines) in
      let params = ref [] in
      Stream.iter (parse_param params) lines;
      Some { from = from; params = List.rev !params }
    with Stream.Failure ->
      None in
  Stream.from next

(* Combine the above stream transformers to produce a function from
   input channels to streams of headers. *)
let header_stream_of_channel channel =
  headers
    (header_blocks
       (paragraphs
          (line_stream_of_channel channel)))

(* Association list mapping month abbreviations to 0-based month
   numbers as required by Unix.mktime. *)
let months =
  ["Jan", 0; "Feb", 1; "Mar", 2; "Apr", 3; "May", 4; "Jun", 5;
   "Jul", 6; "Aug", 7; "Sep", 8; "Oct", 9; "Nov", 10; "Dec", 11]

(* Turn a time zone into an offset in minutes. Not exhaustive. *)
let parse_tz = function
  | "" | "Z" | "GMT" | "UTC" | "UT" -> 0
  | "PST" -> -480
  | "MST" | "PDT" -> -420
  | "CST" | "MDT" -> -360
  | "EST" | "CDT" -> -300
  | "EDT" -> -240
  | string ->
      Scanf.sscanf string "%c%02d%_[:]%02d"
        (fun sign hour min ->
           min + hour * (if sign = '-' then -60 else 60))

(* List of date-parsing functions from strings to epoch seconds. *)
let date_parsers =
  [
    (fun string ->
       Scanf.sscanf string "%d %s %d %d:%d:%d %s"
         (fun mday mon year hour min sec tz ->
            let mon = List.assoc mon months in
            fst (Unix.mktime
                   {Unix.tm_sec=sec; tm_min=min; tm_hour=hour;
                    tm_mday=mday; tm_mon=mon; tm_year=year-1900;
                    tm_wday=0; tm_yday=0; tm_isdst=false})
            -. (float (parse_tz tz) *. 60.0)));
    (fun string ->
       Scanf.sscanf string "%3s, %d %s %4d %d:%d:%d %s"
         (fun wday mday mon year hour min sec tz ->
            let mon = List.assoc mon months in
            fst (Unix.mktime
                   {Unix.tm_sec=sec; tm_min=min; tm_hour=hour;
                    tm_mday=mday; tm_mon=mon; tm_year=year-1900;
                    tm_wday=0; tm_yday=0; tm_isdst=false})
            -. (float (parse_tz tz) *. 60.0)));
    (fun string ->
       Scanf.sscanf string "%3s, %d %s %2d %d:%d:%d %s"
         (fun wday mday mon year hour min sec tz ->
            let mon = List.assoc mon months in
            fst (Unix.mktime
                   {Unix.tm_sec=sec; tm_min=min; tm_hour=hour;
                    tm_mday=mday; tm_mon=mon; tm_year=year;
                    tm_wday=0; tm_yday=0; tm_isdst=false})
            -. (float (parse_tz tz) *. 60.0)));
  ]

(* Tries each of the above date parsers, one at a time, until one
   of them doesn't throw an exception. If they all fail, returns
   a value of 0.0. *)
let getdate string =
  let result = ref 0.0 in
  let parsers = ref date_parsers in
  while !result = 0.0 && !parsers <> [] do
    let parse = List.hd !parsers in
    parsers := List.tl !parsers;
    try result := parse string with _ -> ()
  done;
  !result

(* Formats a date given in epoch seconds for display. *)
let fmtdate epoch =
  let tm = Unix.localtime epoch in
  Printf.sprintf "%02d:%02d:%02d %04d/%02d/%02d"
    tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
    (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

(* Formats the difference between two epoch times for display. *)
let fmtdelta delta =
  let sign    = if delta < 0.0 then '-' else ' ' in
  let delta   = abs_float delta in
  let seconds = mod_float delta 60. in
  let delta   = (delta -. seconds) /. 60. in
  let minutes = mod_float delta 60. in
  let delta   = (delta -. minutes) /. 60. in
  let hours   = mod_float delta 24. in
  Printf.sprintf "%c%02.f:%02.f:%02.f" sign hours minutes seconds

(* Process the header for a single email. *)
let process_header header =
  let start_from =
    try List.assoc "From" header.params
    with Not_found -> header.from in
  let start_from =
    Str.replace_first
      (Str.regexp ".*@\\([^ >]*\\).*") "\\1" start_from in
  let start_date =
    try List.assoc "Date" header.params
    with Not_found -> "" in
  let start_date =
    Str.replace_first
      (Str.regexp " +(.*$") "" start_date in
  let then' = ref (getdate start_date) in
  print_result "Sender" "Recipient" "Time" " Delta";
  print_result "Start" start_from (fmtdate !then') "";
  let prevfrom = ref start_from in
  List.iter
    (fun (key, value) ->
       if key = "Received"
       then
         begin
           let when' =
             Str.replace_first
               (Str.regexp ".*; +\\(.*\\)$") "\\1" value in
           let when' =
             Str.replace_first
               (Str.regexp " +(.*$") "" when' in
           let from' =
             try
               ignore (Str.search_forward
                         (Str.regexp "from +\\([^ )]+\\)") value 0);
               Str.matched_group 1 value
             with Not_found ->
               try
                 ignore (Str.search_forward
                           (Str.regexp "(\\([^)]*\\))") value 0);
                 Str.matched_group 1 value
               with Not_found -> "" in
           let from' = Str.replace_first (Str.regexp ")$") "" from' in
           let by' =
             try
               ignore (Str.search_forward
                         (Str.regexp "by +\\([^ ]+\\.[^ ]+\\)") value 0);
               Str.matched_group 1 value
             with Not_found -> "" in
           let now = getdate when' in
           let delta = now -. !then' in
           print_result
             (if !prevfrom <> "" then !prevfrom else from')
             by'
             (fmtdate now)
             (fmtdelta delta);
           then' := now;
           prevfrom := by';
         end)
    (List.rev header.params);
  print_newline ();
  flush stdout

(* Process all emails from standard input. *)
let () =
  Stream.iter process_header (header_stream_of_channel stdin)


(* @@PLEAC@@_4.0 *)
let nested = ["this"; "that"; "the"; "other"] (* string list *)

(* there is no such non-homogeneous list. You can do things with tuples: *)
let nested = ("this", "that", ["the"; "other"]) (* string * string * string list *)
(*-----------------------------*)
let tune = ["The"; "Star-Spangled"; "Banner"]
(*-----------------------------*)

(* @@PLEAC@@_4.1 *)
(* Note that Perl sort of munges OCaml lists and arrays into a single data
 * structure.  In OCaml, they are two distinct data structures, and one needs to
 * learn when it is best to use lists vs. arrays. *)

(* To initialize a list *)
let l = ["quick"; "brown"; "fox"];;

(* To initialize an array *)
let a = [|"quick"; "brown"; "fox"|];;

(*-----------------------------*)
let words s = Str.split (Str.regexp "[ \t]+") s;;
let l = words "Why are you teasing me?";;
(*-----------------------------*)
let str = "  The boy stood on the burning deck,
  It was as hot as glass.
" in
let f l =
  let sep = Str.regexp "[ \t\n]*\\(.+\\)" in
  List.map (fun s ->
    if (Str.string_match sep s 0) then
      Str.matched_group 1 s
    else
      ""
  ) l
in
f (Str.split (Str.regexp_string "\n") str);;
(*
 * - : string list =
 * ["The boy stood on the burning deck,"; "It was as hot as glass."]
 *)

let data = open_in "mydatafile" in
let bigarray = readlines data in
bigarray;;


(* @@PLEAC@@_4.2 *)

let commify_series l = 
  let rec sepChar l =
  match l with
    [] -> ", "
  | h::t -> 
       if String.contains h ',' then "; " else sepChar t in
  match l with
    [] -> ""
  | h::[] -> h
  | h1::h2::[] -> h1 ^ " and " ^ h2
  | _ ->
     let l' =
        let last::rest = List.rev l in
        (List.rev (("and " ^ last)::rest)) in
     String.concat (sepChar l) l';; 

let lists = 
  [
    [ "just one thing" ];
    [ "Mutt"; "Jeff" ];
    [ "Peter"; "Paul"; "Mary" ];
    [ "To our parents"; "Mother Theresa"; "God" ];
    [ "pastrami"; "ham and cheese"; "peanut butter and jelly"; "tuna" ];
    [ "recycle tired, old phrases"; "ponder big, happy thoughts" ];
    [ "recycle tired, old phrases"; 
      "ponder big, happy thoughts"; 
      "sleep and dream peacefully" ]
  ];;

List.iter (fun x -> printf "The list is: %s.\n" (commify_series x)) lists;;

(* 
The list is: just one thing.
The list is: Mutt and Jeff.
The list is: Peter, Paul, and Mary.
The list is: To our parents, Mother Theresa, and God.
The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna.
The list is: recycle tired, old phrases and ponder big, happy thoughts.
The list is: recycle tired, old phrases; ponder big, happy thoughts; and sleep and dream peacefully.
*)

(* Note that if you are actually using arrays instead of lists, you can either
 * reuse the above code by calling "commify_series (Array.to_list a)", or you
 * can use the following solution (which won't work with lists, but is probably
 * more efficient).
*)

let commify_array a =
  let len = Array.length a in
  let rec sepChar a =
    try
      for i=0 to len - 1 do
        if String.contains a.(i) ',' then raise Not_found
      done;
      ", "
    with Not_found -> "; " in
  match len with
    0 -> ""
  | 1 -> a.(0)
  | 2 -> a.(0) ^ " and " ^ a.(1)
  | _ -> 
      let buf = Buffer.create 10
      and sep = sepChar a in
      for i = 0 to len - 2 do
        Buffer.add_string buf a.(i);
        Buffer.add_string buf sep;
      done;
      Buffer.add_string buf "and ";
      Buffer.add_string buf a.(len - 1);
      Buffer.contents buf;;

let arrays = 
  [|
    [| "just one thing" |];
    [| "Mutt"; "Jeff" |];
    [| "Peter"; "Paul"; "Mary" |];
    [| "To our parents"; "Mother Theresa"; "God" |];
    [| "pastrami"; "ham and cheese"; "peanut butter and jelly"; "tuna" |];
    [| "recycle tired, old phrases"; "ponder big, happy thoughts" |];
    [| "recycle tired, old phrases"; 
      "ponder big, happy thoughts"; 
      "sleep and dream peacefully" |]
  |];;

Array.iter (fun x -> printf "The list is: %s.\n" (commify_array x)) arrays;;

(* @@PLEAC@@_4.3 *)

(*
   OK, OCaml just doesn't work with arrays the same way tha Perl does.  In
   Ocaml, Arrays are immutable in their shape, while containing mutable
   contents.  You can simulate this example as shown below (which only works for
   string arrays), or you can get resizeable arrays from a library such as
   extlib <http://ocaml-lib.sourceforge.net/>
*)

let what_about_that_array a =
  let len = Array.length a in
  printf "The array now has %d elements.\n" len;
  printf "The index of the last element is %d.\n" (if len=0 then 0 else len-1);
  printf "Element 3 is \"%s\".\n" a.(3);; 

let resizeArray a s =
  (* begin stupid hack to work like the Perl example *)
  let s = s + 1 in
  (* end stupid hack to work like the Perl example *)
  assert (s >= 0);
  let len = Array.length a in
  if s = len then a else
    if s < len then
      Array.sub a 0 s
    else
      Array.append a (Array.make (s - len) "");;

let people = [|"Crosby"; "Stills"; "Nash"; "Young"|];;
what_about_that_array people;;

(*
The array now has 4 elements.
The index of the last element is 3.
Element 3 is "Young".
*)

let people = resizeArray people 2;;
what_about_that_array people;;

(*
The array now has 3 elements.
The index of the last element is 2.
Exception: Invalid_argument "index out of bounds".
*)

let people = resizeArray people 10000;;
what_about_that_array people;;
(*
The array now has 10001 elements.
The index of the last element is 10000.
Element 3 is "".
*)

(* @@PLEAC@@_4.4 *)

Array.iter complain bad_users;;
(* Or for lists *)
List.iter complain bad_users;;

(* For the hashtable example, we'd iterate over the table itself *)

Hashtbl.iter (fun k v -> printf "%s=%s\n" k v) h;; 

(* Of course if you want to iterate over the keys in lexicographic order, then
 * you'll need to build a list of keys, sort it, then iterate over that *)

List.iter (fun x -> printf "%s=%s\n" x (Hashtbl.find env x))
  (List.sort compare (Hashtbl.fold (fun k v b -> k::b) env []));;

Array.iter (fun x -> if get_usage x > max_quota then complain x) all_users;;
(* or for lists of users *)
List.iter (fun x -> if get_usage x > max_quota then complain x) all_users;;

(* for this example, we're going to assume that the output of the who command is
 * contained in the list named who, with one line of output per list element.
 * This example requires the use of the Str module which is not loaded or linked
 * by default (but is part of the standard library), at the toplevel, use the
 * directive "#load "str.cma"
*)

List.iter 
  (fun x -> 
    try 
      ignore (Str.search_forward (Str.quote "tchrist") x 0);
      print_endline x;
    with Not_found -> ()) who;;

(* To iterate over all lines read in from some channel we would do the following *)
  
let iter_channel f ic =
  try
    while true do
      f (input_line ic)
    done
  with Not_found -> ();;

(* and the example would then be written as *)
iter_channel
  (fun  s ->
    let reverse s ='let len = String.length s in
      let s' = String.create len in
      for i = 0 to len - 1 do
        s'.[len-i-1] <- s.[i]
      done;
      s' in
    (* assuming we have written a chomp workalike *)
    let s = chomp s in
    List.iter 
      (fun x -> print_endline (reverse x)) 
      (Str.split (Str.regexp "[ \t]+") s)) fh;;

(* In OCaml the iterator variable also is an alias for the current element,
 * however, because of the functional nature of OCaml, unless the elements of
 * the array are references, the only way to change them is by resetting the
 * value of the array to something new -- this is best done using iteri *)

let a = [|1; 2; 3|];;
Array.iteri (fun i x -> a.(i) <- x-1) a;;

(* or, with references *)

let a = [| ref 1; ref 2; ref 3 |];;
Array.iter (fun x -> x := !x - 1) a;;

(* You can, of course, use map to create a new array with the desired contents
 * as well *)
let a = [| 0.5; 3.|];;
let b = [|0.; 1.|];;
Array.iter (printf "%f ") (Array.map (( *. ) 7.) (Array.append a b));;


let strip s =
  Str.replace_first (Str.regexp "^[ \t\n]") ""
    (Str.replace_first (Str.regexp "[ \t\n$]") "" s);;


let sc,ar,h = 
  strip sc,
  Array.map strip ar,
  (Hashtbl.iter (fun k v -> Hashtbl.replace h k (strip v)) h; h);;

(* of course, the Hashtbl.replace already destructively updates the old
 * hashtable... *)

(* @@PLEAC@@_4.5 *)

(* iterate over elements of array in arrayref *)

Array.iter (fun x -> (* do something with x *)) !arrayref;;

for i = 0 to Array.length !arrayref - 1 do
  (* do something with !arrayref.(i) *)
done

let fruits = [| "Apple"; "Blackberry" |];;
let fruit_ref = ref fruits;;
Array.iter (printf "%s tastes good in a pie.\n") !fruit_ref;;

for i = 0 to  Array.length !fruit_ref - 1 do
  printf "%s tastes good in a pie.\n" !fruit_ref.(i)
done;;

Hashtbl.add namelist "felines" (ref rogue_cats);;
Array.iter (printf "%s purrs hypnotically.\n") !(Hashtbl.find namelist
"felines");;
print_endline "--More--\nYou are controlled.";;

for i=0 to Array.length !(Hashtbl.find namelist "felines") - 1 do
  printf "%s purrs hypnotically.\n" !(Hashtbl.find namelist "felines").(i)
done;;

(* @@PLEAC@@_4.6 *)

(* For lists, the most "natural" way to do this is by walking the list and
 * looking for duplicates of each item *)

let rec uniquesOnly l = 
  let rec contains x l =
    match l with
      [] -> false
    | h::t -> if x = h then true else contains x t in
  match l with 
    [] -> []
  | h::t -> if contains h t then uniquesOnly t else h::(uniquesOnly t);;

(* if you have a lot of duplicates, it might be better to use List.filter *)
let rec uniquesOnly l =
  match l with
    [] -> []
  | h::t -> h::(uniquesOnly (List.filter ((<>) h) t));;

(* Or, for lists or arrays, you can use a hashtable *)
(* Straightforward *)
let uniquesOnly l =
  let seen = Hashtbl.create 17
  and uniq = ref [] in
  List.iter 
    (fun x -> 
      if not (Hashtbl.mem seen x) then 
        (Hashtbl.add seen x 1; uniq := (x::!uniq)))
    l;
  !uniq;;

(* Or more likely *)
let uniquesOnly l =
  let seen = Hashtbl.create 17 in
  List.iter (fun x -> Hashtbl.replace seen x 1) l;
  Hashtbl.fold (fun k v b -> k::b) seen [];;

(* To apply a user function to each unique element of a list, one would likely
 * do something like *)

let userUnique f l =
  List.map f (uniquesOnly l);;

(* Generate a list of users logged in, removing duplicates.  Note that this
 * example requires linking with the Unix and Str libraries. *)
let who () =
  let w = Unix.open_process_in "who"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> !l;;

let ucnt = Hashtbl.create 17;;
List.iter 
  (fun x -> 
    Hashtbl.replace ucnt (Str.replace_first (Str.regexp "[ \t].*$") "" x) 1)
  (who ());;
let users = Hashtbl.fold (fun k v b -> k::b) ucnt [];;

printf "users logged in: %s";;
List.iter (printf "%s ") users;;

(* @@PLEAC@@_4.7 *)

(* using hashtables, like the cookbook *)
let arrayDiff a b = 
  let seen = Hashtbl.create 17 
  and l = ref [] in
  Array.iter (fun x -> Hashtbl.add seen x 1) b;
  Array.iter (fun x -> if not (Hashtbl.mem seen x) then l := x::!l) a;
  Array.of_list !l;;


(* @@PLEAC@@_4.8 *)

let a = [ 1;3;5;6;7;8 ];;
let b = [ 2;3;5;7;9 ];;

let union = Hashtbl.create 13
and isect = Hashtbl.create 13
and diff = Hashtbl.create 13;;

(* simple solution for union and intersection *)
List.iter (fun x -> Hashtbl.add union x 1) a;;
List.iter 
  (fun x -> hashtbl.add (if Hashtbl.mem union x then isect else union) x 1) b;;
let u = Hashtbl.fold (fun k v b -> k::b) union []
and i = Hashtbl.fold (fun k v b -> k::b) isect [];;

(* Union, intersection, and symmetric difference *)
let hincr h x = 
  let v = try Hashtbl.find h x with Not_found -> 0 in
  Hashtbl.replace h x (v+1);;

let count = Hashtbl.create 13;;
List.iter (fun x -> Hashtbl.add count x 1) a;;
List.iter (hincr count) b;;
let u,i,d =
  let u = Hashtbl.fold (fun k v b -> (k,v)::b) count [] in
  let i,d = List.partition(fun x -> snd x = 2) u in
  let vo l = List.map fst l in
  (vo u),(vo i),(vo d);;


(* @@PLEAC@@_4.9 *)

(* For lists, use the @ operator for two lists, or List.concat for a list of
 * lists, for arrays, use Array.append for two arrays, or Array.concat for a
 * list of arrays*)

let list1 = list1 @ list2;;
let array1 = Array.append array1 array2;;

let members = [| "Time"; "Flies" |];;
let initiates = [| "An"; "Arrow" |];;
let members = Array.append members initiates;;

(* It is easiest to write a splice workalike and then just use the new function
 * much like in Perl *)

let splice ?length ?list arr off =
  let len = Array.length arr in
  let off = if off < 0 then len + off else off in
  let l,back =
    match length with
      None -> (len - off),[||]
    | Some l -> 
        l,
        (let boff = off + l in
        try Array.sub arr boff (len - boff)  with Invalid_argument _ -> [||]) in
  let front = Array.sub arr 0 off
  and mid = 
    match list with 
      None -> [||] 
    | Some a -> a
  and sp = Array.sub arr off l in
  sp,Array.concat [front;mid;back];;

let _,members = 
  splice members 2 ~length:0 ~list:(Array.append [|"Like"|] initiates);;
Array.iter (printf "%s ") members; print_newline ();;

let _,members = splice members 0 ~length:1 ~list:[|"Fruit"|];;
let _,members = splice members (-2) ~length:2 ~list:[|"A"; "Banana"|];;
Array.iter (printf "%s ") members; print_newline ();;

(* @@PLEAC@@_4.10 *)

(* To reverse a list, use List.rev *)
let reversed = List.rev l;;

(* For an array, it is probably easiest to use Array.init *)

let revArray a = 
  let len = Array.length a - 1 in
  Array.init len+1 (fun i -> a.(len - i);;

let reversed = revArray a;;

(* Or one can use a for loop *)
for i = Array.length a - 1 downto 0 do
  (* Do something to a.(i) *)
done;;

(* @@PLEAC@@_4.11 *)

(* To remove multiple elements from an array at once, one can use the splice
 * function from section 4.9 *)

(* Remove n elements from the front of arr *)
front,arr = splice arr 0 ~length:n;;
rear,arr = splice arr (-n);;

(* this can also be wrapped as an explicit function *)

let shift2 a = splice a 0 ~length:2;;
let pop2 a = splice a (-2);;

(* This lets you do something like Perl's hinkey pattern matching *)
let friends = [|"Peter"; "Paul"; "Mary"; "Jim"; "Tim" |];;
let [|this; that|],friends = shift2 friends;;

let beverages = [|"Dew"; "Jolt"; "Cola"; "Sprite"; "Fresca"|];;;
let pair,beverages =  pop2 beverages;;

(* @@PLEAC@@_4.12 *)

(* To find the first element in a list that satisfies some predicate, just use
 * the List.find function to return an 'a option *)

match
  (try Some (List.find (fun x -> x > 10) l)
  with Not_found -> None)
with
    None -> (* unfound *)
  | Some x -> (* Do something with x *);;

(* Note that this is a very general form, and can be shortened in some cases *)
let pf l =
  try 
    printf "hah! Found %d!\n" (List.find (fun x -> x > 10) l)
  with 
    Not_found -> "Sorry charly!\n";;

(*
# pf [1;2;3;4;5;6];;
Sorry charly!

# pf [1;2;3;50;100];;
Hah!  Found 50!
*)

(* To return the index of a matching element in an array, we can use exceptions
 * to short circuit the search *)

exception Found of int;;

let findi pred arr = 
  Array.iteri (fun i x -> if pred x then raise (Found i)) arr;
  raise Not_found;;

let f arr = 
try
  findi (fun x -> x > 10) arr
with
  Found i -> printf "element %d is a big element - %d\n" i arr.(i)
| Not_found -> printf "Only small values here!\n";;

(*
# f [|1; 2; 3; 4; 5; 6|];;
Only small values here!

# f [|1; 2; 3; 4; 5; 60; 8; 9; 100|];;
element 5 is a big element - 60
*)

let highest_engineer =
  List.find (fun x -> x#category = "engineer") employees in
  printf "Highest paid engineer is: %s\n" highest_engineer#name;;


(* @@PLEAC@@_4.13 *)

(* to find all elements of a list that satisfy a certain predicate, just use the
 * List.find_all function *)

let matching = List.find_all ( (* predicate *) l;;

(* for an array, it's likely easiest to convert the original array to a list,
 * use List.find_all, and convert that list into an array *)
let matching = 
  Array.ofList (List.find_all ( (*predicate *) ) (Array.to_list a));;

(* the next example requires use of the Str library, which must be linked in.
 * In the toplevel environment use `#load "str.cma"' *)

let bigs = List.find_all (fun x -> x > 1000000) nums;;
let pigs = List.find_all (fun x -> (Hashtbl.find users x) > 1e7) 
            (Hashtbl.fold (fun k v b -> k::b) users []);;

let matching = 
  List.find_all (fun x -> Str.string_match (Str.regexp "gnat") x 0) (who ());;

let engineers = List.find_all (fun x -> x#position = "Engineer") employees;;

let secondary_assistance = 
  List.find_all (fun x -> x#income >= 26000 && x#income < 30000) applicants;;

(* @@PLEAC@@_4.14 *)

(* OCaml is smart enough to figure out if a list is full of numbers or
 * non-numbers, so the polymorphic compare function works just fine *)
let sorted = List.sort compare unsorted;;

(* note that Array.sort sorts the given array in place, so unexpected results
 * can occur, e.g.
let sorted = Array.sort compare unsorted;;

 * results in unsorted referring to the now sorted array, and sorted referring
 * to something of type unit *)

(* pids is an unsorted list of process IDs *)
List.iter (printf "%d\n") (List.sort compare pids);;
print_endline "Select a process ID to kill:";;
let pid = read_int () in
  Unix.kill pid Sys.sigterm;
  Unix.sleep 2;
  Unix.kill pid Sys.sigterm;;

let descending = List.sort (fun x y -> compare y x) unsorted;;

(* @@PLEAC@@_4.15 *)
(* since compare orders tuples by first comparing the first slot then, if they
 * were equal, comparing the second slot, and so on, we can sort by computable
 * fields as follows *)

let sorted = 
  List.map snd (List.sort compare (List.map (fun x-> (compute x),x) unsorted));;

let ordered = List.sort (fun x y -> compare x#name y#name) employees;;
List.iter (fun x -> printf "%s earns $%2f\n" x#name x#salary)
  (List.sort (fun x y -> compare x#name y#name) employees);;

let sorted_employees = 
  List.map snd (List.sort compare (List.map (fun x-> (compute x),x) unsorted)) in
  List.iter (fun x -> printf "%s earns $%2f\n" x#name x#salary) sorted_employees;
  List.iter 
    (fun x -> if Hashtbl.mem bonus x#ssn then printf "%s got a bonus!\n" x#name)
    sorted_employees;;

let sorted = 
  List.sort 
    (fun x y ->
      match compare x#name y#name with
        0 -> compare x#age y#age
      | c -> c)
    employees;;

(* Assuming we have a getpwent function that returns a value of type users, or
 * throws an End_of_file exception when done (not sure what getpwent is supposed
 * to do), then we can write *)

let getUsers () = 
  let l = ref [] in
  try
    while true do
      l := (getpwent ())::!l
    done
  with End_of_file -> !l;;

List.iter 
  (fun x -> print_endline x#name) 
  (List.sort (fun x y -> compare x#name y#name) (getUsers ()));;

let sorted = List.sort (fun x y -> compare x.[1] y.[1]) strings;;

let sorted = 
  List.map snd
    (List.sort compare (List.map (fun x -> (String.length x),x) strings));;

let sorted_fields = 
  List.map snd
    (List.sort compare 
      (List.map 
        (fun x ->
          (try 
            ignore(Str.search_forward (Str.regexp "[0-9]+") x 0);
            int_of_string (Str.matched_string x)
          with Not_found -> max_int),x) 
        strings));;

let passwd () =
  let w = Unix.open_process_in "cat /etc/passwd"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> !l;;

(* for illustration purposes, we provide a function to return the (non-comment)
 * contents of /etc/passwd *)
let passwd () =
  let w = Unix.open_process_in "cat /etc/passwd"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> 
    List.filter (fun x -> x.[0] <> '#') !l;;

let sortedPasswd = 
  List.map (fun Some x -> snd x)
  (List.sort compare
   (List.filter (function Some x -> true | None -> false)
    (List.map
      (fun x -> 
        match Str.split (Str.regexp ":") x with
          name::_::uid::gid::t -> Some ((gid,uid,name),x)
        | _ -> None) 
     (passwd ()))));;

(* @@PLEAC@@_4.16 *)

(* To get a true circular list, one can use the let rec construct *)

let rec processes = 1::2::3::4::5::processes;;
while true do
  let process::processes = process in
  printf "Handling process %d\n" process;
  Unix.sleep 2;
done;;

(* or one can use these somewhat inefficient functions to simulate the Perl
 * examples *)

let popleft l =
  match l with
    [] -> raise Not_found
  | h::t -> h,(t @ [h]);;

let popright l =
  match List.rev l with
    [] -> raise Not_found
  | h::t -> h,(h::(List.rev t));;

let processes = ref [1;2;3;4;5];;
while true do
  let process,np = popleft !processes in
  processes := np;
  printf "Handling process %d\n" process;
  flush_all ();
  Unix.sleep 1;
done;;

(* @@PLEAC@@_4.17 *)

let fisher_yates_shuffle a =
  for i = Array.length a - 1 downto 1 do
    let x = a.(i)
    and r = Random.int (i+1) in
    a.(i) <- a.(r);
    a.(r) <- x;
  done;;

(* @@PLEAC@@_4.18 *)

(* Assuming we start with a list of all the data called data, and assuming we
 * already have the curent number of screen columns in a variable cols *)

let words data cols =
  let strippedData = 
    Array.of_list 
      (List.map (Str.replace_first (Str.regexp "[ \t\n]+$") "") data) in
  let maxlen = 
    (Array.fold_left (fun m s -> max m (String.length s)) 0 strippedData) + 1 in
  let cols = if cols < maxlen then 1 else cols / maxlen in
  let rows = ((Array.length strippedData - 1) + cols)/cols in
  let bufs = Array.init rows (fun x -> Buffer.create (cols * maxlen)) in
  for i = 0 to Array.length strippedData - 1 do
    let dst = String.make maxlen ' '
    and src = strippedData.(i) in
    String.blit src 0 dst 0 (String.length src);
    Buffer.add_string bufs.(i mod rows) dst
  done;
  Array.iter (fun x -> print_endline (Buffer.contents x)) bufs;;

(* @@PLEAC@@_4.19 *)

(* Note: This routine uses the splice routine written in section 4.9 *)

let tsc_permute arr =
  if Array.length arr > 0 then print_endline "Perms:";
  let rec permute arr perms =
    match Array.length arr with
      0 -> Array.iter (printf "%s ") perms; print_newline ();
    | _ ->
        for i = 0 to Array.length arr - 1 do
          let v,ni = splice arr i ~length:1 in
          permute ni (Array.append v perms);
        done in
  permute arr [||];;

(* Note: This example is going to permute the words of a given string - also, I
 * don't feel like bringing in the BigInt module, so we will trim any array
 * longer than 12 elements down to 12 before permuting *)

let fact = Array.append [|Some 1|] (Array.make 11 None);;
let rec factorial n =
  match fact.(n) with
    Some f -> f
  | None -> let f = n*(factorial (n-1)) in fact.(n) <- Some f; f;;

let n2pat n len =
  let rec nh n i pat =
    if i > len+1 then pat
    else
      nh (n/i) (i+1) ((n mod i)::pat) in
  nh n 1 [];;

let pat2perm pat =
  let rec ph source pat perm =
    match pat with
      [] -> perm
    | h::t ->
        let v,s = splice source h ~length:1 in
        ph s t (v.(0)::perm) in
  Array.of_list (ph (Array.init (List.length pat) (fun i -> i)) pat []);;
  
let n2perm n len =
  pat2perm (n2pat n len);;

let mjd_permute s =
  let arr = 
    let arr = Array.of_list (Str.split (Str.regexp "[ \t]+") s) in
    try
      Array.sub arr 0 12
    with Invalid_argument _ -> arr in
  let len = Array.length arr - 1 in
  for i = 0 to factorial (len+1) do
    let perm = Array.map (fun i -> arr.(i)) (n2perm i len) in
    Array.iter (printf "%s ") perm; print_newline ();
  done;;


(* @@PLEAC@@_5.0 *)
(*-----------------------------*)
(* build an hash table element by element *)
let age = Hashtbl.create 3 ;;  (* 3 is the supposed average size for the
                                  hash table *)
Hashtbl.replace age "Nat" 24 ;
Hashtbl.replace age "Jules" 25 ;
Hashtbl.replace age "Josh" 17 ;;
(*-----------------------------*)
let assoc_list2hashtbl assoc_list = 
  let h = Hashtbl.create 0 in
  List.iter (fun (k,v) -> Hashtbl.replace h k v) assoc_list ;
  h

let food_color = assoc_list2hashtbl 
    [ "Apple", "red" ; 
      "Banana", "yellow" ; 
      "Lemon", "yellow" ; 
      "Carrot", "orange" ;
    ] ;;
(*-----------------------------*)

(* @@PLEAC@@_5.1 *)
(*-----------------------------*)
Hashtbl.replace tbl key value ;;
(*-----------------------------*)
(* food_color defined per the introduction *)
Hashtbl.replace food_color "Raspberry" "pink" ;;


let hashtbl_keys h = Hashtbl.fold (fun key _ l -> key :: l) h []
let hashtbl_values h = Hashtbl.fold (fun _ value l -> value :: l) h []
let hashtbl2assoc_list h = Hashtbl.fold (fun key value l -> (key, value) :: l) h []
;;
print_string "Known_foods:\n" ;
Hashtbl.iter (fun food _ -> print_endline food) food_color ;
print_string "Known_foods:\n" ;
List.iter print_endline (hashtbl_keys food_color) ;;
(*
> Known_foods:
> Banana
> Raspberry
> Apple
> Carrot
> Lemon
*)
(*-----------------------------*)

(* @@PLEAC@@_5.2 *)
(*-----------------------------*)
(* does %HASH have a value for $KEY ?  *)
if (Hashtbl.mem hash key) then
  (* it exists *)
else
  (* id doesn't exists *)
 ;;
(*-----------------------------*)
(* food_color defined per the introduction *)
List.iter (fun name ->
  let kind = if Hashtbl.mem food_color name then "food" else "drink" in
  printf "%s is a %s.\n" name kind
) ["Banana"; "Martini"] ;;
(*
> Banana is a food.
> Martini is a drink.
*)
(*-----------------------------*)
(* there's no such thing called "undef", "nil" or "null" in Caml
   if you really want such a value, use type "option" as shown below *)
let age = assoc_list2hashtbl 
    [ "Toddler", 3 ; "Unborn", 0 ] ;;
(*> val age : (string, int) Hashtbl.t = <abstr> *)

List.iter (fun thing ->
  printf "%s: %s\n" thing
    (try match Hashtbl.find age thing with
    | 0 -> "Exists"
    | _ -> "Exists NonNull"
    with Not_found -> "")
) ["Toddler" ; "Unborn" ; "Phantasm" ; "Relic" ]

let age = assoc_list2hashtbl 
    [ "Toddler", Some 3 ; "Unborn", Some 0 ; "Phantasm", None ] ;;
(*> val age : (string, int option) Hashtbl.t = <abstr> *)

List.iter (fun thing ->
  printf "%s: %s\n" thing
    (try match Hashtbl.find age thing with
    | None -> "Exists"
    | Some 0 -> "Exists Defined"
    | Some _ -> "Exists Defined NonNull"
    with Not_found -> "")
) ["Toddler" ; "Unborn" ; "Phantasm" ; "Relic" ]
(*
> Toddler: Exists Defined NonNull
> Unborn: Exists Defined
> Phantasm: Exists
> Relic: 
*)
(*-----------------------------*)
let size = Hashtbl.create 20 in
List.iter (fun f -> 
  if not (Hashtbl.mem size f) then
    Hashtbl.replace size f (Unix.stat f).Unix.st_size;
) (readlines stdin);
(*-----------------------------*)
(* here is a more complete solution which does stat 2 times the same file (to
be mimic perl's version) *)
let size = Hashtbl.create 20 in
List.iter (fun f -> 
  if not (Hashtbl.mem size f) then
    Hashtbl.replace size f (try Some (Unix.stat f).Unix.st_size with _ -> None)
) (readlines stdin);


(* @@PLEAC@@_5.3 *)
(*-----------------------------*)
(* remove $KEY and its value from %HASH *)
Hashtbl.remove hash key ;
(*-----------------------------*)
(* food_color as per Introduction *)
open Printf

let print_foods () =
  printf "Keys: %s\n" (String.concat " " (hashtbl_keys food_color)) ;
  printf "Values: %s\n" (String.concat " " (hashtbl_values food_color))
;;
print_string "Initially:\n";
print_foods ();

print_string "\nWith Banana deleted\n";
Hashtbl.remove food_color "Banana";
print_foods ()
;;
(*-----------------------------*)
Hashtbl.clear food_color ;;
(*-----------------------------*)

(* @@PLEAC@@_5.4 *)
(*-----------------------------*)
(* in this section consider opened the Printf module using: *)
open Printf;;

Hashtbl.iter
  (fun key value ->
    (*
      do something with key and value
    *)
  )
  hash
;;
(*-----------------------------*)
List.iter (fun key ->
  let value = Hashtbl.find hash key in
    (*
      do something with key and value
    *)
) (hashtbl_keys hash)
;;
(*-----------------------------*)
(* food_color as defined in the introduction *)
Hashtbl.iter (printf "%s is %s.\n") food_color;
(*
> Lemon is yellow.
> Apple is red.
> Carrot is orange.
> Banana is yellow.
*)
(* but beware of: *)
Hashtbl.iter (printf "food_color: %s is %s.\n") food_color;
(*
> food_color: Lemon is yellow.
> Apple is red.
> Carrot is orange.
> Banana is yellow.
*)
(* write this instead:
  (more on it at http://caml.inria.fr/ocaml/htmlman/manual055.html) *)
Hashtbl.iter (fun k v -> printf "food_color: %s is %s.\n" k v) food_color;
(*
> food_color: Lemon is yellow.
> food_color: Apple is red.
> food_color: Carrot is orange.
> food_color: Banana is yellow.
*)

List.iter (fun key ->
  let value = Hashtbl.find food_color key in
  printf "%s is %s.\n" key value
) (hashtbl_keys food_color) ;
(*
> Lemon is yellow.
> Apple is red.
> Carrot is orange.
> Banana is yellow.
*)

(*-----------------------------*)
List.iter
  (fun key ->
    printf "%s is %s.\n" key (Hashtbl.find food_color key)
  )
  (sort_ (hashtbl_keys food_color))
;;

(*
> Apple is red.
> Banana is yellow.
> Carrot is orange.
> Lemon is yellow.
*)

(*-----------------------------*)
(* Ocaml is safe in loop, so you can't reset the hash iterator as in
Perl and you don't risk infinite loops using, say, List.iter or
Hashtbl.iter, but if you really want to infinite loop on the first key
you get ... *)
List.iter
  (fun key ->
    while true do
      printf "Processing %s\n" key
    done
  )
  (hashtbl_keys food_color)
;;
(*-----------------------------*)
(* countfrom - count number of messages from each sender *)
let main () =
  let file =
    let files = ref [] in
    Arg.parse [] (fun file -> files := !files @ [file]) "";
    try
      open_in (List.hd !files)
    with Failure "hd" -> stdin
  in
  let from = Hashtbl.create 50 in
  let add_from address =
    let old_count =
      try Hashtbl.find from address
      with Not_found -> 0
    in
    let new_count = old_count + 1 in
    Hashtbl.replace from address new_count;
  in
  let extractfrom = Str.regexp "^From: \(.*\)" in

  iter_lines (fun line ->
    if (Str.string_match extractfrom line 0) then
      add_from (Str.matched_group 1 line)
    else ()
  ) file;
  Hashtbl.iter (printf "%s: %d\n") from
;;
main() ;

(* @@PLEAC@@_5.5 *)
(*-----------------------------*)
(* note that OCaml does not have a native polymorphic print function, so
examples in this section work for hashes that map string keys to string
values *)
Hashtbl.iter (printf "%s => %s\n") hash ;
(*-----------------------------*)

(* map in ocaml maps a function on a list, rather that evaluate an
expression in turn on a list as Perl does *)
List.iter
  (fun key ->
    printf "%s => %s\n" key (Hashtbl.find hash key)
  )
  (hashtbl_keys hash) ;
(*-----------------------------*)

(* build a list from an hash table, note that this is possibile only if
the type of key and value are the same *)
let hashtbl2list hash =
  Hashtbl.fold
    (fun key value init -> key :: value :: init)
    hash
    []
;;
List.iter (printf "%s ") (hashtbl2list hash) ;
(* or *)
print_endline (String.concat " " (hashtbl2list hash)) ;

(* @@PLEAC@@_5.6 *)
(*-----------------------------*)
(* In OCaml one usually use association lists which really is a list of
(key,value). Note that insertion and lookup is O(n) (!!!) *)

(* initialization *)
let empty_food_color = []
let food_color = 
    [ "Banana", "Yellow" ; 
      "Apple", "Green" ; 
      "Lemon", "Yellow" ; 
    ]
(* adding *)
let food_color' = food_color @ [ "Carrot", "orange" ]
;;
(* output entries in insertion order *)
print_endline "In insertion order, the foods are:";
List.iter (printf "%s is colored %s.\n") food_color;
(*
> Banana is colored Yellow.
> Apple is colored Green.
> Lemon is colored Yellow.
*)
(* is it a key? *)
let has_food food = mem_assoc food food_color
(* remove a key *)
let remove_food food = remove_assoc food food_color
(* searching *)
let what_color food =
  try
    let color = assoc food food_color in
    printf "%s is colored %s.\n" food color
  with Not_found -> printf "i don't know the color of %s\n" food
;;
(* @@PLEAC@@_5.7 *)
(*-----------------------------*)
let re = Str.regexp "^\([^ ]*\) *\([^ ]*\)" in
let lines = readlines (Unix.open_process_in "who") in
let ttys = filter_some (List.map (fun line ->
  if (Str.string_match re line 0) then
    Some(Str.matched_group 1 line, Str.matched_group 2 line)
  else None) lines) in
List.iter
  (fun user ->
    printf "%s: %s\n" user (String.concat " " (all_assoc user ttys))
  ) (sort_ (uniq (List.map fst ttys)))
;
(*-----------------------------*)
List.iter
  (fun user ->
    let ttylist = all_assoc user ttys in
    printf "%s: %d ttys.\n" user (List.length ttylist);
    List.iter
      (fun tty ->
        let uname =
          try
            let uid = (Unix.stat ("/dev/" ^ tty)).Unix.st_uid in
            (Unix.getpwuid uid).Unix.pw_name
          with Unix.Unix_error _ -> "(not available)"
        in
        printf "%s (owned by %s)\n" tty uname
      ) ttylist
  ) (sort_ (uniq (List.map fst ttys)))
(*-----------------------------*)
(* @@PLEAC@@_5.8 *)
(*-----------------------------*)

open Hashtbl

(* size of an hash, i.e. number of bindings *)
let hashtbl_size h = List.length (hashtbl_keys h);;

(* in OCaml does not exists a builtin function like "reverse", here is
an equivalent one: *)
let hashtbl_reverse h =
  assoc_list2hashtbl (List.combine (hashtbl_values h) (hashtbl_keys h))
(* or *)
let hashtbl_reverse h =
  assoc_list2hashtbl (List.map (fun (a,b) -> (b,a)) (hashtbl2assoc_list h))
;;
(* or *)
let hashtbl_reverse_multi h =
  let newhash = Hashtbl.create (hashtbl_size h) in
  List.iter
    (fun v -> add newhash (find h v) v)
    (hashtbl_keys h);
  newhash
(* note that the last  implementation maintain also multiple binding for the
same key, see Hashtbl.add in the standard OCaml library for more info *)

(*-----------------------------*)
(* example of hashtbl_reverse *)

let reverse = hashtbl_reverse lookup;;
(*-----------------------------*)
let surname = assoc_list2hashtbl ["Mickey", "Mantle"; "Babe", "Ruth"] in
let firstname = hashtbl_reverse surname in
print_endline (Hashtbl.find firstname "Mantle");;
(*
> Mickey
*)

(*-----------------------------*)
(* foodfind - find match for food or color *)

let given = Sys.argv.(1) in
let color = assoc_list2hashtbl
  ["Apple", "red";
   "Banana", "yellow";
   "Lemon", "yellow";
   "Carrot", "orange"] in
let food = hashtbl_reverse color in
(try
  printf "%s is a food with color %s.\n" given (Hashtbl.find color given);
with Not_found -> ());
(try
  printf "%s is a food with color %s.\n" (Hashtbl.find food given) given
with Not_found -> ())
;;
(*-----------------------------*)
(* food_color defined as previous *)

let foods_with_color = hashtbl_reverse food_color in
List.iter (printf "%s ") (Hashtbl.find_all foods_with_color "yellow");
print_endline "were yellow foods."
;;
(*-----------------------------*)

(* @@PLEAC@@_5.9 *)
(*-----------------------------*)

(* you may define your own compare function to be used in sorting *)
let keys = List.sort compare_function (hashtbl_keys hash) in
List.iter
  (fun key ->
    let value = Hashtbl.find hash key in
    (* do something with key and value *)
    ()
  )
  keys ;
(* or use this one if you want to compare not only on keys *)
Hashtbl.iter
  (fun (key, value) ->
    (* do something with key and value *)
    ()
  ) (List.sort compare_function (hashtbl2assoc_list hash)) ;
(*-----------------------------*)
List.iter
  (fun food ->
    printf "%s is %s.\n" food (Hashtbl.find food_color food)
  )
  (List.sort (hashtbl_keys food_color))
;;
(*-----------------------------*)
(* examples of "compare_function": *)

(* alphabetical sort on the hash value *)
let compare_function (_,color1) (_,color2) = compare color1 color2

(* length sort on the hash value *)
let compare_function (_,color1) (_,color2) = compare (String.length color1) (String.length color2)

(*-----------------------------*)

(* @@PLEAC@@_5.10 *)
(*-----------------------------*)
(* definition of merge function on hashes: *)
let hashtbl_merge h1 h2 = assoc_list2hashtbl (hashtbl2assoc_list h1 @ hashtbl2assoc_list h2)

(* usage: *)
let merged = hashtbl_merge a b;;
(*-----------------------------*)
let merged = Hashtbl.create 0 in
List.iter
  (Hashtbl.iter (fun k v -> Hashtbl.add merged k v))
  [a;b]
;;
(*-----------------------------*)
let drink_color = assoc_list2hashtbl
    ["Galliano", "yellow";
     "Mai Tai", "blue"]
;;

let ingested_color = hashtbl_merge drink_color food_color;;
(*-----------------------------*)
let substance_color = Hashtbl.create 0 in
List.iter
  (Hashtbl.iter (fun k v -> Hashtbl.add merged k v))
  [food_color; drink_color]
;;

(* @@PLEAC@@_5.11 *)
(*-----------------------------*)
let common =
  List.filter
    (fun key -> Hashtbl.mem hash2 key)
    (hashtbl_keys hash1)
;;
(* common now contains commne keys, note that a key may appear multiple
times in this list due tu multiple bindings allowed in Hashtbl
implementation *)

let this_not_that =
  List.filter
    (fun key -> not (Hashtbl.mem hash2 key))
    (hashtbl_keys hash1)
;;
(*-----------------------------*)
let citrus_color = assoc_list2hashtbl
                      ["Lemon", "yellow";
                       "Orange", "orange";
                       "Lime", "green"]
in
let non_citrus = Hashtbl.create 3 in
List.filter
  (fun key -> not (Hashtbl.mem citrus_color key))
  (hashtbl_keys food_color)
;;

(*-----------------------------*)
(* @@PLEAC@@_5.12 *)
(*-----------------------------*)
open Unix;;
open Printf;;

let filenames = ["/etc/printcap"; "/vmlinuz"; "/bin/cat"] in
let openfiles = Hashtbl.create 3 in
print_newline();
List.iter
  (fun fname ->
    printf "%s is %d bytes long.\n"
      fname
      (stat fname).st_size
  )
  filenames
;;
  
(*-----------------------------*)
(* @@PLEAC@@_5.13 *)
(*-----------------------------*)

(* presize hash to num elements *)
let hash = Hashtbl.create num;;
(* other examples of initial size on hashes *)
let hash = Hashtbl.create 512;;
let hash = Hashtbl.create 1000;;

(*-----------------------------*)
(* @@PLEAC@@_5.14 *)
(*-----------------------------*)

(* size of an array named "a" *)
let count = Array.length a;;

(* size of a list named "l" *)
let count = List.length l;;

(*-----------------------------*)
(* @@PLEAC@@_5.15 *)
(*-----------------------------*)

open Printf;;
open Hashtbl;;

let father = assoc_list2hashtbl
  [ "Cain", "Adam";
    "Abel", "Adam";
    "Seth", "Adam";
    "Enoch", "Cain";
    "Irad", "Enoch";
    "Mehujael", "Irad";
    "Methusael", "Mehujael";
    "Lamech", "Methusael";
    "Jabal", "Lamech";
    "Jubal", "Lamech";
    "Tubalcain", "Lamech";
    "Enos", "Seth"] ;;
(*-----------------------------*)
(* recursively print all parents of a given name *)
let rec parents s =
  printf "%s " s;
  if mem father s then
    parents (find father s)
  else
    printf "\n"
in
  iter_lines parents stdin
;;
(*-----------------------------*)
let children = hashtbl_reverse_multi father in
iter_lines 
  (fun line ->
    List.iter (printf "%s ") (find_all children line);
    print_newline()
  )
  stdin;
;;
(*-----------------------------*)
(* build an hash that map filename to list of included file *)
open Hashtbl;;
open Str;;

let includes = create (List.length files);;
let includeRE = regexp "^#include <\([a-zA-Z0-9.]+\)>";;
let isincludeline l = string_match includeRE l 0;;
let getincludes fname =
  let includelines =
    List.filter isincludeline (readlines (open_in fname))
  in
  List.map (replace_first includeRE "\1") includelines
;;
List.iter (fun fname -> add includes fname (getincludes fname)) files;;

(*-----------------------------*)
(* build a list of files that does not include system headers *)
let hasnoinclude fname = (find includes fname = []) in
List.filter hasnoinclude (uniq (hashtbl_keys includes));;

(*-----------------------------*)
(* @@PLEAC@@_5.16 *)
(*-----------------------------*)

#!/usr/bin/ocaml
(* dutree - print sorted indented rendition of du output *)
#load "str.cma";;
#load "unix.cma";;

let dirsize = Hashtbl.create 0
let kids = Hashtbl.create 0

(* run du, read in input, save sizes and kids *)
(* return last directory (file?) read *)
let input () =
  let last_name = ref "" in
  let last_push = ref None in
  let argv = "du" :: List.tl (Array.to_list Sys.argv) in
  let ch = Unix.open_process_in (String.concat " " argv) in
  begin
    try
      while true do
        let line = input_line ch in
        match Str.bounded_split (Str.regexp "[ \t]+") line 2 with
          | [size; name] ->
              let size = int_of_string size in
              Hashtbl.replace dirsize name size;
              let parent =
                Str.replace_first (Str.regexp "/[^/]+$") "" name in
              last_name := name;
              last_push :=
                Some (parent,
                      try Some (Hashtbl.find kids parent)
                      with Not_found -> None);
              Hashtbl.replace kids parent
                (name ::
                   (try Hashtbl.find kids parent
                    with Not_found -> []))
          | _ -> failwith line
      done
    with End_of_file ->
      ignore (Unix.close_process_in ch)
  end;
  begin
    match !last_push with
      | None -> ()
      | Some (parent, None) ->
          Hashtbl.remove kids parent
      | Some (parent, Some previous) ->
          Hashtbl.replace kids parent previous
  end;
  !last_name

(* figure out how much is taken up in each directory *)
(* that isn't stored in subdirectories.  add a new *)
(* fake kid called "." containing that much. *)
let rec getdots root =
  let size = Hashtbl.find dirsize root in
  let cursize = ref size in
  if Hashtbl.mem kids root
  then
    begin
      List.iter
        (fun kid ->
           cursize := !cursize - Hashtbl.find dirsize kid;
           getdots kid)
        (Hashtbl.find kids root)
    end;
  if size <> !cursize
  then
    begin
      let dot = root ^ "/." in
      Hashtbl.replace dirsize dot !cursize;
      Hashtbl.replace kids root
        (dot ::
           (try Hashtbl.find kids root
            with Not_found -> []))
    end

(* recursively output everything, *)
(* passing padding and number width in as well *)
(* on recursive calls *)
let rec output ?(prefix="") ?(width=0) root =
  let path = Str.replace_first (Str.regexp ".*/") "" root in
  let size = Hashtbl.find dirsize root in
  let line = Printf.sprintf "%*d %s" width size path in
  Printf.printf "%s%s\n" prefix line;
  let prefix =
    Str.global_replace (Str.regexp "[^|]") " "
      (Str.replace_first (Str.regexp "[0-9] ") "| "
         (prefix ^ line)) in
  if Hashtbl.mem kids root
  then
    begin
      let kids = Hashtbl.find kids root in
      let kids =
        List.rev_map
          (fun kid -> (Hashtbl.find dirsize kid, kid)) kids in
      let kids = List.sort compare kids in
      let kids = List.rev_map (fun (_, kid) -> kid) kids in
      let width =
        String.length
          (string_of_int (Hashtbl.find dirsize (List.hd kids))) in
      List.iter (output ~prefix ~width) kids
    end

let () =
  let topdir = input () in
  getdots topdir;
  output topdir


(* @@PLEAC@@_6.0 *)
(* We will use the Str library distributed with OCaml for regular expressions.
 * There are two ways to use the str library, building a top or passing it to ocaml.
 * Under Unix, you can create a new toplevel which has the Str module:
 *      $ ocamlmktop -o strtop str.cma 
 *      $ ./strtop
 *   Now you don't need to prefix the contents of the str module with Str.
 * The alternative is to pass str.cma as a parameter:
 *     $ ocaml str.cma
 *   Now you may refer to the contents of the str module by using Str. 
 * Under Windows, if you are using ocamlwin.exe you can simply load Str:
 *      # load "str.cma";;
 *)
(* Str.search_forward returns an int or throws an exception if the pattern isn't found.
 * In Perl, the =~ operator returns null. Since these two values have different
 * types in OCaml, we cannot copy this behaviour directly.
 * Instead, we return an impossible index, -1 using try ... with.
 * Another method would be to define an =~ operator and use that directly:
# let (=~) s re = Str.string_match (Str.regexp re) s 0;; 
val ( =~ ) : string -> string -> bool = <fun>
# "abc" =~ "a";;
- : bool = true
# "bc" =~ "a";;
- : bool = false
 * Don't underestimate the power of this. Many of the following examples could be 
 * simplified by defining infix operators.
 *)
try Str.search_forward (Str.regexp pattern) string 0;
with Not_found -> -1;;

try Str.replace_first (Str.regexp pattern) replacement string;
with Not_found -> "";;
(*-----------------------------*)
try (Str.search_forward (Str.regexp "sheep") meadow 0) > -1;
with Not_found -> false;; (* true if meadow contains "sheep" *)

try not ((Str.search_forward (Str.regexp "sheep") meadow 0) > -1);
with Not_found -> true;; (* true if meadow doesn't contain "sheep" *)

let meadow = 
    try Str.replace_first (Str.regexp "old") "new" meadow;
    with Not_found -> meadow;; (* Replace "old" with "new" in meadow *)
(*-----------------------------*)
try 
    let temp = Str.search_forward (Str.regexp "\\bovines?\\b") meadow 0 in
        print_string "Here be sheep!";
with Not_found -> ();;
(*-----------------------------*)
let string = "good food" in
    try
        Str.replace_first (Str.regexp "o*") "e" string;
    with Not_found -> string;;
(*-----------------------------*)
(* There is no way to take command line parameters to ocaml that I know of. 
 * You would first have to compile your OCaml program using ocamlc.
 *)
(*-----------------------------*)
let rec match_num s start=
    if String.length s > 0 then
        try 
            let temp = Str.search_forward (Str.regexp "[0123456789]+") s start in
                print_string (String.concat "" ("Found number " :: Str.matched_string s :: ["\n"]));
                match_num s (temp + 1);
        with Not_found -> ();
    else
        ();;
(*-----------------------------*)
let rec match_group s start numbers=
    if String.length s > 0 then
        try 
            let temp = (Str.search_forward (Str.regexp "[0123456789]+") s start) in
                let numbers = Str.matched_string s :: numbers in 
                    match_group s (temp + 1) numbers;
        with Not_found -> numbers;
    else
        numbers;;
(*-----------------------------*)
let (=+) s re = 
    let result = ref [] in
    let offset = ref 0 in
    while ((String.length s) > !offset) do
        try
            offset := 1 + (Str.search_forward (Str.regexp re) s !offset);
            result := !result @ [Str.matched_string s] @ [];
        with Not_found -> ignore (offset := String.length s)
    done;
    result;;
    
let (=-) s re = 
    let result = ref [] in
    let offset = ref 0 in
    while ((String.length s) > !offset) do
        try
            ignore (Str.search_forward (Str.regexp re) s !offset);
            offset := Str.match_end ();
            result := !result @ [Str.matched_string s] @ [];
        with Not_found -> ignore (offset := String.length s)
    done;
    result;;

let digits = "123456789";;
let yeslap = digits =+ "[1234567890][1234567890][1234567890]";;
let nonlap = digits =- "[1234567890][1234567890][1234567890]";;

print_string "Non-overlapping: ";
List.iter (fun v -> print_string (v ^ " ")) !nonlap;
print_string "\n";;
(* Non-overlapping: 123 456 789 *)

print_string "Overlapping: ";
List.iter (fun v -> print_string (v ^ " ")) !yeslap;
print_string "\n";;
(* Overlapping: 123 234 345 456 567 678 789 *)
(*-----------------------------*)
let index = ref 0;;
let string = "And little lambs eat ivy";;
try
    index := Str.search_forward (Str.regexp "l[^s]*s") string 0;
with Not_found -> ();;
    
print_string ("(" ^ (String.sub string 0 !index) ^ ") ");
print_string ("(" ^ (Str.matched_string string) ^ ") ");
print_string ("(" ^ (Str.string_after string 16) ^ ")\n");;
(* (And ) (little lambs) ( eat ivy) *)

(* @@PLEAC@@_6.1 *)
#load "str.cma";;

(* The Str module doesn't modify strings in place; you always get
   a copy when you perform a substitution. *)
let dst = Str.global_replace (Str.regexp "this") "that" src

(* Strip to basename. *)
let progname = Str.replace_first (Str.regexp "^.*/") "" Sys.argv.(0)

(* Make All Words Title-Cased. *)
let capword =
  Str.global_substitute
    (Str.regexp "\\b.")
    (fun s -> String.uppercase (Str.matched_string s))
    words

(* /usr/man/man3/foo.1 changes to /usr/man/cat3/foo.1 *)
let catpage =
  Str.replace_first (Str.regexp "man\\([0-9]\\)") "cat\\1" manpage

(* Copy and substitute on all strings in a list. *)
let bindirs = ["/usr/bin"; "/bin"; "/usr/local/bin"]
let libdirs =
  List.map (fun s -> Str.replace_first (Str.regexp "bin") "lib" s)
    bindirs
(* ["/usr/lib"; "/lib"; "/usr/local/lib"] *)

(* @@PLEAC@@_6.2 *)
(* Str can do a simple character range match, but it isn't very
   practical for matching alphabetic characters in general. *)
#load "str.cma";;
let () =
  if Str.string_match (Str.regexp "^[A-Za-z]+$") var 0
  then print_endline "var is purely alphabetic"

(* With Pcre, you can use UTF8 support and match characters with
   the letter property. *)
#directory "+pcre";;
#load "pcre.cma";;
let () =
  if Pcre.pmatch ~rex:(Pcre.regexp ~flags:[`UTF8] "^\\pL+$") var
  then print_endline "var is purely alphabetic"

(* @@PLEAC@@_6.3 *)
#load "str.cma";;

(* Str's regexps lack a whitespace-matching pattern.
   Here is a substitute. *)
let whitespace_chars =
  String.concat ""
    (List.map (String.make 1)
       [
         Char.chr 9;  (* HT *)
         Char.chr 10; (* LF *)
         Char.chr 11; (* VT *)
         Char.chr 12; (* FF *)
         Char.chr 13; (* CR *)
         Char.chr 32; (* space *)
       ])
let space = "[" ^ whitespace_chars ^ "]"
let non_space = "[^" ^ whitespace_chars ^ "]"

(* as many non-whitespace characters as possible *)
let regexp = Str.regexp (non_space ^ "+")

(* as many letters, apostrophes, and hyphens *)
let regexp = Str.regexp "[A-Za-z'-]+"

(* usually best *)
let regexp = Str.regexp "\\b\\([A-Za-z]+\\)\\b"

(* fails at ends or w/ punctuation *)
let regexp = Str.regexp (space ^ "\\([A-Za-z]+\\)" ^ space)

(* @@PLEAC@@_6.4 *)
#!/usr/bin/ocaml
(* resname - change all "foo.bar.com" style names in the input stream
   into "foo.bar.com [204.148.40.9]" (or whatever) instead *)

#directory "+pcre";;
#load "pcre.cma";;
#load "unix.cma";;

let regexp =
  Pcre.regexp ~flags:[`EXTENDED] "
    (                     # capture the hostname in substring 1
      (?:                 # these parens for grouping only
        (?! [-_]  )       # lookahead for neither underscore nor dash
        [\\w-] +          # hostname component
        \\.               # and the domain dot
      ) +                 # now repeat that whole thing a bunch of times
      [A-Za-z]            # next must be a letter
      [\\w-] +            # now trailing domain part
    )                     # end of substring 1 capture
  "

let process line =
  print_endline
    (Pcre.substitute_substrings
       ~rex:regexp
       ~subst:(fun subs ->
                 let name = Pcre.get_substring subs 1 in
                 let addr =
                   try
                     Unix.string_of_inet_addr
                       (Unix.gethostbyname name).Unix.h_addr_list.(0)
                   with Not_found -> "???" in
                 name ^ " [" ^ addr ^ "]")
       line)

let () =
  try
    while true do
      let line = read_line () in
      process line
    done
  with End_of_file -> ()

(*-----------------------------*)

let vars = Hashtbl.create 0
let () =
  Hashtbl.replace vars "name" "Bob";
  Hashtbl.replace vars "flavor" "rhubarb"

let () =
  print_endline
    (Pcre.substitute_substrings
       ~rex:(Pcre.regexp ~flags:[`EXTENDED] "
               \\#                #   a pound sign
               (\\w+)             #   the variable name
               \\#                #   another pound sign
             ")
       ~subst:(fun subs -> Hashtbl.find vars (Pcre.get_substring subs 1))
       "Hello, #name#, would you like some #flavor# pie?")

(* @@PLEAC@@_6.5 *)
#load "str.cma";;

let want = 3
let count = ref 0
let pond = "One fish two fish red fish blue fish"
let regexp = Str.regexp_case_fold "\\([a-z]+\\)[ ]+fish\\b"

exception Found of string
let () =
  let start = ref 0 in
  try
    while true do
      ignore (Str.search_forward regexp pond !start);
      start := !start + String.length (Str.matched_string pond);
      incr count;
      if !count = want then raise (Found (Str.matched_group 1 pond))
    done
  with
    | Found color ->
        Printf.printf "The third fish is a %s one.\n" color
    | Not_found ->
        Printf.printf "Only found %d fish!\n" !count

(* The third fish is a red one. *)

(*-----------------------------*)

let colors =
  let start = ref 0 in
  let fish = ref [] in
  begin
    try
      while true do
        ignore (Str.search_forward regexp pond !start);
        start := !start + (String.length (Str.matched_string pond));
        fish := (Str.matched_group 1 pond) :: !fish
      done;
    with Not_found -> ()
  end;
  Array.of_list (List.rev !fish)

let () =
  Printf.printf "The third fish in the pond is %s.\n" colors.(2)

(* The third fish in the pond is red. *)

(*-----------------------------*)

let evens =
  let colors' = ref [] in
  Array.iteri
    (fun i color -> if i mod 2 = 1 then colors' := color :: !colors')
    colors;
  List.rev !colors'
let () =
  Printf.printf "Even numbered fish are %s.\n" (String.concat " " evens)

(* Even numbered fish are two blue. *)

(*-----------------------------*)

let () =
  let count = ref 0 in
  print_endline
    (Str.global_substitute
       (Str.regexp_case_fold "\\b\\([a-z]+\\)\\([ ]+fish\\b\\)")
       (fun s ->
          incr count;
          if !count = 4
          then "sushi" ^ Str.matched_group 2 s
          else Str.matched_group 1 s ^ Str.matched_group 2 s)
       pond)

(* One fish two fish red fish sushi fish *)

(*-----------------------------*)

let pond = "One fish two fish red fish blue fish swim here."
let regexp = Str.regexp_case_fold "\\b\\([a-z]+\\)[ ]+fish\\b"
let colors =
  let rec loop start acc =
    try
      ignore (Str.search_forward regexp pond start);
      loop
        (start + String.length (Str.matched_string pond))
        (Str.matched_group 1 pond :: acc)
    with Not_found ->
      acc in
  loop 0 []
let color = List.hd colors
let () = Printf.printf "Last fish is %s.\n" color

(* Last fish is blue. *)

(* @@PLEAC@@_6.6 *)
#!/usr/bin/ocaml
(* killtags - very bad html tag killer *)
#load "str.cma";;
let regexp = Str.regexp "<[^>]*>"
let () =
  List.iter
    (fun filename ->
       let lines = ref [] in
       let in_channel = open_in filename in
       try
         begin
           try while true do lines := input_line in_channel :: !lines done
           with End_of_file -> ()
         end;
         let contents = String.concat "\n" (List.rev !lines) in
         print_endline
           (String.concat ""
              (List.map
                 (function
                    | Str.Text s -> s
                    | _ -> "")
                 (Str.full_split regexp contents)));
         close_in in_channel
       with e ->
         close_in in_channel;
         raise e)
    (List.tl (Array.to_list Sys.argv))

(*-----------------------------*)

#!/usr/bin/ocaml
(* headerfy - change certain chapter headers to html *)
#load "str.cma";;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

let paragraph_stream_of_channel channel =
  let lines = line_stream_of_channel channel in
  let rec next para_lines i =
    match Stream.peek lines, para_lines with
      | None, [] -> None
      | Some "", [] -> Stream.junk lines; next para_lines i
      | Some "", _
      | None, _ -> Some (String.concat "\n" (List.rev para_lines))
      | Some line, _ -> Stream.junk lines; next (line :: para_lines) i in
  Stream.from (next [])

let regexp = Str.regexp "^Chapter[\r\n\t ]+[0-9]+[\r\n\t ]*:[^\r\n]*"

let headerfy chunk =
  String.concat ""
    (List.map
       (function
          | Str.Text s -> s
          | Str.Delim s -> "<H1>" ^ s ^ "</H1>")
       (Str.full_split regexp chunk))

let () =
  List.iter
    (fun filename ->
       let in_channel = open_in filename in
       try
         Stream.iter
           (fun para ->
              print_endline (headerfy para);
              print_newline ())
           (paragraph_stream_of_channel in_channel);
         close_in in_channel
       with e ->
         close_in in_channel;
         raise e)
    (List.tl (Array.to_list Sys.argv))

(* @@PLEAC@@_6.7 *)
#load "str.cma";;
let chunks =
  let lines = ref [] in
  begin
    try while true do lines := input_line stdin :: !lines done
    with End_of_file -> ()
  end;
  let contents = String.concat "\n" (List.rev !lines) in
  Str.full_split (Str.regexp "^\\.\\(Ch\\|Se\\|Ss\\)$") contents
let () =
  Printf.printf
    "I read %d chunks.\n"
    (List.length chunks)

(* @@PLEAC@@_6.8 *)
#load "str.cma";;

(* Creates a stream that produces ranges of items from another stream.
   Production of items starts when when (start_test count item) returns
   true and stops when (finish_test count item) returns true. Multiple
   ranges will be produced if start_test returns true again. The count
   starts at 1. Ranges are inclusive; the item that causes finish_test
   to return true will be produced. *)
let stream_range start_test finish_test stream =
  let active = ref false in
  let count = ref 1 in
  let rec next i =
    match Stream.peek stream with
      | None -> None
      | Some item ->
          if not !active then
            begin
              if start_test !count item
              then (active := true; next i)
              else (Stream.junk stream; incr count; next i)
            end
          else
            begin
              if finish_test !count item then active := false;
              Stream.junk stream;
              incr count;
              Some item
            end in
  Stream.from next

(* Creates a stream that produces items between a pair of indices.
   If start = 2 and finish = 4, items 2, 3, and 4 will be produced.
   The first item is number 1. *)
let stream_range_numbers start finish stream =
  stream_range
    (fun count _ -> count = start)
    (fun count _ -> count = finish)
    stream

(* Creates a stream that produces strings between a pair of regexps.
   The regexp will be tested using Str.string_match. *)
let stream_range_patterns start finish stream =
  stream_range
    (fun _ line -> Str.string_match start line 0)
    (fun _ line -> Str.string_match finish line 0)
    stream

(* Produce a stream of lines from an input channel. *)
let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

(* Print lines 15 through 17 inclusive. *)
let () =
  Stream.iter
    print_endline
    (stream_range_numbers 15 17
       (line_stream_of_channel (open_in datafile)))

(* Print out all <XMP> .. </XMP> displays from HTML doc. *)
let () =
  Stream.iter
    print_endline
    (stream_range_patterns
       (Str.regexp ".*<XMP>")
       (Str.regexp ".*</XMP>")
       (line_stream_of_channel stdin))

(*-----------------------------*)

let in_header = ref true
let in_body = ref false
let () =
  Stream.iter
    (fun line ->
       if !in_header && line = ""
       then (in_header := false; in_body := true)
       else
         begin
           (* do something with line *)
         end)
    (line_stream_of_channel stdin)

(*-----------------------------*)

module StringSet = Set.Make(String)
let seen = ref StringSet.empty
let email_regexp = Str.regexp "\\([^<>(),; \t]+@[^<>(),; \t]+\\)"
let () =
  Stream.iter
    (fun line ->
       List.iter
         (function
            | Str.Delim email ->
                if not (StringSet.mem email !seen)
                then
                  begin
                    seen := StringSet.add email !seen;
                    print_endline email;
                  end
            | _ -> ())
         (Str.full_split email_regexp line))
    (stream_range_patterns
       (Str.regexp "^From:?[ \t]")
       (Str.regexp "^$")
       (line_stream_of_channel stdin))

(* @@PLEAC@@_6.9 *)
#load "str.cma";;

let regexp_string_of_glob s =
  let i, buffer = ref (-1), Buffer.create (String.length s + 8) in
  let read () =
    incr i;
    if !i < String.length s
    then Some s.[!i]
    else None in
  let write = Buffer.add_string buffer in
  let rec parse_glob () =
    match read () with
      | Some '*' -> write ".*"; parse_glob ()
      | Some '?' -> write "."; parse_glob ()
      | Some '[' -> parse_bracket ""
      | Some c -> write (Str.quote (String.make 1 c)); parse_glob ()
      | None -> ()
  and parse_bracket text =
    match read () with
      | Some '!' when text = "" -> parse_bracket "^"
      | Some ']' -> write ("[" ^ text ^ "]"); parse_glob ()
      | Some c -> parse_bracket (text ^ (String.make 1 c))
      | None -> write (Str.quote ("[" ^ text)) in
  write "^";
  parse_glob ();
  write "$";
  Buffer.contents buffer

let regexp_of_glob s =
  Str.regexp (regexp_string_of_glob s)

let regexp_of_glob_case_fold s =
  Str.regexp_case_fold (regexp_string_of_glob s)

(* @@PLEAC@@_6.10 *)
#load "str.cma";;

let popstates = ["CO"; "ON"; "MI"; "WI"; "MN"]

(* Naive version: Compile a regexp each time it is needed. *)
let popgrep1 () =
  try
    begin
      while true do
        let line = input_line stdin in
        try
          List.iter
            (fun state ->
               if (Str.string_match
                     (Str.regexp (".*\\b" ^ (Str.quote state) ^ "\\b"))
                     line 0)
               then (print_endline line; raise Exit))
            popstates
        with Exit -> ()
      done
    end
  with End_of_file -> ()

(* First optimization: Compile the regexps in advance. *)
let popgrep2 () =
  let popstate_regexps =
    List.map
      (fun state ->
         Str.regexp (".*\\b" ^ (Str.quote state) ^ "\\b"))
      popstates in
  try
    begin
      while true do
        let line = input_line stdin in
        try
          List.iter
            (fun regexp ->
               if (Str.string_match regexp line 0)
               then (print_endline line; raise Exit))
            popstate_regexps
        with Exit -> ()
      done
    end
  with End_of_file -> ()

(* Second optimization: Build a single regexp for all states. *)
let popgrep3 () =
  let popstates_regexp =
    Str.regexp
      (".*\\b\\("
       ^ (String.concat "\\|" (List.map Str.quote popstates))
       ^ "\\)\\b") in
  try
    begin
      while true do
        let line = input_line stdin in
        if Str.string_match popstates_regexp line 0
        then print_endline line
      done
    end
  with End_of_file -> ()

(* Speed tests with a 15,000 line input file: *)
let () = popgrep1 ()         (* time: 13.670s *)
let () = popgrep2 ()         (* time:  0.264s *)
let () = popgrep3 ()         (* time:  0.123s *)

(* @@PLEAC@@_6.11 *)
#load "str.cma";;
let () =
  while true do
    print_string "Pattern? ";
    flush stdout;
    let pattern = input_line stdin in
    try ignore (Str.regexp pattern)
    with Failure message ->
      Printf.printf "INVALID PATTERN: %s\n" message
  done

(*-----------------------------*)

let is_valid_pattern pattern =
  try ignore (Str.regexp pattern); true
  with Failure _ -> false

(*-----------------------------*)

#!/usr/bin/ocaml
(* paragrep - trivial paragraph grepper *)
#load "str.cma";;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

let paragraph_stream_of_channel channel =
  let lines = line_stream_of_channel channel in
  let rec next para_lines i =
    match Stream.peek lines, para_lines with
      | None, [] -> None
      | Some "", [] -> Stream.junk lines; next para_lines i
      | Some "", _
      | None, _ -> Some (String.concat "\n" (List.rev para_lines))
      | Some line, _ -> Stream.junk lines; next (line :: para_lines) i in
  Stream.from (next [])

let paragrep pat files =
  let regexp =
    begin
      try Str.regexp pat
      with Failure msg ->
        Printf.eprintf "%s: Bad pattern %s: %s\n" Sys.argv.(0) pat msg;
        exit 1
    end in
  let count = ref 0 in
  List.iter
    (fun file ->
       let channel =
         if file = "-"
         then stdin
         else open_in file in
       try
         Stream.iter
           (fun para ->
              incr count;
              try
                ignore (Str.search_forward regexp para 0);
                Printf.printf "%s %d: %s\n\n" file !count para
              with Not_found -> ())
           (paragraph_stream_of_channel channel);
         close_in channel
       with e ->
         close_in channel;
         raise e)
    files

let () =
  match List.tl (Array.to_list Sys.argv) with
    | pat :: [] -> paragrep pat ["-"]
    | pat :: files -> paragrep pat files
    | [] -> Printf.eprintf "usage: %s pat [files]\n" Sys.argv.(0)

(*-----------------------------*)

let safe_pat = Str.quote pat

(* @@PLEAC@@_6.12 *)
(* OCaml does not provide a way to change the locale, and PCRE does
   not appear to be sensitive to the default locale. Regardless, Str
   does not support locales, and PCRE only matches ASCII characters
   for \w and friends. This example instead demonstrates the use of
   PCRE's UTF-8 support to match words, and it does not use locales. *)

#directory "+pcre";;
#load "pcre.cma";;

(* encoded as UTF-8 *)
let name = "andreas k\xc3\xb6nig"

(* the original regexp which is not Unicode-aware *)
let ascii_regexp = Pcre.regexp "\\b(\\w+)\\b"

(* a revised regexp which tests for Unicode letters and numbers *)
let utf8_regexp = Pcre.regexp ~flags:[`UTF8] "([\\pL\\pN]+)"

let () =
  List.iter
    (fun (enc, regexp) ->
       Printf.printf "%s names: %s\n" enc
         (String.concat " "
            (List.map
               String.capitalize
               (List.flatten
                  (Array.to_list
                     (Array.map
                        Array.to_list
                        (Pcre.extract_all
                           ~full_match:false
                           ~rex:regexp
                           name)))))))
    ["ASCII", ascii_regexp; "UTF-8", utf8_regexp]

(*
  ASCII names: Andreas K Nig
  UTF-8 names: Andreas König
*)

(* @@PLEAC@@_6.13 *)
(* Calculates the Levenshtein, or edit distance, between two strings. *)
let levenshtein s t =
  let n = String.length s in
  let m = String.length t in
  match (m, n) with
    | (m, 0) -> m
    | (0, n) -> n
    | (m, n) ->
        let d = Array.init (m + 1) (fun x -> x) in
        let x = ref 0 in
        for i = 0 to n - 1 do
          let e = ref (i + 1) in
          for j = 0 to m - 1 do
            let cost = if s.[i] = t.[j] then 0 else 1 in
            x :=
              min
                (d.(j + 1) + 1)      (* insertion *)
                (min
                   (!e + 1)          (* deletion *)
                   (d.(j) + cost));  (* substitution *)
            d.(j) <- !e;
            e := !x
          done;
          d.(m) <- !x
        done;
        !x

(* Determines if two strings are an approximate match. *)
let amatch ?(percentage=20) s t =
  levenshtein s t * 100 / String.length s <= percentage

let () =
  let dict = open_in "/usr/dict/words" in
  try
    while true do
      let word = input_line dict in
      if amatch "balast" word
      then print_endline word
    done
  with End_of_file -> close_in dict

(*
  ballast
  blast
*)

(* @@PLEAC@@_6.14 *)
#directory "+pcre";;
#load "pcre.cma";;

let s = "12 345 hello 6 7world89 10"
let rex = Pcre.regexp "(\\d+)"

let () =
  let subs = ref (Pcre.exec ~rex s) in
  try
    while true do
      Printf.printf "Found %s\n" (Pcre.get_substring !subs 1);
      subs := Pcre.next_match ~rex !subs
    done
  with Not_found -> ()

(*-----------------------------*)

let () =
  let n = "   49 here" in
  let n = Pcre.replace ~pat:"\\G " ~templ:"0" n in
  print_endline n

(* 00049 here *)

(*-----------------------------*)

let s = "3,4,5,9,120"
let rex = Pcre.regexp "\\G,?(\\d+)"

let () =
  let subs = ref (Pcre.exec ~rex s) in
  try
    while true do
      Printf.printf "Found number %s\n" (Pcre.get_substring !subs 1);
      subs := Pcre.next_match ~rex !subs
    done
  with Not_found -> ()

(*-----------------------------*)

let s = "The year 1752 lost 10 days on the 3rd of September"

let rex = Pcre.regexp "(\\d+)"
let subs = ref (Pcre.exec ~rex s)

let () =
  try
    while true do
      Printf.printf "Found number %s\n" (Pcre.get_substring !subs 1);
      subs := Pcre.next_match ~rex !subs
    done
  with Not_found -> ()

let () =
  let rex = Pcre.regexp "\\G(\\S+)" in
  subs := Pcre.next_match ~rex !subs;
  Printf.printf "Found %s after the last number.\n"
    (Pcre.get_substring !subs 1)

(*
  Found number 1752
  Found number 10
  Found number 3
  Found rd after the last number.
*)

(*-----------------------------*)

let () =
  match Pcre.get_substring_ofs !subs 1 with
    | (start, finish) ->
        Printf.printf
          "The position in 's' is %d..%d\n" start finish

(* The position in 's' is 35..37 *)

(* @@PLEAC@@_6.15 *)
let s = "Even <TT>vi</TT> can edit <TT>troff</TT> effectively."

(* The Str library does not support non-greedy matches. In many cases,
   you can turn a non-greedy match into a greedy one, however: *)

#load "str.cma";;

let () = print_endline (Str.global_replace (Str.regexp "<.*>") "" s)
(* Even  effectively. *)
let () = print_endline (Str.global_replace (Str.regexp "<[^>]*>") "" s)
(* Even vi can edit troff effectively. *)

(* If you need non-greedy matches, you'll want to use PCRE instead: *)

#directory "+pcre";;
#load "pcre.cma";;

let () = print_endline (Pcre.replace ~pat:"<.*?>" ~templ:"" s)
(* Even vi can edit troff effectively. *)

(* Non-greedy matches don't always work the way you expect: *)

let s = "<b><i>this</i> and <i>that</i> are important</b> Oh, <b><i>me too!</i></b>"

let rex = Pcre.regexp "<b><i>(.*?)</i></b>"
let () = print_endline (Pcre.extract ~rex s).(1)
(* this</i> and <i>that</i> are important</b> Oh, <b><i>me too! *)

(* One solution is to use a non-grouping negative lookahead assertion: *)

let rex = Pcre.regexp "<b><i>((?:(?!</b>|</i>).)*)</i></b>"
let () = print_endline (Pcre.extract ~rex s).(1)
(* me too! *)

(* If performance is important, here is a faster technique: *)

let rex = Pcre.regexp ~flags:[`DOTALL; `EXTENDED] "
    <b><i>
    [^<]*  # stuff not possibly bad, and not possibly the end.
    (?:
 # at this point, we can have '<' if not part of something bad
     (?!  </?[ib]>  )   # what we can't have
     <                  # okay, so match the '<'
     [^<]*              # and continue with more safe stuff
    ) *
    </i></b>
"

let () = print_endline (Pcre.extract ~rex s).(0)
(* <b><i>me too!</i></b> *)

(* @@PLEAC@@_6.16 *)
#directory "+pcre";;
#load "pcre.cma";;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

let paragraph_stream_of_channel channel =
  let lines = line_stream_of_channel channel in
  let rec next para_lines i =
    match Stream.peek lines, para_lines with
      | None, [] -> None
      | Some "", [] -> Stream.junk lines; next para_lines i
      | Some "", _
      | None, _ -> Some (String.concat "\n" (List.rev para_lines))
      | Some line, _ -> Stream.junk lines; next (line :: para_lines) i in
  Stream.from (next [])

let find_dup_words files =
  let rex = Pcre.regexp ~flags:[`CASELESS; `EXTENDED] "
      \\b            # start at a word boundary (begin letters)
      (\\S+)         # find chunk of non-whitespace
      \\b            # until another word boundary (end letters)
      (
          \\s+       # separated by some whitespace
          \\1        # and that very same chunk again
          \\b        # until another word boundary
      ) +            # one or more sets of those
  " in
  let count = ref 0 in
  List.iter
    (fun file ->
       let channel = if file = "-" then stdin else open_in file in
       try
         Stream.iter
           (fun para ->
              incr count;
              try
                let subs = ref (Pcre.exec ~rex para) in
                while true do
                  Printf.printf "dup word '%s' at paragraph %d.\n"
                    (Pcre.get_substring !subs 1)
                    !count;
                  flush stdout;
                  subs := Pcre.next_match ~rex !subs;
                done
              with Not_found -> ())
           (paragraph_stream_of_channel channel);
         close_in channel
       with e ->
         close_in channel;
         raise e)
    files

let () =
  match List.tl (Array.to_list Sys.argv) with
    | [] -> find_dup_words ["-"]
    | files -> find_dup_words files

(*-----------------------------*)

(*
  This is a test
  test of the duplicate word finder.
*)

(* dup word 'test' at paragraph 1. *)

(*-----------------------------*)

let a = "nobody"
let b = "bodysnatcher"
let () =
  try
    let subs =
      Pcre.exec
        ~pat:"^(\\w+)(\\w+) \\2(\\w+)$"
        (a ^ " " ^ b) in
    Printf.printf "%s overlaps in %s-%s-%s\n"
      (Pcre.get_substring subs 2)
      (Pcre.get_substring subs 1)
      (Pcre.get_substring subs 2)
      (Pcre.get_substring subs 3)
  with Not_found ->
    ()

(* body overlaps in no-body-snatcher *)

(*-----------------------------*)

#!/usr/bin/ocaml
(* prime_pattern -- find prime factors of argument using pattern matching *)
#directory "+pcre";;
#load "pcre.cma";;

let arg = try int_of_string Sys.argv.(1) with _ -> 0
let n = ref (String.make arg 'o')
let rex = Pcre.regexp "^(oo+?)\\1+$"
let templ = "o"
let () =
  try
    while true do
      let pat = Pcre.get_substring (Pcre.exec ~rex !n) 1 in
      Printf.printf "%d " (String.length pat);
      n := Pcre.replace ~pat ~templ !n
    done
  with Not_found ->
    Printf.printf "%d\n" (String.length !n)

(*-----------------------------*)

exception Found of (int * int * int)
let () =
  try
    match
      Pcre.extract
        ~full_match:false
        ~pat:"^(o*)\\1{11}(o*)\\2{14}(o*)\\3{15}$"
        (String.make 281 'o')
    with
      | [| x; y; z |] -> raise (Found
                                  (String.length x,
                                   String.length y,
                                   String.length z))
      | _ -> raise Not_found
  with
    | Found (x, y, z) ->
        Printf.printf "One solution is: x=%d; y=%d; z=%d.\n"
          x y z
    | Not_found ->
        Printf.printf "No solution.\n"

(* One solution is: x=17; y=3; z=2. *)

(*-----------------------------*)

~pat:"^(o+)\\1{11}(o+)\\2{14}(o+)\\3{15}$"
(* One solution is: x=17; y=3; z=2. *)

~pat:"^(o*?)\\1{11}(o*)\\2{14}(o*)\\3{15}$"
(* One solution is: x=0; y=7; z=11. *)

~pat:"^(o+?)\\1{11}(o*)\\2{14}(o*)\\3{15}$"
(* One solution is: x=1; y=3; z=14. *)

(* @@PLEAC@@_6.17 *)
#directory "+pcre";;
#load "pcre.cma";;

let pat = input_line config_channel
let () = if Pcre.pmatch ~pat data then (* ... *) ()

(*-----------------------------*)

(* alpha OR beta *)
let regexp = Pcre.regexp "alpha|beta"

(* alpha AND beta *)
let regexp = Pcre.regexp ~flags:[`DOTALL] "^(?=.*alpha)(?=.*beta)"

(* alpha AND beta, no overlap *)
let regexp = Pcre.regexp ~flags:[`DOTALL] "alpha.*beta|beta.*alpha"

(* NOT pat *)
let regexp = Pcre.regexp ~flags:[`DOTALL] "^(?:(?!pat).)*$"

(* NOT bad BUT good *)
let regexp = Pcre.regexp ~flags:[`DOTALL] "(?=(?:(?!bad).)*$)good"

(*-----------------------------*)

let () =
  if not (Pcre.pmatch ~rex:regexp text)
  then something ()

(*-----------------------------*)

let () =
  if (Pcre.pmatch ~rex:rexexp1 text) && (Pcre.pmatch ~rex:rexexp2 text)
  then something ()

(*-----------------------------*)

let () =
  if (Pcre.pmatch ~rex:rexexp1 text) || (Pcre.pmatch ~rex:rexexp2 text)
  then something ()

(*-----------------------------*)

#!/usr/bin/ocaml
(* minigrep - trivial grep *)
#directory "+pcre";;
#load "pcre.cma";;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> try Some (input_line channel) with End_of_file -> None)

let minigrep pat files =
  let rex =
    try Pcre.regexp pat
    with Pcre.BadPattern (msg, _) ->
      Printf.eprintf "%s: Bad pattern %s: %s\n" Sys.argv.(0) pat msg;
      exit 1 in
  let process file =
    let channel = if file = "-" then stdin else open_in file in
    try
      Stream.iter
        (fun line -> if Pcre.pmatch ~rex line then print_endline line)
        (line_stream_of_channel channel);
      close_in channel
    with e ->
      close_in channel;
      raise e in
  List.iter process files

let () =
  match List.tl (Array.to_list Sys.argv) with
    | pat :: [] -> minigrep pat ["-"]
    | pat :: files -> minigrep pat files
    | [] -> Printf.eprintf "usage: %s pat [files]\n" Sys.argv.(0)

(*-----------------------------*)

let string = "labelled"

let () =
  Printf.printf "%b\n"
    (Pcre.pmatch
       ~rex:(Pcre.regexp ~flags:[`DOTALL] "^(?=.*bell)(?=.*lab)")
       string)

let () =
  Printf.printf "%b\n"
    (Pcre.pmatch ~pat:"bell" string && Pcre.pmatch ~pat:"lab" string)

let () =
  if (Pcre.pmatch
        ~rex:(Pcre.regexp ~flags:[`DOTALL; `EXTENDED] "
             ^              # start of string
            (?=             # zero-width lookahead
                .*          # any amount of intervening stuff
                bell        # the desired bell string
            )               # rewind, since we were only looking
            (?=             # and do the same thing
                .*          # any amount of intervening stuff
                lab         # and the lab part
            )")
        string)
  then print_endline "Looks like Bell Labs might be in Murray Hill!"

let () =
  Printf.printf "%b\n"
    (Pcre.pmatch ~pat:"(?:^.*bell.*lab)|(?:^.*lab.*bell)" string)

let brand = "labelled"
let () =
  if