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
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)
;;
let string = "\\n"
let string = "Jon 'Maddog' Orwant"
let string = "\n"
let string = "Jon \"Maddog\" Orwant"
let a = "
This is a multiline here document
terminated by one double quote
"
let value = String.sub string offset count
let value = String.sub string offset (String.length string - offset)
let value = sub_end string offset
let sub_end string offset = String.sub string offset (String.length string - offset)
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
let chars = List.map (fun x -> x.[0]) (split_every_n_chars 1 string)
let string = "This is what you have";;
let first = String.sub string 0 1
let start = String.sub string 5 2
let rest = String.sub string 13 (String.length string - 13)
let last = String.sub string (String.length string - 1) 1
let theend = String.sub string (String.length string - 4) 4
let piece = String.sub string (String.length string - 8) 3
let string = "This is what you have";;
Printf.printf "%s" string ;
let string = (String.sub string 0 5) ^ "wasn't" ^ sub_end string 7
let string = (String.sub string 0 (String.length string -12)) ^
"ondrous";;
let string = String.sub string 1 (String.length string - 1)
let string = String.sub string 0 (String.length string -10)
let a = match b with None -> c | _ -> b;;
let x = match x with None -> y | _ -> x;;
let foo = match bar with Some x -> bar | _ -> Some "DEFAULT VALUE";;
let foo = match bar with Some x -> x | _ -> "DEFAULT VALUE";;
let dir = if Array.length Sys.argv > 1 then argv.(1) else "/tmp";;
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
let alpha, beta, production = "January", "March", "August"
let alpha, beta, production = beta, production, alpha
let num = Char.code char
let char = Char.chr num
printf "Number %d is character %c\n" num (Char.chr num)
let explode s =
let rec f acc = function
| -1 -> acc
| k -> f (s.[k] :: acc) (k - 1)
in f [] (String.length s - 1)
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
let ascii = List.map Char.code (explode string)
let string = implode (List.map Char.ord ascii)
let ascii_value = Char.code 'e'
let character = Char.chr 101
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]);;
printf "%s\n" word
sample
let hal = "HAL"
let ascii = List.map Char.code (explode hal)
let ascii = List.map (( + ) 1) ascii
let ibm = implode (List.map Char.chr ascii);;
printf "%s\n" ibm
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]);;
String.iter
(fun i -> ) s;;
let keys h =
let k = Hashtbl.fold (fun k v b -> k::b) h [] in
List.fold_left (fun b x -> if List.mem x b then b else x::b) [] k;;
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 ();;
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 ();;
let cksum s =
let sum = ref 0 in
String.iter (fun x -> sum := !sum + (Char.code x)) s;
!sum;;
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 in
List.fold_left addString 0 (slurp_to_list fn);;
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;;
#!/usr/local/bin/ocaml
#load "unix.cma";;
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;;
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';;
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;;
let reverse_words s =
String.concat " " (List.rev (Str.split (Str.regexp " ") s));;
let is_palindrome s =
s = reverse s;;
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;;
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 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)
let big = String.uppercase little;;
let little = String.lowercase big;;
let big = String.capitalize little;;
let little = String.uncapitalize big;;
let text = "thIS is a loNG liNE";;
let text = String.capitalize (String.lowercase text);;
print_endline text;;
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;;
let phrase = "I have " ^ (string_of_int (n+1)) ^ " guanacos.";;
let prhase = sprintf "I have %d guanacos." (n+1);;
#load "str.cma";;
let var = Str.global_replace (Str.regexp "^[\t ]+") "" "\
your text
goes here
";;
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 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 ();;
#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 ;;
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;;
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))
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
#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
#!/usr/bin/ocaml
#load "unix.cma";;
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 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}
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 =
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;
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 ->
match Printexc.to_string e with
| "Typecore.Error(_, _)" -> (TypeError pred)
| "Syntaxerr.Error(_)"
| "Lexer.Error(1, _)"
| "Lexer.Error(_, _)" -> (SyntaxError pred)
| "Misc.Fatal_error" -> pred
| _ -> e)
preds
then print_endline line
done
with
| End_of_file ->
ignore (Unix.close_process_in proc)
| e ->
ignore (Unix.close_process_in proc);
e
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;;
if predicate s then
else
let equalStr num1 num2 accuracy =
let p x = sprintf "%.*f" accuracy x in
(p num1) = (p num2)
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.);;
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);;
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;;
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;;
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) "";;
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";;
let numInt = decStr_of_binStr "0110110";;
let bin1 = binStr_of_decInt 54;;
let bin2 = binStr_of_decStr "54";;
for i = low to high do
done
let rec loop low high f =
if low > high then
()
else
begin
ignore (f low);
loop (succ low) high f
end;;
let rec loopStep low high step f =
if low > high then
()
else
begin
ignore (f low);
loopStep (low + step) high f
end;;
let makeArraySequence lo hi =
Array.init (hi - lo + 1) (fun i -> i + lo);;
Array.iter ( your function here ) (makeArraySequence lo hi);;
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();;
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 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
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];;
let password = Array.init 8 (fun i -> chars.(Random.int (Array.length chars)));;
let passString =
let s = String.make 8 ' ' in
for i=0 to 7 do
s.[i] <- chars.(Random.int (Array.length chars))
done;
s;;
Random.init 5;;
Random.full_init [| 1; 2; 178653; -62 |];;
Random.self_init ();;
let prng = Cryptokit.Random.secure_rng;;
let buf = String.make 10 ' ';;
prng#random_bytes buf 0 10;;
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;;
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;;
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);;
let sec x = 1. /. (sin x);;
let log_e = log 100.;;
let log_10 = log10 100.;;
let logB base x = (log x) /. (log base);;
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 (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;;
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};;
open Complex;;
let c = Complex.mul a b;;
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;;
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;;
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;;
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));;
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));;
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));;
let chopn n s =
match s with
"" -> [""]
| _ ->
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);;
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 -> "Exiting...\n";;
printf "The decimal value is %d\n" permissions;;
#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))
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))
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");;
#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 =
exn_map Not_found (f x) (x ^ "s") rules;;
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;;
#load "nums.cma";;
open Big_int;;
let cmd = [|"bigfact"; "8"; "9"; "96"; "2178";
"239322000000000000000000"; "25000000000000000000000000"; "17"|];;
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;;
#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 ;;
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 ;;
let ttup = mktime (localtime (time ())) ;;
Printf.printf "Epoch Seconds (local): %.0f\n" (fst ttup) ;;
let ttup = mktime (gmtime (time ())) ;;
Printf.printf "Epoch Seconds (UTC): %.0f\n" (fst ttup) ;;
#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
let birthtime = 96176750.
let interval = 5. +.
17. *. 60. +.
2. *. 60. *. 60. +.
55. *. 60. *. 60. *. 24.
let then' = birthtime +. interval
let () =
Printf.printf "Then is %s\n" (format_time then');
let bree = 361535725.
let nat = 96201950.
let difference = bree -. nat
let () =
Printf.printf "There were %.f seconds between Nat and Bree\n"
difference
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
#load "unix.cma";;
let {Unix.tm_mday=monthday; tm_wday=weekday; tm_yday=yearday} =
Unix.localtime date
let weeknum = yearday / 7 + 1
#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
#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)
#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)
let usleep time =
ignore (Unix.select [] [] [] time)
let () =
while true do
usleep 0.25;
print_newline ();
done
#!/usr/bin/ocaml
#load "str.cma";;
#load "unix.cma";;
let print_result sender recipient time delta =
Printf.printf "%-30s %-30s %-20s %s\n"
sender recipient time delta
let line_stream_of_channel channel =
Stream.from
(fun _ -> try Some (input_line channel) with End_of_file -> None)
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 [])
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
let continuation_regexp = Str.regexp "^[\t ]+"
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
type header = { from : string;
params : (string * string) list }
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
let header_stream_of_channel channel =
headers
(header_blocks
(paragraphs
(line_stream_of_channel channel)))
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]
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))
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)));
]
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
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
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
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
let () =
Stream.iter process_header (header_stream_of_channel stdin)
let nested = ["this"; "that"; "the"; "other"]
let nested = ("this", "that", ["the"; "other"])
let tune = ["The"; "Star-Spangled"; "Banner"]
let l = ["quick"; "brown"; "fox"];;
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);;
let data = open_in "mydatafile" in
let bigarray = readlines data in
bigarray;;
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;;
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 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;;
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 =
let s = s + 1 in
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;;
let people = resizeArray people 2;;
what_about_that_array people;;
let people = resizeArray people 10000;;
what_about_that_array people;;
Array.iter complain bad_users;;
List.iter complain bad_users;;
Hashtbl.iter (fun k v -> printf "%s=%s\n" k v) h;;
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;;
List.iter (fun x -> if get_usage x > max_quota then complain x) all_users;;
List.iter
(fun x ->
try
ignore (Str.search_forward (Str.quote "tchrist") x 0);
print_endline x;
with Not_found -> ()) who;;
let iter_channel f ic =
try
while true do
f (input_line ic)
done
with Not_found -> ();;
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
let s = chomp s in
List.iter
(fun x -> print_endline (reverse x))
(Str.split (Str.regexp "[ \t]+") s)) fh;;
let a = [|1; 2; 3|];;
Array.iteri (fun i x -> a.(i) <- x-1) a;;
let a = [| ref 1; ref 2; ref 3 |];;
Array.iter (fun x -> x := !x - 1) a;;
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);;
Array.iter (fun x -> ) !arrayref;;
for i = 0 to Array.length !arrayref - 1 do
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;;
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);;
let rec uniquesOnly l =
match l with
[] -> []
| h::t -> h::(uniquesOnly (List.filter ((<>) h) t));;
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;;
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 [];;
let userUnique f l =
List.map f (uniquesOnly l);;
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;;
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;;
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;;
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 [];;
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);;
let list1 = list1 @ list2;;
let array1 = Array.append array1 array2;;
let members = [| "Time"; "Flies" |];;
let initiates = [| "An"; "Arrow" |];;
let members = Array.append members initiates;;
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 ();;
let reversed = List.rev l;;
let revArray a =
let len = Array.length a - 1 in
Array.init len+1 (fun i -> a.(len - i);;
let reversed = revArray a;;
for i = Array.length a - 1 downto 0 do
done;;
front,arr = splice arr 0 ~length:n;;
rear,arr = splice arr (-n);;
let shift2 a = splice a 0 ~length:2;;
let pop2 a = splice a (-2);;
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;;
match
(try Some (List.find (fun x -> x > 10) l)
with Not_found -> None)
with
None ->
| Some x -> ;;
let pf l =
try
printf "hah! Found %d!\n" (List.find (fun x -> x > 10) l)
with
Not_found -> "Sorry charly!\n";;
exception Found of int;;
let findi pred arr =
Array.iteri (fun i x -> if pred x then (Found i)) arr;
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";;
let highest_engineer =
List.find (fun x -> x#category = "engineer") employees in
printf "Highest paid engineer is: %s\n" highest_engineer#name;;
let matching = List.find_all ( l;;
let matching =
Array.ofList (List.find_all ( ) (Array.to_list a));;
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;;
let sorted = List.sort compare unsorted;;
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;;
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;;
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;;
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 ()))));;
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;;
let popleft l =
match l with
[] -> Not_found
| h::t -> h,(t @ [h]);;
let popright l =
match List.rev l with
[] -> 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;;
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;;
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;;
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 [||];;
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;;
let age = Hashtbl.create 3 ;;
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" ;
] ;;
Hashtbl.replace tbl key value ;;
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) ;;
if (Hashtbl.mem hash key) then
else
;;
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"] ;;
let age = assoc_list2hashtbl
[ "Toddler", 3 ; "Unborn", 0 ] ;;
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 ] ;;
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" ]
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);
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);
Hashtbl.remove hash key ;
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 ;;
open Printf;;
Hashtbl.iter
(fun key value ->
)
hash
;;
List.iter (fun key ->
let value = Hashtbl.find hash key in
) (hashtbl_keys hash)
;;
Hashtbl.iter (printf "%s is %s.\n") food_color;
Hashtbl.iter (printf "food_color: %s is %s.\n") food_color;
Hashtbl.iter (fun k v -> printf "food_color: %s is %s.\n" k v) food_color;
List.iter (fun key ->
let value = Hashtbl.find food_color key in
printf "%s is %s.\n" key value
) (hashtbl_keys food_color) ;
List.iter
(fun key ->
printf "%s is %s.\n" key (Hashtbl.find food_color key)
)
(sort_ (hashtbl_keys food_color))
;;
List.iter
(fun key ->
while true do
printf "Processing %s\n" key
done
)
(hashtbl_keys food_color)
;;
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() ;
Hashtbl.iter (printf "%s => %s\n") hash ;
List.iter
(fun key ->
printf "%s => %s\n" key (Hashtbl.find hash key)
)
(hashtbl_keys hash) ;
let hashtbl2list hash =
Hashtbl.fold
(fun key value init -> key :: value :: init)
hash
[]
;;
List.iter (printf "%s ") (hashtbl2list hash) ;
print_endline (String.concat " " (hashtbl2list hash)) ;
let empty_food_color = []
let food_color =
[ "Banana", "Yellow" ;
"Apple", "Green" ;
"Lemon", "Yellow" ;
]
let food_color' = food_color @ [ "Carrot", "orange" ]
;;
print_endline "In insertion order, the foods are:";
List.iter (printf "%s is colored %s.\n") food_color;
let has_food food = mem_assoc food food_color
let remove_food food = remove_assoc food food_color
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
;;
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)))
open Hashtbl
let hashtbl_size h = List.length (hashtbl_keys h);;
let hashtbl_reverse h =
assoc_list2hashtbl (List.combine (hashtbl_values h) (hashtbl_keys h))
let hashtbl_reverse h =
assoc_list2hashtbl (List.map (fun (a,b) -> (b,a)) (hashtbl2assoc_list h))
;;
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
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");;
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 -> ())
;;
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."
;;
let keys = List.sort compare_function (hashtbl_keys hash) in
List.iter
(fun key ->
let value = Hashtbl.find hash key in
()
)
keys ;
Hashtbl.iter
(fun (key, 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))
;;
let compare_function (_,color1) (_,color2) = compare color1 color2
let compare_function (_,color1) (_,color2) = compare (String.length color1) (String.length color2)
let hashtbl_merge h1 h2 = assoc_list2hashtbl (hashtbl2assoc_list h1 @ hashtbl2assoc_list h2)
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]
;;
let common =
List.filter
(fun key -> Hashtbl.mem hash2 key)
(hashtbl_keys hash1)
;;
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)
;;
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
;;
let hash = Hashtbl.create num;;
let hash = Hashtbl.create 512;;
let hash = Hashtbl.create 1000;;
let count = Array.length a;;
let count = List.length l;;
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"] ;;
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;
;;
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;;
let hasnoinclude fname = (find includes fname = []) in
List.filter hasnoinclude (uniq (hashtbl_keys includes));;
#!/usr/bin/ocaml
#load "str.cma";;
#load "unix.cma";;
let dirsize = Hashtbl.create 0
let kids = Hashtbl.create 0
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 -> []))
| _ -> 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
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
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
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;;
try not ((Str.search_forward (Str.regexp "sheep") meadow 0) > -1);
with Not_found -> true;;
let meadow =
try Str.replace_first (Str.regexp "old") "new" meadow;
with Not_found -> 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;;
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";;
print_string "Overlapping: ";
List.iter (fun v -> print_string (v ^ " ")) !yeslap;
print_string "\n";;
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");;
#load "str.cma";;
let dst = Str.global_replace (Str.regexp "this") "that" src
let progname = Str.replace_first (Str.regexp "^.*/") "" Sys.argv.(0)
let capword =
Str.global_substitute
(Str.regexp "\\b.")
(fun s -> String.uppercase (Str.matched_string s))
words
let catpage =
Str.replace_first (Str.regexp "man\\([0-9]\\)") "cat\\1" manpage
let bindirs = ["/usr/bin"; "/bin"; "/usr/local/bin"]
let libdirs =
List.map (fun s -> Str.replace_first (Str.regexp "bin") "lib" s)
bindirs
#load "str.cma";;
let () =
if Str.string_match (Str.regexp "^[A-Za-z]+$") var 0
then print_endline "var is purely alphabetic"
#directory "+pcre";;
#load "pcre.cma";;
let () =
if Pcre.pmatch ~rex:(Pcre.regexp ~flags:[`UTF8] "^\\pL+$") var
then print_endline "var is purely alphabetic"
#load "str.cma";;
let whitespace_chars =
String.concat ""
(List.map (String.make 1)
[
Char.chr 9;
Char.chr 10;
Char.chr 11;
Char.chr 12;
Char.chr 13;
Char.chr 32;
])
let space = "[" ^ whitespace_chars ^ "]"
let non_space = "[^" ^ whitespace_chars ^ "]"
let regexp = Str.regexp (non_space ^ "+")
let regexp = Str.regexp "[A-Za-z'-]+"
let regexp = Str.regexp "\\b\\([A-Za-z]+\\)\\b"
let regexp = Str.regexp (space ^ "\\([A-Za-z]+\\)" ^ space)
#!/usr/bin/ocaml
#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?")
#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 (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
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)
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)
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)
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
#!/usr/bin/ocaml
#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;
e)
(List.tl (Array.to_list Sys.argv))
#!/usr/bin/ocaml
#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;
e)
(List.tl (Array.to_list Sys.argv))
#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)
#load "str.cma";;
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
let stream_range_numbers start finish stream =
stream_range
(fun count _ -> count = start)
(fun count _ -> count = finish)
stream
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
let line_stream_of_channel channel =
Stream.from
(fun _ -> try Some (input_line channel) with End_of_file -> None)
let () =
Stream.iter
print_endline
(stream_range_numbers 15 17
(line_stream_of_channel (open_in datafile)))
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
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))
#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)
#load "str.cma";;
let popstates = ["CO"; "ON"; "MI"; "WI"; "MN"]
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; Exit))
popstates
with Exit -> ()
done
end
with End_of_file -> ()
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; Exit))
popstate_regexps
with Exit -> ()
done
end
with End_of_file -> ()
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 -> ()
let () = popgrep1 ()
let () = popgrep2 ()
let () = popgrep3 ()
#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
#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;
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
#directory "+pcre";;
#load "pcre.cma";;
let name = "andreas k\xc3\xb6nig"
let ascii_regexp = Pcre.regexp "\\b(\\w+)\\b"
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]
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)
(min
(!e + 1)
(d.(j) + cost));
d.(j) <- !e;
e := !x
done;
d.(m) <- !x
done;
!x
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
#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
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)
let () =
match Pcre.get_substring_ofs !subs 1 with
| (start, finish) ->
Printf.printf
"The position in 's' is %d..%d\n" start finish
let s = "Even <TT>vi</TT> can edit <TT>troff</TT> effectively."
#load "str.cma";;
let () = print_endline (Str.global_replace (Str.regexp "<.*>") "" s)
let () = print_endline (Str.global_replace (Str.regexp "<[^>]*>") "" s)
#directory "+pcre";;
#load "pcre.cma";;
let () = print_endline (Pcre.replace ~pat:"<.*?>" ~templ:"" s)
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)
let rex = Pcre.regexp "<b><i>((?:(?!</b>|</i>).)*)</i></b>"
let () = print_endline (Pcre.extract ~rex s).(1)
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)
#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;
e)
files
let () =
match List.tl (Array.to_list Sys.argv) with
| [] -> find_dup_words ["-"]
| files -> find_dup_words files
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 ->
()
#!/usr/bin/ocaml
#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 |] -> (Found
(String.length x,
String.length y,
String.length z))
| _ -> 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"
~pat:"^(o+)\\1{11}(o+)\\2{14}(o+)\\3{15}$"
~pat:"^(o*?)\\1{11}(o*)\\2{14}(o*)\\3{15}$"
~pat:"^(o+?)\\1{11}(o*)\\2{14}(o*)\\3{15}$"
#directory "+pcre";;
#load "pcre.cma";;
let pat = input_line config_channel
let () = if Pcre.pmatch ~pat data then ()
let regexp = Pcre.regexp "alpha|beta"
let regexp = Pcre.regexp ~flags:[`DOTALL] "^(?=.*alpha)(?=.*beta)"
let regexp = Pcre.regexp ~flags:[`DOTALL] "alpha.*beta|beta.*alpha"
let regexp = Pcre.regexp ~flags:[`DOTALL] "^(?:(?!pat).)*$"
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
#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;
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