OCaml version of CTFP (#201)

* OCaml version of the book upto chapter 24
* Checking in Chapter 25
* Adding Ch 26
* Add final two chapters
* Add Marcello Seri's comments
* Ch 25 changes
* Ch 26
* Run formatter
* Adding OCaml tweaks in the half-title + colophon
* Adding links in the colophon

Co-authored-by: Igal Tabachnik <[email protected]>

src/Makefile

@@ -1,7 +1,7 @@
 # Igal Tabachnik, 2007.
 # Based on work by Andres Raba et al., 2013-2015.
 
-.PHONY: default all clean out-dir version.tex
+.PHONY: default all clean out-dir version.tex scala ocaml
 
 DIR := $(shell pwd)
 GIT_VER := $(shell git describe --tags --always --long | tr -d '\n')
@@ -13,16 +13,21 @@ DEFAULTTOPTEX = ctfp-reader.tex ctfp-print.tex
 
 SCALATEXFILES = ctfp-reader-scala.tex ctfp-print-scala.tex # todo make this a macro
 
+OCAMLTEXFILES = ctfp-reader-ocaml.tex ctfp-print-ocaml.tex # todo make this a macro
+
 # Top-level LaTeX files from which CTFP book can be generated
-TOPTEXFILES = version.tex $(DEFAULTTOPTEX) $(SCALATEXFILES)
+TOPTEXFILES = version.tex $(DEFAULTTOPTEX) $(SCALATEXFILES) $(OCAMLTEXFILES)
 
 # Default PDF file to make
 DEFAULTPDF:=$(DEFAULTTOPTEX:.tex=.pdf)
 
 # Scala PDF file to make
 SCALAPDF:=$(SCALATEXFILES:.tex=.pdf)
 
-# Other PDF files for the CTFP book
+# OCaml PDF file to make
+OCAMLPDF:=$(OCAMLTEXFILES:.tex=.pdf)
+
+# Other PDF files for the CTFP book 
 TOPPDFFILES:=$(TOPTEXFILES:.tex=.pdf)
 
 # Configuration files
@@ -31,21 +36,24 @@ OPTFILES = opt-print-ustrade.tex \
 			opt-scala.tex
 
 # All the LaTeX files for the CTFP book in order of dependency
-TEXFILES = $(TOPTEXFILES) $(SCALATEXFILES) $(OPTFILES)
+TEXFILES = $(TOPTEXFILES) $(SCALATEXFILES) $(OCAMLTEXFILES) $(OPTFILES)
 
 default: suffix=''
 default: out-dir $(DEFAULTPDF) # todo cover
 
-all: default scala
+all: default scala ocaml
 
 scala: suffix='-scala'
 scala: out-dir version.tex $(SCALAPDF)
 
+ocaml: suffix='-ocaml'
+ocaml: out-dir version.tex $(OCAMLPDF)
+
 # Main targets
 $(TOPPDFFILES) : %.pdf : %.tex $(TEXFILES)
 	if which latexmk > /dev/null 2>&1 ;\
 	then \
-		latexmk -shell-escape -interaction=nonstopmode -halt-on-error -norc -jobname=ctfp -pdflatex="xelatex %O %S" -pdf $< ;\
+		latexmk -shell-escape -interaction=nonstopmode -halt-on-error -norc -jobname=ctfp -pdflatex="xelatex %O %S" -pdfxe $< ;\
 		mv ctfp.pdf ../out/$(GIT_VER)/$(subst ctfp,$(OUTPUT),$(subst ctfp-reader,$(OUTPUT),$*)).pdf ;\
 	else @printf "Error: unable to find latexmk. Is it installed?\n" ;\
 	fi
@@ -64,5 +72,5 @@ clean:
 	if which latexmk > /dev/null 2>&1 ; then latexmk -CA; fi
 	rm -rf ../out
 
-clean-minted:
+clean-minted: 
 	rm -rf _minted-*

src/content/1.1/code/ocaml/snippet01.ml

@@ -0,0 +1,6 @@
+module type Polymorphic_Function_F = sig
+  type a
+  type b
+
+  val f : a -> b
+end

src/content/1.1/code/ocaml/snippet02.ml

@@ -0,0 +1,6 @@
+module type Polymorphic_Function_G = sig
+  type b
+  type c
+
+  val g : b -> c
+end

src/content/1.1/code/ocaml/snippet03.ml

@@ -0,0 +1,9 @@
+module Compose_Example
+    (F : Polymorphic_Function_F)
+    (G : Polymorphic_Function_G with type b = F.b) =
+struct
+  (** OCaml doesn't have a compose operator. So, creating one. **)
+  let ( >> ) g f x = g (f x)
+
+  let compose : 'a -> 'c = G.g >> F.f
+end

src/content/1.1/code/ocaml/snippet04.ml

@@ -0,0 +1,9 @@
+module Compose_Three_GF = functor(F:Polymorphic_Function_F)(G:Polymorphic_Function_G with type b = F.b)(H:Polymorphic_Function_H with type c = G.c) -> struct
+  let compose : 'a -> 'd = H.h >> (G.g >> F.f)
+end
+
+module Compose_Three_HG = functor(F:Polymorphic_Function_F)(G:Polymorphic_Function_G with type b = F.b)(H:Polymorphic_Function_H with type c = G.c) -> struct
+  let compose : 'a -> 'd = (H.h >> G.g) >> F.f
+end
+
+Compose_Three_GF.compose = Compose_Three_HG.compose

src/content/1.1/code/ocaml/snippet05.ml

@@ -0,0 +1 @@
+let id x = x

src/content/1.1/code/ocaml/snippet06.ml

@@ -0,0 +1,2 @@
+f >> id
+id >> f

src/content/1.10/code/ocaml/snippet01.ml

@@ -0,0 +1 @@
+val alpha : 'a . 'a f -> 'a g

src/content/1.10/code/ocaml/snippet02.ml

@@ -0,0 +1 @@
+val alpha : 'a f -> 'a g

src/content/1.10/code/ocaml/snippet03.ml

@@ -0,0 +1 @@
+val alpha : 'a f -> 'a g

src/content/1.10/code/ocaml/snippet04.ml

@@ -0,0 +1,4 @@
+let safe_head = function
+  | [] -> None
+  | x :: xs -> Some x
+;;

src/content/1.10/code/ocaml/snippet05.ml

@@ -0,0 +1 @@
+compose (fmap f) safe_head = compose safe_head (fmap f)

src/content/1.10/code/ocaml/snippet06.ml

@@ -0,0 +1,2 @@
+(* Starting with empty list *)
+let fmap f (safe_head []) = fmap f None = None

src/content/1.10/code/ocaml/snippet07.ml

@@ -0,0 +1 @@
+let safe_head (fmap f []) = safe_head [] = None

src/content/1.10/code/ocaml/snippet08.ml

@@ -0,0 +1 @@
+let fmap f (safe_head (x :: xs)) = fmap f (Some x)= Some (f x)

src/content/1.10/code/ocaml/snippet09.ml

@@ -0,0 +1 @@
+let safe_head (fmap f (x :: xs)) = safe_head (f x :: f xs) = Some (f x)

src/content/1.10/code/ocaml/snippet10.ml

@@ -0,0 +1,4 @@
+let rec fmap f = function
+  | [] -> []
+  | x :: xs -> f x :: fmap f xs
+;;

src/content/1.10/code/ocaml/snippet11.ml

@@ -0,0 +1,4 @@
+let rec fmap f = function
+  | None -> None
+  | Some x -> Some (f x)
+;;

src/content/1.10/code/ocaml/snippet12.ml

@@ -0,0 +1,8 @@
+(** OCaml requires mutually recursive functions to be defined together *)
+let rec length : 'a list -> (int, 'a) const = function
+  | [] -> Const 0
+  | _ :: xs -> Const (1 + un_const (length xs))
+
+and un_const : 'c 'a. ('c, 'a) const -> 'c = function
+  | Const c -> c
+;;

src/content/1.10/code/ocaml/snippet13.ml

@@ -0,0 +1,3 @@
+let un_const : 'c 'a. ('c, 'a) const -> 'c = function
+  | Const c -> c
+;;

src/content/1.10/code/ocaml/snippet14.ml

@@ -0,0 +1 @@
+val length : 'a list -> int

src/content/1.10/code/ocaml/snippet15.ml

@@ -0,0 +1,3 @@
+let scam : 'a. ('int, 'a) const -> 'a option = function
+  | Const a -> None
+;;

src/content/1.10/code/ocaml/snippet16.ml

@@ -0,0 +1 @@
+type ('e, 'a) reader = Reader of ('e -> 'a)

src/content/1.10/code/ocaml/snippet17.ml

@@ -0,0 +1,10 @@
+module Reader_Functor (T : sig
+  type e
+end) : Functor = struct
+  type 'a t = (T.e, 'a) reader
+
+  let fmap : 'a 'b. ('a -> 'b) -> 'a t -> 'b t =
+   fun f -> function
+    | Reader r -> Reader (compose f r)
+ ;;
+end

src/content/1.10/code/ocaml/snippet18.ml

@@ -0,0 +1 @@
+val alpha : (unit, 'a) reader -> 'a option

src/content/1.10/code/ocaml/snippet19.ml

@@ -0,0 +1,3 @@
+let dumb : 'a. (unit, 'a) reader -> 'a option = function
+  | Reader _ -> None
+;;

src/content/1.10/code/ocaml/snippet20.ml

@@ -0,0 +1,3 @@
+let obvious : 'a. (unit, 'a) reader -> 'a option = function
+  | Reader f -> Some (f ())
+;;

src/content/1.10/code/ocaml/snippet21.ml

@@ -0,0 +1 @@
+type ('r, 'a) op = Op of ('a -> 'r)

src/content/1.10/code/ocaml/snippet22.ml

@@ -0,0 +1,10 @@
+module Op_Contravariant (T : sig
+  type r
+end) : Contravariant = struct
+  type 'a t = (T.r, 'a) op
+
+  let contramap : ('b -> 'a) -> 'a t -> 'b t =
+   fun f -> function
+    | Op g -> Op (compose g f)
+ ;;
+end

src/content/1.10/code/ocaml/snippet23.ml

@@ -0,0 +1,3 @@
+let pred_to_str = function
+  | Op f -> Op (fun x -> if f x then "T" else "F")
+;;

src/content/1.10/code/ocaml/snippet24.ml

@@ -0,0 +1 @@
+compose (contramap f) pred_to_str = compose pred_to_str (contramap f)

src/content/1.10/code/ocaml/snippet25.ml

@@ -0,0 +1,7 @@
+module Op_Bool = Op_Contravariant (struct
+  type r = bool
+end)
+
+let op_bool_contramap : ('b -> 'a) -> 'a Op_Bool.t -> 'b Op_Bool.t =
+  Op_Bool.contramap
+;;

src/content/1.10/code/ocaml/snippet26.ml

@@ -0,0 +1 @@
+'a -> 'a

src/content/1.10/code/ocaml/snippet27.ml

@@ -0,0 +1 @@
+('a -> 'a) -> 'a f

src/content/1.2/code/ocaml/snippet01.ml

@@ -0,0 +1,3 @@
+module type Chapter2_DeclareVariable = sig
+  val x : int
+end

src/content/1.2/code/ocaml/snippet010.ml

@@ -0,0 +1 @@
+let unit _ = ()

src/content/1.2/code/ocaml/snippet011.ml

@@ -0,0 +1,3 @@
+type bool =
+  | false
+  | true

src/content/1.2/code/ocaml/snippet02.ml

@@ -0,0 +1,3 @@
+module type Chapter2_DeclareFunction = sig
+  val f : bool -> bool
+end

src/content/1.2/code/ocaml/snippet03.ml

@@ -0,0 +1,3 @@
+module Chapter2_Bottom : Chapter2_DeclareFunction = struct
+  let f (b : bool) : bool = failwith "Not Implemented"
+end

src/content/1.2/code/ocaml/snippet04.ml

@@ -0,0 +1,3 @@
+module Chapter2_Bottom : Chapter2_DeclareFunction = struct
+  let f : bool -> bool = fun _ -> failwith "Not implemented"
+end

src/content/1.2/code/ocaml/snippet05.ml

@@ -0,0 +1 @@
+let fact n = List.fold (List.range 1 n) ~init:1 ~f:( * )

src/content/1.2/code/ocaml/snippet06.ml

@@ -0,0 +1,3 @@
+type void
+
+let rec absurd (x : void) = absurd x

src/content/1.2/code/ocaml/snippet07.ml

@@ -0,0 +1 @@
+let f44 () : int = 44

src/content/1.2/code/ocaml/snippet08.ml

@@ -0,0 +1 @@
+let f_int (x : int) = ()

src/content/1.2/code/ocaml/snippet09.ml

@@ -0,0 +1 @@
+let f_int (_ : int) = ()

src/content/1.2/code/ocaml/snippet10.ml

@@ -0,0 +1 @@
+let unit _ = ()

src/content/1.2/code/ocaml/snippet11.ml

@@ -0,0 +1,3 @@
+type bool =
+  | false
+  | true

src/content/1.3/code/ocaml/snippet01.ml

@@ -0,0 +1,6 @@
+module type Monoid = sig
+  type a
+
+  val mempty : a
+  val mappend : a -> a -> a
+end

src/content/1.3/code/ocaml/snippet02.ml

@@ -0,0 +1,6 @@
+module StringMonoid : Monoid = struct
+  type a = string
+
+  let mempty = ""
+  let mappend = ( ^ )
+end

src/content/1.4/code/ocaml/snippet01.ml

@@ -0,0 +1 @@
+type 'a writer = 'a * string

src/content/1.4/code/ocaml/snippet02.ml

@@ -0,0 +1 @@
+'a -> 'b writer

src/content/1.4/code/ocaml/snippet03.ml

@@ -0,0 +1,7 @@
+module type Kleisli = sig
+  type a
+  type b
+  type c
+
+  val ( >=> ) : (a -> b writer) -> (b -> c writer) -> a -> c writer
+end

src/content/1.4/code/ocaml/snippet04.ml

@@ -0,0 +1 @@
+let pure x = x, ""

src/content/1.4/code/ocaml/snippet05.ml

@@ -0,0 +1,3 @@
+let up_case : string -> string writer =
+ fun s -> String.uppercase s, "up_case "
+;;

src/content/1.4/code/ocaml/snippet06.ml

@@ -0,0 +1,3 @@
+let to_words : string -> string list writer =
+ fun s -> String.split s ~on:' ', "to_words "
+;;

src/content/1.4/code/ocaml/snippet07.ml

@@ -0,0 +1,10 @@
+module KleisiExample
+    (K : Kleisli
+           with type a = string
+            and type b = string
+            and type c = string list) =
+struct
+  let up_case_and_to_words : string -> string list writer =
+    K.( >=> ) up_case to_words
+  ;;
+end

src/content/1.5/code/ocaml/snippet01.ml

@@ -0,0 +1,3 @@
+type void (* Uninhabited type *)
+
+val absurd : void -> 'a

src/content/1.5/code/ocaml/snippet02.ml

@@ -0,0 +1 @@
+let unit x = ()

src/content/1.5/code/ocaml/snippet03.ml

@@ -0,0 +1 @@
+let yes _ = true

src/content/1.5/code/ocaml/snippet04.ml

@@ -0,0 +1 @@
+let no _ = false

src/content/1.5/code/ocaml/snippet05.ml

@@ -0,0 +1,2 @@
+compose f g = id
+compose g f = id

src/content/1.5/code/ocaml/snippet06.ml

@@ -0,0 +1 @@
+let fst (a, b) = a

src/content/1.5/code/ocaml/snippet07.ml

@@ -0,0 +1 @@
+let snd (a, b) = b

src/content/1.5/code/ocaml/snippet08.ml

@@ -0,0 +1,2 @@
+let fst (a, _) = a
+let snd (_, b) = b

src/content/1.5/code/ocaml/snippet09.ml

@@ -0,0 +1,8 @@
+module type Chapter5_Product = sig
+  type a
+  type c
+  type b
+
+  val p : c -> a
+  val q : c -> b
+end

src/content/1.5/code/ocaml/snippet10.ml

@@ -0,0 +1,12 @@
+module Chapter5_Product_Example :
+  Chapter5_Product
+    with type a = int
+     and type b = bool
+     and type c = int = struct
+  type a = int
+  type b = bool
+  type c = int
+
+  let p x = x
+  let q _ = true
+end

src/content/1.5/code/ocaml/snippet11.ml

@@ -0,0 +1,8 @@
+module Chapter5_Product_Example2 : Chapter5_Product = struct
+  type a = int
+  type b = bool
+  type c = int * int * bool
+
+  let p (x, _, _) = x
+  let q (_, _, b) = b
+end

src/content/1.5/code/ocaml/snippet12.ml

@@ -0,0 +1,2 @@
+let p' = compose Chapter5_Product_Example.p m
+let q' = compose Chapter5_Product_Example.q m

src/content/1.5/code/ocaml/snippet13.ml

@@ -0,0 +1 @@
+let m (x : int) = x, true

src/content/1.5/code/ocaml/snippet14.ml

@@ -0,0 +1,2 @@
+let p x = fst (m x)
+let q x = snd (m x)

src/content/1.5/code/ocaml/snippet15.ml

@@ -0,0 +1 @@
+let m ((x, _, b) : int * int * bool) = x, b

src/content/1.5/code/ocaml/snippet16.ml

@@ -0,0 +1,2 @@
+fst = compose p m'
+snd = compose q m'

src/content/1.5/code/ocaml/snippet17.ml

@@ -0,0 +1 @@
+let m' ((x, b) : int * bool) = x, x, b

src/content/1.5/code/ocaml/snippet18.ml

@@ -0,0 +1 @@
+let m' ((x, b) : int * bool) = x, 42, b

src/content/1.5/code/ocaml/snippet19.ml

@@ -0,0 +1,9 @@
+module type Chapter5_product_projection_example = functor
+  (Product : Chapter5_Product)
+  -> sig
+  val m : Product.c -> Product.a * Product.b
+end
+
+module ProjectionImpl (Product : Chapter5_Product) = struct
+  let m c = Product.p c, Product.q c
+end

src/content/1.5/code/ocaml/snippet20.ml

@@ -0,0 +1,11 @@
+module type Factorizer = functor (Product : Chapter5_Product) -> sig
+  val factorizer
+    :  (Product.c -> Product.a)
+    -> (Product.c -> Product.b)
+    -> Product.c
+    -> Product.a * Product.b
+end
+
+module FactorizerImpl (Product : Chapter5_Product) = struct
+  let factorizer ca cb = Product.p ca, Product.q cb
+end

src/content/1.5/code/ocaml/snippet21.ml

@@ -0,0 +1,8 @@
+module type CoProduct = sig
+  type a
+  type b
+  type c
+
+  val i : a -> c
+  val j : b -> c
+end