(* -*- 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... *)

(* @@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

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

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. *. (