├── Chapter 10 ├── examples.ml └── exercises.ml ├── Chapter 11 ├── examples.ml └── exercises.ml ├── Chapter 12 ├── examples.ml └── exercises.ml ├── Chapter 13 ├── examples.ml └── exercises.ml ├── Chapter 14 ├── examples.ml └── exercises.ml ├── Chapter 15 └── exercises.ml ├── Chapter 16 ├── README.txt ├── gregor.txt ├── q2.ml ├── q3.ml ├── q4.ml ├── stats.ml ├── textstat.ml └── textstat.mli ├── Chapter 2 ├── examples.ml └── exercises.ml ├── Chapter 3 ├── examples.ml └── exercises.ml ├── Chapter 4 ├── examples.ml └── exercises.ml ├── Chapter 5 ├── examples.ml └── exercises.ml ├── Chapter 6 ├── examples.ml └── exercises.ml ├── Chapter 7 ├── examples.ml └── exercises.ml ├── Chapter 8 ├── examples.ml └── exercises.ml ├── Chapter 9 ├── examples.ml └── exercises.ml └── README.md /Chapter 10/examples.ml: -------------------------------------------------------------------------------- 1 | type colour = Red | Green | Blue | Yellow 2 | 3 | let col = Blue 4 | 5 | let cols = [Red; Red; Green; Yellow] 6 | 7 | let colpair = ('R', Red) 8 | 9 | type colour = 10 | Red 11 | | Green 12 | | Blue 13 | | Yellow 14 | | RGB of int * int * int 15 | 16 | let cols = [Red; Red; Green; Yellow; RGB (150, 0, 255)] 17 | 18 | let components c = 19 | match c with 20 | Red -> (255, 0, 0) 21 | | Green -> (0, 255, 0) 22 | | Blue -> (0, 0, 255) 23 | | Yellow -> (255, 255, 0) 24 | | RGB (r, g, b) -> (r, g, b) 25 | 26 | let nothing = None 27 | 28 | let number = Some 50 29 | 30 | let numbers = [Some 12; None; None; Some 2] 31 | 32 | let word = Some ['c'; 'a'; 'k'; 'e'] 33 | 34 | let rec lookup_opt x l = 35 | match l with 36 | [] -> None 37 | | (k, v)::t -> if x = k then Some v else lookup_opt x t 38 | 39 | let rec length l = 40 | match l with 41 | [] -> 0 42 | | _::t -> 1 + length t 43 | 44 | let rec append a b = 45 | match a with 46 | [] -> b 47 | | h::t -> h :: append t b 48 | 49 | type 'a sequence = Nil | Cons of 'a * 'a sequence 50 | 51 | let rec length s = 52 | match s with 53 | Nil -> 0 54 | | Cons (_, t) -> 1 + length t 55 | 56 | let rec append a b = 57 | match a with 58 | Nil -> b 59 | | Cons (h, t) -> Cons (h, append t b) 60 | 61 | type expr = 62 | Num of int 63 | | Add of expr * expr 64 | | Subtract of expr * expr 65 | | Multiply of expr * expr 66 | | Divide of expr * expr 67 | 68 | let rec evaluate e = 69 | match e with 70 | Num x -> x 71 | | Add (e, e') -> evaluate e + evaluate e' 72 | | Subtract (e, e') -> evaluate e - evaluate e' 73 | | Multiply (e, e') -> evaluate e * evaluate e' 74 | | Divide (e, e') -> evaluate e / evaluate e' 75 | -------------------------------------------------------------------------------- /Chapter 10/exercises.ml: -------------------------------------------------------------------------------- 1 | type rect = 2 | Square of int 3 | | Rectangle of int * int 4 | 5 | let area r = 6 | match r with 7 | Square s -> s * s 8 | | Rectangle (w, h) -> w * h 9 | 10 | let rotate r = 11 | match r with 12 | Rectangle (w, h) -> 13 | if w > h then Rectangle (h, w) else r 14 | | Square _ -> r 15 | 16 | let width_of_rect r = 17 | match r with 18 | Square s -> s 19 | | Rectangle (w, _) -> w 20 | 21 | let rect_compare a b = 22 | width_of_rect a < width_of_rect b 23 | 24 | let rec map f l = 25 | match l with 26 | [] -> [] 27 | | h::t -> f h :: map f t 28 | 29 | let rec insert f x l = 30 | match l with 31 | [] -> [x] 32 | | h::t -> 33 | if f x h 34 | then x :: h :: t 35 | else h :: insert f x t 36 | 37 | let rec sort f l = 38 | match l with 39 | [] -> [] 40 | | h::t -> insert f h (sort f t) 41 | 42 | let pack rs = 43 | sort rect_compare (map rotate rs) 44 | 45 | type 'a sequence = Nil | Cons of 'a * 'a sequence 46 | 47 | let rec take n l = 48 | if n = 0 then Nil else 49 | match l with 50 | Nil -> raise (Invalid_argument "take") 51 | | Cons (h, t) -> Cons (h, take (n - 1) t) 52 | 53 | let rec drop n l = 54 | if n = 0 then l else 55 | match l with 56 | Nil -> raise (Invalid_argument "drop") 57 | | Cons (_, l) -> drop (n - 1) l 58 | 59 | let rec map f l = 60 | match l with 61 | Nil -> Nil 62 | | Cons (h, t) -> Cons (f h, map f t) 63 | 64 | let rec power x n = 65 | if n = 0 then 1 else 66 | if n = 1 then x else 67 | x * power x (n - 1) 68 | 69 | type expr = 70 | Num of int 71 | | Add of expr * expr 72 | | Subtract of expr * expr 73 | | Multiply of expr * expr 74 | | Divide of expr * expr 75 | | Power of expr * expr 76 | 77 | let rec evaluate e = 78 | match e with 79 | Num x -> x 80 | | Add (e, e') -> evaluate e + evaluate e' 81 | | Subtract (e, e') -> evaluate e - evaluate e' 82 | | Multiply (e, e') -> evaluate e * evaluate e' 83 | | Divide (e, e') -> evaluate e / evaluate e' 84 | | Power (e, e') -> power (evaluate e) (evaluate e') 85 | 86 | let evaluate_opt e = 87 | try Some (evaluate e) with Division_by_zero -> None 88 | -------------------------------------------------------------------------------- /Chapter 11/examples.ml: -------------------------------------------------------------------------------- 1 | type 'a tree = 2 | Br of 'a * 'a tree * 'a tree 3 | | Lf 4 | 5 | let rec size tr = 6 | match tr with 7 | Br (_, l, r) -> 1 + size l + size r 8 | | Lf -> 0 9 | 10 | let rec total tr = 11 | match tr with 12 | Br (x, l, r) -> x + total l + total r 13 | | Lf -> 0 14 | 15 | let max x y = 16 | if x > y then x else y 17 | 18 | let rec maxdepth tr = 19 | match tr with 20 | Br (_, l, r) -> 1 + max (maxdepth l) (maxdepth r) 21 | | Lf -> 0 22 | 23 | let rec list_of_tree tr = 24 | match tr with 25 | Br (x, l, r) -> list_of_tree l @ [x] @ list_of_tree r 26 | | Lf -> [] 27 | 28 | let rec tree_map f tr = 29 | match tr with 30 | Br (x, l, r) -> Br (f x, tree_map f l, tree_map f r) 31 | | Lf -> Lf 32 | 33 | let rec lookup tr k = 34 | match tr with 35 | Lf -> raise Not_found 36 | | Br ((k', v), l, r) -> 37 | if k = k' then v 38 | else if k < k' then lookup l k 39 | else lookup r k 40 | 41 | let rec lookup tr k = 42 | match tr with 43 | Lf -> None 44 | | Br ((k', v), l, r) -> 45 | if k = k' then Some v 46 | else if k < k' then lookup l k 47 | else lookup r k 48 | 49 | let rec insert tr k v = 50 | match tr with 51 | Lf -> Br ((k, v), Lf, Lf) 52 | | Br ((k', v'), l, r) -> 53 | if k = k' then Br ((k, v), l, r) 54 | else if k < k' then Br ((k', v'), insert l k v, r) 55 | else Br ((k', v'), l, insert r k v) 56 | -------------------------------------------------------------------------------- /Chapter 11/exercises.ml: -------------------------------------------------------------------------------- 1 | type 'a tree = 2 | Lf 3 | | Br of 'a * 'a tree * 'a tree 4 | 5 | let rec member_tree x tr = 6 | match tr with 7 | Lf -> false 8 | | Br (y, l, r) -> x = y || member_tree x l || member_tree x r 9 | 10 | let rec flip_tree tr = 11 | match tr with 12 | Lf -> Lf 13 | | Br (x, l, r) -> Br (x, flip_tree r, flip_tree l) 14 | 15 | let rec equal_shape tr tr2 = 16 | match tr, tr2 with 17 | Lf, Lf -> 18 | true 19 | | Br (_, l, r), Br (_, l2, r2) -> 20 | equal_shape l l2 && equal_shape r r2 21 | | _, _ -> 22 | false 23 | 24 | let rec tree_map f tr = 25 | match tr with 26 | Br (x, l, r) -> Br (f x, tree_map f l, tree_map f r) 27 | | Lf -> Lf 28 | 29 | let rec equal_shape tr tr2 = 30 | tree_map (fun _ -> 0) tr = tree_map (fun _ -> 0) tr2 31 | 32 | let rec insert tr k v = 33 | match tr with 34 | Lf -> Br ((k, v), Lf, Lf) 35 | | Br ((k', v'), l, r) -> 36 | if k = k' then Br ((k, v), l, r) 37 | else if k < k' then Br ((k', v'), insert l k v, r) 38 | else Br ((k', v'), l, insert r k v) 39 | 40 | let rec list_of_tree tr = 41 | match tr with 42 | Br (x, l, r) -> list_of_tree l @ [x] @ list_of_tree r 43 | | Lf -> [] 44 | 45 | let rec tree_of_list l = 46 | match l with 47 | [] -> Lf 48 | | (k, v)::t -> insert (tree_of_list t) k v 49 | 50 | let tree_union t t' = 51 | tree_of_list (list_of_tree t' @ list_of_tree t) 52 | 53 | type 'a mtree = Branch of 'a * 'a mtree list 54 | 55 | let rec sum l = 56 | match l with 57 | [] -> 0 58 | | h::t -> h + sum t 59 | 60 | let rec map f l = 61 | match l with 62 | [] -> [] 63 | | h::t -> f h :: map f t 64 | 65 | let rec size tr = 66 | match tr with 67 | Branch (e, l) -> 1 + sum (map size l) 68 | 69 | let rec total tr = 70 | match tr with 71 | Branch (e, l) -> e + sum (map total l) 72 | 73 | let rec map_mtree f tr = 74 | match tr with 75 | Branch (e, l) -> Branch (f e, map (map_mtree f) l) 76 | 77 | let rec size (Branch (e, l)) = 78 | 1 + sum (map size l) 79 | 80 | let rec total (Branch (e, l)) = 81 | e + sum (map total l) 82 | 83 | let rec map_mtree f (Branch (e, l)) = 84 | Branch (f e, map (map_mtree f) l) 85 | -------------------------------------------------------------------------------- /Chapter 12/examples.ml: -------------------------------------------------------------------------------- 1 | let print_dict_entry (k, v) = 2 | print_int k ; print_newline () ; print_string v ; print_newline () 3 | 4 | let print_dict_entry (k, v) = 5 | print_int k; 6 | print_newline (); 7 | print_string v; 8 | print_newline () 9 | 10 | let rec print_dict d = 11 | match d with 12 | [] -> () 13 | | h::t -> print_dict_entry h; print_dict t 14 | 15 | let rec iter f l = 16 | match l with 17 | [] -> () 18 | | h::t -> f h; iter f t 19 | 20 | let print_dict d = 21 | iter print_dict_entry d 22 | 23 | let print_dict = 24 | iter print_dict_entry 25 | 26 | let rec read_dict () = 27 | let i = read_int () in 28 | if i = 0 then [] else 29 | let name = read_line () in 30 | (i, name) :: read_dict () 31 | 32 | let rec read_dict () = 33 | try 34 | let i = read_int () in 35 | if i = 0 then [] else 36 | let name = read_line () in 37 | (i, name) :: read_dict () 38 | with 39 | Failure _ -> 40 | print_string "This is not a valid integer. Please try again."; 41 | print_newline (); 42 | read_dict () 43 | 44 | let entry_to_channel ch (k, v) = 45 | output_string ch (string_of_int k); 46 | output_char ch '\n'; 47 | output_string ch v; 48 | output_char ch '\n' 49 | 50 | let dictionary_to_channel ch d = 51 | iter (entry_to_channel ch) d 52 | 53 | let dictionary_to_file filename dict = 54 | let ch = open_out filename in 55 | dictionary_to_channel ch dict; 56 | close_out ch 57 | 58 | let entry_of_channel ch = 59 | let number = input_line ch in 60 | let name = input_line ch in 61 | (int_of_string number, name) 62 | 63 | let rec dictionary_of_channel ch = 64 | try 65 | let e = entry_of_channel ch in 66 | e :: dictionary_of_channel ch 67 | with 68 | End_of_file -> [] 69 | 70 | let dictionary_of_file filename = 71 | let ch = open_in filename in 72 | let dict = dictionary_of_channel ch in 73 | close_in ch; 74 | dict 75 | -------------------------------------------------------------------------------- /Chapter 12/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec iter f l = 2 | match l with 3 | [] -> () 4 | | h::t -> f h; iter f t 5 | 6 | let print_integers l = 7 | print_string "["; 8 | iter (fun i -> print_int i; print_string "; ") l; 9 | print_string "]" 10 | 11 | let rec print_integers_inner l = 12 | match l with 13 | [] -> () 14 | | [i] -> print_int i 15 | | h::t -> print_int h; print_string "; "; print_integers_inner t 16 | 17 | let print_integers l = 18 | print_string "["; 19 | print_integers_inner l; 20 | print_string "]" 21 | 22 | let rec read_three () = 23 | try 24 | print_string "Type three integers, pressing Enter after each"; 25 | print_newline (); 26 | let x = read_int () in 27 | let y = read_int () in 28 | let z = read_int () in 29 | (x, y, z) 30 | with 31 | Failure _ -> 32 | print_string "failed to read integers; please try again"; 33 | print_newline (); 34 | read_three () 35 | 36 | let rec read_dict_number n = 37 | if n = 0 then [] else 38 | try 39 | let i = read_int () in 40 | let name = read_line () in 41 | (i, name) :: read_dict_number (n - 1) 42 | with 43 | Failure _ -> 44 | print_string "This is not a valid integer."; 45 | print_newline (); 46 | print_string "Please enter integer and name again."; 47 | print_newline (); 48 | read_dict_number n 49 | 50 | exception BadNumber 51 | 52 | let rec read_dict () = 53 | print_string "How many dictionary entries to input?"; 54 | print_newline (); 55 | try 56 | let n = read_int () in 57 | if n < 0 then raise BadNumber else read_dict_number n 58 | with 59 | Failure _ -> 60 | print_string "Not a number. Try again"; 61 | print_newline (); 62 | read_dict () 63 | | BadNumber -> 64 | print_string "Number is negative. Try again"; 65 | print_newline (); 66 | read_dict () 67 | 68 | let rec numlist n = 69 | match n with 70 | 0 -> [] 71 | | _ -> (numlist (n - 1)) @ [n] 72 | 73 | let rec map f l = 74 | match l with 75 | [] -> [] 76 | | h::t -> f h :: map f t 77 | 78 | let write_table_channel ch n = 79 | iter 80 | (fun x -> 81 | iter 82 | (fun i -> 83 | output_string ch (string_of_int i); 84 | output_string ch "\t") 85 | (map (( * ) x) (numlist n)); 86 | output_string ch "\n") 87 | (numlist n) 88 | 89 | exception FileProblem 90 | 91 | let table filename n = 92 | if n < 0 then raise (Invalid_argument "table") else 93 | try 94 | let ch = open_out filename in 95 | write_table_channel ch n; 96 | close_out ch 97 | with 98 | _ -> raise FileProblem 99 | 100 | let rec countlines_channel ch = 101 | try 102 | let _ = input_line ch in 103 | 1 + countlines_channel ch 104 | with 105 | End_of_file -> 0 106 | 107 | let countlines file = 108 | try 109 | let ch = open_in file in 110 | let result = countlines_channel ch in 111 | close_in ch; 112 | result 113 | with 114 | _ -> raise (Failure "countlines") 115 | 116 | let rec copy_file_ch from_ch to_ch = 117 | try 118 | output_string to_ch (input_line from_ch); 119 | output_string to_ch "\n"; 120 | copy_file_ch from_ch to_ch 121 | with 122 | End_of_file -> () 123 | 124 | exception CopyFailed 125 | 126 | let copy_file from_name to_name = 127 | try 128 | let from_ch = open_in from_name in 129 | let to_ch = open_out to_name in 130 | copy_file_ch from_ch to_ch; 131 | close_in from_ch; 132 | close_out to_ch 133 | with 134 | _ -> raise CopyFailed 135 | -------------------------------------------------------------------------------- /Chapter 13/examples.ml: -------------------------------------------------------------------------------- 1 | let swap a b = 2 | let t = !a in 3 | a := !b; b := t 4 | 5 | let smallest_pow2 x = 6 | let t = ref 1 in 7 | while !t < x do 8 | t := !t * 2 9 | done; 10 | !t 11 | 12 | (* Final version of word counter *) 13 | let print_histogram arr = 14 | print_string "Character frequencies:"; 15 | print_newline (); 16 | for x = 0 to 255 do 17 | if arr.(x) > 0 then 18 | begin 19 | print_string "For character '"; 20 | print_char (char_of_int x); 21 | print_string "' (character number "; 22 | print_int x; 23 | print_string ") the count is "; 24 | print_int arr.(x); 25 | print_string "."; 26 | print_newline () 27 | end 28 | done 29 | 30 | let channel_statistics in_channel = 31 | let lines = ref 0 32 | and characters = ref 0 33 | and words = ref 0 34 | and sentences = ref 0 35 | and histogram = Array.make 256 0 in 36 | try 37 | while true do 38 | let line = input_line in_channel in 39 | lines := !lines + 1; 40 | characters := !characters + String.length line; 41 | String.iter 42 | (fun c -> 43 | match c with 44 | '.' | '?' | '!' -> sentences := !sentences + 1 45 | | ' ' -> words := !words + 1 46 | | _ -> ()) 47 | line; 48 | String.iter 49 | (fun c -> 50 | let i = int_of_char c in 51 | histogram.(i) <- histogram.(i) + 1) 52 | line 53 | done 54 | with 55 | End_of_file -> 56 | print_string "There were "; 57 | print_int !lines; 58 | print_string " lines, making up "; 59 | print_int !characters; 60 | print_string " characters with "; 61 | print_int !words; 62 | print_string " words in "; 63 | print_int !sentences; 64 | print_string " sentences."; 65 | print_newline (); 66 | print_histogram histogram 67 | 68 | let file_statistics name = 69 | let channel = open_in name in 70 | try 71 | channel_statistics channel; 72 | close_in channel 73 | with 74 | _ -> close_in channel 75 | -------------------------------------------------------------------------------- /Chapter 13/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec forloop f n m = 2 | if n <= m then 3 | begin 4 | f n; 5 | forloop f (n + 1) m 6 | end 7 | 8 | let array_sum a = 9 | let sum = ref 0 in 10 | for x = 0 to Array.length a - 1 do 11 | sum := !sum + a.(x) 12 | done; 13 | !sum 14 | 15 | let array_rev a = 16 | if Array.length a > 1 then 17 | for x = 0 to Array.length a / 2 - 1 do 18 | let t = a.(x) in 19 | a.(x) <- a.(Array.length a - 1 - x); 20 | a.(Array.length a - 1 - x) <- t 21 | done 22 | 23 | let table n = 24 | let a = Array.make n [||] in 25 | for x = 0 to n - 1 do 26 | a.(x) <- Array.make n 0 27 | done; 28 | for y = 0 to n - 1 do 29 | for x = 0 to n - 1 do 30 | a.(x).(y) <- (x + 1) * (y + 1) 31 | done 32 | done; 33 | a 34 | 35 | let uppercase x = 36 | if int_of_char x >= 97 && int_of_char x <= 122 37 | then char_of_int (int_of_char x - 32) 38 | else x 39 | 40 | let lowercase x = 41 | if int_of_char x >= 65 && int_of_char x <= 90 42 | then char_of_int (int_of_char x + 32) 43 | else x 44 | -------------------------------------------------------------------------------- /Chapter 14/examples.ml: -------------------------------------------------------------------------------- 1 | let make_vector (x0, y0) (x1, y1) = 2 | (x1 -. x0, y1 -. y0) 3 | 4 | let vector_length (x, y) = 5 | sqrt (x *. x +. y *. y) 6 | 7 | let offset_point (x, y) (px, py) = 8 | (px +. x, py +. y) 9 | 10 | let scale_to_length l (a, b) = 11 | let currentlength = vector_length (a, b) in 12 | if currentlength = 0. then (a, b) else 13 | let factor = l /. currentlength in 14 | (a *. factor, b *. factor) 15 | -------------------------------------------------------------------------------- /Chapter 14/exercises.ml: -------------------------------------------------------------------------------- 1 | let round x = 2 | let c = ceil x in 3 | let f = floor x in 4 | if c -. x <= x -. f then c else f 5 | 6 | let between (x, y) (x', y') = 7 | ((x +. x') /. 2., (y +. y') /. 2.) 8 | 9 | let rec parts x = 10 | if x < 0. then 11 | let a, b = parts (-. x) in 12 | (-. a, b) 13 | else 14 | (floor x, x -. floor x) 15 | 16 | let star x = 17 | let i = int_of_float (floor (x *. 50.)) in 18 | let i' = if i = 50 then 49 else i in 19 | for x = 1 to i' - 1 do print_char ' ' done; 20 | print_char '*'; 21 | print_newline () 22 | 23 | let plot f a b dy = 24 | let pos = ref a in 25 | while !pos < b do 26 | star (f !pos); 27 | pos := !pos +. dy 28 | done 29 | -------------------------------------------------------------------------------- /Chapter 15/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec concat l = 2 | match l with 3 | [] -> [] 4 | | h::t -> h @ concat t 5 | 6 | let rec concat_tail a l = 7 | match l with 8 | [] -> List.rev a 9 | | h::t -> concat_tail (List.rev h @ a) t 10 | 11 | let concat l = 12 | concat_tail [] l 13 | 14 | let all_contain_true l = 15 | not (List.mem false (List.map (List.mem true) l)) 16 | 17 | let count_exclamations s = 18 | let n = ref 0 in 19 | String.iter (function '!' -> n := !n + 1 | _ -> ()) s; 20 | !n 21 | 22 | let calm = 23 | String.map (function '!' -> '.' | x -> x) 24 | 25 | let concat = 26 | String.concat "" 27 | 28 | let concat ss = 29 | let b = Buffer.create 100 in 30 | List.iter (Buffer.add_string b) ss; 31 | Buffer.contents b 32 | 33 | let occurrences ss s = 34 | if ss = "" then 0 else 35 | let num = ref 0 in 36 | let str = ref s in 37 | while 38 | String.length ss <= String.length !str && !str <> "" 39 | do 40 | if String.sub !str 0 (String.length ss) = ss then 41 | num := !num + 1; 42 | str := String.sub !str 1 (String.length !str - 1) 43 | done; 44 | !num 45 | -------------------------------------------------------------------------------- /Chapter 16/README.txt: -------------------------------------------------------------------------------- 1 | Chapter 16 Examples and Exercises 2 | ================================= 3 | 4 | The files textstat.ml, textstat.mli and stats.ml contain the text statistics 5 | example as a stand-alone program, extended as the exercise at the end of the 6 | chapter demands. 7 | 8 | The file gregor.txt is suitable input. (Note for Windows users: this file may 9 | not appear to have newlines in it when opened up in a Windows text editor. Do 10 | not worry about this.) 11 | 12 | The files q2.ml, q3.ml, and q4.ml are for the other questions. 13 | 14 | To build these examples: 15 | 16 | ocamlc q2.ml -o reverse 17 | 18 | ocamlc q3.ml -o bigloop 19 | 20 | ocamlopt q3.ml -o bigloop 21 | 22 | ocamlc q4.ml -o search 23 | 24 | ocamlc textstat.mli textstat.ml stats.ml -o stats 25 | 26 | (The name following -o in each example is the name of the executable program) 27 | 28 | 29 | -------------------------------------------------------------------------------- /Chapter 16/gregor.txt: -------------------------------------------------------------------------------- 1 | One morning, when Gregor Samsa woke from troubled dreams, he found 2 | himself transformed in his bed into a horrible vermin. He lay on 3 | his armour-like back, and if he lifted his head a little he could 4 | see his brown belly, slightly domed and divided by arches into stiff 5 | sections. The bedding was hardly able to cover it and seemed ready 6 | to slide off any moment. His many legs, pitifully thin compared 7 | with the size of the rest of him, waved about helplessly as he 8 | looked. 9 | -------------------------------------------------------------------------------- /Chapter 16/q2.ml: -------------------------------------------------------------------------------- 1 | (* Reverse the lines in a file *) 2 | 3 | let putlines lines filename = 4 | let channel = open_out filename in 5 | List.iter 6 | (fun s -> 7 | output_string channel s; 8 | output_char channel '\n') 9 | lines; 10 | close_out channel 11 | 12 | let getlines filename = 13 | let channel = open_in filename in 14 | let lines = ref [] in 15 | try 16 | while true do 17 | lines := input_line channel :: !lines 18 | done; 19 | [] 20 | with 21 | End_of_file -> 22 | close_in channel; 23 | List.rev !lines 24 | 25 | let _ = 26 | match Sys.argv with 27 | [|_; infile; outfile|] -> 28 | begin 29 | try 30 | let lines = List.rev (getlines infile) in 31 | putlines lines outfile 32 | with 33 | e -> 34 | print_string "There was an error. Details follow:\n"; 35 | print_string (Printexc.to_string e); 36 | print_newline (); 37 | exit 1 38 | end 39 | | _ -> 40 | print_string "Usage: reverse input_filename output_filename\n"; 41 | exit 1 42 | -------------------------------------------------------------------------------- /Chapter 16/q3.ml: -------------------------------------------------------------------------------- 1 | (* A program which takes sufficiently long to run that we can distinguish 2 | between the ocamlc and ocamlopt compilers *) 3 | for x = 1 to 10000000 do 4 | () 5 | done 6 | 7 | -------------------------------------------------------------------------------- /Chapter 16/q4.ml: -------------------------------------------------------------------------------- 1 | (* Search for a string in a file *) 2 | 3 | let rec string_in_line term line pos = 4 | pos + String.length term <= String.length line 5 | && 6 | (String.sub line pos (String.length term) = term 7 | || string_in_line term line (pos + 1)) 8 | 9 | let getlines filename = 10 | let channel = open_in filename in 11 | let lines = ref [] in 12 | try 13 | while true do 14 | lines := input_line channel :: !lines 15 | done; 16 | [] 17 | with 18 | End_of_file -> 19 | close_in channel; 20 | List.rev !lines 21 | 22 | let _ = 23 | match Sys.argv with 24 | [|_; searchterm; filename|] -> 25 | begin 26 | try 27 | List.iter 28 | (fun line -> 29 | if string_in_line searchterm line 0 30 | then 31 | begin 32 | print_string line; 33 | print_newline () 34 | end) 35 | (getlines filename) 36 | with 37 | e -> 38 | print_string "An error occurred:"; 39 | print_newline (); 40 | print_string (Printexc.to_string e); 41 | print_newline () 42 | end 43 | | _ -> 44 | print_string "Usage: search search_term filename"; 45 | print_newline () 46 | 47 | -------------------------------------------------------------------------------- /Chapter 16/stats.ml: -------------------------------------------------------------------------------- 1 | let print_histogram stats = 2 | print_string "Character frequencies:\n"; 3 | for x = 0 to 255 do 4 | let freq = Textstat.frequency stats (char_of_int x) in 5 | if freq > 0 then 6 | begin 7 | print_string "For character '"; 8 | print_char (char_of_int x); 9 | print_string "'(character number "; 10 | print_int x; 11 | print_string ") the count is "; 12 | print_int freq; 13 | print_string ".\n" 14 | end 15 | done 16 | in 17 | try 18 | begin match Sys.argv with 19 | [|_; filename|] -> 20 | let stats = Textstat.stats_from_file filename in 21 | print_string "Words: "; 22 | print_int (Textstat.words stats); 23 | print_newline (); 24 | print_string "Characters: "; 25 | print_int (Textstat.characters stats); 26 | print_newline (); 27 | print_string "Sentences: "; 28 | print_int (Textstat.sentences stats); 29 | print_newline (); 30 | print_string "Lines: "; 31 | print_int (Textstat.lines stats); 32 | print_newline (); 33 | print_histogram stats 34 | | _ -> 35 | print_string "Usage: stats "; 36 | print_newline () 37 | end 38 | with 39 | e -> 40 | print_string "An error occurred: "; 41 | print_string (Printexc.to_string e); 42 | print_newline (); 43 | exit 1 44 | -------------------------------------------------------------------------------- /Chapter 16/textstat.ml: -------------------------------------------------------------------------------- 1 | (* Text statistics *) 2 | type stats = int * int * int * int * int array 3 | 4 | (* Utility functions to retrieve parts of a stats value *) 5 | let lines (l, _, _, _, _) = l 6 | 7 | let characters (_, c, _, _, _) = c 8 | 9 | let words (_, _, w, _, _) = w 10 | 11 | let sentences (_, _, _, s, _) = s 12 | 13 | let frequency (_, _, _, _, h) x = h.(int_of_char x) 14 | 15 | (* Read statistics from a channel *) 16 | let stats_from_channel in_channel = 17 | let lines = ref 0 18 | and characters = ref 0 19 | and words = ref 0 20 | and sentences = ref 0 21 | and histogram = Array.make 256 0 in 22 | try 23 | while true do 24 | let line = input_line in_channel in 25 | lines := !lines + 1; 26 | characters := !characters + String.length line; 27 | String.iter 28 | (fun c -> 29 | match c with 30 | '.' | '?' | '!' -> sentences := !sentences + 1 31 | | ' ' -> words := !words + 1 32 | | _ -> ()) 33 | line; 34 | String.iter 35 | (fun c -> 36 | let i = int_of_char c in 37 | histogram.(i) <- histogram.(i) + 1) 38 | line 39 | done; 40 | (0, 0, 0, 0, [||]) (* Just to make the type agree *) 41 | with 42 | End_of_file -> (!lines, !characters, !words, !sentences, histogram) 43 | 44 | (* Read statistics, given a filename. Exceptions are not handled *) 45 | let stats_from_file filename = 46 | let channel = open_in filename in 47 | let result = stats_from_channel channel in 48 | close_in channel; 49 | result 50 | 51 | 52 | -------------------------------------------------------------------------------- /Chapter 16/textstat.mli: -------------------------------------------------------------------------------- 1 | (* Textstat.mli *) 2 | type stats 3 | 4 | val lines : stats -> int 5 | 6 | val characters : stats -> int 7 | 8 | val words : stats -> int 9 | 10 | val sentences : stats -> int 11 | 12 | val frequency : stats -> char -> int 13 | 14 | val stats_from_file : string -> stats 15 | 16 | -------------------------------------------------------------------------------- /Chapter 2/examples.ml: -------------------------------------------------------------------------------- 1 | let x = 200 2 | 3 | let x = 200 in x * x * x 4 | 5 | let a = 500 in (let b = a * a in a + b) 6 | 7 | let cube x = x * x * x 8 | 9 | let neg x = if x < 0 then true else false 10 | 11 | let neg x = x < 0 12 | 13 | let isvowel c = 14 | c = 'a' || c = 'e' || c = 'i' || c = 'o' || c = 'u' 15 | 16 | let addtoten a b = 17 | a + b = 10 18 | 19 | let rec factorial a = 20 | if a = 1 then 1 else a * factorial (a - 1) 21 | 22 | let rec gcd a b = 23 | if b = 0 then a else gcd b (a mod b) 24 | 25 | let not x = 26 | if x then false else true 27 | -------------------------------------------------------------------------------- /Chapter 2/exercises.ml: -------------------------------------------------------------------------------- 1 | let times_ten x = x * 10 2 | 3 | let both_non_zero x y = 4 | x <> 0 && y <> 0 5 | 6 | let rec sum n = 7 | if n = 1 then 1 else n + sum (n - 1) 8 | 9 | let rec power x n = 10 | if n = 0 then 1 else 11 | (if n = 1 then x else 12 | x * power x (n - 1)) 13 | 14 | let rec power x n = 15 | if n = 0 then 1 else 16 | if n = 1 then x else 17 | x * power x (n - 1) 18 | 19 | let isvowel c = 20 | c = 'a' || c = 'e' || c = 'i' || c = 'o' || c = 'u' 21 | 22 | let isconsonant c = 23 | not (isvowel c) 24 | 25 | let rec factorial x = 26 | if x < 0 then 0 else 27 | if x = 0 then 1 else 28 | x * factorial (x - 1) 29 | -------------------------------------------------------------------------------- /Chapter 3/examples.ml: -------------------------------------------------------------------------------- 1 | let rec factorial a = 2 | match a with 3 | 1 -> a 4 | | _ -> a * factorial (a - 1) 5 | 6 | let isvowel c = 7 | match c with 8 | 'a' -> true 9 | | 'e' -> true 10 | | 'i' -> true 11 | | 'o' -> true 12 | | 'u' -> true 13 | | _ -> false 14 | 15 | let isvowel c = 16 | match c with 17 | 'a' | 'e' | 'i' | 'o' | 'u' -> true 18 | | _ -> false 19 | 20 | let rec gcd a b = 21 | match b with 22 | 0 -> a 23 | | _ -> gcd b (a mod b) 24 | -------------------------------------------------------------------------------- /Chapter 3/exercises.ml: -------------------------------------------------------------------------------- 1 | let not x = 2 | match x with 3 | true -> false 4 | | false -> true 5 | 6 | let rec sum_match n = 7 | match n with 8 | 1 -> 1 9 | | _ -> n + sum_match (n - 1) 10 | 11 | let rec power_match x n = 12 | match n with 13 | 0 -> 1 14 | | 1 -> x 15 | | _ -> x * power_match x (n - 1) 16 | 17 | let isupper c = 18 | match c with 19 | 'A'..'Z' -> true 20 | | _ -> false 21 | 22 | let islower c = 23 | match c with 24 | 'a'..'z' -> true 25 | | _ -> false 26 | 27 | let islower c = 28 | not (isupper c) 29 | -------------------------------------------------------------------------------- /Chapter 4/examples.ml: -------------------------------------------------------------------------------- 1 | let isnil l = 2 | match l with 3 | [] -> true 4 | | _ -> false 5 | 6 | let rec length l = 7 | match l with 8 | [] -> 0 9 | | h::t -> 1 + length t 10 | 11 | let rec length l = 12 | match l with 13 | [] -> 0 14 | | _::t -> 1 + length t 15 | 16 | let rec sum l = 17 | match l with 18 | [] -> 0 19 | | h::t -> h + sum t 20 | 21 | let rec length_inner l n = 22 | match l with 23 | [] -> n 24 | | h::t -> length_inner t (n + 1) 25 | 26 | let length l = length_inner l 0 27 | 28 | let rec odd_elements l = 29 | match l with 30 | [] -> [] 31 | | [a] -> [a] 32 | | a::_::t -> a :: odd_elements t 33 | 34 | let rec odd_elements l = 35 | match l with 36 | a::_::t -> a :: odd_elements t 37 | | _ -> l 38 | 39 | let rec append a b = 40 | match a with 41 | [] -> b 42 | | h::t -> h :: append t b 43 | 44 | let rec rev l = 45 | match l with 46 | [] -> [] 47 | | h::t -> rev t @ [h] 48 | 49 | let rec take n l = 50 | if n = 0 then [] else 51 | match l with 52 | h::t -> h :: take (n - 1) t 53 | 54 | let rec drop n l = 55 | if n = 0 then l else 56 | match l with 57 | h::t -> drop (n - 1) t 58 | -------------------------------------------------------------------------------- /Chapter 4/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec even_elements l = 2 | match l with 3 | [] -> [] 4 | | [_] -> [] 5 | | _::b::t -> b :: even_elements t 6 | 7 | let rec even_elements l = 8 | match l with 9 | _::b::t -> b :: even_elements t 10 | | l -> [] 11 | 12 | let rec count_true l = 13 | match l with 14 | [] -> 0 15 | | true::t -> 1 + count_true t 16 | | false::t -> count_true t 17 | 18 | let rec count_true_inner n l = 19 | match l with 20 | [] -> n 21 | | true::t -> count_true_inner (n + 1) t 22 | | false::t -> count_true_inner n t 23 | 24 | let count_true l = 25 | count_true_inner 0 l 26 | 27 | let rec rev l = 28 | match l with 29 | [] -> [] 30 | | h::t -> rev t @ [h] 31 | 32 | let mk_palindrome l = 33 | l @ rev l 34 | 35 | let is_palindrome l = 36 | l = rev l 37 | 38 | let rec drop_last l = 39 | match l with 40 | [] -> [] 41 | | [_] -> [] 42 | | h::t -> h :: drop_last t 43 | 44 | let rec drop_last_inner a l = 45 | match l with 46 | [] -> rev a 47 | | [_] -> rev a 48 | | h::t -> drop_last_inner (h :: a) t 49 | 50 | let drop_last l = 51 | drop_last_inner [] l 52 | 53 | let rec member e l = 54 | match l with 55 | [] -> false 56 | | h::t -> h = e || member e t 57 | 58 | let rec make_set l = 59 | match l with 60 | [] -> [] 61 | | h::t -> if member h t then make_set t else h :: make_set t 62 | 63 | let rec rev_inner a l = 64 | match l with 65 | [] -> a 66 | | h::t -> rev_inner (h :: a) t 67 | 68 | let rev l = 69 | rev_inner [] l 70 | -------------------------------------------------------------------------------- /Chapter 5/examples.ml: -------------------------------------------------------------------------------- 1 | let rec insert x l = 2 | match l with 3 | [] -> [x] 4 | | h::t -> 5 | if x <= h 6 | then x :: h :: t 7 | else h :: insert x t 8 | 9 | let rec sort l = 10 | match l with 11 | [] -> [] 12 | | h::t -> insert h (sort t) 13 | 14 | let rec merge x y = 15 | match x, y with 16 | [], l -> l 17 | | l, [] -> l 18 | | hx::tx, hy::ty -> 19 | if hx < hy 20 | then hx :: merge tx (hy :: ty) 21 | else hy :: merge (hx :: tx) ty 22 | 23 | let rec take n l = 24 | if n = 0 then [] else 25 | match l with 26 | h::t -> h :: take (n - 1) t 27 | 28 | let rec drop n l = 29 | if n = 0 then l else 30 | match l with 31 | h::t -> drop (n - 1) t 32 | 33 | let rec length x = 34 | match x with 35 | [] -> 0 36 | | _::t -> 1 + length t 37 | 38 | let rec msort l = 39 | match l with 40 | [] -> [] 41 | | [x] -> [x] 42 | | _ -> 43 | let left = take (length l / 2) l 44 | and right = drop (length l / 2) l in 45 | merge (msort left) (msort right) 46 | -------------------------------------------------------------------------------- /Chapter 5/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec take n l = 2 | if n = 0 then [] else 3 | match l with 4 | h::t -> h :: take (n - 1) t 5 | 6 | let rec drop n l = 7 | if n = 0 then l else 8 | match l with 9 | h::t -> drop (n - 1) t 10 | 11 | let rec length x = 12 | match x with 13 | [] -> 0 14 | | _::t -> 1 + length t 15 | 16 | let rec merge x y = 17 | match x, y with 18 | [], l -> l 19 | | l, [] -> l 20 | | hx::tx, hy::ty -> 21 | if hx < hy 22 | then hx :: merge tx (hy :: ty) 23 | else hy :: merge (hx :: tx) ty 24 | 25 | let rec msort l = 26 | match l with 27 | [] -> [] 28 | | [x] -> [x] 29 | | _ -> 30 | let x = length l / 2 in 31 | let left = take x l 32 | and right = drop x l in 33 | merge (msort left) (msort right) 34 | 35 | let rec insert x l = 36 | match l with 37 | [] -> [x] 38 | | h::t -> 39 | if x >= h 40 | then x :: h :: t 41 | else h :: insert x t 42 | 43 | let rec sort l = 44 | match l with 45 | [] -> [] 46 | | h::t -> insert h (sort t) 47 | 48 | let rec is_sorted l = 49 | match l with 50 | [] -> true 51 | | [x] -> true 52 | | a::b::t -> a <= b && is_sorted (b :: t) 53 | 54 | let rec is_sorted l = 55 | match l with 56 | a::b::t -> a <= b && is_sorted (b :: t) 57 | | _ -> true 58 | 59 | let rec sort l = 60 | let rec insert x s = 61 | match s with 62 | [] -> [x] 63 | | h::t -> 64 | if x <= h 65 | then x :: h :: t 66 | else h :: insert x t 67 | in 68 | match l with 69 | [] -> [] 70 | | h::t -> insert h (sort t) 71 | -------------------------------------------------------------------------------- /Chapter 6/examples.ml: -------------------------------------------------------------------------------- 1 | let rec double l = 2 | match l with 3 | [] -> [] 4 | | h::t -> (h * 2) :: double t 5 | 6 | let rec evens l = 7 | match l with 8 | [] -> [] 9 | | h::t -> (h mod 2 = 0) :: evens t 10 | 11 | let rec map f l = 12 | match l with 13 | [] -> [] 14 | | h::t -> f h :: map f t 15 | 16 | let is_even x = 17 | x mod 2 = 0 18 | 19 | let evens l = 20 | map is_even l 21 | 22 | let evens l = 23 | map (fun x -> x mod 2 = 0) l 24 | 25 | let greater a b = 26 | a >= b 27 | 28 | let rec merge cmp x y = 29 | match x, y with 30 | [], l -> l 31 | | l, [] -> l 32 | | hx::tx, hy::ty -> 33 | if cmp hx hy 34 | then hx :: merge cmp tx (hy :: ty) 35 | else hy :: merge cmp (hx :: tx) ty 36 | 37 | let rec length l = 38 | match l with 39 | [] -> 0 40 | | _::t -> 1 + length t 41 | 42 | let rec take n l = 43 | if n = 0 then [] else 44 | match l with 45 | h::t -> h :: take (n - 1) t 46 | 47 | let rec drop n l = 48 | if n = 0 then l else 49 | match l with 50 | h::t -> drop (n - 1) t 51 | 52 | let rec msort cmp l = 53 | match l with 54 | [] -> [] 55 | | [x] -> [x] 56 | | _ -> 57 | let left = take (length l / 2) l in 58 | let right = drop (length l / 2) l in 59 | merge cmp (msort cmp left) (msort cmp right) 60 | -------------------------------------------------------------------------------- /Chapter 6/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec calm l = 2 | match l with 3 | [] -> [] 4 | | '!'::t -> '.' :: calm t 5 | | h::t -> h :: calm t 6 | 7 | let calm_char x = 8 | match x with '!' -> '.' | _ -> x 9 | 10 | let rec map f l = 11 | match l with 12 | [] -> [] 13 | | h::t -> f h :: map f t 14 | 15 | let calm l = 16 | map calm_char l 17 | 18 | let clip x = 19 | if x < 1 then 1 else 20 | if x > 10 then 10 else x 21 | 22 | let cliplist l = 23 | map clip l 24 | 25 | let cliplist l = 26 | map 27 | (fun x -> 28 | if x < 1 then 1 else 29 | if x > 10 then 10 else x) 30 | l 31 | 32 | let rec apply f n x = 33 | if n = 0 34 | then x 35 | else f (apply f (n - 1) x) 36 | 37 | let power a b = 38 | apply (fun x -> x * a) b 1 39 | 40 | let rec insert f x l = 41 | match l with 42 | [] -> [x] 43 | | h::t -> 44 | if f x h 45 | then x :: h :: t 46 | else h :: insert f x t 47 | 48 | let rec sort f l = 49 | match l with 50 | [] -> [] 51 | | h::t -> insert f h (sort f t) 52 | 53 | let rec filter f l = 54 | match l with 55 | [] -> [] 56 | | h::t -> 57 | if f h 58 | then h :: filter f t 59 | else filter f t 60 | 61 | let rec for_all f l = 62 | match l with 63 | [] -> true 64 | | h::t -> f h && for_all f t 65 | 66 | let rec mapl f l = 67 | match l with 68 | [] -> [] 69 | | h::t -> map f h :: mapl f t 70 | -------------------------------------------------------------------------------- /Chapter 7/examples.ml: -------------------------------------------------------------------------------- 1 | let rec take n l = 2 | match l with 3 | [] -> 4 | if n = 0 5 | then [] 6 | else raise (Invalid_argument "take") 7 | | h::t -> 8 | if n < 0 then raise (Invalid_argument "take") else 9 | if n = 0 then [] else h :: take (n - 1) t 10 | 11 | let rec drop n l = 12 | match l with 13 | [] -> 14 | if n = 0 15 | then [] 16 | else raise (Invalid_argument "drop") 17 | | h::t -> 18 | if n < 0 then raise (Invalid_argument "drop") else 19 | if n = 0 then l else drop (n - 1) t 20 | 21 | let safe_divide x y = 22 | try x / y with 23 | Division_by_zero -> 0 24 | 25 | let rec last l = 26 | match l with 27 | [x] -> x 28 | | _::t -> last t 29 | 30 | let rec last l = 31 | match l with 32 | [] -> raise Not_found 33 | | [x] -> x 34 | | _::t -> last t 35 | -------------------------------------------------------------------------------- /Chapter 7/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec smallest_inner current found l = 2 | match l with 3 | [] -> 4 | if found then current else raise Not_found 5 | | h::t -> 6 | if h > 0 && h < current 7 | then smallest_inner h true t 8 | else smallest_inner current found t 9 | 10 | let smallest l = 11 | smallest_inner max_int false l 12 | 13 | let smallest_or_zero l = 14 | try smallest l with Not_found -> 0 15 | 16 | let rec sqrt_inner x n = 17 | if x * x > n then x - 1 else sqrt_inner (x + 1) n 18 | 19 | exception Complex 20 | 21 | let sqrt n = 22 | if n < 0 then raise Complex else sqrt_inner 1 n 23 | 24 | let safe_sqrt n = 25 | try sqrt n with Complex -> 0 26 | -------------------------------------------------------------------------------- /Chapter 8/examples.ml: -------------------------------------------------------------------------------- 1 | let p = (1, 4) 2 | 3 | let q = (1, '1') 4 | 5 | let fst p = match p with (x, _) -> x 6 | 7 | let snd p = match p with (_, y) -> y 8 | 9 | let fst (x, _) = x 10 | 11 | let snd (_, y) = y 12 | 13 | let census = [(1, 4); (2, 2); (3, 2); (4, 3); (5, 1); (6, 2)] 14 | 15 | let y = (1, [2; 3; 4]) 16 | 17 | let rec lookup x l = 18 | match l with 19 | [] -> raise Not_found 20 | | (k, v)::t -> 21 | if k = x then v else lookup x t 22 | 23 | let rec add k v d = 24 | match d with 25 | [] -> [(k, v)] 26 | | (k', v')::t -> 27 | if k = k' 28 | then (k, v) :: t 29 | else (k', v') :: add k v t 30 | 31 | let rec remove k d = 32 | match d with 33 | [] -> [] 34 | | (k', v')::t -> 35 | if k = k' 36 | then t 37 | else (k', v') :: remove k t 38 | 39 | let rec key_exists k d = 40 | try 41 | let _ = lookup k d in true 42 | with 43 | Not_found -> false 44 | -------------------------------------------------------------------------------- /Chapter 8/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec replace k v l = 2 | match l with 3 | [] -> raise Not_found 4 | | (k', v')::t -> 5 | if k = k' 6 | then (k, v) :: t 7 | else (k', v') :: replace k v t 8 | 9 | let rec mkdict keys values = 10 | match keys, values with 11 | [], [] -> [] 12 | | _, [] -> raise (Invalid_argument "mkdict") 13 | | [], _ -> raise (Invalid_argument "mkdict") 14 | | k::ks, v::vs -> (k, v) :: mkdict ks vs 15 | 16 | let rec mklists l = 17 | match l with 18 | [] -> ([], []) 19 | | (k, v)::more -> 20 | match mklists more with 21 | (ks, vs) -> (k :: ks, v :: vs) 22 | 23 | let rec mklists l = 24 | match l with 25 | [] -> ([], []) 26 | | (k, v)::more -> 27 | let (ks, vs) = mklists more in 28 | (k :: ks, v :: vs) 29 | 30 | let rec member x l = 31 | match l with 32 | [] -> false 33 | | h::t -> x = h || member x t 34 | 35 | let rec dictionary_of_pairs_inner keys_seen l = 36 | match l with 37 | [] -> [] 38 | | (k, v)::t -> 39 | if member k keys_seen 40 | then dictionary_of_pairs_inner keys_seen t 41 | else (k, v) :: dictionary_of_pairs_inner (k :: keys_seen) t 42 | 43 | let dictionary_of_pairs l = 44 | dictionary_of_pairs_inner [] l 45 | 46 | let rec add k v d = 47 | match d with 48 | [] -> [(k, v)] 49 | | (k', v')::t -> 50 | if k = k' 51 | then (k, v) :: t 52 | else (k', v') :: add k v t 53 | 54 | let rec union a b = 55 | match a with 56 | [] -> b 57 | | (k, v)::t -> add k v (union t b) 58 | -------------------------------------------------------------------------------- /Chapter 9/examples.ml: -------------------------------------------------------------------------------- 1 | let add x y = x + y 2 | 3 | let rec map f l = 4 | match l with 5 | [] -> [] 6 | | h::t -> f h :: map f t 7 | 8 | let rec mapl f l = 9 | match l with 10 | [] -> [] 11 | | h::t -> map f h :: mapl f t 12 | 13 | let mapl f l = map (map f) l 14 | 15 | let mapl f = map (map f) 16 | 17 | let add = fun x -> fun y -> x + y 18 | -------------------------------------------------------------------------------- /Chapter 9/exercises.ml: -------------------------------------------------------------------------------- 1 | let rec map f l = 2 | match l with 3 | [] -> [] 4 | | h::t -> f h :: map f t 5 | 6 | let rec member e l = 7 | match l with 8 | [] -> false 9 | | h::t -> h = e || member e t 10 | 11 | let member_all x ls = 12 | let booleans = map (member x) ls in 13 | not (member false booleans) 14 | 15 | let member_all x ls = 16 | not (member false (map (member x) ls)) 17 | 18 | let rdiv x y = y / x 19 | 20 | let mapll f l = map (map (map f)) l 21 | 22 | let mapll f = map (map (map f)) 23 | 24 | let rec length l = 25 | match l with 26 | [] -> 0 27 | | _::t -> 1 + length t 28 | 29 | let rec take n l = 30 | if n = 0 then [] else 31 | match l with 32 | h::t -> h :: take (n - 1) t 33 | 34 | let truncate_l n l = 35 | if length l >= n then take n l else l 36 | 37 | let truncate_l n l = 38 | try take n l with Invalid_argument _ -> l 39 | 40 | let truncate n ll = 41 | map (truncate_l n) ll 42 | 43 | let firstelt n l = 44 | match l with [] -> n | h::_ -> h 45 | 46 | let firstelts n l = 47 | map (firstelt n) l 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | OCaml from the Very Begining 2 | ============================ 3 | 4 | These are the examples and exercises for the book "OCaml from the Very 5 | Beginning" which can be obtained at 6 | [http://www.ocaml-book.com/](http://www.ocaml-book.com). 7 | 8 | The directories for Chapters 2 to 15 contain two files each, one with the 9 | examples from the text of the chapter, and one with the answers to the 10 | exercises. Where answers depend on functions written earlier, they are included 11 | in the file too. 12 | 13 | Chapter 16 has its own README file. 14 | 15 | In case of errata, please contact the author: john@coherentgraphics.co.uk 16 | --------------------------------------------------------------------------------