\n"
},
{
"path": "code/files-modules-and-programs-freq/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:[] ~f:(fun counts line ->\n let count =\n match List.Assoc.find counts line with\n | None -> 0\n | Some x -> x\n in\n List.Assoc.add counts line (count + 1)\n )\n\nlet () =\n build_counts ()\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun l -> List.take l 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n"
},
{
"path": "code/files-modules-and-programs-freq/simple_build.sh",
"content": "ocamlfind ocamlc -linkpkg -thread -package core freq.ml -o freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq/simple_build_fail.errsh",
"content": "ocamlc freq.ml -o freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic1/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic1/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n\n(* part 1 *)\nlet singleton l = Counter.touch Counter.empty\n\n(* part 2 *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nlet median t =\n let sorted_strings = List.sort (Map.to_alist t)\n ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n in\n let len = List.length sorted_strings in\n if len = 0 then failwith \"median: empty frequency count\";\n let nth n = fst (List.nth_exn sorted_strings n) in\n if len mod 2 = 1\n then Median (nth (len/2))\n else Before_and_after (nth (len/2 - 1), nth (len/2));;\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic1/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n\n(** Represents the median computed from a set of strings. In the case where\n there is an even number of choices, the one before and after the median is\n returned. *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nval median : t -> median\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic1/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic2/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic2/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n\n(* part 1 *)\nlet _build_counts = Freq.build_counts\n\n(* part 2 *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nlet median t =\n let sorted_strings = List.sort (Map.to_alist t)\n ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n in\n let len = List.length sorted_strings in\n if len = 0 then failwith \"median: empty frequency count\";\n let nth n = fst (List.nth_exn sorted_strings n) in\n if len mod 2 = 1\n then Median (nth (len/2))\n else Before_and_after (nth (len/2 - 1), nth (len/2));;\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic2/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n\n(** Represents the median computed from a set of strings. In the case where\n there is an even number of choices, the one before and after the median is\n returned. *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nval median : t -> median\n"
},
{
"path": "code/files-modules-and-programs-freq-cyclic2/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-fast/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-fast/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-fast/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n"
},
{
"path": "code/files-modules-and-programs-freq-fast/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-median/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-median/build_use_median.sh",
"content": "../corebuild use_median_1.native\n../corebuild use_median_2.native\n"
},
{
"path": "code/files-modules-and-programs-freq-median/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n\n(* part 1 *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nlet median t =\n let sorted_strings = List.sort (Map.to_alist t)\n ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n in\n let len = List.length sorted_strings in\n if len = 0 then failwith \"median: empty frequency count\";\n let nth n = fst (List.nth_exn sorted_strings n) in\n if len mod 2 = 1\n then Median (nth (len/2))\n else Before_and_after (nth (len/2 - 1), nth (len/2));;\n"
},
{
"path": "code/files-modules-and-programs-freq-median/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n\n(* part 1 *)\n(** Represents the median computed from a set of strings. In the case where\n there is an even number of choices, the one before and after the median is\n returned. *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nval median : t -> median\n"
},
{
"path": "code/files-modules-and-programs-freq-median/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-median/use_median_1.ml",
"content": "open Core.Std\n\n(* part 1 *)\nlet print_median m =\n match m with\n | Counter.Median string -> printf \"True median:\\n %s\\n\" string\n | Counter.Before_and_after (before, after) ->\n printf \"Before and after median:\\n %s\\n %s\\n\" before after\n"
},
{
"path": "code/files-modules-and-programs-freq-median/use_median_2.ml",
"content": "open Core.Std\n\n(* part 1 *)\nlet print_median m =\n let module C = Counter in\n match m with\n | C.Median string -> printf \"True median:\\n %s\\n\" string\n | C.Before_and_after (before, after) ->\n printf \"Before and after median:\\n %s\\n %s\\n\" before after\n"
},
{
"path": "code/files-modules-and-programs-freq-obuild/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-obuild/test.sh",
"content": "strings `which ocamlopt` | ./freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-counter/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-counter/counter.ml",
"content": "open Core.Std\n\nlet touch t s =\n let count =\n match List.Assoc.find t s with\n | None -> 0\n | Some x -> x\n in\n List.Assoc.add t s (count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-counter/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:[] ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun l -> List.take l 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-counter/infer_mli.sh",
"content": "corebuild counter.inferred.mli\ncat _build/counter.inferred.mli\n"
},
{
"path": "code/files-modules-and-programs-freq-with-missing-def/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-missing-def/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n\n(* part 1 *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nlet median t =\n let sorted_strings = List.sort (Map.to_alist t)\n ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n in\n let len = List.length sorted_strings in\n if len = 0 then failwith \"median: empty frequency count\";\n let nth n = fst (List.nth_exn sorted_strings n) in\n if len mod 2 = 1\n then Median (nth (len/2))\n else Before_and_after (nth (len/2 - 1), nth (len/2));;\n"
},
{
"path": "code/files-modules-and-programs-freq-with-missing-def/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n\n(* part 1 *)\nval count : t -> string -> int\n\n(* part 2 *)\n(** Represents the median computed from a set of strings. In the case where\n there is an even number of choices, the one before and after the median is\n returned. *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nval median : t -> median\n"
},
{
"path": "code/files-modules-and-programs-freq-with-missing-def/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig/counter.ml",
"content": "open Core.Std\n\nlet touch t s =\n let count =\n match List.Assoc.find t s with\n | None -> 0\n | Some x -> x\n in\n List.Assoc.add t s (count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig/counter.mli",
"content": "open Core.Std\n\n(** Bump the frequency count for the given string. *)\nval touch : (string * int) list -> string -> (string * int) list\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:[] ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun l -> List.take l 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract/counter.ml",
"content": "open Core.Std\n\ntype t = (string * int) list\n\nlet empty = []\n\nlet to_list x = x\n\nlet touch t s =\n let count =\n match List.Assoc.find t s with\n | None -> 0\n | Some x -> x\n in\n List.Assoc.add t s (count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(** Converts the set of frequency counts to an association list. A string shows\n up at most once, and the counts are >= 1. *)\nval to_list : t -> (string * int) list\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:[] ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun l -> List.take l 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract-fixed/build.sh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract-fixed/counter.ml",
"content": "open Core.Std\n\ntype t = (string * int) list\n\nlet empty = []\n\nlet to_list x = x\n\nlet touch t s =\n let count =\n match List.Assoc.find t s with\n | None -> 0\n | Some x -> x\n in\n List.Assoc.add t s (count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract-fixed/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-abstract-fixed/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-mismatch/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-mismatch/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-mismatch/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(* part 1 *)\n(** Bump the frequency count for the given string. *)\nval touch : string -> t -> t\n(* part 2 *)\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n"
},
{
"path": "code/files-modules-and-programs-freq-with-sig-mismatch/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/files-modules-and-programs-freq-with-type-mismatch/build.errsh",
"content": "corebuild freq.byte\n"
},
{
"path": "code/files-modules-and-programs-freq-with-type-mismatch/counter.ml",
"content": "open Core.Std\n\ntype t = int String.Map.t\n\nlet empty = String.Map.empty\n\nlet to_list t = Map.to_alist t\n\nlet touch t s =\n let count =\n match Map.find t s with\n | None -> 0\n | Some x -> x\n in\n Map.add t ~key:s ~data:(count + 1)\n\n(* part 1 *)\ntype median = | Median of string\n | Before_and_after of string * string\n\nlet median t =\n let sorted_strings = List.sort (Map.to_alist t)\n ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n in\n let len = List.length sorted_strings in\n if len = 0 then failwith \"median: empty frequency count\";\n let nth n = fst (List.nth_exn sorted_strings n) in\n if len mod 2 = 1\n then Median (nth (len/2))\n else Before_and_after (nth (len/2 - 1), nth (len/2));;\n"
},
{
"path": "code/files-modules-and-programs-freq-with-type-mismatch/counter.mli",
"content": "open Core.Std\n\n(** A collection of string frequency counts *)\ntype t\n\n(** The empty set of frequency counts *)\nval empty : t\n\n(** Bump the frequency count for the given string. *)\nval touch : t -> string -> t\n\n(* Converts the set of frequency counts to an association list. Every strings\n in the list will show up at most once, and the integers will be at least\n 1. *)\nval to_list : t -> (string * int) list\n\n(* part 1 *)\n(** Represents the median computed from a set of strings. In the case where\n there is an even number of choices, the one before and after the median is\n returned. *)\ntype median = | Before_and_after of string * string\n | Median of string\n(* part 2 *)\nval median : t -> median\n"
},
{
"path": "code/files-modules-and-programs-freq-with-type-mismatch/freq.ml",
"content": "open Core.Std\n\nlet build_counts () =\n In_channel.fold_lines stdin ~init:Counter.empty ~f:Counter.touch\n\nlet () =\n build_counts ()\n |> Counter.to_list\n |> List.sort ~cmp:(fun (_,x) (_,y) -> Int.descending x y)\n |> (fun counts -> List.take counts 10)\n |> List.iter ~f:(fun (line,count) -> printf \"%3d: %s\\n\" count line)\n\n"
},
{
"path": "code/front-end/alice.ml",
"content": "let friends = [ Bob.name ]\n"
},
{
"path": "code/front-end/alice.mli",
"content": "val friends : Bob.t list\n"
},
{
"path": "code/front-end/alice_combined.ml",
"content": "module Alice : sig\n val friends : Bob.t list\nend = struct\n let friends = [ Bob.name ]\nend\n"
},
{
"path": "code/front-end/broken_module.ml",
"content": "let () =\n module MyString = String;\n ()\n"
},
{
"path": "code/front-end/broken_poly.ml",
"content": "let rec algebra =\n function\n | `Add (x,y) -> (algebra x) + (algebra y)\n | `Sub (x,y) -> (algebra x) - (algebra y)\n | `Mul (x,y) -> (algebra x) * (algebra y)\n | `Num x -> x\n\nlet _ =\n algebra (\n `Add (\n (`Num 0),\n (`Sub (\n (`Num 1),\n (`Mul (\n (`Nu 3),(`Num 2)\n ))\n ))\n ))\n"
},
{
"path": "code/front-end/broken_poly_with_annot.ml",
"content": "type t = [\n | `Add of t * t\n | `Sub of t * t\n | `Mul of t * t\n | `Num of int\n]\n\nlet rec algebra (x:t) =\n match x with\n | `Add (x,y) -> (algebra x) + (algebra y)\n | `Sub (x,y) -> (algebra x) - (algebra y)\n | `Mul (x,y) -> (algebra x) * (algebra y)\n | `Num x -> x\n\nlet _ =\n algebra (\n `Add (\n (`Num 0),\n (`Sub (\n (`Num 1),\n (`Mul (\n (`Nu 3),(`Num 2)\n ))\n ))\n ))\n"
},
{
"path": "code/front-end/build_broken_module.errsh",
"content": "ocamlc -c broken_module.ml\n"
},
{
"path": "code/front-end/build_broken_poly.errsh",
"content": "ocamlc -c broken_poly.ml\n"
},
{
"path": "code/front-end/build_broken_poly_with_annot.errsh",
"content": "ocamlc -i broken_poly_with_annot.ml\n"
},
{
"path": "code/front-end/build_follow_on_function.errsh",
"content": "ocamlc -c follow_on_function.ml\n"
},
{
"path": "code/front-end/build_non_principal.sh",
"content": "ocamlc -i -principal non_principal.ml\n"
},
{
"path": "code/front-end/build_ocamldoc.rawsh",
"content": "$ mkdir -p html man/man3\n$ ocamldoc -html -d html doc.ml\n$ ocamldoc -man -d man/man3 doc.ml\n$ man -M man Doc\n"
},
{
"path": "code/front-end/build_principal.sh",
"content": "ocamlc -i -principal principal.ml\n"
},
{
"path": "code/front-end/build_type_conv_with_camlp4.rawsh",
"content": "$ ocamlfind ocamlc -c -syntax camlp4o -package sexplib.syntax \\\n -package fieldslib.syntax type_conv_example.ml\n"
},
{
"path": "code/front-end/build_type_conv_without_camlp4.errsh",
"content": "ocamlfind ocamlc -c type_conv_example.ml\n"
},
{
"path": "code/front-end/camlp4_dump.cmd",
"content": "#!/bin/sh\n\nOCAMLFIND=\"ocamlfind query -predicates syntax,preprocessor -r\"\nINCLUDE=`$OCAMLFIND -i-format comparelib.syntax`\nARCHIVES=`$OCAMLFIND -a-format comparelib.syntax`\ncamlp4o -printer o $INCLUDE $ARCHIVES $1\n"
},
{
"path": "code/front-end/camlp4_toplevel.topscript",
"content": "#use \"topfind\" ;;\n#camlp4o ;;\n#part 1\n#require \"comparelib.syntax\" ;;\ntype t = { foo: string; bar : t } ;;\ntype t = { foo: string; bar: t } with compare ;;\n"
},
{
"path": "code/front-end/comparelib_test.ml",
"content": "type t = { \n foo: string; \n bar: t\n} with compare\n"
},
{
"path": "code/front-end/comparelib_test.mli",
"content": "type t = { \n foo: string; \n bar: t\n} with compare\n"
},
{
"path": "code/front-end/conflicting_interfaces.errsh",
"content": "echo type t = Foo > test.ml\necho type t = Bar > test.mli\nocamlc -c test.mli test.ml\n"
},
{
"path": "code/front-end/doc.ml",
"content": "(** example.ml: The first special comment of the file is the comment \n associated with the whole module. *)\n\n(** Comment for exception My_exception. *)\nexception My_exception of (int -> int) * int\n\n(** Comment for type [weather] *)\ntype weather =\n | Rain of int (** The comment for construtor Rain *)\n | Sun (** The comment for constructor Sun *)\n\n(** Find the current weather for a country\n @author Anil Madhavapeddy\n @param location The country to get the weather for.\n*)\nlet what_is_the_weather_in location =\n match location with\n | `Cambridge -> Rain 100\n | `New_york -> Rain 20\n | `California -> Sun\n"
},
{
"path": "code/front-end/fixed_module.ml",
"content": "let () =\n let module MyString = String in\n ()\n"
},
{
"path": "code/front-end/follow_on_function.ml",
"content": "let concat_and_print x y =\n let v = x ^ y in\n print_endline v;\n v;\n\nlet add_and_print x y =\n let v = x + y in\n print_endline (string_of_int v);\n v\n\nlet () =\n let _x = add_and_print 1 2 in\n let _y = concat_and_print \"a\" \"b\" in\n ()\n"
},
{
"path": "code/front-end/follow_on_function_fixed.ml",
"content": "let concat_and_print x y =\n let v = x ^ y in\n print_endline v;\n v\n\nlet add_and_print x y =\n let v = x + y in\n print_endline (string_of_int v);\n v\n\nlet () =\n let _x = add_and_print 1 2 in\n let _y = concat_and_print \"a\" \"b\" in\n ()\n"
},
{
"path": "code/front-end/html/Doc.html",
"content": "\n\n\n\n\n\n\n\n\n\n\nDoc\n\n\n\nModule Doc
\nmodule Doc: sig .. end
\nexample.ml: The first special comment of the file is the comment \n associated with the whole module.
\n
\n
\nexception My_exception of (int -> int) * int
\n\nComment for exception My_exception.
\n
\ntype
\n\n\n| | \n\nRain of int | \n\n
\n\n\n| | \n\nSun | \n\n
\n\n\nComment for type weather
\n
\n\nval what_is_the_weather_in : [< `California | `Cambridge | `New_york ] -> weather
\nFind the current weather for a country
\nAuthor(s): Anil Madhavapeddy
\n
\nlocation : The country to get the weather for.
\n"
},
{
"path": "code/front-end/html/index.html",
"content": "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n
\n\n| Doc | \nexample.ml: The first special comment of the file is the comment \n associated with the whole module.\n \n |
\n
\n\n"
},
{
"path": "code/front-end/html/index_attributes.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of class attributes\n\n\n\nIndex of class attributes
\n\n\n"
},
{
"path": "code/front-end/html/index_class_types.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of class types\n\n\n\nIndex of class types
\n\n\n"
},
{
"path": "code/front-end/html/index_classes.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of classes\n\n\n\nIndex of classes
\n\n\n"
},
{
"path": "code/front-end/html/index_exceptions.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of exceptions\n\n\n\nIndex of exceptions
\n\n\n"
},
{
"path": "code/front-end/html/index_methods.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of class methods\n\n\n\nIndex of class methods
\n\n\n"
},
{
"path": "code/front-end/html/index_module_types.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of module types\n\n\n\nIndex of module types
\n\n\n"
},
{
"path": "code/front-end/html/index_modules.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of modules\n\n\n\nIndex of modules
\n\n
D |
\n| Doc | \n\nexample.ml: The first special comment of the file is the comment \n associated with the whole module.\n \n |
\n
\n\n"
},
{
"path": "code/front-end/html/index_types.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of types\n\n\n\nIndex of types
\n\n
W |
\n| weather [Doc] | \n\nComment for type weather\n \n |
\n
\n\n"
},
{
"path": "code/front-end/html/index_values.html",
"content": "\n\n\n\n\n\n\n\n\nIndex of values\n\n\n\nIndex of values
\n\n\n"
},
{
"path": "code/front-end/html/style.css",
"content": ".keyword { font-weight : bold ; color : Red }\n.keywordsign { color : #C04600 }\n.superscript { font-size : 4 }\n.subscript { font-size : 4 }\n.comment { color : Green }\n.constructor { color : Blue }\n.type { color : #5C6585 }\n.string { color : Maroon }\n.warning { color : Red ; font-weight : bold }\n.info { margin-left : 3em; margin-right: 3em }\n.param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em }\n.code { color : #465F91 ; }\n.typetable { border-style : hidden }\n.paramstable { border-style : hidden ; padding: 5pt 5pt}\ntr { background-color : White }\ntd.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;}\ndiv.sig_block {margin-left: 2em}\n*:target { background: yellow; }\nbody {font: 13px sans-serif; color: black; text-align: left; padding: 5px; margin: 0}\nh1 { font-size : 20pt ; text-align: center; }\nh2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; }\nh3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; }\nh4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; }\nh5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; }\nh6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ; padding: 2px; }\ndiv.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; }\ndiv.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; }\ndiv.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; }\na {color: #416DFF; text-decoration: none}\na:hover {background-color: #ddd; text-decoration: underline}\npre { margin-bottom: 4px; font-family: monospace; }\npre.verbatim, pre.codepre { }\n.indextable {border: 1px #ddd solid; border-collapse: collapse}\n.indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}\n.indextable td.module {background-color: #eee ; padding-left: 2px; padding-right: 2px}\n.indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}\n.indextable td.module a:hover {text-decoration: underline; background-color: transparent}\n.deprecated {color: #888; font-style: italic}\n.indextable tr td div.info { margin-left: 2px; margin-right: 2px }\nul.indexlist { margin-left: 0; padding-left: 0;}\nul.indexlist li { list-style-type: none ; margin-left: 0; padding-left: 0; }"
},
{
"path": "code/front-end/html/type_Doc.html",
"content": "\n\n\n\n\n\n\n\nDoc\n\n\nsig end"
},
{
"path": "code/front-end/inconsistent_compilation_units.rawsh",
"content": "$ ocamlc -c foo.ml\nFile \"foo.ml\", line 1, characters 0-1:\nError: The files /home/build/bar.cmi\n and /usr/lib/ocaml/map.cmi make inconsistent assumptions\n over interface Map\n"
},
{
"path": "code/front-end/indent_follow_on_function.sh",
"content": "ocp-indent follow_on_function.ml\n"
},
{
"path": "code/front-end/indent_follow_on_function_fixed.sh",
"content": "ocp-indent follow_on_function_fixed.ml\n"
},
{
"path": "code/front-end/infer_typedef.sh",
"content": "ocamlc -i typedef.ml\n"
},
{
"path": "code/front-end/install_ocp_index.rawsh",
"content": "$ opam install ocp-index\n$ ocp-index\n"
},
{
"path": "code/front-end/let_notunit.ml",
"content": "let (_:some_type) = \nlet () = ignore ( : some_type)\n)(* if the expression returns a unit Deferred.t *)\nlet () = don't_wait_for (\n"
},
{
"path": "code/front-end/let_unit.syntax",
"content": "let () = \n"
},
{
"path": "code/front-end/man/man3/Doc.3o",
"content": ".TH \"Doc\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nDoc \\- example.ml: The first special comment of the file is the comment associated with the whole module.\n.SH Module\nModule Doc\n.SH Documentation\n.sp\nModule\n.BI \"Doc\"\n : \n.B sig end\n\n.sp\nexample\\&.ml: The first special comment of the file is the comment \nassociated with the whole module\\&.\n.sp\n\n.sp\n\n.sp\n.sp\n\n.I exception My_exception \n.B of \n.B (int -> int) * int\n\n.sp\nComment for exception My_exception\\&.\n.sp\n\n.sp\n.I type weather \n=\n | Rain\n.B of \n.B int\n.I \" \"\n(* The comment for construtor Rain *)\n | Sun (* The comment for constructor Sun *)\n \n.sp\nComment for type \n.B weather\n\n.sp\n\n.sp\n\n.I val what_is_the_weather_in \n: \n.B [< `California | `Cambridge | `New_york ] -> weather\n.sp\nFind the current weather for a country\n.sp\n.B \"Author(s)\"\n:\nAnil Madhavapeddy\n.sp\n\n.sp\n"
},
{
"path": "code/front-end/man/man3/My_exception.3o",
"content": ".TH \"My_exception\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nMy_exception \\- all My_exception elements\n\n\n.SH Module Doc\n\n.I exception My_exception \n.B of \n.B (int -> int) * int\n\n.sp\nComment for exception My_exception\\&.\n.sp\n\n.sp\n"
},
{
"path": "code/front-end/man/man3/Rain.3o",
"content": ".TH \"Rain\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nRain \\- all Rain elements\n\n"
},
{
"path": "code/front-end/man/man3/Sun.3o",
"content": ".TH \"Sun\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nSun \\- all Sun elements\n\n"
},
{
"path": "code/front-end/man/man3/weather.3o",
"content": ".TH \"weather\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nweather \\- all weather elements\n\n\n.SH Module Doc\n.I type weather \n=\n | Rain\n.B of \n.B int\n.I \" \"\n(* The comment for construtor Rain *)\n | Sun (* The comment for constructor Sun *)\n \n.sp\nComment for type \n.B weather\n\n.sp\n\n.sp\n"
},
{
"path": "code/front-end/man/man3/what_is_the_weather_in.3o",
"content": ".TH \"what_is_the_weather_in\" 3 2013-07-23 OCamldoc \"\"\n.SH NAME\nwhat_is_the_weather_in \\- all what_is_the_weather_in elements\n\n\n.SH Module Doc\n\n.I val what_is_the_weather_in \n: \n.B [< `California | `Cambridge | `New_york ] -> weather\n.sp\nFind the current weather for a country\n.sp\n.B \"Author(s)\"\n:\nAnil Madhavapeddy\n.sp\n\n.sp\n"
},
{
"path": "code/front-end/non_principal.ml",
"content": "type s = { foo: int; bar: unit }\ntype t = { foo: int }\n\nlet f x =\n x.bar;\n x.foo\n"
},
{
"path": "code/front-end/parsetree_typedef.sh",
"content": "ocamlc -dparsetree typedef.ml 2>&1\n"
},
{
"path": "code/front-end/pipeline.ascii",
"content": " Source code\n |\n | parsing and preprocessing\n |\n | camlp4 syntax extensions\n |\n v\n Parsetree (untyped AST)\n |\n | type inference and checking\n v\n Typedtree (type-annotated AST)\n |\n | pattern-matching compilation\n | elimination of modules and classes\n v\n Lambda\n / \\\n / \\ closure conversion, inlining, uncurrying,\n v \\ data representation strategy\n Bytecode \\\n | +-----+\n | Cmm\n |ocamlrun |\n | | code generation\n | | assembly & linking\n v v\n Interpreted Compiled\n"
},
{
"path": "code/front-end/principal.ml",
"content": "type s = { foo: int; bar: unit }\ntype t = { foo: int }\n\nlet f (x:s) =\n x.bar;\n x.foo\n"
},
{
"path": "code/front-end/process_comparelib_interface.sh",
"content": "sh camlp4_dump.cmd comparelib_test.mli\n"
},
{
"path": "code/front-end/process_comparelib_test.sh",
"content": "sh camlp4_dump.cmd comparelib_test.ml\n"
},
{
"path": "code/front-end/short_paths_1.rawsh",
"content": "$ ocaml\n# List.map print_endline \"\" ;;\nError: This expression has type string but an expression was expected of type\n string list\n"
},
{
"path": "code/front-end/short_paths_2.rawsh",
"content": "$ ocaml\n# open Core.Std ;;\n# List.map ~f:print_endline \"\" ;;\nError: This expression has type string but an expression was expected of type\n 'a Core.Std.List.t = 'a list\n"
},
{
"path": "code/front-end/short_paths_3.rawsh",
"content": "$ ocaml -short-paths\n# open Core.Std;;\n# List.map ~f:print_endline \"foo\";;\nError: This expression has type string but an expression was expected of type\n 'a list\n"
},
{
"path": "code/front-end/test.ml",
"content": "type t = Foo\n"
},
{
"path": "code/front-end/test.mli",
"content": "type t = Bar\n"
},
{
"path": "code/front-end/type_conv_example.ml",
"content": "open Sexplib.Std\n\ntype t = {\n foo: int;\n bar: string\n} with sexp, fields\n"
},
{
"path": "code/front-end/typedef.ml",
"content": "type t = Foo | Bar\nlet v = Foo\n"
},
{
"path": "code/front-end/typedef_objinfo.sh",
"content": "ocamlc -c typedef.ml\nocamlobjinfo typedef.cmi\n"
},
{
"path": "code/front-end/typedtree_typedef.sh",
"content": "ocamlc -dtypedtree typedef.ml 2>&1\n"
},
{
"path": "code/front-end/unused_var.ml",
"content": "let fn x y =\n let _z = x + y in\n ()\n"
},
{
"path": "code/front-end/xbuild_type_conv_with_camlp4.sh",
"content": "ocamlfind ocamlc -c -syntax camlp4o -package sexplib.syntax -package fieldslib.syntax type_conv_example.ml\n"
},
{
"path": "code/functors/build_extended_fqueue.sh",
"content": "corebuild extended_fqueue.cmo\n"
},
{
"path": "code/functors/build_fqueue.sh",
"content": "corebuild fqueue.cmo\n"
},
{
"path": "code/functors/compare_example.ml",
"content": "compare x y < 0 (* x < y *)\ncompare x y = 0 (* x = y *)\ncompare x y > 0 (* x > y *)\n"
},
{
"path": "code/functors/destructive_sub.syntax",
"content": " with type := \n"
},
{
"path": "code/functors/extended_fqueue.ml",
"content": "include Fqueue\ninclude Foldable.Extend(Fqueue)\n"
},
{
"path": "code/functors/extended_fqueue.mli",
"content": "type 'a t\ninclude (module type of Fqueue) with type 'a t := 'a t\ninclude Foldable.Extension with type 'a t := 'a t\n"
},
{
"path": "code/functors/foldable.ml",
"content": "open Core.Std\n\nmodule type S = sig\n type 'a t\n val fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc\nend\n\nmodule type Extension = sig\n type 'a t\n val iter : 'a t -> f:('a -> unit) -> unit\n val length : 'a t -> int\n val count : 'a t -> f:('a -> bool) -> int\n val for_all : 'a t -> f:('a -> bool) -> bool\n val exists : 'a t -> f:('a -> bool) -> bool\nend\n\n(* For extending a Foldable module *)\nmodule Extend(Arg : S)\n : (Extension with type 'a t := 'a Arg.t) =\nstruct\n open Arg\n\n let iter t ~f =\n fold t ~init:() ~f:(fun () a -> f a)\n\n let length t =\n fold t ~init:0 ~f:(fun acc _ -> acc + 1)\n\n let count t ~f =\n fold t ~init:0 ~f:(fun count x -> count + if f x then 1 else 0)\n\n exception Short_circuit\n\n let for_all c ~f =\n try iter c ~f:(fun x -> if not (f x) then raise Short_circuit); true\n with Short_circuit -> false\n\n let exists c ~f =\n try iter c ~f:(fun x -> if f x then raise Short_circuit); false\n with Short_circuit -> true\nend\n"
},
{
"path": "code/functors/fqueue.ml",
"content": "open Core.Std\n\ntype 'a t = 'a list * 'a list\n\nlet empty = ([],[])\n\nlet enqueue (in_list, out_list) x =\n (x :: in_list,out_list)\n\nlet dequeue (in_list, out_list) =\n match out_list with\n | hd :: tl -> Some (hd, (in_list, tl))\n | [] ->\n match List.rev in_list with\n | [] -> None\n | hd :: tl -> Some (hd, ([], tl))\n\nlet fold (in_list, out_list) ~init ~f =\n let after_out = List.fold ~init ~f out_list in\n List.fold_right ~init:after_out ~f:(fun x acc -> f acc x) in_list\n"
},
{
"path": "code/functors/fqueue.mli",
"content": "type 'a t\n\nval empty : 'a t\n\n(** [enqueue el q] adds [el] to the back of [q] *)\nval enqueue : 'a t -> 'a -> 'a t\n\n(** [dequeue q] returns None if the [q] is empty, otherwise returns\n the first element of the queue and the remainder of the queue *)\nval dequeue : 'a t -> ('a * 'a t) option\n\n(** Folds over the queue, from front to back *)\nval fold : 'a t -> init:'acc -> f:('acc -> 'a -> 'acc) -> 'acc\n"
},
{
"path": "code/functors/main-15.rawscript",
"content": "# module Make_interval(Endpoint : Comparable) : Interval_intf = struct\n type endpoint = Endpoint.t\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n ...\n\n end ;;\n module Make_interval : functor (Endpoint : Comparable) -> Interval_intf\n"
},
{
"path": "code/functors/main-18.rawscript",
"content": "# module Make_interval(Endpoint : Comparable)\n : (Interval_intf with type endpoint = Endpoint.t)\n = struct\n\n type endpoint = Endpoint.t\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n ...\n\n end ;;\nmodule Make_interval :\n functor (Endpoint : Comparable) ->\n sig\n type t\n type endpoint = Endpoint.t\n val create : endpoint -> endpoint -> t\n val is_empty : t -> bool\n val contains : t -> endpoint -> bool\n val intersect : t -> t -> t\n end\n"
},
{
"path": "code/functors/main-21.rawscript",
"content": "# module Make_interval(Endpoint : Comparable)\n : Interval_intf with type endpoint := Endpoint.t =\n struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n ...\n\n end ;;\n module Make_interval :\n functor (Endpoint : Comparable) ->\n sig\n type t\n val create : Endpoint.t -> Endpoint.t -> t\n val is_empty : t -> bool\n val contains : t -> Endpoint.t -> bool\n val intersect : t -> t -> t\n end\n"
},
{
"path": "code/functors/main-25.rawscript",
"content": "# module Make_interval(Endpoint : Comparable)\n : (Interval_intf with type endpoint := Endpoint.t) = struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n with sexp\n\n ...\n\n end ;;\n Characters 136-146:\n Error: Unbound value Endpoint.t_of_sexp\n"
},
{
"path": "code/functors/main.topscript",
"content": "module type X_int = sig val x : int end;;\n#part 1\nmodule Increment (M : X_int) : X_int = struct\n let x = M.x + 1\n end;;\n#part 2\nmodule Increment (M : X_int) = struct\n let x = M.x + 1\n end;;\n#part 3\nmodule Three = struct let x = 3 end;;\nmodule Four = Increment(Three);;\nFour.x - Three.x;;\n#part 4\nmodule Three_and_more = struct\n let x = 3\n let y = \"three\"\n end;;\nmodule Four = Increment(Three_and_more);;\n#part 5\nmodule type Comparable = sig\n type t\n val compare : t -> t -> int\n end ;;\n#part 6\nmodule Make_interval(Endpoint : Comparable) = struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n\n end ;;\n#part 7\nmodule Int_interval =\n Make_interval(struct\n type t = int\n let compare = Int.compare\n end);;\n#part 8\nmodule Int_interval = Make_interval(Int) ;;\nmodule String_interval = Make_interval(String) ;;\n#part 9\nlet i1 = Int_interval.create 3 8;;\nlet i2 = Int_interval.create 4 10;;\nInt_interval.intersect i1 i2;;\n#part 10\nmodule Rev_int_interval =\n Make_interval(struct\n type t = int\n let compare x y = Int.compare y x\n end);;\n#part 11\nlet interval = Int_interval.create 4 3;;\nlet rev_interval = Rev_int_interval.create 4 3;;\n#part 12\nInt_interval.contains rev_interval 3;;\n#part 13\nInt_interval.is_empty (* going through create *)\n (Int_interval.create 4 3) ;;\nInt_interval.is_empty (* bypassing create *)\n (Int_interval.Interval (4,3)) ;;\n#part 14\nmodule type Interval_intf = sig\n type t\n type endpoint\n val create : endpoint -> endpoint -> t\n val is_empty : t -> bool\n val contains : t -> endpoint -> bool\n val intersect : t -> t -> t\n end;;\n#part 15\nmodule Make_interval(Endpoint : Comparable) : Interval_intf = struct\n\n type endpoint = Endpoint.t\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n\n end ;;\n#part 16\nmodule Int_interval = Make_interval(Int);;\nInt_interval.create 3 4;;\n#part 17\nmodule type Int_interval_intf =\n Interval_intf with type endpoint = int;;\n#part 18\nmodule Make_interval(Endpoint : Comparable)\n : (Interval_intf with type endpoint = Endpoint.t)\n = struct\n\n type endpoint = Endpoint.t\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n end ;;\n#part 19\nmodule Int_interval = Make_interval(Int);;\nlet i = Int_interval.create 3 4;;\nInt_interval.contains i 5;;\n#part 20\nmodule type Int_interval_intf =\n Interval_intf with type endpoint := int;;\n#part 21\nmodule Make_interval(Endpoint : Comparable)\n : Interval_intf with type endpoint := Endpoint.t =\n struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n\n\n end ;;\n#part 22\nmodule Int_interval = Make_interval(Int);;\nInt_interval.is_empty\n (Int_interval.create 3 4);;\nInt_interval.is_empty\n (Int_interval.Interval (4,3));;\n#part 23\nSexp.of_string \"(This is (an s-expression))\";;\n#part 24\ntype some_type = int * string list with sexp;;\nsexp_of_some_type (33, [\"one\"; \"two\"]);;\nSexp.of_string \"(44 (five six))\" |> some_type_of_sexp;;\n#part 25\nmodule Make_interval(Endpoint : Comparable)\n : (Interval_intf with type endpoint := Endpoint.t) = struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n with sexp\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n\n end ;;\n#part 26\nmodule type Interval_intf_with_sexp = sig\n include Interval_intf\n include Sexpable with type t := t\n end;;\n#part 27\nmodule type Interval_intf_with_sexp = sig\n type t\n include Interval_intf with type t := t\n include Sexpable with type t := t\n end;;\n#part 28\nmodule Make_interval(Endpoint : sig\n type t\n include Comparable with type t := t\n include Sexpable with type t := t\n end)\n : (Interval_intf_with_sexp with type endpoint := Endpoint.t)\n = struct\n\n type t = | Interval of Endpoint.t * Endpoint.t\n | Empty\n with sexp\n\n (** [create low high] creates a new interval from [low] to\n [high]. If [low > high], then the interval is empty *)\n let create low high =\n if Endpoint.compare low high > 0 then Empty\n else Interval (low,high)\n\n (* put a wrapper around the autogenerated [t_of_sexp] to enforce\n the invariants of the data structure *)\n let t_of_sexp sexp =\n match t_of_sexp sexp with\n | Empty -> Empty\n | Interval (x,y) -> create x y\n\n (** Returns true iff the interval is empty *)\n let is_empty = function\n | Empty -> true\n | Interval _ -> false\n\n (** [contains t x] returns true iff [x] is contained in the\n interval [t] *)\n let contains t x =\n match t with\n | Empty -> false\n | Interval (l,h) ->\n Endpoint.compare x l >= 0 && Endpoint.compare x h <= 0\n\n (** [intersect t1 t2] returns the intersection of the two input\n intervals *)\n let intersect t1 t2 =\n let min x y = if Endpoint.compare x y <= 0 then x else y in\n let max x y = if Endpoint.compare x y >= 0 then x else y in\n match t1,t2 with\n | Empty, _ | _, Empty -> Empty\n | Interval (l1,h1), Interval (l2,h2) ->\n create (max l1 l2) (min h1 h2)\n end;;\n#part 29\nmodule Int_interval = Make_interval(Int) ;;\nInt_interval.sexp_of_t (Int_interval.create 3 4);;\nInt_interval.sexp_of_t (Int_interval.create 4 3);;\n#part 30\n#part 31\n#part 32\n#part 33\n#part 34\n#part 35\n#part 36\n#part 37\n#part 38\n#part 39\n#part 40\n#part 41\n#part 42\n#part 43\n#part 44\n#part 45\n#part 46\n#part 47\n#part 48\n#part 49\n#part 50\n#part 51\n#part 52\n#part 53\n#part 54\n#part 55\n#part 56\n#part 57\n#part 58\n#part 59\n#part 60\n#part 61\n#part 62\n#part 63\n#part 64\n#part 65\n#part 66\n#part 67\n#part 68\n#part 69\n#part 70\n#part 71\n#part 72\n#part 73\n#part 74\n#part 75\n#part 76\n#part 77\n#part 78\n#part 79\n#part 80\n#part 81\n#part 82\n#part 83\n#part 84\n#part 85\n#part 86\n#part 87\n#part 88\n#part 89\n#part 90\n#part 91\n#part 92\n#part 93\n#part 94\n#part 95\n#part 96\n#part 97\n#part 98\n#part 99\n#part 100\n"
},
{
"path": "code/functors/multi_sharing_constraint.syntax",
"content": " with type = and = \n"
},
{
"path": "code/functors/sexpable.ml",
"content": "module type Sexpable = sig\n type t\n val sexp_of_t : t -> Sexp.t\n val t_of_sexp : Sexp.t -> t\nend\n"
},
{
"path": "code/functors/sharing_constraint.syntax",
"content": " with type = \n"
},
{
"path": "code/gc/barrier_bench.ml",
"content": "open Core.Std\nopen Core_bench.Std\n\ntype t1 = { mutable iters1: int; mutable count1: float }\ntype t2 = { iters2: int; count2: float }\n\nlet rec test_mutable t1 =\n match t1.iters1 with\n |0 -> ()\n |_ ->\n t1.iters1 <- t1.iters1 - 1;\n t1.count1 <- t1.count1 +. 1.0;\n test_mutable t1\n\nlet rec test_immutable t2 =\n match t2.iters2 with\n |0 -> ()\n |n ->\n let iters2 = n - 1 in\n let count2 = t2.count2 +. 1.0 in\n test_immutable { iters2; count2 }\n\nlet () =\n let iters = 1000000 in\n let tests = [\n Bench.Test.create ~name:\"mutable\" \n (fun () -> test_mutable { iters1=iters; count1=0.0 });\n Bench.Test.create ~name:\"immutable\"\n (fun () -> test_immutable { iters2=iters; count2=0.0 })\n ] in\n Bench.make_command tests |> Command.run\n"
},
{
"path": "code/gc/finalizer.ml",
"content": "open Core.Std\nopen Async.Std\n\nlet attach_finalizer n v =\n match Heap_block.create v with\n | None -> printf \"%20s: FAIL\\n%!\" n\n | Some hb ->\n let final _ = printf \"%20s: OK\\n%!\" n in\n Gc.add_finalizer hb final\n\ntype t = { foo: bool }\n\nlet main () =\n let alloced_float = Unix.gettimeofday () in\n let alloced_bool = alloced_float > 0.0 in\n let alloced_string = String.create 4 in\n attach_finalizer \"immediate int\" 1;\n attach_finalizer \"immediate float\" 1.0;\n attach_finalizer \"immediate variant\" (`Foo \"hello\");\n attach_finalizer \"immediate string\" \"hello world\";\n attach_finalizer \"immediate record\" { foo=false };\n attach_finalizer \"allocated float\" alloced_float;\n attach_finalizer \"allocated bool\" alloced_bool;\n attach_finalizer \"allocated variant\" (`Foo alloced_bool);\n attach_finalizer \"allocated string\" alloced_string;\n attach_finalizer \"allocated record\" { foo=alloced_bool };\n Gc.compact ();\n return ()\n\nlet () =\n Command.async_basic ~summary:\"Testing finalizers\"\n Command.Spec.empty main\n |> Command.run\n"
},
{
"path": "code/gc/minor_heap.ascii",
"content": " <---- size ---->\n base --- start ---------------- end\n limit ptr <------\n blocks\n"
},
{
"path": "code/gc/run_barrier_bench.sh",
"content": "corebuild -pkg core_bench barrier_bench.native\n./barrier_bench.native -ascii alloc\n"
},
{
"path": "code/gc/run_finalizer.sh",
"content": "corebuild -pkg async finalizer.native\n./finalizer.native\n"
},
{
"path": "code/gc/show_barrier_bench_help.sh",
"content": "./barrier_bench.native -help\n"
},
{
"path": "code/gc/tune.topscript",
"content": "let c = Gc.get () ;;\nGc.tune ~minor_heap_size:(262144 * 2) () ;;\n#part 1\nGc.tune ~major_heap_increment:(1000448 * 4) () ;;\n#part 2\nGc.major_slice 0 ;;\nGc.full_major () ;;\n#part 3\nGc.tune ~max_overhead:0 () ;;\n"
},
{
"path": "code/guided-tour/build_sum.sh",
"content": "corebuild sum.native\n"
},
{
"path": "code/guided-tour/local_let.topscript",
"content": "let x = 7 in\n x + x\n ;;\n#part 1\nx;;\n#part 2\nlet x = 7 in\n let y = x * x in\n x + y\n ;;\n"
},
{
"path": "code/guided-tour/main.topscript",
"content": "open Core.Std;;\n#part 1\n3 + 4;;\n8 / 3;;\n3.5 +. 6.;;\n30_000_000 / 300_000;;\nsqrt 9.;;\n#part 2\nlet x = 3 + 4;;\nlet y = x + x;;\n#part 3\nlet x7 = 3 + 4;;\nlet x_plus_y = x + y;;\nlet x' = x + 1;;\nlet _x' = x' + x';;\n_x';;\n#part 4\nlet Seven = 3 + 4;;\nlet 7x = 7;;\nlet x-plus-y = x + y;;\n#part 5\nlet square x = x * x ;;\nsquare 2;;\nsquare (square 2);;\n#part 6\nlet ratio x y =\n Float.of_int x /. Float.of_int y\n ;;\nratio 4 7;;\n#part 7\nlet sum_if_true test first second =\n (if test first then first else 0)\n + (if test second then second else 0)\n ;;\n#part 8\nlet even x =\n x mod 2 = 0 ;;\nsum_if_true even 3 4;;\nsum_if_true even 2 4;;\n#part 9\nlet sum_if_true (test : int -> bool) (x : int) (y : int) : int =\n (if test x then x else 0)\n + (if test y then y else 0)\n ;;\n#part 10\nlet first_if_true test x y =\n if test x then x else y\n ;;\n#part 11\nlet long_string s = String.length s > 6;;\nfirst_if_true long_string \"short\" \"loooooong\";;\n#part 12\nlet big_number x = x > 3;;\nfirst_if_true big_number 4 3;;\n#part 13\nfirst_if_true big_number \"short\" \"loooooong\";;\n#part 14\nlet add_potato x =\n x + \"potato\";;\n#part 15\nlet is_a_multiple x y =\n x mod y = 0 ;;\nis_a_multiple 8 2;;\nis_a_multiple 8 0;;\n#part 16\nlet a_tuple = (3,\"three\");;\nlet another_tuple = (3,\"four\",5.);;\n#part 17\nlet (x,y) = a_tuple;;\n#part 18\nx + String.length y;;\n#part 19\nlet distance (x1,y1) (x2,y2) =\n sqrt ((x1 -. x2) ** 2. +. (y1 -. y2) ** 2.)\n ;;\n#part 20\nlet languages = [\"OCaml\";\"Perl\";\"C\"];;\n#part 21\nlet numbers = [3;\"four\";5];;\n#part 22\nList.length languages;;\n#part 23\nList.map languages ~f:String.length;;\n#part 24\nList.map ~f:String.length languages;;\n#part 25\n\"French\" :: \"Spanish\" :: languages;;\n#part 26\nlanguages;;\n#part 27\n[\"OCaml\", \"Perl\", \"C\"];;\n#part 28\n1,2,3;;\n#part 29\n[1; 2; 3];;\n1 :: (2 :: (3 :: []));;\n1 :: 2 :: 3 :: [];;\n#part 30\n[1;2;3] @ [4;5;6];;\n#part 31\nlet my_favorite_language (my_favorite :: the_rest) =\n my_favorite\n ;;\n#part 32\nmy_favorite_language [\"English\";\"Spanish\";\"French\"];;\nmy_favorite_language [];;\n#part 33\nlet my_favorite_language languages =\n match languages with\n | first :: the_rest -> first\n | [] -> \"OCaml\" (* A good default! *)\n ;;\nmy_favorite_language [\"English\";\"Spanish\";\"French\"];;\nmy_favorite_language [];;\n#part 34\nlet rec sum l =\n match l with\n | [] -> 0 (* base case *)\n | hd :: tl -> hd + sum tl (* inductive case *)\n ;;\nsum [1;2;3];;\n#part 35\nlet rec destutter list =\n match list with\n | [] -> []\n | hd1 :: hd2 :: tl ->\n if hd1 = hd2 then destutter (hd2 :: tl)\n else hd1 :: destutter (hd2 :: tl)\n ;;\n#part 36\nlet rec destutter list =\n match list with\n | [] -> []\n | [hd] -> [hd]\n | hd1 :: hd2 :: tl ->\n if hd1 = hd2 then destutter (hd2 :: tl)\n else hd1 :: destutter (hd2 :: tl)\n ;;\ndestutter [\"hey\";\"hey\";\"hey\";\"man!\"];;\n#part 37\nlet divide x y =\n if y = 0 then None else Some (x/y) ;;\n#part 38\nlet log_entry maybe_time message =\n let time =\n match maybe_time with\n | Some x -> x\n | None -> Time.now ()\n in\n Time.to_sec_string time ^ \" -- \" ^ message\n ;;\nlog_entry (Some Time.epoch) \"A long long time ago\";;\nlog_entry None \"Up to the minute\";;\n#part 39\nlet x = 7 in\n x + x\n ;;\n#part 40\nlet x = 7 in\n let y = x * x in\n x + y\n ;;\n#part 41\ntype point2d = { x : float; y : float };;\n#part 42\nlet p = { x = 3.; y = -4. };;\n#part 43\nlet magnitude { x = x_pos; y = y_pos } =\n sqrt (x_pos ** 2. +. y_pos ** 2.);;\n#part 44\nlet magnitude { x; y } = sqrt (x ** 2. +. y ** 2.);;\n#part 45\nlet distance v1 v2 =\n magnitude { x = v1.x -. v2.x; y = v1.y -. v2.y };;\n#part 46\ntype circle_desc = { center: point2d; radius: float }\n type rect_desc = { lower_left: point2d; width: float; height: float }\n type segment_desc = { endpoint1: point2d; endpoint2: point2d } ;;\n#part 47\ntype scene_element =\n | Circle of circle_desc\n | Rect of rect_desc\n | Segment of segment_desc\n ;;\n#part 48\nlet is_inside_scene_element point scene_element =\n match scene_element with\n | Circle { center; radius } ->\n distance center point < radius\n | Rect { lower_left; width; height } ->\n point.x > lower_left.x && point.x < lower_left.x +. width\n && point.y > lower_left.y && point.y < lower_left.y +. height\n | Segment { endpoint1; endpoint2 } -> false\n ;;\nlet is_inside_scene point scene =\n List.exists scene\n ~f:(fun el -> is_inside_scene_element point el)\n ;;\nis_inside_scene {x=3.;y=7.}\n [ Circle {center = {x=4.;y= 4.}; radius = 0.5 } ];;\nis_inside_scene {x=3.;y=7.}\n [ Circle {center = {x=4.;y= 4.}; radius = 5.0 } ];;\n#part 49\nlet numbers = [| 1; 2; 3; 4 |];;\nnumbers.(2) <- 4;;\nnumbers;;\n#part 50\ntype running_sum =\n { mutable sum: float;\n mutable sum_sq: float; (* sum of squares *)\n mutable samples: int;\n }\n ;;\n#part 51\nlet mean rsum = rsum.sum /. float rsum.samples\n let stdev rsum =\n sqrt (rsum.sum_sq /. float rsum.samples\n -. (rsum.sum /. float rsum.samples) ** 2.) ;;\n#part 52\nlet create () = { sum = 0.; sum_sq = 0.; samples = 0 }\n let update rsum x =\n rsum.samples <- rsum.samples + 1;\n rsum.sum <- rsum.sum +. x;\n rsum.sum_sq <- rsum.sum_sq +. x *. x\n ;;\n#part 53\nlet rsum = create ();;\nList.iter [1.;3.;2.;-7.;4.;5.] ~f:(fun x -> update rsum x);;\nmean rsum;;\nstdev rsum;;\n#part 54\nlet x = { contents = 0 };;\nx.contents <- x.contents + 1;;\nx;;\n#part 55\nlet x = ref 0 (* create a ref, i.e., { contents = 0 } *) ;;\n!x (* get the contents of a ref, i.e., x.contents *) ;;\nx := !x + 1 (* assignment, i.e., x.contents <- ... *) ;;\n!x ;;\n#part 56\ntype 'a ref = { mutable contents : 'a }\n\n let ref x = { contents = x }\n let (!) r = r.contents\n let (:=) r x = r.contents <- x\n ;;\n#part 57\nlet sum list =\n let sum = ref 0 in\n List.iter list ~f:(fun x -> sum := !sum + x);\n !sum\n ;;\n#part 58\nlet permute array =\n let length = Array.length array in\n for i = 0 to length - 2 do\n (* pick a j that is after i and before the end of the array *)\n let j = i + 1 + Random.int (length - i - 1) in\n (* Swap i and j *)\n let tmp = array.(i) in\n array.(i) <- array.(j);\n array.(j) <- tmp\n done\n ;;\n#part 59\nlet ar = Array.init 20 ~f:(fun i -> i);;\npermute ar;;\nar;;\n#part 60\nlet find_first_negative_entry array =\n let pos = ref 0 in\n while !pos < Array.length array && array.(!pos) >= 0 do\n pos := !pos + 1\n done;\n if !pos = Array.length array then None else Some !pos\n ;;\nfind_first_negative_entry [|1;2;0;3|];;\nfind_first_negative_entry [|1;-2;0;3|];;\n#part 61\nlet find_first_negative_entry array =\n let pos = ref 0 in\n while\n let pos_is_good = !pos < Array.length array in\n let element_is_non_negative = array.(!pos) >= 0 in\n pos_is_good && element_is_non_negative\n do\n pos := !pos + 1\n done;\n if !pos = Array.length array then None else Some !pos\n ;;\nfind_first_negative_entry [|1;2;0;3|];;\n#part 62\n#part 63\n\n"
},
{
"path": "code/guided-tour/recursion.ml",
"content": " sum [1;2;3]\n= 1 + sum [2;3]\n= 1 + (2 + sum [3])\n= 1 + (2 + (3 + sum []))\n= 1 + (2 + (3 + 0))\n= 1 + (2 + 3)\n= 1 + 5\n= 6\n"
},
{
"path": "code/guided-tour/run_sum.sh",
"content": "./sum.native\n"
},
{
"path": "code/guided-tour/sum.ml",
"content": "open Core.Std\n\nlet rec read_and_accumulate accum =\n let line = In_channel.input_line In_channel.stdin in\n match line with\n | None -> accum\n | Some x -> read_and_accumulate (accum +. Float.of_string x)\n\nlet () =\n printf \"Total: %F\\n\" (read_and_accumulate 0.)\n"
},
{
"path": "code/guided-tour/sum.rawsh",
"content": "$ ./sum.native\n1\n2\n3\n94.5\nTotal: 100.5\n"
},
{
"path": "code/imperative-programming/.gitignore",
"content": "numbers.txt\n"
},
{
"path": "code/imperative-programming/array-get.syntax",
"content": ".()\n"
},
{
"path": "code/imperative-programming/array-set.syntax",
"content": ".() <- \n"
},
{
"path": "code/imperative-programming/bigarray.syntax",
"content": ".{}\n.{} <- \n"
},
{
"path": "code/imperative-programming/build_all.sh",
"content": "corebuild dictionary.cmo\ncorebuild dlist.cmo\ncorebuild time_converter.byte\ncorebuild time_converter2.byte\n"
},
{
"path": "code/imperative-programming/dictionary.ml",
"content": "(* part 1 *)\n(* file: dictionary.ml *)\nopen Core.Std\n\ntype ('a, 'b) t = { mutable length: int;\n buckets: ('a * 'b) list array;\n }\n\n(* part 2 *)\nlet num_buckets = 17\n\nlet hash_bucket key = (Hashtbl.hash key) mod num_buckets\n\nlet create () =\n { length = 0;\n buckets = Array.create ~len:num_buckets [];\n }\n\nlet length t = t.length\n\nlet find t key =\n List.find_map t.buckets.(hash_bucket key)\n ~f:(fun (key',data) -> if key' = key then Some data else None)\n\n(* part 3 *)\nlet iter t ~f =\n for i = 0 to Array.length t.buckets - 1 do\n List.iter t.buckets.(i) ~f:(fun (key, data) -> f ~key ~data)\n done\n\n(* part 4 *)\nlet bucket_has_key t i key =\n List.exists t.buckets.(i) ~f:(fun (key',_) -> key' = key)\n\nlet add t ~key ~data =\n let i = hash_bucket key in\n let replace = bucket_has_key t i key in\n let filtered_bucket =\n if replace then\n List.filter t.buckets.(i) ~f:(fun (key',_) -> key' <> key)\n else\n t.buckets.(i)\n in\n t.buckets.(i) <- (key, data) :: filtered_bucket;\n if not replace then t.length <- t.length + 1\n\nlet remove t key =\n let i = hash_bucket key in\n if bucket_has_key t i key then (\n let filtered_bucket =\n List.filter t.buckets.(i) ~f:(fun (key',_) -> key' <> key)\n in\n t.buckets.(i) <- filtered_bucket;\n t.length <- t.length - 1\n )\n"
},
{
"path": "code/imperative-programming/dictionary.mli",
"content": "(* part 1 *)\n(* file: dictionary.mli *)\nopen Core.Std\n\ntype ('a, 'b) t\n\nval create : unit -> ('a, 'b) t\nval length : ('a, 'b) t -> int\nval add : ('a, 'b) t -> key:'a -> data:'b -> unit\nval find : ('a, 'b) t -> 'a -> 'b option\nval iter : ('a, 'b) t -> f:(key:'a -> data:'b -> unit) -> unit\nval remove : ('a, 'b) t -> 'a -> unit\n"
},
{
"path": "code/imperative-programming/dictionary2.ml",
"content": "open Core.Std\n\ntype ('a, 'b) t = { mutable length: int;\n buckets: ('a * 'b) list array;\n }\n\nlet num_buckets = 17\n\nlet hash_bucket key = (Hashtbl.hash key) mod num_buckets\n\nlet create () =\n { length = 0;\n buckets = Array.create ~len:num_buckets [];\n }\n\nlet length t = t.length\n\nlet find t key =\n List.find_map t.buckets.(hash_bucket key)\n ~f:(fun (key',data) -> if key' = key then Some data else None)\n\nlet iter t ~f =\n for i = 0 to Array.length t.buckets - 1 do\n List.iter t.buckets.(i) ~f:(fun (key, data) -> f ~key ~data)\n done\n\nlet bucket_has_key t i key =\n List.exists t.buckets.(i) ~f:(fun (key',_) -> key' = key)\n\nlet add t ~key ~data =\n let i = hash_bucket key in\n let replace = bucket_has_key t i key in\n let filtered_bucket =\n if replace then\n List.filter t.buckets.(i) ~f:(fun (key',_) -> key' <> key)\n else\n t.buckets.(i)\n in\n (* part 1 *)\n let () = t.buckets.(i) <- (key, data) :: filtered_bucket in\n if not replace then t.length <- t.length + 1\n(* part 2 *)\nlet remove t key =\n let i = hash_bucket key in\n if bucket_has_key t i key then (\n let filtered_bucket =\n List.filter t.buckets.(i) ~f:(fun (key',_) -> key' <> key)\n in\n t.buckets.(i) <- filtered_bucket;\n t.length <- t.length - 1\n )\n"
},
{
"path": "code/imperative-programming/dlist.ml",
"content": "(* part 1 *)\n(* file: dlist.ml *)\nopen Core.Std\n\ntype 'a element =\n { value : 'a;\n mutable next : 'a element option;\n mutable prev : 'a element option\n }\n\ntype 'a t = 'a element option ref\n\n(* part 2 *)\nlet create () = ref None\nlet is_empty t = !t = None\n\nlet value elt = elt.value\n\nlet first t = !t\nlet next elt = elt.next\nlet prev elt = elt.prev\n\n(* part 3 *)\nlet insert_first t value =\n let new_elt = { prev = None; next = !t; value } in\n begin match !t with\n | Some old_first -> old_first.prev <- Some new_elt\n | None -> ()\n end;\n t := Some new_elt;\n new_elt\n\n(* part 4 *)\nlet insert_after elt value =\n let new_elt = { value; prev = Some elt; next = elt.next } in\n begin match elt.next with\n | Some old_next -> old_next.prev <- Some new_elt\n | None -> ()\n end;\n elt.next <- Some new_elt;\n new_elt\n\n(* part 5 *)\nlet remove t elt =\n let { prev; next; _ } = elt in\n begin match prev with\n | Some prev -> prev.next <- next\n | None -> t := next\n end;\n begin match next with\n | Some next -> next.prev <- prev;\n | None -> ()\n end;\n elt.prev <- None;\n elt.next <- None\n\n(* part 6 *)\nlet iter t ~f =\n let rec loop = function\n | None -> ()\n | Some el -> f (value el); loop (next el)\n in\n loop !t\n\nlet find_el t ~f =\n let rec loop = function\n | None -> None\n | Some elt ->\n if f (value elt) then Some elt\n else loop (next elt)\n in\n loop !t\n"
},
{
"path": "code/imperative-programming/dlist.mli",
"content": "(* file: dlist.mli *)\nopen Core.Std\n\ntype 'a t\ntype 'a element\n\n(** Basic list operations *)\nval create : unit -> 'a t\nval is_empty : 'a t -> bool\n\n(** Navigation using [element]s *)\nval first : 'a t -> 'a element option\nval next : 'a element -> 'a element option\nval prev : 'a element -> 'a element option\nval value : 'a element -> 'a\n\n(** Whole-data-structure iteration *)\nval iter : 'a t -> f:('a -> unit) -> unit\nval find_el : 'a t -> f:('a -> bool) -> 'a element option\n\n(** Mutation *)\nval insert_first : 'a t -> 'a -> 'a element\nval insert_after : 'a element -> 'a -> 'a element\nval remove : 'a t -> 'a element -> unit\n"
},
{
"path": "code/imperative-programming/edit_distance.ascii",
"content": "edit_distance \"OCam\" \"ocaml\"\nedit_distance \"OCaml\" \"ocam\"\nedit_distance \"OCam\" \"ocam\"\n"
},
{
"path": "code/imperative-programming/edit_distance2.ascii",
"content": "edit_distance \"OCam\" \"ocaml\"\n edit_distance \"OCa\" \"ocaml\"\n edit_distance \"OCam\" \"ocam\"\n edit_distance \"OCa\" \"ocam\"\nedit_distance \"OCaml\" \"ocam\"\n edit_distance \"OCam\" \"ocam\"\n edit_distance \"OCaml\" \"oca\"\n edit_distance \"OCam\" \"oca\"\nedit_distance \"OCam\" \"ocam\"\n edit_distance \"OCa\" \"ocam\"\n edit_distance \"OCam\" \"oca\"\n edit_distance \"OCa\" \"oca\"\n"
},
{
"path": "code/imperative-programming/examples.topscript",
"content": "1;;\n#part 1\nList.find_map;;\n#part 2\nlet rec endless_loop = 1 :: 2 :: 3 :: endless_loop;;\n"
},
{
"path": "code/imperative-programming/fib.topscript",
"content": "let time f =\n let start = Time.now () in\n let x = f () in\n let stop = Time.now () in\n printf \"Time: %s\\n\" (Time.Span.to_string (Time.diff stop start));\n x ;;\nlet memoize f =\n let table = Hashtbl.Poly.create () in\n (fun x ->\n match Hashtbl.find table x with\n | Some y -> y\n | None ->\n let y = f x in\n Hashtbl.add_exn table ~key:x ~data:y;\n y\n );;\n#part 1\nlet rec fib i =\n if i <= 1 then 1 else fib (i - 1) + fib (i - 2);;\n#part 2\ntime (fun () -> fib 20);;\ntime (fun () -> fib 40);;\n#part 3\nlet fib = memoize fib;;\ntime (fun () -> fib 40);;\ntime (fun () -> fib 40);;\n#part 4\nlet fib_norec fib i =\n if i <= 1 then i\n else fib (i - 1) + fib (i - 2) ;;\n#part 5\nlet rec fib i = fib_norec fib i;;\nfib 20;;\n#part 6\nlet make_rec f_norec =\n let rec f x = f_norec f x in\n f\n ;;\nlet fib = make_rec fib_norec;;\nfib 20;;\n#part 7\nlet memo_rec f_norec x =\n let fref = ref (fun _ -> assert false) in\n let f = memoize (fun x -> f_norec !fref x) in\n fref := f;\n f x\n ;;\n#part 8\nlet fib = memo_rec fib_norec;;\ntime (fun () -> fib 40);;\n#part 9\nlet fib = memo_rec (fun fib i ->\n if i <= 1 then 1 else fib (i - 1) + fib (i - 2));;\n"
},
{
"path": "code/imperative-programming/file.topscript",
"content": "1;;\n#part 1\nlet create_number_file filename numbers =\n let outc = Out_channel.create filename in\n List.iter numbers ~f:(fun x -> fprintf outc \"%d\\n\" x);\n Out_channel.close outc\n ;;\nlet sum_file filename =\n let file = In_channel.create filename in\n let numbers = List.map ~f:Int.of_string (In_channel.input_lines file) in\n let sum = List.fold ~init:0 ~f:(+) numbers in\n In_channel.close file;\n sum\n ;;\ncreate_number_file \"numbers.txt\" [1;2;3;4;5];;\nsum_file \"numbers.txt\";;\n#part 2\nsum_file \"/etc/hosts\";;\n#part 3\nfor i = 1 to 10000 do try ignore (sum_file \"/etc/hosts\") with _ -> () done;;\nsum_file \"numbers.txt\";;\n"
},
{
"path": "code/imperative-programming/file2.topscript",
"content": "1;;\n#part 1\nlet sum_file filename =\n let file = In_channel.create filename in\n protect ~f:(fun () ->\n let numbers = List.map ~f:Int.of_string (In_channel.input_lines file) in\n List.fold ~init:0 ~f:(+) numbers)\n ~finally:(fun () -> In_channel.close file)\n ;;\n#part 2\nfor i = 1 to 10000 do try ignore (sum_file \"/etc/hosts\") with _ -> () done;;\nsum_file \"numbers.txt\";;\n#part 3\nlet sum_file filename =\n In_channel.with_file filename ~f:(fun file ->\n let numbers = List.map ~f:Int.of_string (In_channel.input_lines file) in\n List.fold ~init:0 ~f:(+) numbers)\n ;;\n#part 4\nlet sum_file filename =\n In_channel.with_file filename ~f:(fun file ->\n In_channel.fold_lines file ~init:0 ~f:(fun sum line ->\n sum + Int.of_string line))\n ;;\n"
},
{
"path": "code/imperative-programming/for.topscript",
"content": "1;;\n#part 1\nfor i = 0 to 3 do printf \"i = %d\\n\" i done;;\n#part 2\nfor i = 3 downto 0 do printf \"i = %d\\n\" i done;;\n#part 3\nlet rev_inplace ar =\n let i = ref 0 in\n let j = ref (Array.length ar - 1) in\n (* terminate when the upper and lower indices meet *)\n while !i < !j do\n (* swap the two elements *)\n let tmp = ar.(!i) in\n ar.(!i) <- ar.(!j);\n ar.(!j) <- tmp;\n (* bump the indices *)\n incr i;\n decr j\n done\n ;;\nlet nums = [|1;2;3;4;5|];;\nrev_inplace nums;;\nnums;;\n"
},
{
"path": "code/imperative-programming/lazy.topscript",
"content": "1;;\n#part 1\nlet v = lazy (print_string \"performing lazy computation\\n\"; sqrt 16.);;\nLazy.force v;;\nLazy.force v;;\n#part 2\ntype 'a lazy_state =\n | Delayed of (unit -> 'a)\n | Value of 'a\n | Exn of exn\n ;;\n#part 3\nlet create_lazy f = ref (Delayed f);;\nlet v = create_lazy\n (fun () -> print_string \"performing lazy computation\\n\"; sqrt 16.);;\n#part 4\nlet force v =\n match !v with\n | Value x -> x\n | Exn e -> raise e\n | Delayed f ->\n try\n let x = f () in\n v := Value x;\n x\n with exn ->\n v := Exn exn;\n raise exn\n ;;\n#part 5\nforce v;;\nforce v;;\n\n\n"
},
{
"path": "code/imperative-programming/let-unit.syntax",
"content": "let () = in\nlet () = in\n...\n\n"
},
{
"path": "code/imperative-programming/let_rec.ml",
"content": "let rec x = x + 1\n"
},
{
"path": "code/imperative-programming/letrec.topscript",
"content": "let time f =\n let start = Time.now () in\n let x = f () in\n let stop = Time.now () in\n printf \"Time: %s\\n\" (Time.Span.to_string (Time.diff stop start));\n x ;;\nlet memoize f =\n let table = Hashtbl.Poly.create () in\n (fun x ->\n match Hashtbl.find table x with\n | Some y -> y\n | None ->\n let y = f x in\n Hashtbl.add_exn table ~key:x ~data:y;\n y\n );;\n#part 1\nlet memo_rec f_norec =\n let rec f = memoize (fun x -> f_norec f x) in\n f\n ;;\n#part 2\nlet rec x = lazy (Lazy.force x + 1);;\n#part 3\nLazy.force x;;\n#part 4\nlet fib_norec fib i =\n if i <= 1 then i\n else fib (i - 1) + fib (i - 2) ;;\n#part 5\nlet lazy_memo_rec f_norec x =\n let rec f = lazy (memoize (fun x -> f_norec (Lazy.force f) x)) in\n (Lazy.force f) x\n ;;\ntime (fun () -> lazy_memo_rec fib_norec 40);;\n\n\n\n"
},
{
"path": "code/imperative-programming/memo.topscript",
"content": "1;;\n#part 1\nlet memoize f =\n let table = Hashtbl.Poly.create () in\n (fun x ->\n match Hashtbl.find table x with\n | Some y -> y\n | None ->\n let y = f x in\n Hashtbl.add_exn table ~key:x ~data:y;\n y\n );;\n#part 2\nlet rec edit_distance s t =\n match String.length s, String.length t with\n | (0,x) | (x,0) -> x\n | (len_s,len_t) ->\n let s' = String.drop_suffix s 1 in\n let t' = String.drop_suffix t 1 in\n let cost_to_drop_both =\n if s.[len_s - 1] = t.[len_t - 1] then 0 else 1\n in\n List.reduce_exn ~f:Int.min\n [ edit_distance s' t + 1\n ; edit_distance s t' + 1\n ; edit_distance s' t' + cost_to_drop_both\n ]\n ;;\nedit_distance \"OCaml\" \"ocaml\";;\n#part 3\nlet time f =\n let start = Time.now () in\n let x = f () in\n let stop = Time.now () in\n printf \"Time: %s\\n\" (Time.Span.to_string (Time.diff stop start));\n x ;;\n#part 4\ntime (fun () -> edit_distance \"OCaml\" \"ocaml\");;\ntime (fun () -> edit_distance \"OCaml 4.01\" \"ocaml 4.01\");;\n#part 5\nlet memo_rec f_norec x =\n let fref = ref (fun _ -> assert false) in\n let f = memoize (fun x -> f_norec !fref x) in\n fref := f;\n f x\n;;\n#part 6\nlet edit_distance = memo_rec (fun edit_distance (s,t) ->\n match String.length s, String.length t with\n | (0,x) | (x,0) -> x\n | (len_s,len_t) ->\n let s' = String.drop_suffix s 1 in\n let t' = String.drop_suffix t 1 in\n let cost_to_drop_both =\n if s.[len_s - 1] = t.[len_t - 1] then 0 else 1\n in\n List.reduce_exn ~f:Int.min\n [ edit_distance (s',t ) + 1\n ; edit_distance (s ,t') + 1\n ; edit_distance (s',t') + cost_to_drop_both\n ]) ;;\n#part 7\ntime (fun () -> edit_distance (\"OCaml 4.01\",\"ocaml 4.01\"));;\n\n\n"
},
{
"path": "code/imperative-programming/order.topscript",
"content": "1;;\n#part 1\nlet x = sin 120. in\n let y = sin 75. in\n let z = sin 128. in\n List.exists ~f:(fun x -> x < 0.) [x;y;z]\n ;;\n#part 2\nlet x = lazy (sin 120.) in\n let y = lazy (sin 75.) in\n let z = lazy (sin 128.) in\n List.exists ~f:(fun x -> Lazy.force x < 0.) [x;y;z]\n ;;\n#part 3\nlet x = lazy (printf \"1\\n\"; sin 120.) in\n let y = lazy (printf \"2\\n\"; sin 75.) in\n let z = lazy (printf \"3\\n\"; sin 128.) in\n List.exists ~f:(fun x -> Lazy.force x < 0.) [x;y;z]\n ;;\n#part 4\nList.exists ~f:(fun x -> x < 0.)\n [ (printf \"1\\n\"; sin 120.);\n (printf \"2\\n\"; sin 75.);\n (printf \"3\\n\"; sin 128.); ]\n ;;\n"
},
{
"path": "code/imperative-programming/printf.topscript",
"content": "open Printf\n1;;\n#part 1\nprintf \"%i is an integer, %F is a float, \\\"%s\\\" is a string\\n\"\n 3 4.5 \"five\";;\n#part 2\nprintf \"An integer: %i\\n\" 4.5;;\n#part 3\nlet fmt = \"%i is an integer, %F is a float, \\\"%s\\\" is a string\\n\";;\n printf fmt 3 4.5 \"five\";;\n#part 4\nlet fmt : ('a, 'b, 'c) format =\n \"%i is an integer, %F is a float, \\\"%s\\\" is a string\\n\";;\n#part 5\nprintf fmt 3 4.5 \"five\";;\n\n"
},
{
"path": "code/imperative-programming/ref.topscript",
"content": "1;;\n#part 1\ntype 'a ref = { mutable contents : 'a };;\n#part 2\nlet ref x = { contents = x };;\n let (!) r = r.contents;;\n let (:=) r x = r.contents <- x;;\n#part 3\nlet x = ref 1;;\n !x;;\n x := !x + 1;;\n !x;;\n"
},
{
"path": "code/imperative-programming/remember_type.ml",
"content": "val remember : '_a -> '_a = \n"
},
{
"path": "code/imperative-programming/semicolon-syntax.syntax",
"content": ";\n;\n...\n\n"
},
{
"path": "code/imperative-programming/semicolon.syntax",
"content": ";\n;\n...\n\n"
},
{
"path": "code/imperative-programming/string.syntax",
"content": ".[]\n.[] <- \n"
},
{
"path": "code/imperative-programming/time_converter.ml",
"content": "open Core.Std\n\nlet () =\n Out_channel.output_string stdout \"Pick a timezone: \";\n Out_channel.flush stdout;\n match In_channel.input_line stdin with\n | None -> failwith \"No timezone provided\"\n | Some zone_string ->\n let zone = Zone.find_exn zone_string in\n let time_string = Time.to_string_abs (Time.now ()) ~zone in\n Out_channel.output_string stdout\n (String.concat\n [\"The time in \";Zone.to_string zone;\" is \";time_string;\".\\n\"]);\n Out_channel.flush stdout\n\n"
},
{
"path": "code/imperative-programming/time_converter.rawsh",
"content": "$ corebuild time_converter.byte\n$ ./time_converter.byte\nPick a timezone:\n"
},
{
"path": "code/imperative-programming/time_converter2.ml",
"content": "open Core.Std\n\nlet () =\n printf \"Pick a timezone: %!\";\n match In_channel.input_line stdin with\n | None -> failwith \"No timezone provided\"\n | Some zone_string ->\n let zone = Time.Zone.find_exn zone_string in\n let time_string = Time.to_string_abs (Time.now ()) ~zone in\n printf \"The time in %s is %s.\\n%!\" (Time.Zone.to_string zone) time_string\n"
},
{
"path": "code/imperative-programming/time_converter2.rawsh",
"content": "Pick a timezone: Europe/London\nThe time in Europe/London is 2013-08-15 00:03:10.666220+01:00.\n"
},
{
"path": "code/imperative-programming/value_restriction-13.rawscript",
"content": "# module Concat_list : sig\n type 'a t\n val empty : 'a t\n val singleton : 'a -> 'a t\n val concat : 'a t -> 'a t -> 'a t (* constant time *)\n val to_list : 'a t -> 'a list (* linear time *)\n end = struct\n\n type 'a t = Empty | Singleton of 'a | Concat of 'a t * 'a t\n\n ...\n\n end;;\n module Concat_list :\n sig\n type 'a t\n val empty : 'a t\n val singleton : 'a -> 'a t\n val concat : 'a t -> 'a t -> 'a t\n val to_list : 'a t -> 'a list\n end\n"
},
{
"path": "code/imperative-programming/value_restriction.topscript",
"content": "let identity x = x;;\nlet time f =\n let start = Time.now () in\n let x = f () in\n let stop = Time.now () in\n printf \"Time: %s\\n\" (Time.Span.to_string (Time.diff stop start));\n x ;;\nlet memoize f =\n let table = Hashtbl.Poly.create () in\n (fun x ->\n match Hashtbl.find table x with\n | Some y -> y\n | None ->\n let y = f x in\n Hashtbl.add_exn table ~key:x ~data:y;\n y\n );;\n#part 1\n(fun x -> [x;x]);;\n#part 2\nmemoize (fun x -> [x;x]);;\n#part 3\nidentity (fun x -> [x;x]);;\n#part 4\nlet f () = ref None;;\n#part 5\nList.init;;\nList.init 10 ~f:Int.to_string;;\n#part 6\nlet list_init_10 = List.init 10;;\n#part 7\nlet list_init_10 ~f = List.init 10 ~f;;\n#part 8\nidentity (fun x -> [x;x]);;\n#part 9\nidentity [];;\n#part 10\n[||];;\nidentity [||];;\n#part 11\nmodule Concat_list : sig\n type 'a t\n val empty : 'a t\n val singleton : 'a -> 'a t\n val concat : 'a t -> 'a t -> 'a t (* constant time *)\n val to_list : 'a t -> 'a list (* linear time *)\n end = struct\n\n type 'a t = Empty | Singleton of 'a | Concat of 'a t * 'a t\n\n let empty = Empty\n let singleton x = Singleton x\n let concat x y = Concat (x,y)\n\n let rec to_list_with_tail t tail =\n match t with\n | Empty -> tail\n | Singleton x -> x :: tail\n | Concat (x,y) -> to_list_with_tail x (to_list_with_tail y tail)\n\n let to_list t =\n to_list_with_tail t []\n\n end;;\n#part 12\nConcat_list.empty;;\nidentity Concat_list.empty;;\n#part 13\nmodule Concat_list : sig\n type +'a t\n val empty : 'a t\n val singleton : 'a -> 'a t\n val concat : 'a t -> 'a t -> 'a t (* constant time *)\n val to_list : 'a t -> 'a list (* linear time *)\n end = struct\n\n type 'a t = Empty | Singleton of 'a | Concat of 'a t * 'a t\n\n let empty = Empty\n let singleton x = Singleton x\n let concat x y = Concat (x,y)\n\n let rec to_list_with_tail t tail =\n match t with\n | Empty -> tail\n | Singleton x -> x :: tail\n | Concat (x,y) -> to_list_with_tail x (to_list_with_tail y tail)\n\n let to_list t =\n to_list_with_tail t []\n\n end;;\n#part 14\nidentity Concat_list.empty;;\n"
},
{
"path": "code/imperative-programming/weak.topscript",
"content": "1;;\n#part 1\nlet remember =\n let cache = ref None in\n (fun x ->\n match !cache with\n | Some y -> y\n | None -> cache := Some x; x)\n ;;\n#part 2\nlet identity x = x;;\nidentity 3;;\nidentity \"five\";;\n#part 3\nlet remember_three () = remember 3;;\nremember;;\nremember \"avocado\";;\n"
},
{
"path": "code/installation/arch_install.rawsh",
"content": "# pacman -Sy ocaml\n"
},
{
"path": "code/installation/arch_opam.rawsh",
"content": "$ sudo pacman -Sy base-devel\n$ wget https://aur.archlinux.org/packages/op/opam/opam.tar.gz\n$ tar -xvf opam.tar.gz && cd opam\n$ makepkg\n$ sudo pacman -U opam-.tar.gz\n"
},
{
"path": "code/installation/brew_install.rawsh",
"content": "$ brew update\n$ brew install ocaml\n$ brew install pcre\n"
},
{
"path": "code/installation/brew_opam_install.rawsh",
"content": "$ brew update\n$ brew install opam\n"
},
{
"path": "code/installation/debian_apt.rawsh",
"content": "# apt-get install \\\n ocaml ocaml-native-compilers camlp4-extra \\\n git libpcre3-dev curl build-essential m4\n"
},
{
"path": "code/installation/debian_apt_opam.rawsh",
"content": "# apt-get update\n# apt-get -t unstable install opam\n"
},
{
"path": "code/installation/emacsrc.scm",
"content": "(autoload 'utop \"utop\" \"Toplevel for OCaml\" t)\n"
},
{
"path": "code/installation/fedora_install.rawsh",
"content": "# yum install ocaml\n# yum install ocaml-camlp4-devel\n# yum install pcre-devel\n"
},
{
"path": "code/installation/macports_install.rawsh",
"content": "$ sudo port install ocaml\n$ sudo port install ocaml-pcre\n"
},
{
"path": "code/installation/macports_opam_install.rawsh",
"content": "$ sudo port install opam\n"
},
{
"path": "code/installation/ocaml_src_install.rawsh",
"content": "$ curl -OL https://github.com/ocaml/ocaml/archive/4.01.tar.gz\n$ tar -zxvf 4.01.tar.gz\n$ cd ocaml-4.01\n$ ./configure\n$ make world world.opt\n$ sudo make install\n"
},
{
"path": "code/installation/ocaml_user_conf.rawsh",
"content": "$ ./configure -prefix $HOME/my-ocaml\n"
},
{
"path": "code/installation/opam_eval.rawsh",
"content": "$ eval `opam config env`\n"
},
{
"path": "code/installation/opam_init.rawsh",
"content": "$ opam init\n<...>\n=-=-=-= Configuring OPAM =-=-=-=\nDo you want to update your configuration to use OPAM ? [Y/n] y\n[1/4] Do you want to update your shell configuration file ? [default: ~/.profile] y\n[2/4] Do you want to update your ~/.ocamlinit ? [Y/n] y\n[3/4] Do you want to install the auto-complete scripts ? [Y/n] y\n[4/4] Do you want to install the `opam-switch-eval` script ? [Y/n] y\nUser configuration:\n ~/.ocamlinit is already up-to-date.\n ~/.profile is already up-to-date.\nGloabal configuration:\n Updating /opam-init/init.sh\n auto-completion : [true]\n opam-switch-eval: [true]\n Updating /opam-init/init.zsh\n auto-completion : [true]\n opam-switch-eval: [true]\n Updating /opam-init/init.csh\n auto-completion : [true]\n opam-switch-eval: [true]\n"
},
{
"path": "code/installation/opam_install.rawsh",
"content": "$ opam install core core_extended core_bench async\n"
},
{
"path": "code/installation/opam_install_utop.rawsh",
"content": "$ opam install utop\n"
},
{
"path": "code/installation/opam_list.rawsh",
"content": "$ opam list\nInstalled packages for 4.01.0:\nasync 109.38.00 Monadic concurrency library\nasync_core 109.38.00 Monadic concurrency library\nasync_extra 109.38.00 Monadic concurrency library\n<...>\n"
},
{
"path": "code/installation/opam_switch.rawsh",
"content": "$ opam switch 4.01.0dev+trunk\n$ eval `opam config env`\n"
},
{
"path": "code/installation/open_core.ml",
"content": "open Core.Std\n"
},
{
"path": "code/installation/show_ocamlinit.rawsh",
"content": "$ cat ~/.ocamlinit\n#use \"topfind\"\n#thread\n#camlp4o\n#require \"core.top\"\n#require \"core.syntax\"\n"
},
{
"path": "code/installation/ubuntu_opam_ppa.rawsh",
"content": "$ add-apt-repository ppa:avsm/ppa\n$ apt-get update\n$ apt-get install ocaml opam\n"
},
{
"path": "code/json/_tags",
"content": "true: -warn_32\n"
},
{
"path": "code/json/book.json",
"content": "{\n \"title\": \"Real World OCaml\",\n \"tags\" : [ \"functional programming\", \"ocaml\", \"algorithms\" ],\n \"pages\": 450,\n \"authors\": [\n { \"name\": \"Jason Hickey\", \"affiliation\": \"Google\" },\n { \"name\": \"Anil Madhavapeddy\", \"affiliation\": \"Cambridge\"},\n { \"name\": \"Yaron Minsky\", \"affiliation\": \"Jane Street\"}\n ],\n \"is_online\": true\n}\n"
},
{
"path": "code/json/build_github_atd.sh",
"content": "atdgen -t github.atd\natdgen -j github.atd\nocamlfind ocamlc -package atd -i github_t.mli\n"
},
{
"path": "code/json/build_github_org.sh",
"content": "atdgen -t github_org.atd\natdgen -j github_org.atd\ncorebuild -pkg core_extended,yojson,atdgen github_org_info.native\n"
},
{
"path": "code/json/build_json.topscript",
"content": "#require \"yojson\" ;;\nopen Core.Std ;;\n#part 1\nlet person = `Assoc [ (\"name\", `String \"Anil\") ] ;;\n#part 2\nYojson.Basic.pretty_to_string ;;\n#part 3\nYojson.Basic.pretty_to_string person ;;\nYojson.Basic.pretty_to_channel stdout person ;;\n#part 4\nlet person = `Assoc (\"name\", `String \"Anil\");;\nYojson.Basic.pretty_to_string person ;;\n#part 5\nlet (person : Yojson.Basic.json) =\n `Assoc (\"name\", `String \"Anil\");;\n"
},
{
"path": "code/json/generate_github_org_json.sh",
"content": "atdgen -j github_org.atd\ncat github_org_j.mli\n"
},
{
"path": "code/json/generate_github_org_types.sh",
"content": "atdgen -t github_org.atd\ncat github_org_t.mli\n"
},
{
"path": "code/json/github.atd",
"content": "type scope = [\n User \n | Public_repo \n | Repo \n | Repo_status \n | Delete_repo \n | Gist \n]\n\ntype app = {\n name: string;\n url: string;\n} \n\ntype authorization_request = {\n scopes: scope list;\n note: string;\n} \n\ntype authorization_response = {\n scopes: scope list;\n token: string;\n app: app;\n url: string;\n id: int;\n ?note: string option;\n ?note_url: string option;\n}\n"
},
{
"path": "code/json/github_j.ml",
"content": "(* Auto-generated from \"github.atd\" *)\n\n\ntype scope = Github_t.scope\n\ntype app = Github_t.app = {\n app_name (*atd name *): string;\n app_url (*atd url *): string\n}\n\ntype authorization_request = Github_t.authorization_request = {\n auth_req_scopes (*atd scopes *): scope list;\n auth_req_note (*atd note *): string\n}\n\ntype authorization_response = Github_t.authorization_response = {\n scopes: scope list;\n token: string;\n app: app;\n url: string;\n id: int;\n note: string option;\n note_url: string option\n}\n\nlet write_scope = (\n fun ob x ->\n match x with\n | `User -> Bi_outbuf.add_string ob \"<\\\"user\\\">\"\n | `Public_repo -> Bi_outbuf.add_string ob \"<\\\"public_repo\\\">\"\n | `Repo -> Bi_outbuf.add_string ob \"<\\\"repo\\\">\"\n | `Repo_status -> Bi_outbuf.add_string ob \"<\\\"repo_status\\\">\"\n | `Delete_repo -> Bi_outbuf.add_string ob \"<\\\"delete_repo\\\">\"\n | `Gist -> Bi_outbuf.add_string ob \"<\\\"gist\\\">\"\n)\nlet string_of_scope ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write_scope ob x;\n Bi_outbuf.contents ob\nlet read_scope = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n match Yojson.Safe.start_any_variant p lb with\n | `Edgy_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n match len with\n | 4 -> (\n match String.unsafe_get s pos with\n | 'g' -> (\n if String.unsafe_get s (pos+1) = 'i' && String.unsafe_get s (pos+2) = 's' && String.unsafe_get s (pos+3) = 't' then (\n 5\n )\n else (\n raise (Exit)\n )\n )\n | 'r' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'p' && String.unsafe_get s (pos+3) = 'o' then (\n 2\n )\n else (\n raise (Exit)\n )\n )\n | 'u' -> (\n if String.unsafe_get s (pos+1) = 's' && String.unsafe_get s (pos+2) = 'e' && String.unsafe_get s (pos+3) = 'r' then (\n 0\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n | 11 -> (\n match String.unsafe_get s pos with\n | 'd' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'l' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' then (\n 4\n )\n else (\n raise (Exit)\n )\n )\n | 'p' -> (\n if String.unsafe_get s (pos+1) = 'u' && String.unsafe_get s (pos+2) = 'b' && String.unsafe_get s (pos+3) = 'l' && String.unsafe_get s (pos+4) = 'i' && String.unsafe_get s (pos+5) = 'c' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' then (\n 1\n )\n else (\n raise (Exit)\n )\n )\n | 'r' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'p' && String.unsafe_get s (pos+3) = 'o' && String.unsafe_get s (pos+4) = '_' && String.unsafe_get s (pos+5) = 's' && String.unsafe_get s (pos+6) = 't' && String.unsafe_get s (pos+7) = 'a' && String.unsafe_get s (pos+8) = 't' && String.unsafe_get s (pos+9) = 'u' && String.unsafe_get s (pos+10) = 's' then (\n 3\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | 0 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `User\n | 1 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `Public_repo\n | 2 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `Repo\n | 3 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `Repo_status\n | 4 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `Delete_repo\n | 5 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n `Gist\n | _ -> (\n assert false\n )\n )\n | `Double_quote -> (\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n match len with\n | 4 -> (\n match String.unsafe_get s pos with\n | 'g' -> (\n if String.unsafe_get s (pos+1) = 'i' && String.unsafe_get s (pos+2) = 's' && String.unsafe_get s (pos+3) = 't' then (\n 5\n )\n else (\n raise (Exit)\n )\n )\n | 'r' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'p' && String.unsafe_get s (pos+3) = 'o' then (\n 2\n )\n else (\n raise (Exit)\n )\n )\n | 'u' -> (\n if String.unsafe_get s (pos+1) = 's' && String.unsafe_get s (pos+2) = 'e' && String.unsafe_get s (pos+3) = 'r' then (\n 0\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n | 11 -> (\n match String.unsafe_get s pos with\n | 'd' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'l' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = 't' && String.unsafe_get s (pos+5) = 'e' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' then (\n 4\n )\n else (\n raise (Exit)\n )\n )\n | 'p' -> (\n if String.unsafe_get s (pos+1) = 'u' && String.unsafe_get s (pos+2) = 'b' && String.unsafe_get s (pos+3) = 'l' && String.unsafe_get s (pos+4) = 'i' && String.unsafe_get s (pos+5) = 'c' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' then (\n 1\n )\n else (\n raise (Exit)\n )\n )\n | 'r' -> (\n if String.unsafe_get s (pos+1) = 'e' && String.unsafe_get s (pos+2) = 'p' && String.unsafe_get s (pos+3) = 'o' && String.unsafe_get s (pos+4) = '_' && String.unsafe_get s (pos+5) = 's' && String.unsafe_get s (pos+6) = 't' && String.unsafe_get s (pos+7) = 'a' && String.unsafe_get s (pos+8) = 't' && String.unsafe_get s (pos+9) = 'u' && String.unsafe_get s (pos+10) = 's' then (\n 3\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_string p f lb in\n match i with\n | 0 ->\n `User\n | 1 ->\n `Public_repo\n | 2 ->\n `Repo\n | 3 ->\n `Repo_status\n | 4 ->\n `Delete_repo\n | 5 ->\n `Gist\n | _ -> (\n assert false\n )\n )\n | `Square_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | _ -> (\n assert false\n )\n )\n)\nlet scope_of_string s =\n read_scope (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write_app = (\n fun ob x ->\n Bi_outbuf.add_char ob '{';\n let is_first = ref true in\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"name\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.app_name;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"url\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.app_url;\n Bi_outbuf.add_char ob '}';\n)\nlet string_of_app ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write_app ob x;\n Bi_outbuf.contents ob\nlet read_app = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_lcurl p lb;\n let x =\n {\n app_name = Obj.magic 0.0;\n app_url = Obj.magic 0.0;\n }\n in\n let bits0 = ref 0 in\n try\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_end lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 3 -> (\n if String.unsafe_get s pos = 'u' && String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 1\n )\n else (\n -1\n )\n )\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'a' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n while true do\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_sep p lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 3 -> (\n if String.unsafe_get s pos = 'u' && String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 1\n )\n else (\n -1\n )\n )\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'a' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n done;\n assert false;\n with Yojson.End_of_object -> (\n if !bits0 <> 0x3 then Ag_oj_run.missing_fields [| !bits0 |] [| \"name\"; \"url\" |];\n Ag_oj_run.identity x\n )\n)\nlet app_of_string s =\n read_app (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write__1 = (\n Ag_oj_run.write_list (\n write_scope\n )\n)\nlet string_of__1 ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write__1 ob x;\n Bi_outbuf.contents ob\nlet read__1 = (\n Ag_oj_run.read_list (\n read_scope\n )\n)\nlet _1_of_string s =\n read__1 (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write_authorization_request = (\n fun ob x ->\n Bi_outbuf.add_char ob '{';\n let is_first = ref true in\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"scopes\\\":\";\n (\n write__1\n )\n ob x.auth_req_scopes;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"note\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.auth_req_note;\n Bi_outbuf.add_char ob '}';\n)\nlet string_of_authorization_request ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write_authorization_request ob x;\n Bi_outbuf.contents ob\nlet read_authorization_request = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_lcurl p lb;\n let x =\n {\n auth_req_scopes = Obj.magic 0.0;\n auth_req_note = Obj.magic 0.0;\n }\n in\n let bits0 = ref 0 in\n try\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_end lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' then (\n 1\n )\n else (\n -1\n )\n )\n | 6 -> (\n if String.unsafe_get s pos = 's' && String.unsafe_get s (pos+1) = 'c' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'p' && String.unsafe_get s (pos+4) = 'e' && String.unsafe_get s (pos+5) = 's' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n read__1\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n while true do\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_sep p lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' then (\n 1\n )\n else (\n -1\n )\n )\n | 6 -> (\n if String.unsafe_get s pos = 's' && String.unsafe_get s (pos+1) = 'c' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'p' && String.unsafe_get s (pos+4) = 'e' && String.unsafe_get s (pos+5) = 's' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n read__1\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n done;\n assert false;\n with Yojson.End_of_object -> (\n if !bits0 <> 0x3 then Ag_oj_run.missing_fields [| !bits0 |] [| \"scopes\"; \"note\" |];\n Ag_oj_run.identity x\n )\n)\nlet authorization_request_of_string s =\n read_authorization_request (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write__2 = (\n Ag_oj_run.write_option (\n Yojson.Safe.write_string\n )\n)\nlet string_of__2 ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write__2 ob x;\n Bi_outbuf.contents ob\nlet read__2 = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n match Yojson.Safe.start_any_variant p lb with\n | `Edgy_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 then (\n match String.unsafe_get s pos with\n | 'N' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'n' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n )\n | 'S' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 1\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | 0 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n None\n | 1 ->\n Ag_oj_run.read_until_field_value p lb;\n let x = (\n Ag_oj_run.read_string\n ) p lb\n in\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n Some x\n | _ -> (\n assert false\n )\n )\n | `Double_quote -> (\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 && String.unsafe_get s pos = 'N' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'n' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_string p f lb in\n match i with\n | 0 ->\n None\n | _ -> (\n assert false\n )\n )\n | `Square_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 && String.unsafe_get s pos = 'S' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | 0 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_comma p lb;\n Yojson.Safe.read_space p lb;\n let x = (\n Ag_oj_run.read_string\n ) p lb\n in\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_rbr p lb;\n Some x\n | _ -> (\n assert false\n )\n )\n)\nlet _2_of_string s =\n read__2 (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write_authorization_response = (\n fun ob x ->\n Bi_outbuf.add_char ob '{';\n let is_first = ref true in\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"scopes\\\":\";\n (\n write__1\n )\n ob x.scopes;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"token\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.token;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"app\\\":\";\n (\n write_app\n )\n ob x.app;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"url\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.url;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"id\\\":\";\n (\n Yojson.Safe.write_int\n )\n ob x.id;\n (match x.note with None -> () | Some x ->\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"note\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x;\n );\n (match x.note_url with None -> () | Some x ->\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"note_url\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x;\n );\n Bi_outbuf.add_char ob '}';\n)\nlet string_of_authorization_response ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write_authorization_response ob x;\n Bi_outbuf.contents ob\nlet read_authorization_response = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_lcurl p lb;\n let x =\n {\n scopes = Obj.magic 0.0;\n token = Obj.magic 0.0;\n app = Obj.magic 0.0;\n url = Obj.magic 0.0;\n id = Obj.magic 0.0;\n note = None;\n note_url = None;\n }\n in\n let bits0 = ref 0 in\n try\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_end lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 2 -> (\n if String.unsafe_get s pos = 'i' && String.unsafe_get s (pos+1) = 'd' then (\n 4\n )\n else (\n -1\n )\n )\n | 3 -> (\n match String.unsafe_get s pos with\n | 'a' -> (\n if String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'p' then (\n 2\n )\n else (\n -1\n )\n )\n | 'u' -> (\n if String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 3\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' then (\n 5\n )\n else (\n -1\n )\n )\n | 5 -> (\n if String.unsafe_get s pos = 't' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'k' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = 'n' then (\n 1\n )\n else (\n -1\n )\n )\n | 6 -> (\n if String.unsafe_get s pos = 's' && String.unsafe_get s (pos+1) = 'c' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'p' && String.unsafe_get s (pos+4) = 'e' && String.unsafe_get s (pos+5) = 's' then (\n 0\n )\n else (\n -1\n )\n )\n | 8 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = '_' && String.unsafe_get s (pos+5) = 'u' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'l' then (\n 6\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n read__1\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | 2 ->\n let v =\n (\n read_app\n ) p lb\n in\n Obj.set_field (Obj.repr x) 2 (Obj.repr v);\n bits0 := !bits0 lor 0x4;\n | 3 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 3 (Obj.repr v);\n bits0 := !bits0 lor 0x8;\n | 4 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 4 (Obj.repr v);\n bits0 := !bits0 lor 0x10;\n | 5 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 5 (Obj.repr v);\n )\n | 6 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 6 (Obj.repr v);\n )\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n while true do\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_sep p lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 2 -> (\n if String.unsafe_get s pos = 'i' && String.unsafe_get s (pos+1) = 'd' then (\n 4\n )\n else (\n -1\n )\n )\n | 3 -> (\n match String.unsafe_get s pos with\n | 'a' -> (\n if String.unsafe_get s (pos+1) = 'p' && String.unsafe_get s (pos+2) = 'p' then (\n 2\n )\n else (\n -1\n )\n )\n | 'u' -> (\n if String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 3\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 4 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' then (\n 5\n )\n else (\n -1\n )\n )\n | 5 -> (\n if String.unsafe_get s pos = 't' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'k' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = 'n' then (\n 1\n )\n else (\n -1\n )\n )\n | 6 -> (\n if String.unsafe_get s pos = 's' && String.unsafe_get s (pos+1) = 'c' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'p' && String.unsafe_get s (pos+4) = 'e' && String.unsafe_get s (pos+5) = 's' then (\n 0\n )\n else (\n -1\n )\n )\n | 8 -> (\n if String.unsafe_get s pos = 'n' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 't' && String.unsafe_get s (pos+3) = 'e' && String.unsafe_get s (pos+4) = '_' && String.unsafe_get s (pos+5) = 'u' && String.unsafe_get s (pos+6) = 'r' && String.unsafe_get s (pos+7) = 'l' then (\n 6\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n read__1\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | 2 ->\n let v =\n (\n read_app\n ) p lb\n in\n Obj.set_field (Obj.repr x) 2 (Obj.repr v);\n bits0 := !bits0 lor 0x4;\n | 3 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 3 (Obj.repr v);\n bits0 := !bits0 lor 0x8;\n | 4 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 4 (Obj.repr v);\n bits0 := !bits0 lor 0x10;\n | 5 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 5 (Obj.repr v);\n )\n | 6 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 6 (Obj.repr v);\n )\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n done;\n assert false;\n with Yojson.End_of_object -> (\n if !bits0 <> 0x1f then Ag_oj_run.missing_fields [| !bits0 |] [| \"scopes\"; \"token\"; \"app\"; \"url\"; \"id\" |];\n Ag_oj_run.identity x\n )\n)\nlet authorization_response_of_string s =\n read_authorization_response (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\n"
},
{
"path": "code/json/github_j.mli",
"content": "(* Auto-generated from \"github.atd\" *)\n\n\ntype scope = Github_t.scope\n\ntype app = Github_t.app = {\n app_name (*atd name *): string;\n app_url (*atd url *): string\n}\n\ntype authorization_request = Github_t.authorization_request = {\n auth_req_scopes (*atd scopes *): scope list;\n auth_req_note (*atd note *): string\n}\n\ntype authorization_response = Github_t.authorization_response = {\n scopes: scope list;\n token: string;\n app: app;\n url: string;\n id: int;\n note: string option;\n note_url: string option\n}\n\nval write_scope :\n Bi_outbuf.t -> scope -> unit\n (** Output a JSON value of type {!scope}. *)\n\nval string_of_scope :\n ?len:int -> scope -> string\n (** Serialize a value of type {!scope}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval read_scope :\n Yojson.Safe.lexer_state -> Lexing.lexbuf -> scope\n (** Input JSON data of type {!scope}. *)\n\nval scope_of_string :\n string -> scope\n (** Deserialize JSON data of type {!scope}. *)\n\nval write_app :\n Bi_outbuf.t -> app -> unit\n (** Output a JSON value of type {!app}. *)\n\nval string_of_app :\n ?len:int -> app -> string\n (** Serialize a value of type {!app}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval read_app :\n Yojson.Safe.lexer_state -> Lexing.lexbuf -> app\n (** Input JSON data of type {!app}. *)\n\nval app_of_string :\n string -> app\n (** Deserialize JSON data of type {!app}. *)\n\nval write_authorization_request :\n Bi_outbuf.t -> authorization_request -> unit\n (** Output a JSON value of type {!authorization_request}. *)\n\nval string_of_authorization_request :\n ?len:int -> authorization_request -> string\n (** Serialize a value of type {!authorization_request}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval read_authorization_request :\n Yojson.Safe.lexer_state -> Lexing.lexbuf -> authorization_request\n (** Input JSON data of type {!authorization_request}. *)\n\nval authorization_request_of_string :\n string -> authorization_request\n (** Deserialize JSON data of type {!authorization_request}. *)\n\nval write_authorization_response :\n Bi_outbuf.t -> authorization_response -> unit\n (** Output a JSON value of type {!authorization_response}. *)\n\nval string_of_authorization_response :\n ?len:int -> authorization_response -> string\n (** Serialize a value of type {!authorization_response}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval read_authorization_response :\n Yojson.Safe.lexer_state -> Lexing.lexbuf -> authorization_response\n (** Input JSON data of type {!authorization_response}. *)\n\nval authorization_response_of_string :\n string -> authorization_response\n (** Deserialize JSON data of type {!authorization_response}. *)\n\n"
},
{
"path": "code/json/github_j_excerpt.mli",
"content": "val string_of_authorization_request :\n ?len:int -> authorization_request -> string\n (** Serialize a value of type {!authorization_request}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval string_of_authorization_response :\n ?len:int -> authorization_response -> string\n (** Serialize a value of type {!authorization_response}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n"
},
{
"path": "code/json/github_org.atd",
"content": "type org = {\n login: string;\n id: int;\n url: string;\n ?name: string option;\n ?blog: string option;\n ?email: string option;\n public_repos: int\n}\n"
},
{
"path": "code/json/github_org_info.ml",
"content": "open Core.Std\n\nlet print_org file () =\n let url = sprintf \"https://api.github.com/orgs/%s\" file in\n Core_extended.Shell.run_full \"curl\" [url]\n |> Github_org_j.org_of_string\n |> fun org ->\n let open Github_org_t in\n let name = Option.value ~default:\"???\" org.name in\n printf \"%s (%d) with %d public repos\\n\"\n name org.id org.public_repos\n\nlet () =\n Command.basic ~summary:\"Print Github organization information\"\n Command.Spec.(empty +> anon (\"organization\" %: string))\n print_org\n |> Command.run\n"
},
{
"path": "code/json/github_org_j.ml",
"content": "(* Auto-generated from \"github_org.atd\" *)\n\n\ntype org = Github_org_t.org = {\n login: string;\n id: int;\n url: string;\n name: string option;\n blog: string option;\n email: string option;\n public_repos: int\n}\n\nlet write__1 = (\n Ag_oj_run.write_option (\n Yojson.Safe.write_string\n )\n)\nlet string_of__1 ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write__1 ob x;\n Bi_outbuf.contents ob\nlet read__1 = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n match Yojson.Safe.start_any_variant p lb with\n | `Edgy_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 then (\n match String.unsafe_get s pos with\n | 'N' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'n' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n )\n | 'S' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 1\n )\n else (\n raise (Exit)\n )\n )\n | _ -> (\n raise (Exit)\n )\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | 0 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n None\n | 1 ->\n Ag_oj_run.read_until_field_value p lb;\n let x = (\n Ag_oj_run.read_string\n ) p lb\n in\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_gt p lb;\n Some x\n | _ -> (\n assert false\n )\n )\n | `Double_quote -> (\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 && String.unsafe_get s pos = 'N' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'n' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_string p f lb in\n match i with\n | 0 ->\n None\n | _ -> (\n assert false\n )\n )\n | `Square_bracket -> (\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n try\n if len = 4 && String.unsafe_get s pos = 'S' && String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 0\n )\n else (\n raise (Exit)\n )\n with Exit -> (\n Ag_oj_run.invalid_variant_tag (String.sub s pos len)\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n match i with\n | 0 ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_comma p lb;\n Yojson.Safe.read_space p lb;\n let x = (\n Ag_oj_run.read_string\n ) p lb\n in\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_rbr p lb;\n Some x\n | _ -> (\n assert false\n )\n )\n)\nlet _1_of_string s =\n read__1 (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\nlet write_org = (\n fun ob x ->\n Bi_outbuf.add_char ob '{';\n let is_first = ref true in\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"login\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.login;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"id\\\":\";\n (\n Yojson.Safe.write_int\n )\n ob x.id;\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"url\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x.url;\n (match x.name with None -> () | Some x ->\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"name\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x;\n );\n (match x.blog with None -> () | Some x ->\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"blog\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x;\n );\n (match x.email with None -> () | Some x ->\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"email\\\":\";\n (\n Yojson.Safe.write_string\n )\n ob x;\n );\n if !is_first then\n is_first := false\n else\n Bi_outbuf.add_char ob ',';\n Bi_outbuf.add_string ob \"\\\"public_repos\\\":\";\n (\n Yojson.Safe.write_int\n )\n ob x.public_repos;\n Bi_outbuf.add_char ob '}';\n)\nlet string_of_org ?(len = 1024) x =\n let ob = Bi_outbuf.create len in\n write_org ob x;\n Bi_outbuf.contents ob\nlet read_org = (\n fun p lb ->\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_lcurl p lb;\n let x =\n {\n login = Obj.magic 0.0;\n id = Obj.magic 0.0;\n url = Obj.magic 0.0;\n name = None;\n blog = None;\n email = None;\n public_repos = Obj.magic 0.0;\n }\n in\n let bits0 = ref 0 in\n try\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_end lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 2 -> (\n if String.unsafe_get s pos = 'i' && String.unsafe_get s (pos+1) = 'd' then (\n 1\n )\n else (\n -1\n )\n )\n | 3 -> (\n if String.unsafe_get s pos = 'u' && String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 2\n )\n else (\n -1\n )\n )\n | 4 -> (\n match String.unsafe_get s pos with\n | 'b' -> (\n if String.unsafe_get s (pos+1) = 'l' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'g' then (\n 4\n )\n else (\n -1\n )\n )\n | 'n' -> (\n if String.unsafe_get s (pos+1) = 'a' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 3\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 5 -> (\n match String.unsafe_get s pos with\n | 'e' -> (\n if String.unsafe_get s (pos+1) = 'm' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 'i' && String.unsafe_get s (pos+4) = 'l' then (\n 5\n )\n else (\n -1\n )\n )\n | 'l' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'g' && String.unsafe_get s (pos+3) = 'i' && String.unsafe_get s (pos+4) = 'n' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 12 -> (\n if String.unsafe_get s pos = 'p' && String.unsafe_get s (pos+1) = 'u' && String.unsafe_get s (pos+2) = 'b' && String.unsafe_get s (pos+3) = 'l' && String.unsafe_get s (pos+4) = 'i' && String.unsafe_get s (pos+5) = 'c' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' && String.unsafe_get s (pos+11) = 's' then (\n 6\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | 2 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 2 (Obj.repr v);\n bits0 := !bits0 lor 0x4;\n | 3 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 3 (Obj.repr v);\n )\n | 4 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 4 (Obj.repr v);\n )\n | 5 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 5 (Obj.repr v);\n )\n | 6 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 6 (Obj.repr v);\n bits0 := !bits0 lor 0x8;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n while true do\n Yojson.Safe.read_space p lb;\n Yojson.Safe.read_object_sep p lb;\n Yojson.Safe.read_space p lb;\n let f =\n fun s pos len ->\n if pos < 0 || len < 0 || pos + len > String.length s then\n invalid_arg \"out-of-bounds substring position or length\";\n match len with\n | 2 -> (\n if String.unsafe_get s pos = 'i' && String.unsafe_get s (pos+1) = 'd' then (\n 1\n )\n else (\n -1\n )\n )\n | 3 -> (\n if String.unsafe_get s pos = 'u' && String.unsafe_get s (pos+1) = 'r' && String.unsafe_get s (pos+2) = 'l' then (\n 2\n )\n else (\n -1\n )\n )\n | 4 -> (\n match String.unsafe_get s pos with\n | 'b' -> (\n if String.unsafe_get s (pos+1) = 'l' && String.unsafe_get s (pos+2) = 'o' && String.unsafe_get s (pos+3) = 'g' then (\n 4\n )\n else (\n -1\n )\n )\n | 'n' -> (\n if String.unsafe_get s (pos+1) = 'a' && String.unsafe_get s (pos+2) = 'm' && String.unsafe_get s (pos+3) = 'e' then (\n 3\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 5 -> (\n match String.unsafe_get s pos with\n | 'e' -> (\n if String.unsafe_get s (pos+1) = 'm' && String.unsafe_get s (pos+2) = 'a' && String.unsafe_get s (pos+3) = 'i' && String.unsafe_get s (pos+4) = 'l' then (\n 5\n )\n else (\n -1\n )\n )\n | 'l' -> (\n if String.unsafe_get s (pos+1) = 'o' && String.unsafe_get s (pos+2) = 'g' && String.unsafe_get s (pos+3) = 'i' && String.unsafe_get s (pos+4) = 'n' then (\n 0\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n )\n | 12 -> (\n if String.unsafe_get s pos = 'p' && String.unsafe_get s (pos+1) = 'u' && String.unsafe_get s (pos+2) = 'b' && String.unsafe_get s (pos+3) = 'l' && String.unsafe_get s (pos+4) = 'i' && String.unsafe_get s (pos+5) = 'c' && String.unsafe_get s (pos+6) = '_' && String.unsafe_get s (pos+7) = 'r' && String.unsafe_get s (pos+8) = 'e' && String.unsafe_get s (pos+9) = 'p' && String.unsafe_get s (pos+10) = 'o' && String.unsafe_get s (pos+11) = 's' then (\n 6\n )\n else (\n -1\n )\n )\n | _ -> (\n -1\n )\n in\n let i = Yojson.Safe.map_ident p f lb in\n Ag_oj_run.read_until_field_value p lb;\n (\n match i with\n | 0 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 0 (Obj.repr v);\n bits0 := !bits0 lor 0x1;\n | 1 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 1 (Obj.repr v);\n bits0 := !bits0 lor 0x2;\n | 2 ->\n let v =\n (\n Ag_oj_run.read_string\n ) p lb\n in\n Obj.set_field (Obj.repr x) 2 (Obj.repr v);\n bits0 := !bits0 lor 0x4;\n | 3 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 3 (Obj.repr v);\n )\n | 4 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 4 (Obj.repr v);\n )\n | 5 ->\n if not (Yojson.Safe.read_null_if_possible p lb) then (\n let v =\n Some (\n (\n Ag_oj_run.read_string\n ) p lb\n )\n in\n Obj.set_field (Obj.repr x) 5 (Obj.repr v);\n )\n | 6 ->\n let v =\n (\n Ag_oj_run.read_int\n ) p lb\n in\n Obj.set_field (Obj.repr x) 6 (Obj.repr v);\n bits0 := !bits0 lor 0x8;\n | _ -> (\n Yojson.Safe.skip_json p lb\n )\n );\n done;\n assert false;\n with Yojson.End_of_object -> (\n if !bits0 <> 0xf then Ag_oj_run.missing_fields [| !bits0 |] [| \"login\"; \"id\"; \"url\"; \"public_repos\" |];\n Ag_oj_run.identity x\n )\n)\nlet org_of_string s =\n read_org (Yojson.Safe.init_lexer ()) (Lexing.from_string s)\n"
},
{
"path": "code/json/github_org_j.mli",
"content": "(* Auto-generated from \"github_org.atd\" *)\n\n\ntype org = Github_org_t.org = {\n login: string;\n id: int;\n url: string;\n name: string option;\n blog: string option;\n email: string option;\n public_repos: int\n}\n\nval write_org :\n Bi_outbuf.t -> org -> unit\n (** Output a JSON value of type {!org}. *)\n\nval string_of_org :\n ?len:int -> org -> string\n (** Serialize a value of type {!org}\n into a JSON string.\n @param len specifies the initial length\n of the buffer used internally.\n Default: 1024. *)\n\nval read_org :\n Yojson.Safe.lexer_state -> Lexing.lexbuf -> org\n (** Input JSON data of type {!org}. *)\n\nval org_of_string :\n string -> org\n (** Deserialize JSON data of type {!org}. *)\n\n"
},
{
"path": "code/json/github_org_t.ml",
"content": "(* Auto-generated from \"github_org.atd\" *)\n\n\ntype org = {\n login: string;\n id: int;\n url: string;\n name: string option;\n blog: string option;\n email: string option;\n public_repos: int\n}\n"
},
{
"path": "code/json/github_org_t.mli",
"content": "(* Auto-generated from \"github_org.atd\" *)\n\n\ntype org = {\n login: string;\n id: int;\n url: string;\n name: string option;\n blog: string option;\n email: string option;\n public_repos: int\n}\n"
},
{
"path": "code/json/github_t.ml",
"content": "(* Auto-generated from \"github.atd\" *)\n\n\ntype scope = [\n `User | `Public_repo | `Repo | `Repo_status | `Delete_repo | `Gist\n]\n\ntype app = { app_name (*atd name *): string; app_url (*atd url *): string }\n\ntype authorization_request = {\n auth_req_scopes (*atd scopes *): scope list;\n auth_req_note (*atd note *): string\n}\n\ntype authorization_response = {\n scopes: scope list;\n token: string;\n app: app;\n url: string;\n id: int;\n note: string option;\n note_url: string option\n}\n"
},
{
"path": "code/json/github_t.mli",
"content": "(* Auto-generated from \"github.atd\" *)\n\n\ntype scope = [\n `User | `Public_repo | `Repo | `Repo_status | `Delete_repo | `Gist\n]\n\ntype app = { app_name (*atd name *): string; app_url (*atd url *): string }\n\ntype authorization_request = {\n auth_req_scopes (*atd scopes *): scope list;\n auth_req_note (*atd note *): string\n}\n\ntype authorization_response = {\n scopes: scope list;\n token: string;\n app: app;\n url: string;\n id: int;\n note: string option;\n note_url: string option\n}\n"
},
{
"path": "code/json/install.topscript",
"content": "#require \"yojson\" ;;\nopen Yojson ;;\n"
},
{
"path": "code/json/install_atdgen.rawsh",
"content": "$ opam install atdgen\n$ atdgen -version\n1.2.3\n"
},
{
"path": "code/json/list_excerpt.mli",
"content": "val map : 'a list -> f:('a -> 'b) -> 'b list\nval fold : 'a list -> init:'accum -> f:('accum -> 'a -> 'accum) -> 'accum\n(* part 1 *)\nval iter : 'a list -> f:('a -> unit) -> unit\n"
},
{
"path": "code/json/parse_book.ml",
"content": "open Core.Std\n\nlet () =\n (* Read the JSON file *)\n let json = Yojson.Basic.from_file \"book.json\" in\n\n (* Locally open the JSON manipulation functions *)\n let open Yojson.Basic.Util in\n let title = json |> member \"title\" |> to_string in\n let tags = json |> member \"tags\" |> to_list |> filter_string in\n let pages = json |> member \"pages\" |> to_int in\n let is_online = json |> member \"is_online\" |> to_bool_option in\n let is_translated = json |> member \"is_translated\" |> to_bool_option in\n let authors = json |> member \"authors\" |> to_list in\n let names = List.map authors ~f:(fun json -> member \"name\" json |> to_string) in\n\n (* Print the results of the parsing *)\n printf \"Title: %s (%d)\\n\" title pages;\n printf \"Authors: %s\\n\" (String.concat ~sep:\", \" names);\n printf \"Tags: %s\\n\" (String.concat ~sep:\", \" tags);\n let string_of_bool_option =\n function\n | None -> \"\"\n | Some true -> \"yes\"\n | Some false -> \"no\" in\n printf \"Online: %s\\n\" (string_of_bool_option is_online);\n printf \"Translated: %s\\n\" (string_of_bool_option is_translated)\n"
},
{
"path": "code/json/parse_book.topscript",
"content": "#require \"yojson\" ;;\nlet json = Yojson.Basic.from_file \"book.json\" ;;\n#part 1\nopen Yojson.Basic.Util ;;\nlet title = json |> member \"title\" |> to_string ;;\n#part 2\nlet tags = json |> member \"tags\" |> to_list |> filter_string ;;\nlet pages = json |> member \"pages\" |> to_int ;;\n#part 3\nlet is_online = json |> member \"is_online\" |> to_bool_option ;;\nlet is_translated = json |> member \"is_translated\" |> to_bool_option ;;\n#part 4\nlet authors = json |> member \"authors\" |> to_list ;;\n#part 5\nlet names =\n json |> member \"authors\" |> to_list \n |> List.map ~f:(fun json -> member \"name\" json |> to_string) ;;\n"
},
{
"path": "code/json/read_json.ml",
"content": "open Core.Std\n\nlet () =\n (* Read JSON file into an OCaml string *)\n let buf = In_channel.read_all \"book.json\" in\n (* Use the string JSON constructor *)\n let json1 = Yojson.Basic.from_string buf in\n (* Use the file JSON constructor *)\n let json2 = Yojson.Basic.from_file \"book.json\" in\n (* Test that the two values are the same *)\n print_endline (if json1 = json2 then \"OK\" else \"FAIL\")\n"
},
{
"path": "code/json/run_github_org.sh",
"content": "./github_org_info.native mirage\n./github_org_info.native janestreet\n"
},
{
"path": "code/json/run_parse_book.sh",
"content": "corebuild -pkg yojson parse_book.native\n./parse_book.native\n"
},
{
"path": "code/json/run_read_json.sh",
"content": "corebuild -pkg yojson read_json.native\n./read_json.native\n"
},
{
"path": "code/json/yojson_basic.mli",
"content": "type json = [\n | `Assoc of (string * json) list\n | `Bool of bool\n | `Float of float\n | `Int of int\n | `List of json list\n | `Null\n | `String of string\n]\n\n(* part 1 *)\nval from_string : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int ->\n string -> json\n(* Read a JSON value from a string.\n [buf] : use this buffer at will during parsing instead of\n creating a new one. \n [fname] : data file name to be used in error messages. It does not \n have to be a real file. \n [lnum] : number of the first line of input. Default is 1. *)\n\nval from_file : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int -> \n string -> json\n(* Read a JSON value from a file. See [from_string] for the meaning of the optional\n arguments. *)\n\nval from_channel : ?buf:Bi_outbuf.t -> ?fname:string -> ?lnum:int ->\n in_channel -> json\n (** Read a JSON value from a channel.\n See [from_string] for the meaning of the optional arguments. *)\n"
},
{
"path": "code/json/yojson_basic_simple.mli",
"content": "val from_string : string -> json\nval from_file : string -> json\nval from_channel : in_channel -> json\n"
},
{
"path": "code/json/yojson_safe.mli",
"content": "type json = [\n | `Assoc of (string * json) list\n | `Bool of bool\n | `Float of float\n | `Floatlit of string\n | `Int of int\n | `Intlit of string\n | `List of json list\n | `Null\n | `String of string\n | `Stringlit of string\n | `Tuple of json list\n | `Variant of string * json option\n]\n\n(* part 1 *)\nval to_basic : json -> Yojson.Basic.json\n(** Tuples are converted to JSON arrays, Variants are converted to\n JSON strings or arrays of a string (constructor) and a json value\n (argument). Long integers are converted to JSON strings.\n Examples:\n\n `Tuple [ `Int 1; `Float 2.3 ] -> `List [ `Int 1; `Float 2.3 ]\n `Variant (\"A\", None) -> `String \"A\"\n `Variant (\"B\", Some x) -> `List [ `String \"B\", x ]\n `Intlit \"12345678901234567890\" -> `String \"12345678901234567890\"\n *)\n"
},
{
"path": "code/lists-and-patterns/example.ml",
"content": ""
},
{
"path": "code/lists-and-patterns/example.mli",
"content": ""
},
{
"path": "code/lists-and-patterns/lists_layout.ascii",
"content": "+---+---+ +---+---+ +---+---+\n| 1 | *---->| 2 | *---->| 3 | *---->||\n+---+---+ +---+---+ +---+---+\n"
},
{
"path": "code/lists-and-patterns/main.topscript",
"content": "[1;2;3];;\n#part 1\n1 :: (2 :: (3 :: [])) ;;\n1 :: 2 :: 3 :: [] ;;\n#part 2\nlet empty = [];;\n3 :: empty;;\n\"three\" :: empty;;\n#part 3\nlet l = 1 :: 2 :: 3 :: [];;\nlet m = 0 :: l;;\nl;;\n#part 4\nlet rec sum l =\n match l with\n | [] -> 0\n | hd :: tl -> hd + sum tl\n ;;\nsum [1;2;3];;\nsum [];;\n#part 5\nlet rec drop_value l to_drop =\n match l with\n | [] -> []\n | to_drop :: tl -> drop_value tl to_drop\n | hd :: tl -> hd :: drop_value tl to_drop\n ;;\n#part 6\ndrop_value [1;2;3] 2;;\n#part 7\nlet rec drop_value l to_drop =\n match l with\n | [] -> []\n | hd :: tl ->\n let new_tl = drop_value tl to_drop in\n if hd = to_drop then new_tl else hd :: new_tl\n ;;\ndrop_value [1;2;3] 2;;\n#part 8\nlet rec drop_zero l =\n match l with\n | [] -> []\n | 0 :: tl -> drop_zero tl\n | hd :: tl -> hd :: drop_zero tl\n ;;\ndrop_zero [1;2;0;3];;\n#part 9\nlet plus_one_match x =\n match x with\n | 0 -> 1\n | 1 -> 2\n | 2 -> 3\n | _ -> x + 1\n\n let plus_one_if x =\n if x = 0 then 1\n else if x = 1 then 2\n else if x = 2 then 3\n else x + 1\n ;;\n#part 10\n#require \"core_bench\";;\nopen Core_bench.Std;;\nlet run_bench tests =\n Bench.bench\n ~ascii_table:true\n ~display:Textutils.Ascii_table.Display.column_titles\n tests\n;;\n[ Bench.Test.create ~name:\"plus_one_match\" (fun () ->\n ignore (plus_one_match 10))\n ; Bench.Test.create ~name:\"plus_one_if\" (fun () ->\n ignore (plus_one_if 10)) ]\n |> run_bench\n ;;\n#part 11\nlet rec sum_if l =\n if List.is_empty l then 0\n else List.hd_exn l + sum_if (List.tl_exn l)\n ;;\n#part 12\nlet numbers = List.range 0 1000 in\n [ Bench.Test.create ~name:\"sum_if\" (fun () -> ignore (sum_if numbers))\n ; Bench.Test.create ~name:\"sum\" (fun () -> ignore (sum numbers)) ]\n |> run_bench\n ;;\n#part 13\nlet rec drop_zero l =\n match l with\n | [] -> []\n | 0 :: tl -> drop_zero tl\n ;;\n#part 14\nList.map ~f:String.length [\"Hello\"; \"World!\"];;\n#part 15\nList.map2_exn ~f:Int.max [1;2;3] [3;2;1];;\n#part 16\nList.map2_exn ~f:Int.max [1;2;3] [3;2;1;0];;\n#part 17\nList.fold;;\n#part 18\nList.fold ~init:0 ~f:(+) [1;2;3;4];;\n#part 19\nList.fold ~init:[] ~f:(fun list x -> x :: list) [1;2;3;4];;\n#part 20\nlet max_widths header rows =\n let lengths l = List.map ~f:String.length l in\n List.fold rows\n ~init:(lengths header)\n ~f:(fun acc row ->\n List.map2_exn ~f:Int.max acc (lengths row))\n ;;\n#part 21\nlet render_separator widths =\n let pieces = List.map widths\n ~f:(fun w -> String.make (w + 2) '-')\n in\n \"|\" ^ String.concat ~sep:\"+\" pieces ^ \"|\"\n ;;\nrender_separator [3;6;2];;\n#part 22\nlet s = \".\" ^ \".\" ^ \".\" ^ \".\" ^ \".\" ^ \".\" ^ \".\";;\n#part 23\nlet s = String.concat [\".\";\".\";\".\";\".\";\".\";\".\";\".\"];;\n#part 24\nlet pad s length =\n \" \" ^ s ^ String.make (length - String.length s + 1) ' '\n ;;\npad \"hello\" 10;;\n#part 25\nlet render_row row widths =\n let padded = List.map2_exn row widths ~f:pad in\n \"|\" ^ String.concat ~sep:\"|\" padded ^ \"|\"\n ;;\nrender_row [\"Hello\";\"World\"] [10;15];;\n#part 26\nlet render_table header rows =\n let widths = max_widths header rows in\n String.concat ~sep:\"\\n\"\n (render_row header widths\n :: render_separator widths\n :: List.map rows ~f:(fun row -> render_row row widths)\n )\n ;;\n#part 27\nList.reduce;;\n#part 28\nList.reduce ~f:(+) [1;2;3;4;5];;\nList.reduce ~f:(+) [];;\n#part 29\nList.filter ~f:(fun x -> x mod 2 = 0) [1;2;3;4;5];;\n#part 30\nList.filter_map (Sys.ls_dir \".\") ~f:(fun fname ->\n match String.rsplit2 ~on:'.' fname with\n | None | Some (\"\",_) -> None\n | Some (_,ext) ->\n Some ext)\n |> List.dedup\n ;;\n#part 31\nlet is_ocaml_source s =\n match String.rsplit2 s ~on:'.' with\n | Some (_,(\"ml\"|\"mli\")) -> true\n | _ -> false\n ;;\nlet (ml_files,other_files) =\n List.partition_tf (Sys.ls_dir \".\") ~f:is_ocaml_source;;\n#part 32\nList.append [1;2;3] [4;5;6];;\n#part 33\n[1;2;3] @ [4;5;6];;\n#part 34\nList.concat [[1;2];[3;4;5];[6];[]];;\n#part 35\nlet rec ls_rec s =\n if Sys.is_file_exn ~follow_symlinks:true s\n then [s]\n else\n Sys.ls_dir s\n |> List.map ~f:(fun sub -> ls_rec (s ^/ sub))\n |> List.concat\n ;;\n#part 36\nlet rec ls_rec s =\n if Sys.is_file_exn ~follow_symlinks:true s\n then [s]\n else\n Sys.ls_dir s\n |> List.concat_map ~f:(fun sub -> ls_rec (s ^/ sub))\n ;;\n#part 37\nlet rec length = function\n | [] -> 0\n | _ :: tl -> 1 + length tl\n ;;\nlength [1;2;3];;\n#part 38\nlet make_list n = List.init n ~f:(fun x -> x);;\nlength (make_list 10);;\nlength (make_list 10_000_000);;\n#part 39\nlet rec length_plus_n l n =\n match l with\n | [] -> n\n | _ :: tl -> length_plus_n tl (n + 1)\n ;;\nlet length l = length_plus_n l 0 ;;\nlength [1;2;3;4];;\n#part 40\nlength (make_list 10_000_000);;\n#part 41\nlet rec destutter list =\n match list with\n | [] -> []\n | [hd] -> [hd]\n | hd :: hd' :: tl ->\n if hd = hd' then destutter (hd' :: tl)\n else hd :: destutter (hd' :: tl)\n ;;\n#part 42\nlet rec destutter = function\n | [] as l -> l\n | [_] as l -> l\n | hd :: (hd' :: _ as tl) ->\n if hd = hd' then destutter tl\n else hd :: destutter tl\n ;;\n#part 43\nlet rec destutter = function\n | [] | [_] as l -> l\n | hd :: (hd' :: _ as tl) ->\n if hd = hd' then destutter tl\n else hd :: destutter tl\n ;;\n#part 44\nlet rec destutter = function\n | [] | [_] as l -> l\n | hd :: (hd' :: _ as tl) when hd = hd' -> destutter tl\n | hd :: tl -> hd :: destutter tl\n ;;\n#part 45\n3 = 4;;\n[3;4;5] = [3;4;5];;\n[Some 3; None] = [None; Some 3];;\n#part 46\n(=);;\n#part 47\n(fun x -> x + 1) = (fun x -> x + 1);;\n#part 48\nlet rec count_some list =\n match list with\n | [] -> 0\n | x :: tl when Option.is_none x -> count_some tl\n | x :: tl when Option.is_some x -> 1 + count_some tl\n ;;\n#part 49\ncount_some [Some 3; None; Some 4];;\n#part 50\nlet rec count_some list =\n match list with\n | [] -> 0\n | x :: tl when Option.is_none x -> count_some tl\n | x :: tl when Option.is_some x -> 1 + count_some tl\n | x :: tl -> -1 (* unreachable *)\n ;;\n#part 51\nlet rec count_some list =\n match list with\n | [] -> 0\n | x :: tl when Option.is_none x -> count_some tl\n | _ :: tl -> 1 + count_some tl\n ;;\n#part 52\nlet rec count_some list =\n match list with\n | [] -> 0\n | None :: tl -> count_some tl\n | Some _ :: tl -> 1 + count_some tl\n ;;\n#part 53\nlet count_some l = List.count ~f:Option.is_some l;;\n#part 54\n#part 55\n#part 56\n#part 57\n#part 58\n#part 59\n#part 60\n#part 61\n#part 62\n#part 63\n#part 64\n#part 65\n#part 66\n#part 67\n#part 68\n#part 69\nprintf \"%s\\n\"\n (render_table\n [\"language\";\"architect\";\"first release\"]\n [ [\"Lisp\" ;\"John McCarthy\" ;\"1958\"] ;\n [\"C\" ;\"Dennis Ritchie\";\"1969\"] ;\n [\"ML\" ;\"Robin Milner\" ;\"1973\"] ;\n [\"OCaml\";\"Xavier Leroy\" ;\"1996\"] ;\n ]);;\n"
},
{
"path": "code/maps-and-hash-tables/comparable.ml",
"content": "module type Comparable = sig\n type t\n val sexp_of_t : t -> Sexp.t\n val t_of_sexp : Sexp.t -> t\n val compare : t -> t -> int\nend\n"
},
{
"path": "code/maps-and-hash-tables/core_phys_equal.topscript",
"content": "open Core.Std ;;\n1 == 2 ;;\nphys_equal 1 2 ;;\n"
},
{
"path": "code/maps-and-hash-tables/main-22.rawscript",
"content": "# module Foo_and_bar : sig\n type t = { foo: Int.Set.t; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: Int.Set.t; bar: string } with sexp\n let compare t1 t2 =\n let c = Int.Set.compare t1.foo t2.foo in\n if c <> 0 then c else String.compare t1.bar t2.bar\n end\n include T\n include Comparable.Make(T)\n end;;\nmodule Foo_and_bar :\nsig\n type t = { foo : Int.Set.t; bar : string; }\n val ( >= ) : t -> t -> bool\n val ( <= ) : t -> t -> bool\n val ( = ) : t -> t -> bool\n\n ...\n\nend\n"
},
{
"path": "code/maps-and-hash-tables/main-23.rawscript",
"content": "# module Foo_and_bar : sig\n type t = { foo: Int.Set.t; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: Int.Set.t; bar: string } with sexp, compare\n end\n include T\n include Comparable.Make(T)\n end;;\nmodule Foo_and_bar :\nsig\n type t = { foo : Int.Set.t; bar : string; }\n val ( >= ) : t -> t -> bool\n val ( <= ) : t -> t -> bool\n val ( = ) : t -> t -> bool\n\n ...\n\nend\n"
},
{
"path": "code/maps-and-hash-tables/main-24.rawscript",
"content": "# module Foo_and_bar : sig\n type t = { foo: int; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: int; bar: string } with sexp\n end\n include T\n include Comparable.Poly(T)\n end;;\nmodule Foo_and_bar :\nsig\n type t = { foo : int; bar : string; }\n val ( >= ) : t -> t -> bool\n val ( <= ) : t -> t -> bool\n val ( = ) : t -> t -> bool\n\n ...\n\nend\n\n"
},
{
"path": "code/maps-and-hash-tables/main-30.rawscript",
"content": "# module Foo_and_bar : sig\n type t = { foo: int; bar: string }\n include Hashable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: int; bar: string } with sexp, compare\n let hash t =\n (Int.hash t.foo) lxor (String.hash t.bar)\n end\n include T\n include Hashable.Make(T)\n end;;\nmodule Foo_and_bar :\nsig\n type t = { foo : int; bar : string; }\n module Hashable : sig type t = t end\n val hash : t -> int\n val compare : t -> t -> int\n val hashable : t Pooled_hashtbl.Hashable.t\n\n ...\n\nend\n"
},
{
"path": "code/maps-and-hash-tables/main.topscript",
"content": "let x = 0;;\n#part 1\nlet digit_alist =\n [ 0, \"zero\"; 1, \"one\"; 2, \"two\" ; 3, \"three\"; 4, \"four\"\n ; 5, \"five\"; 6, \"six\"; 7, \"seven\"; 8, \"eight\"; 9, \"nine\" ]\n ;;\n#part 2\nList.Assoc.find digit_alist 6;;\nList.Assoc.find digit_alist 22;;\nList.Assoc.add digit_alist 0 \"zilch\";;\n#part 3\nlet digit_map = Map.of_alist_exn digit_alist\n ~comparator:Int.comparator;;\nMap.find digit_map 3;;\n#part 4\nlet zilch_map = Map.add digit_map ~key:0 ~data:\"zilch\";;\n#part 5\nlet left = String.Map.of_alist_exn [\"foo\",1; \"bar\",3; \"snoo\", 0]\n let right = String.Map.of_alist_exn [\"foo\",0; \"snoo\", 0]\n let diff = Map.symmetric_diff ~data_equal:Int.equal left right\n ;;\n#part 6\nMap.symmetric_diff;;\n#part 7\nmodule Reverse = Comparator.Make(struct\n type t = string\n let sexp_of_t = String.sexp_of_t\n let t_of_sexp = String.t_of_sexp\n let compare x y = String.compare y x\n end);;\n#part 8\nlet alist = [\"foo\", 0; \"snoo\", 3];;\nlet ord_map = Map.of_alist_exn ~comparator:String.comparator alist;;\nlet rev_map = Map.of_alist_exn ~comparator:Reverse.comparator alist;;\n#part 9\nMap.min_elt ord_map;;\nMap.min_elt rev_map;;\n#part 10\nMap.symmetric_diff ord_map rev_map;;\n#part 11\nlet ord_tree = Map.to_tree ord_map;;\n#part 12\nMap.Tree.find ~comparator:String.comparator ord_tree \"snoo\";;\n#part 13\nMap.Tree.find ~comparator:Reverse.comparator ord_tree \"snoo\";;\n#part 14\nMap.of_alist_exn ~comparator:Comparator.Poly.comparator digit_alist;;\n#part 15\nMap.Poly.of_alist_exn digit_alist;;\n#part 16\nMap.symmetric_diff (Map.Poly.singleton 3 \"three\")\n (Int.Map.singleton 3 \"four\" ) ;;\n#part 17\nlet dedup ~comparator l =\n List.fold l ~init:(Set.empty ~comparator) ~f:Set.add\n |> Set.to_list\n ;;\ndedup ~comparator:Int.comparator [8;3;2;3;7;8;10];;\n#part 18\nlet (s1,s2) = (Int.Set.of_list [1;2],\n Int.Set.of_list [2;1]);;\n#part 19\nSet.equal s1 s2;;\n#part 20\ns1 = s2;;\n#part 21\nSet.to_tree s1 = Set.to_tree s2;;\n#part 22\nmodule Foo_and_bar : sig\n type t = { foo: Int.Set.t; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: Int.Set.t; bar: string } with sexp\n let compare t1 t2 =\n let c = Int.Set.compare t1.foo t2.foo in\n if c <> 0 then c else String.compare t1.bar t2.bar\n end\n include T\n include Comparable.Make(T)\n end;;\n#part 23\nmodule Foo_and_bar : sig\n type t = { foo: Int.Set.t; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: Int.Set.t; bar: string } with sexp, compare\n end\n include T\n include Comparable.Make(T)\n end;;\n#part 24\nmodule Foo_and_bar : sig\n type t = { foo: int; bar: string }\n include Comparable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: int; bar: string } with sexp\n end\n include T\n include Comparable.Poly(T)\n end;;\n#part 25\nlet table = Hashtbl.create ~hashable:String.hashable ();;\nHashtbl.replace table ~key:\"three\" ~data:3;;\nHashtbl.find table \"three\";;\n#part 26\nlet table = String.Table.create ();;\n#part 27\nlet table = Hashtbl.create ~hashable:Hashtbl.Poly.hashable ();;\n#part 28\nlet table = Hashtbl.Poly.create ();;\n#part 29\nCaml.Hashtbl.hash (List.range 0 9);;\nCaml.Hashtbl.hash (List.range 0 10);;\nCaml.Hashtbl.hash (List.range 0 11);;\nCaml.Hashtbl.hash (List.range 0 100);;\n#part 30\nmodule Foo_and_bar : sig\n type t = { foo: int; bar: string }\n include Hashable.S with type t := t\n end = struct\n module T = struct\n type t = { foo: int; bar: string } with sexp, compare\n let hash t =\n (Int.hash t.foo) lxor (String.hash t.bar)\n end\n include T\n include Hashable.Make(T)\n end;;\n"
},
{
"path": "code/maps-and-hash-tables/map_vs_hash.ml",
"content": "open Core.Std\nopen Core_bench.Std\n\nlet map_iter ~num_keys ~iterations =\n let rec loop i map =\n if i <= 0 then ()\n else loop (i - 1)\n (Map.change map (i mod num_keys) (fun current ->\n Some (1 + Option.value ~default:0 current)))\n in\n loop iterations Int.Map.empty\n\nlet table_iter ~num_keys ~iterations =\n let table = Int.Table.create ~size:num_keys () in\n let rec loop i =\n if i <= 0 then ()\n else (\n Hashtbl.change table (i mod num_keys) (fun current ->\n Some (1 + Option.value ~default:0 current));\n loop (i - 1)\n )\n in\n loop iterations\n\nlet tests ~num_keys ~iterations =\n let test name f = Bench.Test.create f ~name in\n [ test \"map\" (fun () -> map_iter ~num_keys ~iterations)\n ; test \"table\" (fun () -> table_iter ~num_keys ~iterations)\n ]\n\nlet () =\n tests ~num_keys:1000 ~iterations:100_000\n |> Bench.make_command\n |> Command.run\n"
},
{
"path": "code/maps-and-hash-tables/map_vs_hash2.ml",
"content": "open Core.Std\nopen Core_bench.Std\n\nlet create_maps ~num_keys ~iterations =\n let rec loop i map =\n if i <= 0 then []\n else\n let new_map =\n Map.change map (i mod num_keys) (fun current ->\n Some (1 + Option.value ~default:0 current))\n in\n new_map :: loop (i - 1) new_map\n in\n loop iterations Int.Map.empty\n\nlet create_tables ~num_keys ~iterations =\n let table = Int.Table.create ~size:num_keys () in\n let rec loop i =\n if i <= 0 then []\n else (\n Hashtbl.change table (i mod num_keys) (fun current ->\n Some (1 + Option.value ~default:0 current));\n let new_table = Hashtbl.copy table in\n new_table :: loop (i - 1)\n )\n in\n loop iterations\n\nlet tests ~num_keys ~iterations =\n let test name f = Bench.Test.create f ~name in\n [ test \"map\" (fun () -> ignore (create_maps ~num_keys ~iterations))\n ; test \"table\" (fun () -> ignore (create_tables ~num_keys ~iterations))\n ]\n\nlet () =\n tests ~num_keys:50 ~iterations:1000\n |> Bench.make_command\n |> Command.run\n"
},
{
"path": "code/maps-and-hash-tables/phys_equal.rawscript",
"content": "# type t1 = { foo1:int; bar1:t2 } and t2 = { foo2:int; bar2:t1 } ;;\ntype t1 = { foo1 : int; bar1 : t2; }\nand t2 = { foo2 : int; bar2 : t1; }\n# let rec v1 = { foo1=1; bar1=v2 } and v2 = { foo2=2; bar2=v1 } ;;\n\n# v1 == v1;;\n- : bool = true\n# phys_equal v1 v1;;\n- : bool = true\n# v1 = v1 ;;\n\n"
},
{
"path": "code/maps-and-hash-tables/run_map_vs_hash.sh",
"content": "corebuild -pkg core_bench map_vs_hash.native\n./map_vs_hash.native -ascii -clear-columns time speedup\n"
},
{
"path": "code/maps-and-hash-tables/run_map_vs_hash2.sh",
"content": "corebuild -pkg core_bench map_vs_hash2.native\n./map_vs_hash2.native -ascii -clear-columns time speedup\n"
},
{
"path": "code/memory-repr/block.ascii",
"content": "+------------------------+---------+----------+----------+----------+----\n| size of block in words | color | tag byte | value[0] | value[1] | ...\n+------------------------+---------+----------+----------+----------+----\n <-either 22 or 54 bits-> <-2 bit-> <--8 bit-->\n"
},
{
"path": "code/memory-repr/custom_ops.c",
"content": "struct custom_operations {\n char *identifier;\n void (*finalize)(value v);\n int (*compare)(value v1, value v2);\n intnat (*hash)(value v);\n void (*serialize)(value v,\n /*out*/ uintnat * wsize_32 /*size in bytes*/,\n /*out*/ uintnat * wsize_64 /*size in bytes*/);\n uintnat (*deserialize)(void * dst);\n int (*compare_ext)(value v1, value v2);\n};\n"
},
{
"path": "code/memory-repr/float_array_layout.ascii",
"content": "+---------+----------+----------- - - - -\n| header | float[0] | float[1] | ....\n+---------+----------+----------+- - - - -\n"
},
{
"path": "code/memory-repr/reprs.topscript",
"content": "Obj.is_block (Obj.repr (1,2,3)) ;;\nObj.is_block (Obj.repr 1) ;;\n#part 1\nObj.tag (Obj.repr 1.0) ;;\nObj.double_tag ;;\n#part 2\nObj.double_tag ;;\nObj.double_array_tag ;;\n#part 3\nObj.tag (Obj.repr [| 1.0; 2.0; 3.0 |]) ;;\nObj.tag (Obj.repr (1.0, 2.0, 3.0) ) ;;\nObj.double_field (Obj.repr [| 1.1; 2.2; 3.3 |]) 1 ;;\nObj.double_field (Obj.repr 1.234) 0 ;;\n#part 4\ntype t = Apple | Orange | Pear ;;\n((Obj.magic (Obj.repr Apple)) : int) ;;\n((Obj.magic (Obj.repr Pear)) : int) ;;\nObj.is_block (Obj.repr Apple) ;;\n#part 5\ntype t = Apple | Orange of int | Pear of string | Kiwi ;;\nObj.is_block (Obj.repr (Orange 1234)) ;;\nObj.tag (Obj.repr (Orange 1234)) ;;\nObj.tag (Obj.repr (Pear \"xyz\")) ;;\n(Obj.magic (Obj.field (Obj.repr (Orange 1234)) 0) : int) ;;\n(Obj.magic (Obj.field (Obj.repr (Pear \"xyz\")) 0) : string) ;;\n#part 6\nPa_type_conv.hash_variant \"Foo\" ;;\n(Obj.magic (Obj.repr `Foo) : int) ;;\n"
},
{
"path": "code/memory-repr/simple_record.topscript",
"content": "type t = { foo: int; bar: int } ;;\nlet x = { foo = 13; bar = 14 } ;;\n"
},
{
"path": "code/memory-repr/string_block.ascii",
"content": "+---------------+----------------+--------+-----------+\n| header | 'a' 'b' 'c' 'd' 'e' 'f' | '\\O' '\\1' |\n+---------------+----------------+--------+-----------+\n L data L padding\n"
},
{
"path": "code/memory-repr/string_size_calc.ascii",
"content": "number_of_words_in_block * sizeof(word) - last_byte_of_block - 1\n"
},
{
"path": "code/memory-repr/tuple_layout.ascii",
"content": "+---------+----------+----------- - - - -\n| header | value[0] | value[1] | ....\n+---------+----------+----------+- - - - -\n"
},
{
"path": "code/objects/IsBarbell.java",
"content": "boolean IsBarbell(Shape[] s) {\n return s.length == 3 && (s[0] instanceof Circle) &&\n (s[1] instanceof Line) && (s[2] instanceof Circle) &&\n ((Circle) s[0]).radius() == ((Circle) s[2]).radius();\n}\n"
},
{
"path": "code/objects/Shape.java",
"content": "String GetShapeName(Shape s) {\n if (s instanceof Square) {\n return \"Square\";\n } else if (s instanceof Circle) {\n return \"Circle\";\n } else {\n return \"Other\";\n }\n}\n"
},
{
"path": "code/objects/immutable.topscript",
"content": "1;;\n#part 1\nlet imm_stack init = object\n val v = init\n\n method pop =\n match v with\n | hd :: tl -> Some (hd, {< v = tl >})\n | [] -> None \n\n method push hd = \n {< v = hd :: v >}\n end ;;\n\n#part 2\nlet s = imm_stack [3; 2; 1] ;;\nlet t = s#push 4 ;;\ns#pop ;;\nt#pop ;;\n"
},
{
"path": "code/objects/is_barbell.ml",
"content": "let is_barbell = function\n| [Circle r1; Line _; Circle r2] when r1 = r2 -> true\n| _ -> false\n"
},
{
"path": "code/objects/narrowing.ml",
"content": "(* part 1 *)\ntype shape = < variant : repr; area : float>\nand circle = < variant : repr; area : float; radius : int >\nand line = < variant : repr; area : float; length : int >\nand repr =\n | Circle of circle\n | Line of line;;\n\nlet is_barbell = function\n| [s1; s2; s3] ->\n (match s1#variant, s2#variant, s3#variant with\n | Circle c1, Line _, Circle c2 when c1#radius = c2#radius -> true\n | _ -> false)\n| _ -> false;;\n"
},
{
"path": "code/objects/polymorphism.topscript",
"content": "1;;\n#part 1\nlet area sq = sq#width * sq#width ;;\nlet minimize sq : unit = sq#resize 1 ;;\nlet limit sq = \n if (area sq) > 100 then minimize sq ;;\n\n#part 2\nlet toggle sq b : unit = \n if b then sq#resize `Fullscreen\n else minimize sq ;;\n\n#part 3\nlet area_closed (sq: < width : int >) = sq#width * sq#width ;;\nlet sq = object\n method width = 30 \n method name = \"sq\" \n end ;;\narea_closed sq ;;\n\n#part 4\ntype square = < width : int; ..> ;;\n"
},
{
"path": "code/objects/row_polymorphism.topscript",
"content": "type shape = < area : float > ;;\n\ntype square = < area : float; width : int > ;;\n\nlet square w = object\n method area = Float.of_int (w * w)\n method width = w\n end ;;\n\ntype circle = < area : float; radius : int > ;;\n\nlet circle r = object\n method area = 3.14 *. (Float.of_int r) ** 2.0\n method radius = r\n end ;;\n\n#part 1\nlet remove_large l =\n List.filter ~f:(fun s -> s#area <= 100.) l ;;\n\n#part 2\nlet squares : < area : float; width : int > list = \n [square 5; square 15; square 10] ;;\nremove_large squares ;;\n\n#part 3\nlet remove_large (l: < area : float > list) = \n List.filter ~f:(fun s -> s#area <= 100.) l ;;\nremove_large (squares :> < area : float > list ) ;;\n\n#part 4\nlet hlist: < area: float; ..> list = [square 10; circle 30] ;;\n\n#part 5\nlet shape_ref: < area: float; ..> ref = ref (square 40) ;;\nshape_ref := circle 20 ;;\n\n#part 6\nlet hlist: shape list = [(square 10 :> shape); (circle 30 :> shape)] ;;\nlet shape_ref: shape ref = ref (square 40 :> shape) ;;\nshape_ref := (circle 20 :> shape) ;;\n"
},
{
"path": "code/objects/stack.topscript",
"content": "1;;\n#part 1\nlet s = object\n val mutable v = [0; 2]\n\n method pop =\n match v with\n | hd :: tl -> \n v <- tl;\n Some hd\n | [] -> None\n\n method push hd = \n v <- hd :: v\n end ;;\n#part 2\ns#pop ;;\ns#push 4 ;;\ns#pop ;;\n\n#part 3\nlet stack init = object\n val mutable v = init\n\n method pop =\n match v with\n | hd :: tl -> \n v <- tl;\n Some hd\n | [] -> None\n\n method push hd = \n v <- hd :: v\n end ;;\nlet s = stack [3; 2; 1] ;;\ns#pop ;;\n\n#part 4\nlet print_pop st = Option.iter ~f:(printf \"Popped: %d\\n\") st#pop ;;\nprint_pop (stack [5;4;3;2;1]) ;;\nlet t = object\n method pop = Some (Float.to_int (Time.to_float (Time.now ())))\n end ;;\nprint_pop t ;;\n"
},
{
"path": "code/objects/subtyping.ml",
"content": "(* part 1 *)\ntype shape = < area : float >\n\ntype square = < area : float; width : int >\n\nlet square w = object\n method area = Float.of_int (w * w)\n method width = w\nend\n\ntype circle = < area : float; radius : int >\n\nlet circle r = object\n method area = 3.14 *. (Float.of_int r) ** 2.0\n method radius = r\nend\n\n(* part 2 *)\ntype 'a stack = < pop: 'a option; push: 'a -> unit >\n\nlet square_stack: square stack = stack [square 30; square 10]\n\nlet circle_stack: circle stack = stack [circle 20; circle 40]\n"
},
{
"path": "code/objects/subtyping.topscript",
"content": "let stack init = object\n val mutable v = init\n\n method pop =\n match v with\n | hd :: tl -> \n v <- tl;\n Some hd\n | [] -> None\n \n method push hd = \n v <- hd :: v\n end ;;\n \ntype shape = < area : float > ;;\n\ntype square = < area : float; width : int > ;;\n\nlet square w = object\n method area = Float.of_int (w * w)\n method width = w\n end ;;\n\ntype circle = < area : float; radius : int > ;;\n\nlet circle r = object\n method area = 3.14 *. (Float.of_int r) ** 2.0\n method radius = r\n end ;;\n\ntype 'a stack = < pop: 'a option; push: 'a -> unit > ;;\n\nlet square_stack: square stack = stack [square 30; square 10] ;;\n\nlet circle_stack: circle stack = stack [circle 20; circle 40] ;;\n\n#part 1\nlet shape w : shape = square w ;;\nlet shape w : shape = (square w :> shape) ;;\n\n#part 2\nlet coin = object\n method shape = circle 5\n method color = \"silver\"\n end ;;\nlet map = object\n method shape = square 10\n end ;;\n\n#part 3\ntype item = < shape : shape > ;;\nlet items = [ (coin :> item) ; (map :> item) ] ;;\n\n#part 4\ntype num = [ `Int of int | `Float of float ] ;;\ntype const = [ num | `String of string ] ;;\nlet n : num = `Int 3 ;;\nlet c : const = (n :> const) ;;\n\n#part 5\nlet squares: square list = [ square 10; square 20 ] ;;\nlet shapes: shape list = (squares :> shape list) ;;\n\n#part 6\nlet square_array: square array = [| square 10; square 20 |] ;;\nlet shape_array: shape array = (square_array :> shape array) ;;\n\n#part 7\nlet shape_to_string: shape -> string = \n fun s -> sprintf \"Shape(%F)\" s#area ;;\nlet square_to_string: square -> string = \n (shape_to_string :> square -> string) ;;\n\n#part 8\nmodule Either = struct\n type ('a, 'b) t = \n | Left of 'a\n | Right of 'b\n let left x = Left x\n let right x = Right x\n end ;;\n(Either.left (square 40) :> (shape, shape) Either.t) ;;\n\n#part 9\nmodule AbstractEither : sig \n type ('a, 'b) t\n val left: 'a -> ('a, 'b) t\n val right: 'b -> ('a, 'b) t\n end = Either ;;\n(AbstractEither.left (square 40) :> (shape, shape) AbstractEither.t) ;;\n\n#part 10\nmodule VarEither : sig \n type (+'a, +'b) t\n val left: 'a -> ('a, 'b) t\n val right: 'b -> ('a, 'b) t\n end = Either ;;\n(VarEither.left (square 40) :> (shape, shape) VarEither.t) ;;\n\n#part 11\nlet total_area (shape_stacks: shape stack list) =\n let stack_area acc st = \n let rec loop acc =\n match st#pop with\n | Some s -> loop (acc +. s#area)\n | None -> acc\n in\n loop acc\n in\n List.fold ~init:0.0 ~f:stack_area shape_stacks ;;\n\n#part 12\ntotal_area [(square_stack :> shape stack); (circle_stack :> shape stack)] ;;\n\n#part 13\ntype 'a readonly_stack = < pop : 'a option > ;;\nlet total_area (shape_stacks: shape readonly_stack list) =\n let stack_area acc st = \n let rec loop acc =\n match st#pop with\n | Some s -> loop (acc +. s#area)\n | None -> acc\n in\n loop acc\n in\n List.fold ~init:0.0 ~f:stack_area shape_stacks ;;\ntotal_area [(square_stack :> shape readonly_stack); (circle_stack :> shape readonly_stack)] ;;\n"
},
{
"path": "code/ocp-index/index_ncurses.sh",
"content": "corebuild -pkg ctypes.foreign -tag bin_annot ncurses.cmi\nocp-index complete -I . Ncur\nocp-index complete -I . Ncurses.a\nocp-index complete -I . Ncurses.\n"
},
{
"path": "code/packing/A.ml",
"content": "let v = \"hello\"\n"
},
{
"path": "code/packing/B.ml",
"content": "let w = 42\n"
},
{
"path": "code/packing/X.mlpack",
"content": "A\nB\n"
},
{
"path": "code/packing/_tags",
"content": "<*.cmx> and not \"X.cmx\": for-pack(X)\n"
},
{
"path": "code/packing/build_test.sh",
"content": "corebuild test.inferred.mli test.cmi\ncat _build/test.inferred.mli\nocamlobjinfo _build/test.cmi\n"
},
{
"path": "code/packing/show_files.sh",
"content": "cat A.ml\ncat B.ml\ncat _tags\ncat X.mlpack\n"
},
{
"path": "code/packing/test.ml",
"content": "let v = X.A.v\nlet w = X.B.w\n"
},
{
"path": "code/parsing/basic_parser.mly",
"content": "%token INT\n%token FLOAT\n%token ID\n%token STRING\n%token TRUE\n%token FALSE\n%token NULL\n%token LEFT_BRACE\n%token RIGHT_BRACE\n%token LEFT_BRACK\n%token RIGHT_BRACK\n%token COLON\n%token COMMA\n%token EOF\n\n%start exp\n\n%%\n\nexp: { () }\n"
},
{
"path": "code/parsing/build_short_parser.sh",
"content": "corebuild -use-menhir short_parser.mli\n"
},
{
"path": "code/parsing/example.json",
"content": "{\n \"title\": \"Cities\",\n \"cities\": [\n { \"name\": \"Chicago\", \"zips\": [60601] },\n { \"name\": \"New York\", \"zips\": [10004] } \n ]\n}\n"
},
{
"path": "code/parsing/json.ml",
"content": "type value = [\n | `Assoc of (string * value) list\n | `Bool of bool\n | `Float of float\n | `Int of int\n | `List of value list\n | `Null\n | `String of string\n]\n\n(* part 1 *)\nopen Core.Std\nlet rec output_value outc = function\n | `Assoc obj -> print_assoc outc obj\n | `List l -> print_list outc l\n | `String s -> printf \"\\\"%s\\\"\" s\n | `Int i -> printf \"%d\" i\n | `Float x -> printf \"%f\" x\n | `Bool true -> output_string outc \"true\"\n | `Bool false -> output_string outc \"false\"\n | `Null -> output_string outc \"null\"\n\nand print_assoc outc obj =\n output_string outc \"{ \";\n let sep = ref \"\" in\n List.iter ~f:(fun (key, value) ->\n printf \"%s\\\"%s\\\": %a\" !sep key output_value value;\n sep := \",\\n \") obj;\n output_string outc \" }\"\n\nand print_list outc arr =\n output_string outc \"[\";\n List.iteri ~f:(fun i v ->\n if i > 0 then\n output_string outc \", \";\n output_value outc v) arr;\n output_string outc \"]\"\n"
},
{
"path": "code/parsing/lex.syntax",
"content": "{ OCaml code }\nlet definitions...\nrules...\n{ OCaml code }\n"
},
{
"path": "code/parsing/lexer.mll",
"content": "{\nopen Lexing\nopen Parser\n\nexception SyntaxError of string\n\nlet next_line lexbuf =\n let pos = lexbuf.lex_curr_p in\n lexbuf.lex_curr_p <-\n { pos with pos_bol = lexbuf.lex_curr_pos;\n pos_lnum = pos.pos_lnum + 1\n }\n}\n\n(* part 1 *)\nlet int = '-'? ['0'-'9'] ['0'-'9']*\n\n(* part 2 *)\nlet digit = ['0'-'9']\nlet frac = '.' digit*\nlet exp = ['e' 'E'] ['-' '+']? digit+\nlet float = digit* frac? exp?\n\n(* part 3 *)\nlet white = [' ' '\\t']+\nlet newline = '\\r' | '\\n' | \"\\r\\n\"\nlet id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*\n\n(* part 4 *)\nrule read =\n parse\n | white { read lexbuf }\n | newline { next_line lexbuf; read lexbuf }\n | int { INT (int_of_string (Lexing.lexeme lexbuf)) }\n | float { FLOAT (float_of_string (Lexing.lexeme lexbuf)) }\n | \"true\" { TRUE }\n | \"false\" { FALSE }\n | \"null\" { NULL }\n | '\"' { read_string (Buffer.create 17) lexbuf }\n | '{' { LEFT_BRACE }\n | '}' { RIGHT_BRACE }\n | '[' { LEFT_BRACK }\n | ']' { RIGHT_BRACK }\n | ':' { COLON }\n | ',' { COMMA }\n | _ { raise (SyntaxError (\"Unexpected char: \" ^ Lexing.lexeme lexbuf)) }\n | eof { EOF }\n\n(* part 5 *)\nand read_string buf =\n parse\n | '\"' { STRING (Buffer.contents buf) }\n | '\\\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf }\n | '\\\\' '\\\\' { Buffer.add_char buf '\\\\'; read_string buf lexbuf }\n | '\\\\' 'b' { Buffer.add_char buf '\\b'; read_string buf lexbuf }\n | '\\\\' 'f' { Buffer.add_char buf '\\012'; read_string buf lexbuf }\n | '\\\\' 'n' { Buffer.add_char buf '\\n'; read_string buf lexbuf }\n | '\\\\' 'r' { Buffer.add_char buf '\\r'; read_string buf lexbuf }\n | '\\\\' 't' { Buffer.add_char buf '\\t'; read_string buf lexbuf }\n | [^ '\"' '\\\\']+\n { Buffer.add_string buf (Lexing.lexeme lexbuf);\n read_string buf lexbuf\n }\n | _ { raise (SyntaxError (\"Illegal string character: \" ^ Lexing.lexeme lexbuf)) }\n | eof { raise (SyntaxError (\"String is not terminated\")) }\n"
},
{
"path": "code/parsing/lexer_int_fragment.mll",
"content": "| int { INT (int_of_string (Lexing.lexeme lexbuf)) }\n"
},
{
"path": "code/parsing/manual_token_type.ml",
"content": "type token =\n | NULL\n | TRUE\n | FALSE\n | STRING of string\n | INT of int\n | FLOAT of float\n | ID of string\n | LEFT_BRACK\n | RIGHT_BRACK\n | LEFT_BRACE\n | RIGHT_BRACE\n | COMMA\n | COLON\n | EOF\n"
},
{
"path": "code/parsing/parsed_example.ml",
"content": "`Assoc\n [\"title\", `String \"Cities\";\n \"cities\", `List\n [`Assoc [\"name\", `String \"Chicago\"; \"zips\", `List [`Int 60601]];\n `Assoc [\"name\", `String \"New York\"; \"zips\", `List [`Int 10004]]]]\n"
},
{
"path": "code/parsing/parser.mly",
"content": "%token INT\n%token FLOAT\n%token ID\n%token STRING\n%token TRUE\n%token FALSE\n%token NULL\n%token LEFT_BRACE\n%token RIGHT_BRACE\n%token LEFT_BRACK\n%token RIGHT_BRACK\n%token COLON\n%token COMMA\n%token EOF\n(* part 1 *)\n%start prog\n%%\n(* part 2 *)\nprog:\n | EOF { None }\n | v = value { Some v }\n ;\n\n(* part 3 *)\nvalue:\n | LEFT_BRACE; obj = object_fields; RIGHT_BRACE\n { `Assoc obj }\n | LEFT_BRACK; vl = array_values; RIGHT_BRACK\n { `List vl }\n | s = STRING\n { `String s }\n | i = INT\n { `Int i }\n | x = FLOAT\n { `Float x }\n | TRUE\n { `Bool true }\n | FALSE\n { `Bool false }\n | NULL\n { `Null }\n ;\n\n(* part 4 *)\nobject_fields: obj = rev_object_fields { List.rev obj };\n\nrev_object_fields:\n | (* empty *) { [] }\n | obj = rev_object_fields; COMMA; k = ID; COLON; v = value\n { (k, v) :: obj }\n ;\n\n(* part 5 *)\narray_values:\n | (* empty *) { [] }\n | vl = rev_values { List.rev vl }\n ;\n\nrev_values:\n | v = value { [v] }\n | vl = rev_values; COMMA; v = value\n { v :: vl }\n ;\n"
},
{
"path": "code/parsing/production.syntax",
"content": "symbol: [ id1 = ] symbol1; [ id2 = ] symbol2; ...; [ idN = ] symbolN\n { OCaml code }\n"
},
{
"path": "code/parsing/prog.mli",
"content": "val prog:(Lexing.lexbuf -> token) -> Lexing.lexbuf -> Json.value option\n"
},
{
"path": "code/parsing/quadratic_rule.mly",
"content": "%token INT\n%token FLOAT\n%token ID\n%token STRING\n%token TRUE\n%token FALSE\n%token NULL\n%token LEFT_BRACE\n%token RIGHT_BRACE\n%token LEFT_BRACK\n%token RIGHT_BRACK\n%token COLON\n%token COMMA\n%token EOF\n(* part 1 *)\n%start prog\n%%\n(* part 2 *)\nprog:\n | EOF { None }\n | v = value { Some v }\n ;\n\n(* part 3 *)\nvalue:\n | LEFT_BRACE; obj = object_fields; RIGHT_BRACE\n { `Assoc obj }\n | LEFT_BRACK; vl = array_values; RIGHT_BRACK\n { `List vl }\n | s = STRING\n { `String s }\n | i = INT\n { `Int i }\n | x = FLOAT\n { `Float x }\n | TRUE\n { `Bool true }\n | FALSE\n { `Bool false }\n | NULL\n { `Null }\n ;\n\n(* part 4 *)\n(* Quadratic left-recursive rule *)\nobject_fields:\n | (* empty *) { [] }\n | obj = object_fields; COMMA; k = ID; COLON; v = value\n { obj @ [k, v] }\n ;\n\n(* part 5 *)\narray_values:\n | (* empty *) { [] }\n | vl = rev_values\n { List.rev vl }\n ;\n\nrev_values:\n | v = value { [v] }\n | vl = rev_values; COMMA; v = value\n { v :: vl }\n ;\n"
},
{
"path": "code/parsing/right_rec_rule.mly",
"content": "%token INT\n%token FLOAT\n%token ID\n%token STRING\n%token TRUE\n%token FALSE\n%token NULL\n%token LEFT_BRACE\n%token RIGHT_BRACE\n%token LEFT_BRACK\n%token RIGHT_BRACK\n%token COLON\n%token COMMA\n%token EOF\n(* part 1 *)\n%start prog\n%%\n(* part 2 *)\nprog:\n | EOF { None }\n | v = value { Some v }\n ;\n\n(* part 3 *)\nvalue:\n | LEFT_BRACE; obj = object_fields; RIGHT_BRACE\n { `Assoc obj }\n | LEFT_BRACK; vl = array_values; RIGHT_BRACK\n { `List vl }\n | s = STRING\n { `String s }\n | i = INT\n { `Int i }\n | x = FLOAT\n { `Float x }\n | TRUE\n { `Bool true }\n | FALSE\n { `Bool false }\n | NULL\n { `Null }\n ;\n\n(* part 4 *)\n(* Inefficient right-recursive rule *)\nobject_fields:\n | (* empty *) { [] }\n | k = ID; COLON; v = value; COMMA; obj = object_fields\n { (k, v) :: obj }\n\n(* part 5 *)\narray_values: /* empty */\n { [] }\n | vl = rev_values\n { List.rev vl }\n ;\n\nrev_values: v = value\n { [v] }\n | vl = rev_values; COMMA; v = value\n { v :: vl }\n ;\n"
},
{
"path": "code/parsing/short_parser.mly",
"content": "%token INT\n%token FLOAT\n%token STRING\n%token TRUE\n%token FALSE\n%token NULL\n%token LEFT_BRACE\n%token RIGHT_BRACE\n%token LEFT_BRACK\n%token RIGHT_BRACK\n%token COLON\n%token COMMA\n%token EOF\n\n%start prog\n\n%%\n(* part 1 *)\nprog:\n | v = value { Some v }\n | EOF { None } ;\n\nvalue:\n | LEFT_BRACE; obj = obj_fields; RIGHT_BRACE { `Assoc obj }\n | LEFT_BRACK; vl = list_fields; RIGHT_BRACK { `List vl }\n | s = STRING { `String s }\n | i = INT { `Int i }\n | x = FLOAT { `Float x }\n | TRUE { `Bool true }\n | FALSE { `Bool false }\n | NULL { `Null } ;\n\nobj_fields:\n obj = separated_list(COMMA, obj_field) { obj } ;\n\nobj_field:\n k = STRING; COLON; v = value { (k, v) } ;\n\nlist_fields:\n vl = separated_list(COMMA, value) { vl } ;\n"
},
{
"path": "code/parsing/tokenized_example.ml",
"content": ""
},
{
"path": "code/parsing/tokens.ml",
"content": "[ LEFT_BRACE; ID(\"title\"); COLON; STRING(\"Cities\"); COMMA; ID(\"cities\"); ...\n"
},
{
"path": "code/parsing/yacc.syntax",
"content": "\n%%\n\n%%\n\n"
},
{
"path": "code/parsing-test/build_json_parser.sh",
"content": "corebuild -use-menhir parser.mli\n"
},
{
"path": "code/parsing-test/build_test.sh",
"content": "ocamlbuild -use-menhir -tag thread -use-ocamlfind -quiet -pkg core test.native\n./test.native test1.json\n"
},
{
"path": "code/parsing-test/run_broken_test.errsh",
"content": "cat test2.json\n./test.native test2.json\n"
},
{
"path": "code/parsing-test/test.ml",
"content": "open Core.Std\nopen Lexer\nopen Lexing\n\nlet print_position outx lexbuf =\n let pos = lexbuf.lex_curr_p in\n fprintf outx \"%s:%d:%d\" pos.pos_fname\n pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)\n\nlet parse_with_error lexbuf =\n try Parser.prog Lexer.read lexbuf with\n | SyntaxError msg ->\n fprintf stderr \"%a: %s\\n\" print_position lexbuf msg;\n None\n | Parser.Error ->\n fprintf stderr \"%a: syntax error\\n\" print_position lexbuf;\n exit (-1)\n\n(* part 1 *)\nlet rec parse_and_print lexbuf =\n match parse_with_error lexbuf with\n | Some value ->\n printf \"%a\\n\" Json.output_value value;\n parse_and_print lexbuf\n | None -> ()\n\nlet loop filename () =\n let inx = In_channel.create filename in\n let lexbuf = Lexing.from_channel inx in\n lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };\n parse_and_print lexbuf;\n In_channel.close inx\n\n(* part 2 *)\nlet () =\n Command.basic ~summary:\"Parse and display JSON\"\n Command.Spec.(empty +> anon (\"filename\" %: file))\n loop \n |> Command.run\n"
},
{
"path": "code/parsing-test/test1.json",
"content": "true\nfalse\nnull\n[1, 2, 3., 4.0, .5, 5.5e5, 6.3]\n\"Hello World\"\n{ \"field1\": \"Hello\",\n \"field2\": 17e13,\n \"field3\": [1, 2, 3],\n \"field4\": { \"fieldA\": 1, \"fieldB\": \"Hello\" }\n}\n"
},
{
"path": "code/parsing-test/test2.json",
"content": "{ \"name\": \"Chicago\",\n \"zips\": [12345,\n}\n{ \"name\": \"New York\",\n \"zips\": [10004]\n}\n"
},
{
"path": "code/principal/build_principal.sh",
"content": "corebuild -tag principal principal.cmi non_principal.cmi\n"
},
{
"path": "code/records/functional_update.syntax",
"content": "{ with = ;\n = ;\n ...\n}\n"
},
{
"path": "code/records/main-29.rawscript",
"content": "# module Logon = struct\n type t =\n { session_id: string;\n time: Time.t;\n user: string;\n credentials: string;\n }\n with fields\n end;;\nmodule Logon :\n sig\n type t = {\n session_id : string;\n time : Time.t;\n user : string;\n credentials : string;\n }\n val credentials : t -> string\n val user : t -> string\n val time : t -> Time.t\n val session_id : t -> string\n module Fields :\n sig\n val names : string list\n val credentials :\n ([< `Read | `Set_and_create ], t, string) Field.t_with_perm\n val user :\n ([< `Read | `Set_and_create ], t, string) Field.t_with_perm\n val time :\n ([< `Read | `Set_and_create ], t, Time.t) Field.t_with_perm\n val session_id :\n ([< `Read | `Set_and_create ], t, string) Field.t_with_perm\n\n [ ... many definitions omitted ... ]\n\n end\n end\n"
},
{
"path": "code/records/main.topscript",
"content": "type host_info =\n { hostname : string;\n os_name : string;\n cpu_arch : string;\n timestamp : Time.t;\n };;\n#part 1\n#require \"core_extended\";;\nopen Core_extended.Std;;\nlet my_host =\n let sh = Shell.sh_one_exn in\n { hostname = sh \"hostname\";\n os_name = sh \"uname -s\";\n cpu_arch = sh \"uname -p\";\n timestamp = Time.now ();\n };;\n#part 2\nmy_host.cpu_arch;;\n#part 3\ntype 'a timestamped = { item: 'a; time: Time.t };;\n#part 4\nlet first_timestamped list =\n List.reduce list ~f:(fun a b -> if a.time < b.time then a else b)\n ;;\n#part 5\nlet host_info_to_string { hostname = h; os_name = os;\n cpu_arch = c; timestamp = ts;\n } =\n sprintf \"%s (%s / %s, on %s)\" h os c (Time.to_sec_string ts);;\nhost_info_to_string my_host;;\n#part 6\ntype host_info =\n { hostname : string;\n os_name : string;\n cpu_arch : string;\n os_release : string;\n timestamp : Time.t;\n } ;;\n#part 7\n#warnings \"+9\";;\nlet host_info_to_string { hostname = h; os_name = os;\n cpu_arch = c; timestamp = ts;\n } =\n sprintf \"%s (%s / %s, on %s)\" h os c (Time.to_sec_string ts);;\n#part 8\nlet host_info_to_string { hostname = h; os_name = os;\n cpu_arch = c; timestamp = ts; _\n } =\n sprintf \"%s (%s / %s, on %s)\" h os c (Time.to_sec_string ts);;\n#part 9\nlet host_info_to_string { hostname; os_name; cpu_arch; timestamp; _ } =\n sprintf \"%s (%s / %s) <%s>\" hostname os_name cpu_arch\n (Time.to_string timestamp);;\n#part 10\nlet my_host =\n let sh cmd = Shell.sh_one_exn cmd in\n let hostname = sh \"hostname\" in\n let os_name = sh \"uname -s\" in\n let cpu_arch = sh \"uname -p\" in\n let os_release = sh \"uname -r\" in\n let timestamp = Time.now () in\n { hostname; os_name; cpu_arch; os_release; timestamp };;\n#part 11\nlet create_host_info ~hostname ~os_name ~cpu_arch ~os_release =\n { os_name; cpu_arch; os_release;\n hostname = String.lowercase hostname;\n timestamp = Time.now () };;\n#part 12\nlet create_host_info\n ~hostname:hostname ~os_name:os_name\n ~cpu_arch:cpu_arch ~os_release:os_release =\n { os_name = os_name;\n cpu_arch = cpu_arch;\n os_release = os_release;\n hostname = String.lowercase hostname;\n timestamp = Time.now () };;\n#part 13\ntype log_entry =\n { session_id: string;\n time: Time.t;\n important: bool;\n message: string;\n }\n type heartbeat =\n { session_id: string;\n time: Time.t;\n status_message: string;\n }\n type logon =\n { session_id: string;\n time: Time.t;\n user: string;\n credentials: string;\n }\n;;\n#part 14\nlet get_session_id t = t.session_id;;\n#part 15\nlet get_heartbeat_session_id (t:heartbeat) = t.session_id;;\n#part 16\nlet status_and_session t = (t.status_message, t.session_id);;\nlet session_and_status t = (t.session_id, t.status_message);;\nlet session_and_status (t:heartbeat) = (t.session_id, t.status_message);;\n#part 17\nmodule Log_entry = struct\n type t =\n { session_id: string;\n time: Time.t;\n important: bool;\n message: string;\n }\n end\n module Heartbeat = struct\n type t =\n { session_id: string;\n time: Time.t;\n status_message: string;\n }\n end\n module Logon = struct\n type t =\n { session_id: string;\n time: Time.t;\n user: string;\n credentials: string;\n }\n end;;\n#part 18\nlet create_log_entry ~session_id ~important message =\n { Log_entry.time = Time.now (); Log_entry.session_id;\n Log_entry.important; Log_entry.message }\n ;;\n#part 19\nlet create_log_entry ~session_id ~important message =\n { Log_entry.\n time = Time.now (); session_id; important; message }\n ;;\n#part 20\nlet message_to_string { Log_entry.important; message; _ } =\n if important then String.uppercase message else message\n ;;\n#part 21\nlet is_important t = t.Log_entry.important;;\n#part 22\ntype client_info =\n { addr: Unix.Inet_addr.t;\n port: int;\n user: string;\n credentials: string;\n last_heartbeat_time: Time.t;\n };;\nlet register_heartbeat t hb =\n { addr = t.addr;\n port = t.port;\n user = t.user;\n credentials = t.credentials;\n last_heartbeat_time = hb.Heartbeat.time;\n };;\n#part 23\nlet register_heartbeat t hb =\n { t with last_heartbeat_time = hb.Heartbeat.time };;\n#part 24\ntype client_info =\n { addr: Unix.Inet_addr.t;\n port: int;\n user: string;\n credentials: string;\n last_heartbeat_time: Time.t;\n last_heartbeat_status: string;\n };;\n#part 25\nlet register_heartbeat t hb =\n { t with last_heartbeat_time = hb.Heartbeat.time;\n last_heartbeat_status = hb.Heartbeat.status_message;\n };;\n#part 26\ntype client_info =\n { addr: Unix.Inet_addr.t;\n port: int;\n user: string;\n credentials: string;\n mutable last_heartbeat_time: Time.t;\n mutable last_heartbeat_status: string;\n };;\n#part 27\nlet register_heartbeat t hb =\n t.last_heartbeat_time <- hb.Heartbeat.time;\n t.last_heartbeat_status <- hb.Heartbeat.status_message\n ;;\n#part 28\nlet get_users logons =\n List.dedup (List.map logons ~f:(fun x -> x.Logon.user));;\n#part 29\nmodule Logon = struct\n type t =\n { session_id: string;\n time: Time.t;\n user: string;\n credentials: string;\n }\n with fields\n end;;\n#part 30\nlet get_users logons = List.dedup (List.map logons ~f:Logon.user);;\n#part 31\nField.get Logon.Fields.user;;\n#part 32\nField.get;;\n#part 33\nlet show_field field to_string record =\n let name = Field.name field in\n let field_string = to_string (Field.get field record) in\n name ^ \": \" ^ field_string\n ;;\n#part 34\nlet logon = { Logon.\n session_id = \"26685\";\n time = Time.now ();\n user = \"yminsky\";\n credentials = \"Xy2d9W\"; }\n ;;\nshow_field Logon.Fields.user Fn.id logon;;\nshow_field Logon.Fields.time Time.to_string logon;;\n#part 35\nLogon.Fields.iter;;\n#part 36\nlet print_logon logon =\n let print to_string field =\n printf \"%s\\n\" (show_field field to_string logon)\n in\n Logon.Fields.iter\n ~session_id:(print Fn.id)\n ~time:(print Time.to_string)\n ~user:(print Fn.id)\n ~credentials:(print Fn.id)\n ;;\nprint_logon logon;;\n#part 37\n#part 38\n#part 39\n#part 40\n#part 41\n#part 42\n#part 43\n#part 44\n#part 45\n#part 46\n#part 47\n#part 48\n#part 49\n#part 50\n"
},
{
"path": "code/records/record.syntax",
"content": "type =\n { : ;\n : ;\n ...\n }\n"
},
{
"path": "code/records/warn_help.sh",
"content": "ocaml -warn-help | egrep '\\b9\\b'\n"
},
{
"path": "code/sexpr/auto_making_sexp.topscript",
"content": "type t = { foo: int; bar: float } with sexp ;;\nt_of_sexp (Sexp.of_string \"((bar 35) (foo 3))\") ;;\n#part 1\nexception Bad_message of string list ;;\nExn.to_string (Bad_message [\"1\";\"2\";\"3\"]) ;;\nexception Good_message of string list with sexp;;\nExn.to_string (Good_message [\"1\";\"2\";\"3\"]) ;;\n"
},
{
"path": "code/sexpr/basic.scm",
"content": "(this (is an) (s expression))\n"
},
{
"path": "code/sexpr/build_read_foo.errsh",
"content": "corebuild read_foo.native\n./read_foo.native foo_example_broken.scm\n"
},
{
"path": "code/sexpr/build_read_foo_better_errors.errsh",
"content": "corebuild read_foo_better_errors.native\n./read_foo_better_errors.native foo_example_broken.scm\n"
},
{
"path": "code/sexpr/build_test_interval.sh",
"content": "corebuild test_interval.native\n./test_interval.native\n"
},
{
"path": "code/sexpr/build_test_interval_manual_sexp.sh",
"content": "corebuild test_interval_manual_sexp.native\n"
},
{
"path": "code/sexpr/build_test_interval_nosexp.errsh",
"content": "corebuild test_interval_nosexp.native\n"
},
{
"path": "code/sexpr/comment_heavy.scm",
"content": ";; comment_heavy_example.scm\n((this is included)\n ; (this is commented out\n (this stays)\n #; (all of this is commented\n out (even though it crosses lines.))\n (and #| block delimiters #| which can be nested |#\n will comment out\n an arbitrary multi-line block))) |#\n now we're done\n ))\n"
},
{
"path": "code/sexpr/example.scm",
"content": ";; example.scm\n\n((foo 3.3) ;; This is a comment\n (bar \"this is () an \\\" atom\"))\n"
},
{
"path": "code/sexpr/example_broken.scm",
"content": ";; example.scm\n\n((foo 3.3) ;; This is a comment\n bar \"this is () an \\\" atom\"))\n"
},
{
"path": "code/sexpr/example_load.topscript",
"content": "Sexp.load_sexp \"example.scm\" ;;\n#part 1\nSexp.load_sexp \"comment_heavy.scm\" ;;\n#part 2\nExn.handle_uncaught ~exit:false (fun () ->\n ignore (Sexp.load_sexp \"example_broken.scm\")) ;;\n"
},
{
"path": "code/sexpr/foo_broken_example.scm",
"content": "((a \"not-an-integer\")\n (b \"not-an-integer\")\n (c 1.0))\n"
},
{
"path": "code/sexpr/inline_sexp.topscript",
"content": "let l = [(1,\"one\"); (2,\"two\")] ;;\nList.iter l ~f:(fun x ->\n <:sexp_of> x\n |> Sexp.to_string\n |> print_endline) ;;\n"
},
{
"path": "code/sexpr/int_interval.ml",
"content": "(* Module for representing closed integer intervals *)\nopen Core.Std\n\n(* Invariant: For any Range (x,y), y >= x *)\ntype t =\n | Range of int * int\n | Empty\nwith sexp\n\nlet is_empty =\n function \n | Empty -> true \n | Range _ -> false\n\nlet create x y =\n if x > y then\n Empty \n else \n Range (x,y)\n\nlet contains i x =\n match i with\n | Empty -> false\n | Range (low,high) -> x >= low && x <= high\n"
},
{
"path": "code/sexpr/int_interval.mli",
"content": "type t with sexp\n\nval is_empty : t -> bool\nval create : int -> int -> t\nval contains : t -> int -> bool\n\n"
},
{
"path": "code/sexpr/int_interval_manual_sexp.ml",
"content": "(* Module for representing closed integer intervals *)\nopen Core.Std\n\n(* Invariant: For any Range (x,y), y >= x *)\ntype t =\n | Range of int * int\n | Empty\nwith sexp\n\nlet is_empty =\n function \n | Empty -> true \n | Range _ -> false\n\nlet create x y =\n if x > y then\n Empty \n else \n Range (x,y)\n\nlet contains i x =\n match i with\n | Empty -> false\n | Range (low,high) -> x >= low && x <= high\n"
},
{
"path": "code/sexpr/int_interval_manual_sexp.mli",
"content": "open Core.Std\n\ntype t\nval t_of_sexp : Sexp.t -> t\nval sexp_of_t : t -> Sexp.t\n\nval is_empty : t -> bool\nval create : int -> int -> t\nval contains : t -> int -> bool\n"
},
{
"path": "code/sexpr/int_interval_nosexp.ml",
"content": "(* Module for representing closed integer intervals *)\nopen Core.Std\n\n(* Invariant: For any Range (x,y), y >= x *)\ntype t =\n | Range of int * int\n | Empty\nwith sexp\n\nlet is_empty =\n function \n | Empty -> true \n | Range _ -> false\n\nlet create x y =\n if x > y then\n Empty \n else \n Range (x,y)\n\nlet contains i x =\n match i with\n | Empty -> false\n | Range (low,high) -> x >= low && x <= high\n"
},
{
"path": "code/sexpr/int_interval_nosexp.mli",
"content": "type t\n\nval is_empty : t -> bool\nval create : int -> int -> t\nval contains : t -> int -> bool\n"
},
{
"path": "code/sexpr/list_top_packages.sh",
"content": "ocamlfind list | grep top\n"
},
{
"path": "code/sexpr/manually_making_sexp.topscript",
"content": "type t = { foo: int; bar: float } ;;\nlet sexp_of_t t =\n let a x = Sexp.Atom x and l x = Sexp.List x in\n l [ l [a \"foo\"; Int.sexp_of_t t.foo ];\n l [a \"bar\"; Float.sexp_of_t t.bar]; ] ;;\nsexp_of_t { foo = 3; bar = -5.5 } ;;\n"
},
{
"path": "code/sexpr/print_sexp.topscript",
"content": "Sexp.List [\n Sexp.Atom \"this\";\n Sexp.List [ Sexp.Atom \"is\"; Sexp.Atom \"an\"];\n Sexp.List [ Sexp.Atom \"s\"; Sexp.Atom \"expression\" ];\n ];;\n"
},
{
"path": "code/sexpr/read_foo.ml",
"content": "open Core.Std\n\ntype t = { \n a: string;\n b: int;\n c: float option \n} with sexp\n\nlet run () =\n let t =\n Sexp.load_sexp \"foo_broken_example.scm\"\n |> t_of_sexp\n in\n printf \"b is: %d\\n%!\" t.b\n\nlet () =\n Exn.handle_uncaught ~exit:true run\n"
},
{
"path": "code/sexpr/read_foo_better_errors.ml",
"content": "open Core.Std\n\ntype t = { \n a: string;\n b: int;\n c: float option \n} with sexp\n\nlet run () =\n let t = Sexp.load_sexp_conv_exn \"foo_broken_example.scm\" t_of_sexp in\n printf \"b is: %d\\n%!\" t.b\n\nlet () =\n Exn.handle_uncaught ~exit:true run\n"
},
{
"path": "code/sexpr/sexp.mli",
"content": "module Sexp : sig\n type t =\n | Atom of string\n | List of t list\nend\n"
},
{
"path": "code/sexpr/sexp_default.topscript",
"content": "type http_server_config = {\n web_root: string;\n port: int;\n addr: string;\n } with sexp ;;\n#part 1\ntype http_server_config = {\n web_root: string;\n port: int with default(80);\n addr: string with default(\"localhost\");\n } with sexp ;;\n#part 2\nlet cfg = http_server_config_of_sexp\n (Sexp.of_string \"((web_root /var/www/html))\") ;;\n#part 3\nsexp_of_http_server_config cfg ;;\n#part 4\ntype http_server_config = {\n web_root: string;\n port: int with default(80), sexp_drop_default;\n addr: string with default(\"localhost\"), sexp_drop_default;\n } with sexp ;;\nlet cfg = http_server_config_of_sexp\n (Sexp.of_string \"((web_root /var/www/html))\") ;;\nsexp_of_http_server_config cfg ;;\n#part 5\nsexp_of_http_server_config { cfg with port = 8080 } ;;\nsexp_of_http_server_config\n { cfg with port = 8080; addr = \"192.168.0.1\" } ;;\n"
},
{
"path": "code/sexpr/sexp_list.topscript",
"content": "type compatible_versions =\n | Specific of string list\n | All with sexp ;;\nsexp_of_compatible_versions\n (Specific [\"3.12.0\"; \"3.12.1\"; \"3.13.0\"]) ;;\n#part 1\ntype compatible_versions =\n | Specific of string sexp_list\n | All with sexp ;;\nsexp_of_compatible_versions\n (Specific [\"3.12.0\"; \"3.12.1\"; \"3.13.0\"]) ;;\n"
},
{
"path": "code/sexpr/sexp_opaque.topscript",
"content": "type no_converter = int * int ;;\ntype t = { a: no_converter; b: string } with sexp ;;\n#part 1\ntype t = { a: no_converter sexp_opaque; b: string } with sexp ;;\n#part 2\nsexp_of_t { a = (3,4); b = \"foo\" } ;;\n#part 3\nt_of_sexp (Sexp.of_string \"((a whatever) (b foo))\") ;;\n#part 4\ntype t = { a: no_converter sexp_opaque list; b: string } with sexp ;;\nt_of_sexp (Sexp.of_string \"((a ()) (b foo))\") ;;\n#part 5\ntype t = { a: no_converter sexp_opaque; b: string } with sexp_of ;;\ntype t = { a: no_converter sexp_opaque; b: string } with of_sexp ;;\n"
},
{
"path": "code/sexpr/sexp_option.topscript",
"content": "type t = { a: int option; b: string } with sexp ;;\nsexp_of_t { a = None; b = \"hello\" } ;;\nsexp_of_t { a = Some 3; b = \"hello\" } ;;\n#part 1\ntype t = { a: int sexp_option; b: string } with sexp ;;\nsexp_of_t { a = Some 3; b = \"hello\" } ;;\nsexp_of_t { a = None; b = \"hello\" } ;;\n"
},
{
"path": "code/sexpr/sexp_override.ml",
"content": "type t =\n | Range of int * int\n | Empty\nwith sexp\n\nlet create x y =\n if x > y then Empty else Range (x,y)\n\nlet t_of_sexp sexp =\n let t = t_of_sexp sexp in\n begin match t with\n | Empty -> ()\n | Range (x,y) ->\n if y < x then of_sexp_error \"Upper and lower bound of Range swapped\" sexp\n end;\n t\n"
},
{
"path": "code/sexpr/sexp_printer.topscript",
"content": "Sexp.to_string (Sexp.List [Sexp.Atom \"1\"; Sexp.Atom \"2\"]) ;;\nSexp.of_string (\"(1 2 (3 4))\") ;;\n"
},
{
"path": "code/sexpr/test_interval.ml",
"content": "open Core.Std\n\nlet intervals =\n let module I = Int_interval in\n [ I.create 3 4;\n I.create 5 4; (* should be empty *)\n I.create 2 3;\n I.create 1 6;\n ]\n\nlet () =\n intervals\n |> List.sexp_of_t Int_interval.sexp_of_t\n |> Sexp.to_string_hum\n |> print_endline\n"
},
{
"path": "code/sexpr/test_interval_manual_sexp.ml",
"content": "open Core.Std\nmodule Int_interval = Int_interval_manual_sexp\n\nlet intervals =\n let module I = Int_interval in\n [ I.create 3 4;\n I.create 5 4; (* should be empty *)\n I.create 2 3;\n I.create 1 6;\n ]\n\nlet () =\n intervals\n |> List.sexp_of_t Int_interval.sexp_of_t\n |> Sexp.to_string_hum\n |> print_endline\n"
},
{
"path": "code/sexpr/test_interval_nosexp.ml",
"content": "open Core.Std\nmodule Int_interval = Int_interval_nosexp\n\nlet intervals =\n let module I = Int_interval in\n [ I.create 3 4;\n I.create 5 4; (* should be empty *)\n I.create 2 3;\n I.create 1 6;\n ]\n\nlet () =\n intervals\n |> List.sexp_of_t Int_interval.sexp_of_t\n |> Sexp.to_string_hum\n |> print_endline\n"
},
{
"path": "code/sexpr/to_from_sexp.topscript",
"content": "Int.sexp_of_t 3;;\nString.sexp_of_t \"hello\";;\nExn.sexp_of_t (Invalid_argument \"foo\");;\n#part 1\nList.sexp_of_t;;\nList.sexp_of_t Int.sexp_of_t [1; 2; 3];;\n#part 2\nList.t_of_sexp;;\nList.t_of_sexp Int.t_of_sexp (Sexp.of_string \"(1 2 3)\");;\nList.t_of_sexp Int.t_of_sexp (Sexp.of_string \"(1 2 three)\");;\n"
},
{
"path": "code/variables-and-functions/abs_diff.mli",
"content": "val abs_diff : int -> (int -> int)\n"
},
{
"path": "code/variables-and-functions/htable_sig1.ml",
"content": "val create_hashtable : int -> bool -> ('a,'b) Hashtable.t\n"
},
{
"path": "code/variables-and-functions/htable_sig2.ml",
"content": "val create_hashtable :\n init_size:int -> allow_shrinking:bool -> ('a,'b) Hashtable.t\n"
},
{
"path": "code/variables-and-functions/let.syntax",
"content": "let = \n"
},
{
"path": "code/variables-and-functions/let_in.syntax",
"content": "let = in \n"
},
{
"path": "code/variables-and-functions/main.topscript",
"content": "let x = 3;;\nlet y = 4;;\nlet z = x + y;;\n#part 1\nlet languages = \"OCaml,Perl,C++,C\";;\nlet dashed_languages =\n let language_list = String.split languages ~on:',' in\n String.concat ~sep:\"-\" language_list\n ;;\n#part 2\nlanguage_list;;\n#part 3\nlet languages = \"OCaml,Perl,C++,C\";;\nlet dashed_languages =\n let languages = String.split languages ~on:',' in\n String.concat ~sep:\"-\" languages\n ;;\n#part 4\nlanguages;;\n#part 5\nlet area_of_ring inner_radius outer_radius =\n let pi = acos (-1.) in\n let area_of_circle r = pi *. r *. r in\n area_of_circle outer_radius -. area_of_circle inner_radius\n ;;\narea_of_ring 1. 3.;;\n#part 6\nlet area_of_ring inner_radius outer_radius =\n let pi = acos (-1.) in\n let area_of_circle r = pi *. r *. r in\n let pi = 0. in\n area_of_circle outer_radius -. area_of_circle inner_radius\n ;;\n#part 7\nlet (ints,strings) = List.unzip [(1,\"one\"); (2,\"two\"); (3,\"three\")];;\n#part 8\nlet upcase_first_entry line =\n let (first :: rest) = String.split ~on:',' line in\n String.concat ~sep:\",\" (String.uppercase first :: rest)\n ;;\n#part 9\nlet upcase_first_entry line =\n match String.split ~on:',' line with\n | [] -> assert false (* String.split returns at least one element *)\n | first :: rest -> String.concat ~sep:\",\" (String.uppercase first :: rest)\n ;;\n#part 10\n(fun x -> x + 1);;\n#part 11\n(fun x -> x + 1) 7;;\n#part 12\nList.map ~f:(fun x -> x + 1) [1;2;3];;\n#part 13\nlet increments = [ (fun x -> x + 1); (fun x -> x + 2) ] ;;\nList.map ~f:(fun g -> g 5) increments;;\n#part 14\nlet plusone = (fun x -> x + 1);;\nplusone 3;;\n#part 15\nlet plusone x = x + 1;;\n#part 16\n(fun x -> x + 1) 7;;\nlet x = 7 in x + 1;;\n#part 17\nlet abs_diff x y = abs (x - y);;\nabs_diff 3 4;;\n#part 18\nlet abs_diff =\n (fun x -> (fun y -> abs (x - y)));;\n#part 19\nlet dist_from_3 = abs_diff 3;;\ndist_from_3 8;;\ndist_from_3 (-1);;\n#part 20\nlet abs_diff = (fun x y -> abs (x - y));;\n#part 21\nlet abs_diff (x,y) = abs (x - y);;\nabs_diff (3,4);;\n#part 22\nlet rec find_first_stutter list =\n match list with\n | [] | [_] ->\n (* only zero or one elements, so no repeats *)\n None\n | x :: y :: tl ->\n if x = y then Some x else find_first_stutter (y::tl)\n ;;\n#part 23\nlet rec is_even x =\n if x = 0 then true else is_odd (x - 1)\n and is_odd x =\n if x = 0 then false else is_even (x - 1)\n ;;\nList.map ~f:is_even [0;1;2;3;4;5];;\nList.map ~f:is_odd [0;1;2;3;4;5];;\n#part 24\nInt.max 3 4 (* prefix *);;\n3 + 4 (* infix *);;\n#part 25\n(+) 3 4;;\nList.map ~f:((+) 3) [4;5;6];;\n#part 26\nlet (+!) (x1,y1) (x2,y2) = (x1 + x2, y1 + y2);;\n(3,2) +! (-2,4);;\n#part 27\nlet (***) x y = (x ** y) ** y;;\n#part 28\nlet ( *** ) x y = (x ** y) ** y;;\n#part 29\nInt.max 3 (-4);;\nInt.max 3 -4;;\n#part 30\n(Int.max 3) - 4;;\n#part 31\nlet (|>) x f = f x ;;\n#part 32\nlet path = \"/usr/bin:/usr/local/bin:/bin:/sbin\";;\n String.split ~on:':' path\n |> List.dedup ~compare:String.compare\n |> List.iter ~f:print_endline\n ;;\n#part 33\n let split_path = String.split ~on:':' path in\n let deduped_path = List.dedup ~compare:String.compare split_path in\n List.iter ~f:print_endline deduped_path\n ;;\n#part 34\nList.iter ~f:print_endline [\"Two\"; \"lines\"];;\n#part 35\nList.iter ~f:print_endline;;\n#part 36\nlet (^>) x f = f x;;\nSys.getenv_exn \"PATH\"\n ^> String.split ~on:':' path\n ^> List.dedup ~compare:String.compare\n ^> List.iter ~f:print_endline\n ;;\n#part 37\nlet some_or_zero = function\n | Some x -> x\n | None -> 0\n ;;\nList.map ~f:some_or_zero [Some 3; None; Some 4];;\n#part 38\nlet some_or_zero num_opt =\n match num_opt with\n | Some x -> x\n | None -> 0\n ;;\n#part 39\nlet some_or_default default = function\n | Some x -> x\n | None -> default\n ;;\nsome_or_default 3 (Some 5);;\nList.map ~f:(some_or_default 100) [Some 3; None; Some 4];;\n#part 40\nlet ratio ~num ~denom = float num /. float denom;;\n#part 41\nratio ~num:3 ~denom:10;;\nratio ~denom:10 ~num:3;;\n#part 42\nlet num = 3 in\nlet denom = 4 in\nratio ~num ~denom;;\n#part 43\n String.split ~on:':' path\n |> List.dedup ~compare:String.compare\n |> List.iter ~f:print_endline\n ;;\n#part 44\nlet apply_to_tuple f (first,second) = f ~first ~second;;\n#part 45\nlet apply_to_tuple_2 f (first,second) = f ~second ~first;;\n#part 46\nlet divide ~first ~second = first / second;;\n#part 47\napply_to_tuple_2 divide (3,4);;\n#part 48\nlet apply_to_tuple f (first,second) = f ~first ~second;;\napply_to_tuple divide (3,4);;\n#part 49\nlet concat ?sep x y =\n let sep = match sep with None -> \"\" | Some x -> x in\n x ^ sep ^ y\n ;;\nconcat \"foo\" \"bar\" (* without the optional argument *);;\nconcat ~sep:\":\" \"foo\" \"bar\" (* with the optional argument *);;\n#part 50\nlet concat ?(sep=\"\") x y = x ^ sep ^ y ;;\n#part 51\nconcat ~sep:\":\" \"foo\" \"bar\" (* provide the optional argument *);;\nconcat ?sep:(Some \":\") \"foo\" \"bar\" (* pass an explicit [Some] *);;\n#part 52\nconcat \"foo\" \"bar\" (* don't provide the optional argument *);;\nconcat ?sep:None \"foo\" \"bar\" (* explicitly pass `None` *);;\n#part 53\nlet uppercase_concat ?(sep=\"\") a b = concat ~sep (String.uppercase a) b ;;\nuppercase_concat \"foo\" \"bar\";;\nuppercase_concat \"foo\" \"bar\" ~sep:\":\";;\n#part 54\nlet uppercase_concat ?sep a b = concat ?sep (String.uppercase a) b ;;\n#part 55\nlet numeric_deriv ~delta ~x ~y ~f =\n let x' = x +. delta in\n let y' = y +. delta in\n let base = f ~x ~y in\n let dx = (f ~x:x' ~y -. base) /. delta in\n let dy = (f ~x ~y:y' -. base) /. delta in\n (dx,dy)\n ;;\n#part 56\nlet numeric_deriv ~delta ~x ~y ~f =\n let x' = x +. delta in\n let y' = y +. delta in\n let base = f ~x ~y in\n let dx = (f ~y ~x:x' -. base) /. delta in\n let dy = (f ~x ~y:y' -. base) /. delta in\n (dx,dy)\n ;;\n#part 57\nlet numeric_deriv ~delta ~x ~y ~(f: x:float -> y:float -> float) =\n let x' = x +. delta in\n let y' = y +. delta in\n let base = f ~x ~y in\n let dx = (f ~y ~x:x' -. base) /. delta in\n let dy = (f ~x ~y:y' -. base) /. delta in\n (dx,dy)\n ;;\n#part 58\nlet colon_concat = concat ~sep:\":\";;\ncolon_concat \"a\" \"b\";;\n#part 59\nlet prepend_pound = concat \"# \";;\nprepend_pound \"a BASH comment\";;\n#part 60\nprepend_pound \"a BASH comment\" ~sep:\":\";;\n#part 61\nlet concat x ?(sep=\"\") y = x ^ sep ^ y ;;\n#part 62\nlet prepend_pound = concat \"# \";;\nprepend_pound \"a BASH comment\";;\nprepend_pound \"a BASH comment\" ~sep:\"--- \";;\n#part 63\nconcat \"a\" \"b\" ~sep:\"=\";;\n#part 64\nlet concat x y ?(sep=\"\") = x ^ sep ^ y ;;\n#part 65\nconcat \"a\" \"b\";;\n#part 66\n#part 67\n#part 68\n#part 69\n#part 70\n#part 71\n#part 72\n#part 73\n#part 74\n#part 75\n#part 76\n#part 77\n#part 78\n#part 79\n"
},
{
"path": "code/variables-and-functions/numerical_deriv_alt_sig.mli",
"content": "val numeric_deriv :\n delta:float ->\n x:float -> y:float -> f:(?x:float -> y:float -> float) -> float * float\n\n"
},
{
"path": "code/variables-and-functions/operators.syntax",
"content": "! $ % & * + - . / : < = > ? @ ^ | ~\n"
},
{
"path": "code/variables-and-functions/substring_sig1.ml",
"content": "val substring: string -> int -> int -> string\n"
},
{
"path": "code/variables-and-functions/substring_sig2.ml",
"content": "val substring: string -> pos:int -> len:int -> string\n"
},
{
"path": "code/variants/blang.topscript",
"content": "type 'a expr =\n | Base of 'a\n | Const of bool\n | And of 'a expr list\n | Or of 'a expr list\n | Not of 'a expr\n ;;\n#part 1\ntype mail_field = To | From | CC | Date | Subject\n type mail_predicate = { field: mail_field;\n contains: string }\n ;;\n#part 2\nlet test field contains = Base { field; contains };;\nAnd [ Or [ test To \"doligez\"; test CC \"doligez\" ];\n test Subject \"runtime\";\n ]\n ;;\n#part 3\nlet rec eval expr base_eval =\n (* a shortcut, so we don't need to repeatedly pass [base_eval]\n explicitly to [eval] *)\n let eval' expr = eval expr base_eval in\n match expr with\n | Base base -> base_eval base\n | Const bool -> bool\n | And exprs -> List.for_all exprs ~f:eval'\n | Or exprs -> List.exists exprs ~f:eval'\n | Not expr -> not (eval' expr)\n ;;\n#part 4\nlet and_ l =\n if List.mem l (Const false) then Const false\n else\n match List.filter l ~f:((<>) (Const true)) with\n | [] -> Const true\n | [ x ] -> x\n | l -> And l\n\n let or_ l =\n if List.mem l (Const true) then Const true\n else\n match List.filter l ~f:((<>) (Const false)) with\n | [] -> Const false\n | [x] -> x\n | l -> Or l\n\n let not_ = function\n | Const b -> Const (not b)\n | e -> Not e\n ;;\n#part 5\nlet rec simplify = function\n | Base _ | Const _ as x -> x\n | And l -> and_ (List.map ~f:simplify l)\n | Or l -> or_ (List.map ~f:simplify l)\n | Not e -> not_ (simplify e)\n ;;\n#part 6\nsimplify (Not (And [ Or [Base \"it's snowing\"; Const true];\n Base \"it's raining\"]));;\n#part 7\nsimplify (Not (And [ Or [Base \"it's snowing\"; Const true];\n Not (Not (Base \"it's raining\"))]));;\n#part 8\nlet not_ = function\n | Const b -> Const (not b)\n | (Base _ | And _ | Or _ | Not _) as e -> Not e\n ;;\n#part 9\nlet not_ = function\n | Const b -> Const (not b)\n | Not e -> e\n | (Base _ | And _ | Or _ ) as e -> Not e\n ;;\n"
},
{
"path": "code/variants/catch_all.topscript",
"content": "type basic_color =\n | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White ;;\nlet basic_color_to_int = function\n | Black -> 0 | Red -> 1 | Green -> 2 | Yellow -> 3\n | Blue -> 4 | Magenta -> 5 | Cyan -> 6 | White -> 7 ;;\n#part 1\ntype color =\n | Basic of basic_color (* basic colors *)\n | Bold of basic_color (* bold basic colors *)\n | RGB of int * int * int (* 6x6x6 color cube *)\n | Gray of int (* 24 grayscale levels *)\n;;\n#part 2\nlet color_to_int = function\n | Basic (basic_color,weight) ->\n let base = match weight with Bold -> 8 | Regular -> 0 in\n base + basic_color_to_int basic_color\n | RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | Gray i -> 232 + i ;;\n#part 3\nlet color_to_int = function\n | Basic basic_color -> basic_color_to_int basic_color\n | RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | Gray i -> 232 + i ;;\n#part 4\nlet color_to_int = function\n | Basic basic_color -> basic_color_to_int basic_color\n | Bold basic_color -> 8 + basic_color_to_int basic_color\n | RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | Gray i -> 232 + i ;;\n#part 5\nlet oldschool_color_to_int = function\n | Basic (basic_color,weight) ->\n let base = match weight with Bold -> 8 | Regular -> 0 in\n base + basic_color_to_int basic_color\n | _ -> basic_color_to_int White;;\n \n"
},
{
"path": "code/variants/logger.topscript",
"content": " module Heartbeat = struct\n type t =\n { session_id: string;\n time: Time.t;\n status_message: string;\n }\n end\n module Logon = struct\n type t =\n { session_id: string;\n time: Time.t;\n user: string;\n credentials: string;\n }\n end;;\n#part 1\nmodule Log_entry = struct\n type t =\n { session_id: string;\n time: Time.t;\n important: bool;\n message: string;\n }\n end\n ;;\n#part 2\ntype client_message = | Logon of Logon.t\n | Heartbeat of Heartbeat.t\n | Log_entry of Log_entry.t\n ;;\n#part 3\nlet messages_for_user user messages =\n let (user_messages,_) =\n List.fold messages ~init:([],String.Set.empty)\n ~f:(fun ((messages,user_sessions) as acc) message ->\n match message with\n | Logon m ->\n if m.Logon.user = user then\n (message::messages, Set.add user_sessions m.Logon.session_id)\n else acc\n | Heartbeat _ | Log_entry _ ->\n let session_id = match message with\n | Logon m -> m.Logon.session_id\n | Heartbeat m -> m.Heartbeat.session_id\n | Log_entry m -> m.Log_entry.session_id\n in\n if Set.mem user_sessions session_id then\n (message::messages,user_sessions)\n else acc\n )\n in\n List.rev user_messages\n ;;\n#part 4\nmodule Log_entry = struct\n type t = { important: bool;\n message: string;\n }\n end\n module Heartbeat = struct\n type t = { status_message: string; }\n end\n module Logon = struct\n type t = { user: string;\n credentials: string;\n }\n end ;;\n#part 5\ntype details =\n | Logon of Logon.t\n | Heartbeat of Heartbeat.t\n | Log_entry of Log_entry.t\n ;;\n#part 6\nmodule Common = struct\n type t = { session_id: string;\n time: Time.t;\n }\n end ;;\n#part 7\nlet messages_for_user user messages =\n let (user_messages,_) =\n List.fold messages ~init:([],String.Set.empty)\n ~f:(fun ((messages,user_sessions) as acc) ((common,details) as message) ->\n let session_id = common.Common.session_id in\n match details with\n | Logon m ->\n if m.Logon.user = user then\n (message::messages, Set.add user_sessions session_id)\n else acc\n | Heartbeat _ | Log_entry _ ->\n if Set.mem user_sessions session_id then\n (message::messages,user_sessions)\n else acc\n )\n in\n List.rev user_messages\n ;;\n#part 8\nlet handle_message server_state (common,details) =\n match details with\n | Log_entry m -> handle_log_entry server_state (common,m)\n | Logon m -> handle_logon server_state (common,m)\n | Heartbeat m -> handle_heartbeat server_state (common,m)\n ;;\n"
},
{
"path": "code/variants/main-2.rawscript",
"content": "# let color_by_number number text =\n sprintf \"\\027[38;5;%dm%s\\027[0m\" number text;;\nval color_by_number : int -> string -> string = \n# let blue = color_by_number (basic_color_to_int Blue) \"Blue\";;\nval blue : string = \"\\027[38;5;4mBlue\\027[0m\"\n# printf \"Hello %s World!\\n\" blue;;\nHello Blue World!\n"
},
{
"path": "code/variants/main-5.rawscript",
"content": "# let color_print color s =\n printf \"%s\\n\" (color_by_number (color_to_int color) s);;\nval color_print : color -> string -> unit = \n# color_print (Basic (Red,Bold)) \"A bold red!\";;\nA bold red!\n# color_print (Gray 4) \"A muted gray...\";;\nA muted gray...\n"
},
{
"path": "code/variants/main.topscript",
"content": "type basic_color =\n | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White ;;\nCyan ;;\n[Blue; Magenta; Red] ;;\n#part 1\nlet basic_color_to_int = function\n | Black -> 0 | Red -> 1 | Green -> 2 | Yellow -> 3\n | Blue -> 4 | Magenta -> 5 | Cyan -> 6 | White -> 7 ;;\nList.map ~f:basic_color_to_int [Blue;Red];;\n#part 2\nlet color_by_number number text =\n sprintf \"\\027[38;5;%dm%s\\027[0m\" number text;;\nlet blue = color_by_number (basic_color_to_int Blue) \"Blue\";;\n(* printf \"Hello %s World!\\n\" blue*) ();;\n#part 3\ntype weight = Regular | Bold\n type color =\n | Basic of basic_color * weight (* basic colors, regular and bold *)\n | RGB of int * int * int (* 6x6x6 color cube *)\n | Gray of int (* 24 grayscale levels *)\n;;\n[RGB (250,70,70); Basic (Green, Regular)];;\n#part 4\nlet color_to_int = function\n | Basic (basic_color,weight) ->\n let base = match weight with Bold -> 8 | Regular -> 0 in\n base + basic_color_to_int basic_color\n | RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | Gray i -> 232 + i ;;\n#part 5\nlet color_print color s =\n printf \"%s\\n\" (color_by_number (color_to_int color) s);;\n(* color_print (Basic (Red,Bold)) \"A bold red!\"*) ();;\n(* color_print (Gray 4) \"A muted gray...\" *) ();;\n#part 6\nlet three = `Int 3;;\nlet four = `Float 4.;;\nlet nan = `Not_a_number;;\n[three; four; nan];;\n#part 7\nlet five = `Int \"five\";;\n[three; four; five];;\n#part 8\nlet is_positive = function\n | `Int x -> x > 0\n | `Float x -> x > 0.\n ;;\n#part 9\nlet exact = List.filter ~f:is_positive [three;four];;\n#part 10\nlet is_positive = function\n | `Int x -> Ok (x > 0)\n | `Float x -> Ok (x > 0.)\n | `Not_a_number -> Error \"not a number\";;\nList.filter [three; four] ~f:(fun x ->\n match is_positive x with Error _ -> false | Ok b -> b);;\n#part 11\ntype extended_color =\n | Basic of basic_color * weight (* basic colors, regular and bold *)\n | RGB of int * int * int (* 6x6x6 color space *)\n | Gray of int (* 24 grayscale levels *)\n | RGBA of int * int * int * int (* 6x6x6x6 color space *)\n ;;\n#part 12\nlet extended_color_to_int = function\n | RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | (Basic _ | RGB _ | Gray _) as color -> color_to_int color\n ;;\n#part 13\nlet basic_color_to_int = function\n | `Black -> 0 | `Red -> 1 | `Green -> 2 | `Yellow -> 3\n | `Blue -> 4 | `Magenta -> 5 | `Cyan -> 6 | `White -> 7\n\n let color_to_int = function\n | `Basic (basic_color,weight) ->\n let base = match weight with `Bold -> 8 | `Regular -> 0 in\n base + basic_color_to_int basic_color\n | `RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | `Gray i -> 232 + i\n ;;\n#part 14\nlet extended_color_to_int = function\n | `RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | (`Basic _ | `RGB _ | `Gray _) as color -> color_to_int color\n ;;\n#part 15\nlet extended_color_to_int = function\n | `RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | color -> color_to_int color\n ;;\n#part 16\nlet is_positive_permissive = function\n | `Int x -> Ok (x > 0)\n | `Float x -> Ok (x > 0.)\n | _ -> Error \"Unknown number type\"\n ;;\nis_positive_permissive (`Int 0);;\nis_positive_permissive (`Ratio (3,4));;\n#part 17\nis_positive_permissive (`Floot 3.5);;\n#part 18\n#part 19\n#part 20\n#part 21\n#part 22\n#part 23\n#part 24\n#part 25\n#part 26\n#part 27\n#part 28\n#part 29\n#part 30\n#part 31\n#part 32\n#part 33\n#part 34\n#part 35\n#part 36\n#part 37\n#part 38\n#part 39\n#part 40\n#part 41\n#part 42\n#part 43\n#part 44\n#part 45\n#part 46\n#part 47\n#part 48\n#part 49\n#part 50\n\n"
},
{
"path": "code/variants/variant.syntax",
"content": "type =\n | [ of [* ]... ]\n | [ of [* ]... ]\n | ...\n"
},
{
"path": "code/variants-termcol/build.sh",
"content": "corebuild terminal_color.native\n"
},
{
"path": "code/variants-termcol/terminal_color.ml",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nlet basic_color_to_int = function\n | `Black -> 0 | `Red -> 1 | `Green -> 2 | `Yellow -> 3\n | `Blue -> 4 | `Magenta -> 5 | `Cyan -> 6 | `White -> 7\n\nlet color_to_int = function\n | `Basic (basic_color,weight) ->\n let base = match weight with `Bold -> 8 | `Regular -> 0 in\n base + basic_color_to_int basic_color\n | `RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | `Gray i -> 232 + i\n\nlet extended_color_to_int = function\n | `RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | `Grey x -> 2000 + x\n | (`Basic _ | `RGB _ | `Gray _) as color -> color_to_int color\n"
},
{
"path": "code/variants-termcol/terminal_color.mli",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nval color_to_int : color -> int\nval extended_color_to_int : extended_color -> int\n"
},
{
"path": "code/variants-termcol-annotated/build.errsh",
"content": "corebuild terminal_color.native\n"
},
{
"path": "code/variants-termcol-annotated/terminal_color.ml",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nlet basic_color_to_int = function\n | `Black -> 0 | `Red -> 1 | `Green -> 2 | `Yellow -> 3\n | `Blue -> 4 | `Magenta -> 5 | `Cyan -> 6 | `White -> 7\n\nlet color_to_int = function\n | `Basic (basic_color,weight) ->\n let base = match weight with `Bold -> 8 | `Regular -> 0 in\n base + basic_color_to_int basic_color\n | `RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | `Gray i -> 232 + i\n\n(* part 1 *)\nlet extended_color_to_int : extended_color -> int = function\n | `RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | `Grey x -> 2000 + x\n | (`Basic _ | `RGB _ | `Gray _) as color -> color_to_int color\n"
},
{
"path": "code/variants-termcol-annotated/terminal_color.mli",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nval color_to_int : color -> int\nval extended_color_to_int : extended_color -> int\n"
},
{
"path": "code/variants-termcol-fixed/build.sh",
"content": "corebuild terminal_color.native\n"
},
{
"path": "code/variants-termcol-fixed/terminal_color.ml",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nlet basic_color_to_int = function\n | `Black -> 0 | `Red -> 1 | `Green -> 2 | `Yellow -> 3\n | `Blue -> 4 | `Magenta -> 5 | `Cyan -> 6 | `White -> 7\n\nlet color_to_int = function\n | `Basic (basic_color,weight) ->\n let base = match weight with `Bold -> 8 | `Regular -> 0 in\n base + basic_color_to_int basic_color\n | `RGB (r,g,b) -> 16 + b + g * 6 + r * 36\n | `Gray i -> 232 + i\n\n(* part 1 *)\nlet extended_color_to_int : extended_color -> int = function\n | `RGBA (r,g,b,a) -> 256 + a + b * 6 + g * 36 + r * 216\n | #color as color -> color_to_int color\n"
},
{
"path": "code/variants-termcol-fixed/terminal_color.mli",
"content": "open Core.Std\n\ntype basic_color =\n [ `Black | `Blue | `Cyan | `Green\n | `Magenta | `Red | `White | `Yellow ]\n\ntype color =\n [ `Basic of basic_color * [ `Bold | `Regular ]\n | `Gray of int\n | `RGB of int * int * int ]\n\ntype extended_color =\n [ color\n | `RGBA of int * int * int * int ]\n\nval color_to_int : color -> int\nval extended_color_to_int : extended_color -> int\n"
}
]