├── .gitignore ├── dune-project ├── dune ├── magic.ml ├── Utils └── Utils.ml ├── TypeSystem ├── HKT.ml ├── CoData.ml ├── ADT.ml ├── Monad.ml ├── CoData.md ├── Monoid.ml ├── HKT.md ├── GADT.md ├── Monad.md ├── GADT.ml ├── StateMonad.ml ├── Monoid.md ├── ADT.md └── StateMonad.md ├── TheoryOfComputation ├── ScottE.ml └── ScottE.md ├── Paradigms ├── Continuation.ml ├── TableDriven.ml ├── Continuation.md └── TableDriven.md ├── README.md └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | _*/ 2 | .*/ -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name magic) 3 | ; (public_name magic_in_ten_mins_ml) 4 | (libraries )) 5 | 6 | (include_subdirs unqualified) 7 | 8 | (env 9 | (_ 10 | (flags (:standard -warn-error -A)))) -------------------------------------------------------------------------------- /magic.ml: -------------------------------------------------------------------------------- 1 | (* Type System *) 2 | let module T = ADT.Test () in 3 | let module T = GADT.Test () in 4 | let module T = CoData.Test () in 5 | let module T = Monoid.Test () in 6 | let module T = HKT.Test () in 7 | let module T = Monad.Test () in 8 | let module T = StateMonad.Test () in 9 | (); 10 | 11 | (* Theory of Computation *) 12 | let module T = ScottE.Test () in 13 | (); 14 | 15 | (* Paradigms *) 16 | let module T = TableDriven.Test () in 17 | let module T = Continuation.Test () in 18 | (); 19 | -------------------------------------------------------------------------------- /Utils/Utils.ml: -------------------------------------------------------------------------------- 1 | let width = 50 2 | let start = 20 3 | 4 | let test_begin name = 5 | let sep = '>' in 6 | Printf.printf "%s [%s] %s\n" 7 | (String.make start sep) 8 | (name) 9 | (String.make (width - start - 4 - (String.length name)) sep) 10 | let test_end () = 11 | Printf.printf "%s\n" (String.make width '<') 12 | 13 | module type Test_S = sig 14 | val name : string 15 | val aloud : bool 16 | val test : unit -> unit 17 | end 18 | 19 | module MakeTest = 20 | functor (T: Test_S) -> functor () -> struct 21 | if T.aloud then test_begin T.name; 22 | T.test (); 23 | if T.aloud then test_end (); 24 | if T.aloud then Printf.printf "\n"; 25 | end -------------------------------------------------------------------------------- /TypeSystem/HKT.ml: -------------------------------------------------------------------------------- 1 | module type Container_S = sig 2 | type 'a t 3 | val map : ('a -> 'b) -> 'a t -> 'b t 4 | val create : 'a list -> 'a t 5 | val view : 'a t -> 'a list 6 | val eq : 'a t -> 'a t -> bool 7 | end 8 | 9 | module type Map_S = 10 | functor (C: Container_S) -> sig 11 | val map : ('a -> 'b) -> 'a C.t -> 'b C.t 12 | end 13 | 14 | module Map : Map_S = 15 | functor (C: Container_S) -> struct 16 | let map f ac = C.map f ac 17 | end 18 | 19 | module ListC : Container_S = struct 20 | include List 21 | let rec create l = l 22 | let rec view l = l 23 | let rec eq a b = 24 | match a, b with 25 | | [], [] -> true 26 | | x :: xs, y :: ys -> x = y && eq xs ys 27 | | _ -> false 28 | end 29 | 30 | module Test = Utils.MakeTest(struct 31 | let name = "HKT" 32 | let aloud = false 33 | 34 | let test () = 35 | let module MapList = Map(ListC) in 36 | let lc = MapList.map (( * ) 2) (ListC.create [1;2;3;4]) in 37 | assert (ListC.eq lc (ListC.create [2;4;6;8])); 38 | if aloud then 39 | let l = ListC.view lc in 40 | List.iter (fun i -> Printf.printf "%d " i) l; 41 | Printf.printf "\n"; 42 | end) 43 | -------------------------------------------------------------------------------- /TypeSystem/CoData.ml: -------------------------------------------------------------------------------- 1 | (* wrong impl: 2 | * open ADT.List 3 | * let rec l = cons 1 l 4 | *) 5 | 6 | module CoList = struct 7 | type 'a co_list = 8 | | CoCons of 'a * (unit -> 'a co_list) 9 | let rec to_string cl n = 10 | if n = 0 then "..." 11 | else 12 | let CoCons (c, tl) = cl in 13 | Printf.sprintf "%d :: %s" c (to_string (tl ()) (n - 1)) 14 | end 15 | 16 | (* Alternative impl *) 17 | module RecValue = struct 18 | let rec flip = 1 :: flop 19 | and flop = 2 :: flip 20 | 21 | (* Reference: 22 | * https://ocaml.org/manual/letrecvalues.html 23 | *) 24 | end 25 | 26 | module Test = Utils.MakeTest(struct 27 | let name = "CoData" 28 | let aloud = false 29 | 30 | let test () = 31 | let open CoList in 32 | let rec flip_flop : int co_list = 33 | CoCons (1, fun () -> CoCons (2, fun () -> flip_flop)) 34 | in 35 | if aloud then Printf.printf "%s\n" (to_string flip_flop 4); 36 | assert begin 37 | (to_string flip_flop 4) = "1 :: 2 :: 1 :: 2 :: ..." 38 | end; 39 | let open RecValue in 40 | if aloud then begin 41 | match flip with 42 | | a :: b :: c :: d :: _ -> 43 | Printf.printf "%d :: %d :: %d :: %d :: ...\n" a b c d 44 | | _ -> failwith "not happening" 45 | end; 46 | () 47 | end) 48 | -------------------------------------------------------------------------------- /TheoryOfComputation/ScottE.ml: -------------------------------------------------------------------------------- 1 | module Either = struct 2 | type ('a, 'b, 'r) either = ('a -> 'r) -> ('b -> 'r) -> 'r 3 | 4 | let left: 'a -> ('a, 'b, 'r) either = 5 | fun v -> (fun l -> fun _r -> l v) 6 | let right: 'b -> ('a, 'b, 'r) either = 7 | fun v -> (fun _l -> fun r -> r v) 8 | let case: ('a, 'b, 'r) either -> ('a -> 'r) -> ('b -> 'r) -> 'r = 9 | fun either l r -> 10 | either l r 11 | end 12 | 13 | module List = struct 14 | type ('t, 'r) list = 'r -> ('t -> 'r -> 'r) -> 'r 15 | let nil: ('t, 'r) list = 16 | fun base -> fun _f -> base 17 | let cons: 't -> ('t, 'r) list -> ('t, 'r) list = 18 | fun t list -> 19 | fun base -> fun f -> 20 | f t (list base f) 21 | let map: ('a -> 'b) -> ('a, 'r) list -> ('b, 'rr) list = 22 | fun f list -> 23 | list nil (fun x xs -> cons (f x) xs) 24 | let fold: ('r, 't) list -> 'r -> ('t -> 'r -> 'r) -> 'r = 25 | fun list base f -> 26 | list base f 27 | end 28 | 29 | module ADT = struct 30 | type ('a, 'b, 'r) prod = 'a -> 'b -> 'r 31 | type ('a, 'b, 'r) sum = ('a -> 'r) -> ('b -> 'r) -> 'r 32 | end 33 | 34 | module Test = Utils.MakeTest(struct 35 | let name = "ScottE" 36 | let aloud = false 37 | 38 | (* Since we are only testing the type system, we only need to compile. *) 39 | let test () = () 40 | end) 41 | -------------------------------------------------------------------------------- /TypeSystem/ADT.ml: -------------------------------------------------------------------------------- 1 | type student = { 2 | name: string; 3 | id: int; 4 | } 5 | 6 | type school_person = 7 | | Student of { 8 | name: string; 9 | id: int; 10 | } 11 | | Teacher of { 12 | name: string; 13 | office: string; 14 | } 15 | 16 | (* type student = string * int 17 | * type teacher = string * string 18 | *) 19 | 20 | type bool = 21 | | True 22 | | False 23 | 24 | type nat = 25 | | S of nat 26 | | O 27 | 28 | let rec nat_to_int n = 29 | match n with 30 | | S n -> nat_to_int n + 1 31 | | O -> 0 32 | 33 | let nat_to_string n = 34 | Int.to_string (nat_to_int n) 35 | 36 | 37 | module List = struct 38 | type 'a list = 39 | | Nil 40 | | Cons of 'a * 'a list 41 | 42 | let nil = Nil 43 | let cons x xs = Cons (x, xs) 44 | end 45 | open List 46 | 47 | let l = cons 1 (cons 3 (cons 4 nil)) 48 | 49 | 50 | module StringMap = Map.Make(String) 51 | 52 | type json_value = 53 | | JsonBool of bool 54 | | JsonInt of int 55 | | JsonStr of string 56 | | JsonArr of json_value list 57 | | JsonMap of json_value StringMap.t 58 | 59 | 60 | module Test = Utils.MakeTest(struct 61 | let name = "ADT" 62 | let aloud = false 63 | 64 | let test () = 65 | 66 | let sp = Student { name = "zhang san"; id = 519370010001 } in 67 | assert begin "zhang san" = match sp with 68 | | Student { name; _ } -> name 69 | | Teacher { name; _ } -> name 70 | end; 71 | 72 | (* Boolean *) 73 | let b = True in 74 | assert begin 75 | match b with 76 | | True -> true 77 | | False -> false 78 | end; 79 | 80 | (* Nat *) 81 | let n = (S (S (S O))) in 82 | assert begin 83 | (nat_to_int n) = 3 84 | end; 85 | 86 | end) 87 | -------------------------------------------------------------------------------- /TypeSystem/Monad.ml: -------------------------------------------------------------------------------- 1 | module type MONAD = sig 2 | type 'r t 3 | val return : 'r -> 'r t 4 | val bind : 'a t -> ('a -> 'b t) -> 'b t 5 | end 6 | 7 | module ListM : MONAD with type 'r t = 'r list = struct 8 | type 'r t = 'r list 9 | let return r = [r] 10 | let bind al f = 11 | List.concat (List.map f al) 12 | (* which is basically just 13 | * List.concat_map f al 14 | *) 15 | end 16 | 17 | (* Bad example *) 18 | let add_i (ma : int option) (mb : int option) = 19 | match ma with 20 | | None -> None 21 | | Some a -> 22 | match mb with 23 | | None -> None 24 | | Some b -> 25 | Some (a + b) 26 | 27 | module OptionM : MONAD with type 'r t = 'r option = struct 28 | type 'r t = 'r option 29 | let return v = Some v 30 | let bind o f = 31 | match o with 32 | | None -> None 33 | | Some v -> 34 | f v 35 | end 36 | 37 | module AddI = struct 38 | let add_i (ma : int option) (mb : int option) = 39 | let open OptionM in (* do *) 40 | bind ma (fun a -> ( (* a <- ma *) 41 | bind mb (fun b -> ( (* b <- mb *) 42 | return (a + b) (* pure (a + b) *) 43 | )) 44 | )) 45 | end 46 | 47 | module Syntax (M: MONAD) = struct 48 | let ( let* ) = M.bind 49 | end 50 | 51 | module AddI_Sugar = struct 52 | let add_i ma mb = 53 | let open OptionM in 54 | let open Syntax(OptionM) in 55 | let* a = ma in 56 | let* b = mb in 57 | return (a + b) 58 | end 59 | 60 | module Test = Utils.MakeTest(struct 61 | let name = "Monad" 62 | let aloud = false 63 | 64 | let test () = 65 | let open ListM in 66 | assert begin 67 | (return 3) = [3] 68 | && (bind [1;2;3] (fun x -> [x + 1; x + 2])) = [2;3;3;4;4;5] 69 | end; 70 | () 71 | end) 72 | -------------------------------------------------------------------------------- /TypeSystem/CoData.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：余代数数据类型 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础，ADT 6 | 7 | ## ADT的局限性 8 | 9 | 很显然，ADT可以构造任何树形的数据结构：树的节点内分支用和类型连接，层级间节点用积类型连接。 10 | 11 | 但是同样很显然ADT并不能搞出环形的数据结构或者说是无穷大小的数据结构。比如下面的代码： 12 | 13 | ```ocaml 14 | let rec l = cons 1 l 15 | ``` 16 | 17 | 编译器会表示`list`在当前的 scope 内不存在。 18 | 19 | 为什么会这样呢？ADT 是归纳构造的，也就是说它必须从非递归的基本元素开始组合构造成更大的元素。 20 | 21 | 如果我们去掉这些基本元素那就没法凭空构造大的元素，也就是说如果去掉归纳的第一步那整个归纳过程毫无意义。 22 | 23 | ## 余代数数据类型 24 | 25 | 余代数数据类型（Coalgebraic Data Type）也就是余归纳数据类型（Coinductive Data Type），代表了自顶向下的数据类型构造思路，思考一个类型可以如何被分解从而构造数据类型。 26 | 27 | 这样在分解过程中再次使用自己这个数据类型本身就是一件非常自然的事情了。 28 | 29 | 不过在编程实现过程中使用自己需要加个惰性数据结构包裹，防止积极求值的语言无限递归生成数据。 30 | 31 | 比如一个列表可以被分解为第一项和剩余的列表： 32 | 33 | ```ocaml 34 | type 'a co_list = 35 | | CoCons of 'a * (unit -> 'a co_list) 36 | ``` 37 | 38 | 这里的函数指针`(unit -> 'a co_list)`可以做到仅在需要`next`的时候才求值。使用的例子如下： 39 | 40 | ```ocaml 41 | let rec flip_flop : int co_list = 42 | CoCons (1, fun () -> CoCons (2, fun () -> flip_flop)) 43 | ``` 44 | 45 | 会产出`CoCons(1, CoCons(2, ...))`的无穷结构。这里的`flip_flop`从某种角度来看实际上就是个长度为 2 的环形结构。 46 | 47 | ```ocaml 48 | let rec to_string cl n = 49 | if n = 0 then "..." 50 | else 51 | let CoCons (c, tl) = cl in 52 | Printf.sprintf "%d :: %s" c (to_string (tl ()) (n - 1)) 53 | ``` 54 | 55 | 用这样的思路可以构造出无限大的树、带环的图等数据结构。 56 | 57 | 不过以上都是对余代数数据类型的一种模拟，实际上在对其支持良好的语言（Haskell: 喵喵喵？）都会自动进行辅助构造， 58 | 同时还能处理好对无限大（其实是环）的数据结构的无限递归变换（`map`, `fold` ...）的操作。 59 | 在懒求值的语言中，其 type 定义甚至同时满足 inductive 与 coinductive。 60 | 61 | > 注： 62 | > 63 | > OCaml 其实支持对*值*的递归定义（recursive definitions of values），所以我们可以写出以下代码： 64 | > 65 | > ```ocaml 66 | > let rec flip = 1 :: flop 67 | > and flop = 2 :: flip 68 | > ``` 69 | > 70 | > 其行为也和`CoList`一致。有兴趣的读者可以查阅测试。 71 | > 72 | > 参考： 73 | > 74 | > [OCaml官方文档](https://ocaml.org/manual/letrecvalues.html) 75 | > 76 | > [Haskell wiki](https://wiki.haskell.org/Tying_the_Knot) 77 | -------------------------------------------------------------------------------- /TypeSystem/Monoid.ml: -------------------------------------------------------------------------------- 1 | module type SEMI_GROUP = sig 2 | type t 3 | val (<+>) : t -> t -> t 4 | end 5 | 6 | module type MONOID = sig 7 | type t 8 | include SEMI_GROUP with type t := t 9 | val unit : t 10 | end 11 | 12 | module type GENERIC_TYPE_WORKAROUND = sig type t end 13 | 14 | module OptionM (T: GENERIC_TYPE_WORKAROUND) 15 | : (MONOID with type t = T.t option) 16 | = struct 17 | type t = T.t option 18 | let unit = None 19 | let (<+>) a b = 20 | match a with 21 | | Some _ -> a 22 | | None -> b 23 | end 24 | 25 | module OrderingM : MONOID with type t = int = struct 26 | type t = int 27 | (* Equality is 0, Less than is < 0, Greater than is > 0 *) 28 | let unit = 0 29 | let (<+>) a b = 30 | if a = 0 then b else a 31 | end 32 | 33 | module Student = struct 34 | type t = { 35 | name : string; 36 | sex : string; 37 | from : string; 38 | } 39 | let compare a b = 40 | let open OrderingM in 41 | unit 42 | <+> String.compare a.name b.name 43 | <+> String.compare a.sex b.sex 44 | <+> String.compare a.from b.from 45 | end 46 | 47 | module MonoidUtils (M : MONOID) = struct 48 | open M 49 | let concat = List.fold_left (<+>) unit 50 | let cond c t e = 51 | if c then t else e 52 | let when_ c t = 53 | cond c t unit 54 | end 55 | 56 | 57 | module Test = Utils.MakeTest(struct 58 | let name = "Monoid" 59 | let aloud = false 60 | 61 | let test () = 62 | let open OptionM(Int) in 63 | assert begin 64 | (unit <+> (Some 1) <+> (Some 2)) = (Some 1) 65 | end; 66 | 67 | let open Student in 68 | let st_1 = { name = "Alice"; sex = "Female"; from = "Utopia" } in 69 | let st_2 = { name = "Dorothy"; sex = "Female"; from = "Utopia" } in 70 | let st_3 = { name = "Alice"; sex = "Female"; from = "Vulcan" } in 71 | assert begin 72 | (Student.compare st_1 st_2) < 0 73 | && (Student.compare st_3 st_1) > 0 74 | && (Student.compare st_1 st_3) < 0 75 | && (Student.compare st_1 st_1) = 0 76 | end; 77 | () 78 | end) 79 | -------------------------------------------------------------------------------- /TypeSystem/HKT.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：高阶类型 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础 6 | 7 | 8 | ## 常常碰到的困难 9 | 10 | 写代码的时候常常会碰到语言表达能力不足的问题，比如下面这段用来给`F`容器中的值进行映射的代码： 11 | 12 | ```ocaml 13 | val map : ('a -> 'b) -> 'a 'container -> 'b 'container 14 | ^ type argument not allowed here 15 | ``` 16 | 17 | 并不能通过编译。 18 | 19 | ## 高阶类型 20 | 21 | 假设类型的类型是`*`，比如`int`和`string`类型都是`*`。 22 | 23 | 而对于`list`这样带有一个泛型参数的类型来说，它相当于一个把类型`t`映射到`t list`的函数，其类型可以表示为`* -> *`。 24 | 25 | 同样的对于`map`来说它有两个泛型参数，类型可以表示为`(*, *) -> *`。 26 | 27 | 像这样把类型映射到类型的非平凡类型就叫高阶类型（HKT, Higher Kinded Type）。 28 | 29 | 虽然 OCaml 中存在这样的高阶类型，但是我们并不能用一个泛型参数表示出来，也就不能写出如上`'a 'container`这样的代码了，因为`'container`是个高阶类型。 30 | 31 | > 如果加一层解决不了问题，那就加两层。 32 | 33 | 虽然在 OCaml 中不能直接表示出高阶类型，但是我们可以通过加一个中间层来在保留完整信息的情况下强类型地模拟出高阶类型。 34 | 35 | 首先，我们需要一个中间层来储存高阶类型信息： 36 | 37 | ```ocaml 38 | module type Container_S = sig 39 | type 'a t 40 | val map : ('a -> 'b) -> 'a t -> 'b t 41 | end 42 | ``` 43 | 44 | 然后我们就可以用 `Container_S` 里的 `'a t` 来表示 `'a container` ，这样操作完 `'a t` 后我们仍然有完整的类型信息来还原 `Container` 的类型。 45 | 46 | 这样，上面`map`就可以写成： 47 | 48 | ```ocaml 49 | module type Map_S = 50 | functor (C: Container_S) -> sig 51 | val map : ('a -> 'b) -> 'a C.t -> 'b C.t 52 | end 53 | ``` 54 | 55 | 这样就可以编译通过了。而对于想实现`Map_S`的 `module`，需要先实现`Container_S`这个中间层，这里拿`list`举例： 56 | 57 | ```ocaml 58 | module ListC : Container_S = struct 59 | include List 60 | let rec create l = l 61 | let rec view l = l 62 | let rec eq a b = 63 | match a, b with 64 | | [], [] -> true 65 | | x :: xs, y :: ys -> x = y && eq xs ys 66 | | _ -> false 67 | end 68 | ``` 69 | 70 | 这样，实现`Map`就是一件简单的事情了： 71 | 72 | ```ocaml 73 | module Map : Map_S = 74 | functor (C: Container_S) -> struct 75 | let map f ac = C.map f ac 76 | end 77 | ``` 78 | 79 | > 这里其实不止是为`list`，而是为任何实现了 `Container_S` 的 `module` 实现了 `map`。 80 | > 81 | > 善于思考的读者可能发现了，这个实现本身并没有做任何有意义的事……确实，这并不是一个足够好的例子——它并没有“非使用 HKT 不可”，从这个角度上该例可能是失败的。但从类型的角度而言，我们确实借助 OCaml 的 module system 在函数签名中 encode 了高阶类型的信息（形如 `'a 'container`，写作 `'a Container.t`），倒也不是毫无可取之处。 82 | 83 | ```ocaml 84 | let module MapList = Map(ListC) in 85 | let lc = MapList.map (( * ) 2) (ListC.create [1;2;3;4]) in 86 | assert (ListC.eq lc (ListC.create [2;4;6;8])); 87 | ``` 88 | -------------------------------------------------------------------------------- /TypeSystem/GADT.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：广义代数数据类型 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础，ADT 6 | 7 | 8 | 在ADT中可以构造出如下类型： 9 | 10 | ```ocaml 11 | type expr_fail = 12 | | IVal of int 13 | | BVal of bool 14 | | Add of expr_fail * expr_fail 15 | | Eq of expr_fail * expr_fail 16 | ``` 17 | 18 | 但是这样构造有个问题，很显然`BVal`是不能相加的，而这样的构造并不能防止构造出这样的东西：`Add (BVal true, BVal false)`。一个更全面的例子是： 19 | 20 | ```ocaml 21 | exception IllTyped 22 | 23 | let rec eval e = 24 | match e with 25 | | IVal _ | BVal _ -> e 26 | | Add (a, b) -> 27 | begin 28 | let a = eval a in 29 | let b = eval b in 30 | match a, b with 31 | | IVal a, IVal b -> IVal (a + b) 32 | | _ -> raise IllTyped 33 | end 34 | | Eq (a, b) -> 35 | begin 36 | let a = eval a in 37 | let b = eval b in 38 | match a, b with 39 | | IVal a, IVal b -> BVal (a = b) 40 | | BVal a, BVal b -> BVal (a = b) 41 | | _ -> raise IllTyped 42 | end 43 | ``` 44 | 45 | 46 | 实际上在这种情况下ADT的表达能力是不足的。 47 | 48 | 一个比较显然的解决办法是给`expr`添加一个类型参数用于标记表达式的类型。 49 | 50 | ```ocaml 51 | type _ expr = 52 | | IExpr : int -> int expr 53 | | BExpr : bool -> bool expr 54 | | Add : int pair -> int expr 55 | | Eq : _ pair -> bool expr 56 | and _ pair = 57 | | IPair : int expr * int expr -> int pair 58 | | BPair : bool expr * bool expr -> bool pair 59 | 60 | let make_int n = IExpr n 61 | let make_bool b = BExpr b 62 | let make_add a b = Add (IPair (a, b)) 63 | let make_int_eq a b = Eq (IPair (a, b)) 64 | let make_bool_eq a b = Eq (BPair (a, b)) 65 | ``` 66 | 67 | 这样就可以避免构造出两个类型为`bool`的表达式相加，能构造出的表达式都是类型安全的。我们可以通过写出`eval`函数来验证这一点： 68 | 69 | ```ocaml 70 | let rec eval_int e = 71 | match e with 72 | | IExpr n -> n 73 | | Add (IPair (a, b)) -> (eval_int a) + (eval_int b) 74 | let rec eval_bool e = 75 | match e with 76 | | BExpr b -> b 77 | | Eq (BPair (a, b)) -> (eval_bool a) = (eval_bool b) 78 | | Eq (IPair (a, b)) -> (eval_int a) = (eval_int b) 79 | ``` 80 | 81 | 最显然的不同是我们移除了运行时检查的 exception；对应的，我们在写 match 时也不再需要列出无关的分支。 82 | 83 | 注意到 type constructor `expr` 接受一个匿名的传入类型参数，而四个 data constructor (`IExpr`, `BExpr`, `Add`, `Eq`) 中标记了需要传入的类型和生成的结果类型。与ADT不同的是，生成的结果类型之间并不要求完全一致。而这即广义代数数据类型（Generalized Algebraic Data Type, GADT）。 84 | 85 | > 注： 86 | > 87 | > 参考 [OCaml官方文档](https://ocaml.org/manual/gadts-tutorial.html#c%3Agadts-tutorial) 88 | > 89 | > 和 [论坛](https://www.reddit.com/r/ocaml/comments/1jmjwf/explain_me_gadts_like_im_5_or_like_im_an/) 90 | -------------------------------------------------------------------------------- /TypeSystem/Monad.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：单子 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础，HKT 6 | 7 | 8 | ## 单子 9 | 10 | 单子(Monad)是指一种有一个类型参数的数据结构，拥有`return`（也叫`unit`或者`pure`）和`bind`（也叫`fmap`或者`>>=`）两种操作： 11 | 12 | ```ocaml 13 | module type MONAD = sig 14 | type 'r t 15 | val return : 'r -> 'r t 16 | val bind : 'a t -> ('a -> 'b t) -> 'b t 17 | end 18 | ``` 19 | 20 | 其中`return`要求返回一个包含参数类型内容的数据结构，`bind`要求把值经过某个函数`f : ('a -> 'b t)`以后再串起来。 21 | 22 | 举个最经典的例子： 23 | 24 | ## List Monad 25 | 26 | ```ocaml 27 | module ListM : MONAD = struct 28 | type 'r t = 'r list 29 | let return r = [r] 30 | let bind al f = 31 | List.concat (List.map f al) 32 | (* which is basically just 33 | * List.concat_map f al 34 | *) 35 | end 36 | ``` 37 | 38 | 于是我们可以得到如下平凡的结论： 39 | 40 | ```ocaml 41 | let open ListM in 42 | assert begin 43 | (return 3) = [3] 44 | && (bind [1;2;3] (fun x -> [x + 1; x + 2])) = [2;3;3;4;4;5] 45 | end 46 | ``` 47 | 48 | ## Option Monad 49 | 50 | OCaml 是一个空安全的语言，想表达很多语言中`null`这一概念，我们需要使用 `Option` 类型。对于初学者来说，面对一串可能出现空值的逻辑来说，判空常常是件麻烦事： 51 | 52 | ```ocaml 53 | let add_i (ma : int option) (mb : int option) = 54 | match ma with 55 | | None -> None 56 | | Some a -> 57 | match mb with 58 | | None -> None 59 | | Some b -> 60 | Some (a + b) 61 | ``` 62 | 63 | 现在，我们定义`Option Monad`： 64 | 65 | ```ocaml 66 | module OptionM : MONAD with type 'r t = 'r option = struct 67 | type 'r t = 'r option 68 | let return v = Some v 69 | let bind o f = 70 | match o with 71 | | None -> None 72 | | Some v -> 73 | f v 74 | end 75 | ``` 76 | 77 | 上面`add_i`的代码就可以改成： 78 | 79 | ```ocaml 80 | let add_i (ma : int option) (mb : int option) = 81 | let open OptionM in (* do *) 82 | bind ma (fun a -> ( (* a <- ma *) 83 | bind mb (fun b -> ( (* b <- mb *) 84 | return (a + b) (* pure (a + b) *) 85 | )) 86 | )) 87 | ``` 88 | 89 | 这样看上去比连续`if-return`优雅很多。搭配 OCaml 提供的语法糖食用更佳： 90 | 91 | ```ocaml 92 | module Syntax (M: MONAD) = struct 93 | let ( let* ) = M.bind 94 | end 95 | 96 | let add_i ma mb = 97 | let open OptionM in 98 | let open Syntax(OptionM) in 99 | let* a = ma in 100 | let* b = mb in 101 | return (a + b) 102 | ``` 103 | 104 | 其实 OCaml 的事实标准库 `Core` 里内置的 Option 也有 bind 函数，甚至也提供了此处引入的语法糖。具体可查阅参考中的 Core 文档。 105 | 106 | > 参考: 107 | > 108 | > [OCaml官方文档](https://ocaml.org/manual/bindingops.html) 109 | > 110 | > [Core文档](https://ocaml.janestreet.com/ocaml-core/v0.13/doc/core_kernel/Core_kernel/module-type-Monad/index.html) 111 | -------------------------------------------------------------------------------- /Paradigms/Continuation.ml: -------------------------------------------------------------------------------- 1 | module Cont = struct 2 | let demo () = 3 | let i = ref 1 in 4 | i := !i + 1; 5 | Printf.printf "%d\n" !i 6 | 7 | let _cont2 i = 8 | i := !i + 1; 9 | Printf.printf "%d\n" !i 10 | let _cont3 i = 11 | Printf.printf "%d\n" !i 12 | 13 | let rec cont1 () = 14 | let i = ref 1 in 15 | cont2 i 16 | and cont2 i = 17 | i := !i + 1; 18 | cont3 i 19 | and cont3 i = 20 | Printf.printf "%d\n" !i 21 | 22 | let demo_cont () = 23 | cont1 () 24 | end 25 | 26 | module CPS = struct 27 | let logic1 f = 28 | let i = ref 1 in 29 | f i 30 | let logic2 i f = 31 | i := !i + 1; 32 | f i 33 | let logic3 i f = 34 | Printf.printf "%d\n" !i; 35 | f i 36 | 37 | let demo_cps () = 38 | logic1 ( (* retrieve the return value i *) 39 | fun i -> logic2 i ( 40 | fun i -> logic3 i ( 41 | fun _i -> ()))) 42 | end 43 | 44 | module DelimitedCont = struct 45 | let call_t () = 46 | CPS.demo_cps (); 47 | Printf.printf "3\n" 48 | end 49 | 50 | module TryThrow = struct 51 | (* try and else is OCaml keyword so (as usual) we'll append `_` *) 52 | 53 | (* A type safe version of try_throw *) 54 | type ('r, 'e, 'o) body = ('e, 'o) throw -> ('r, 'o) else_ -> 'o final -> 'o 55 | and ('e, 'o) throw = 'e -> 'o final -> 'o 56 | and ('r, 'o) else_ = 'r -> 'o final -> 'o 57 | and 'o final = 'o -> 'o 58 | 59 | type ('r, 'e, 'o) try_throw = { 60 | body : ('r, 'e, 'o) body; 61 | throw : ('e, 'o) throw; 62 | else_ : ('r, 'o) else_; 63 | final : 'o final; 64 | } 65 | 66 | let try_ { body; throw; else_; final } = 67 | body throw else_ final 68 | 69 | type div_with_zero = unit 70 | let div_with_zero = () 71 | 72 | let try_div (a: int) (b: int): int option = 73 | try_ { 74 | body = (fun throw else_ final -> ( 75 | Printf.printf "try\n"; 76 | if b = 0 then (throw div_with_zero final) else (else_ (a / b) final) 77 | )); 78 | throw = (fun () final -> ( 79 | Printf.printf "caught\n"; 80 | final None 81 | )); 82 | else_ = (fun i final -> ( 83 | Printf.printf "else: %d\n" i; 84 | final (Some i) 85 | )); 86 | final = (fun o -> ( 87 | Printf.printf "final\n"; 88 | o 89 | )); 90 | } 91 | end 92 | 93 | module Test = Utils.MakeTest(struct 94 | let name = "Continuation" 95 | let aloud = false 96 | 97 | let test () = 98 | let open TryThrow in 99 | if aloud then 100 | assert begin 101 | try_div 4 0 = None 102 | && try_div 4 2 = Some 2 103 | end; 104 | () 105 | end) 106 | -------------------------------------------------------------------------------- /TypeSystem/GADT.ml: -------------------------------------------------------------------------------- 1 | module ExprFail = struct 2 | type expr_fail = 3 | | IVal of int 4 | | BVal of bool 5 | | Add of expr_fail * expr_fail 6 | | Eq of expr_fail * expr_fail 7 | 8 | exception IllTyped 9 | 10 | let rec eval e = 11 | match e with 12 | | IVal _ | BVal _ -> e 13 | | Add (a, b) -> 14 | begin 15 | let a = eval a in 16 | let b = eval b in 17 | match a, b with 18 | | IVal a, IVal b -> IVal (a + b) 19 | | _ -> raise IllTyped 20 | end 21 | | Eq (a, b) -> 22 | begin 23 | let a = eval a in 24 | let b = eval b in 25 | match a, b with 26 | | IVal a, IVal b -> BVal (a = b) 27 | | BVal a, BVal b -> BVal (a = b) 28 | | _ -> raise IllTyped 29 | end 30 | end 31 | 32 | (* 33 | module Expr = struct 34 | type _ expr = 35 | | IExpr : int -> int expr 36 | | BExpr : bool -> bool expr 37 | | Add : (int expr * int expr) -> int expr 38 | | IEq : (int expr * int expr) -> bool expr 39 | | BEq : (bool expr * bool expr) -> bool expr 40 | 41 | let make_int n = IExpr n 42 | let make_bool b = BExpr b 43 | let make_add a b = Add (a, b) 44 | let make_int_eq a b = IEq (a, b) 45 | let make_bool_eq a b = BEq (a, b) 46 | 47 | let rec eval_int e = 48 | match e with 49 | | IExpr n -> n 50 | | Add (a, b) -> eval_int a + eval_int b 51 | let rec eval_bool e = 52 | match e with 53 | | BExpr b -> b 54 | | BEq (a, b) -> (eval_bool a) = (eval_bool b) 55 | | IEq (a, b) -> (eval_int a) = (eval_int b) 56 | end 57 | *) 58 | 59 | module Expr = struct 60 | type _ expr = 61 | | IExpr : int -> int expr 62 | | BExpr : bool -> bool expr 63 | | Add : int pair -> int expr 64 | | Eq : _ pair -> bool expr 65 | and _ pair = 66 | | IPair : int expr * int expr -> int pair 67 | | BPair : bool expr * bool expr -> bool pair 68 | 69 | 70 | let make_int n = IExpr n 71 | let make_bool b = BExpr b 72 | let make_add a b = Add (IPair (a, b)) 73 | let make_int_eq a b = Eq (IPair (a, b)) 74 | let make_bool_eq a b = Eq (BPair (a, b)) 75 | 76 | let rec eval_int e = 77 | match e with 78 | | IExpr n -> n 79 | | Add (IPair (a, b)) -> (eval_int a) + (eval_int b) 80 | let rec eval_bool e = 81 | match e with 82 | | BExpr b -> b 83 | | Eq (BPair (a, b)) -> (eval_bool a) = (eval_bool b) 84 | | Eq (IPair (a, b)) -> (eval_int a) = (eval_int b) 85 | end 86 | 87 | (* Reference: 88 | * https://ocaml.org/manual/gadts-tutorial.html#c%3Agadts-tutorial 89 | * https://www.reddit.com/r/ocaml/comments/1jmjwf/explain_me_gadts_like_im_5_or_like_im_an/ 90 | *) 91 | 92 | module Test = Utils.MakeTest(struct 93 | let name = "GADT" 94 | let aloud = false 95 | 96 | (* Since we are only testing the type system, we only need to compile. *) 97 | let test () = () 98 | end) 99 | -------------------------------------------------------------------------------- /TypeSystem/StateMonad.ml: -------------------------------------------------------------------------------- 1 | module Procedural = struct 2 | let i = ref 0 in 3 | i := !i + 1; (* i = 1 *) 4 | assert begin 5 | (Printf.sprintf "%d" !i) = "1" 6 | end; 7 | 8 | let i = 0 in 9 | (fun v -> assert begin 10 | (Printf.sprintf "%d" v) = "1" 11 | end) (i + 1); 12 | end 13 | 14 | module type MONAD = Monad.MONAD 15 | 16 | module type STATE = sig 17 | type 'r t 18 | type state 19 | val get : state t 20 | val put : state -> unit t 21 | val modify : (state -> state) -> unit t 22 | val run : 'r t -> state -> 'r * state 23 | val eval : 'r t -> state -> 'r 24 | end 25 | 26 | module State (S: sig type t end) : sig 27 | type 'r t 28 | include MONAD with type 'r t := 'r t 29 | include STATE with type 'r t := 'r t and type state := S.t 30 | end = struct 31 | type 'r t = S.t -> 'r * S.t 32 | let return v = (fun s -> (v, s)) 33 | let bind (o : 'r t) (f: 'r -> 'rr t) = 34 | (fun s -> ( 35 | let (v', s') = o s in 36 | (f v') s' 37 | )) 38 | let get = (fun v -> (v, v)) 39 | let put s = (fun _ -> ((), s)) 40 | let modify f = 41 | bind get (fun x -> put (f x)) 42 | let run o s = o s 43 | let eval o s = 44 | let (v, _) = run o s in v 45 | end 46 | 47 | module Fib = struct 48 | module FibState = State(struct type t = int * int end) 49 | open FibState 50 | 51 | let fib n = 52 | let rec fib (n : int) : int FibState.t = 53 | match n with 54 | | 0 -> bind get (fun (x, _) -> return x) 55 | | _ -> 56 | bind (modify (fun (x, y) -> (y, x + y))) (fun _ -> fib (n - 1)) 57 | in 58 | eval (fib n) (0, 1) 59 | 60 | open Monad.Syntax(FibState) 61 | 62 | (* With syntax sugar *) 63 | let fib_let_star n = 64 | let rec fib (n : int) : int FibState.t = 65 | match n with 66 | | 0 -> 67 | let* (x, _) = get in 68 | return x 69 | | _ -> 70 | let* _ = modify (fun (x, y) -> (y, x + y)) in 71 | fib (n - 1) 72 | in 73 | eval (fib n) (0, 1) 74 | 75 | (* Straightforward solution *) 76 | let imp_fib n = 77 | let a = Array.of_list [0; 1; 1] in 78 | for i = 0 to n - 1 do 79 | a.((i+2) mod 3) <- 80 | a.((i+1) mod 3) + a.(i mod 3) 81 | done; 82 | a.(n mod 3) 83 | 84 | let rec naive_fib n = 85 | match n with 86 | | 0 | 1 -> n 87 | | _ -> naive_fib (n-1) + naive_fib (n-2) 88 | end 89 | 90 | module Test = Utils.MakeTest(struct 91 | let name = "StateMonad" 92 | let aloud = false 93 | 94 | (* Since we are only testing the type system, we only need to compile. *) 95 | let test () = 96 | let open Fib in 97 | for i = 1 to 10 do 98 | if aloud then Printf.printf "%d\n" (fib i) 99 | done; 100 | assert begin 101 | fib 10 = 55 102 | && fib_let_star 10 = 55 103 | && imp_fib 10 = 55 104 | && naive_fib 10 = 55 105 | end 106 | end) 107 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习 (OCaml) 2 | 3 | [十分钟魔法练习 - 光吟](https://github.com/LighghtEeloo/magic-in-ten-mins-ml) 4 | 5 | 改写自 [十分钟魔法练习 - 玩火](https://github.com/goldimax/magic-in-ten-mins) 6 | 原版为 Java 实现 7 | 8 | 另有 9 | [Rust 版 - 光量子](https://github.com/PhotonQuantum/magic-in-ten-mins-rs) | 10 | [C++版 - 图斯卡蓝瑟](https://github.com/tusikalanse/magic-in-ten-mins-cpp) | 11 | [C#版 - CWKSC](https://github.com/CWKSC/magic-in-ten-mins-csharp) | 12 | [Lua 版 - Ofey Chan](https://github.com/ofey404/magic-in-ten-mins-lua) | 13 | [Python 版 - penguin_wwy](https://github.com/penguin-wwy/magic-in-ten-mins-py) 14 | 15 | 抽象与组合 16 | 17 | 希望能~~在十分钟内~~教会你一样魔法，并尽可能展示 OCaml 的使用姿势。 18 | 19 | > 虽然 Haskell 表达能力更强就是了 (( ◞•̀д•́)◞⚔◟(•̀д•́◟ )) 20 | 21 | 个人水平有限，不保证全部正确性，欢迎大家批判指正。 22 | 23 | QQ群：1070975853 | 24 | [Telegram Group](https://t.me/joinchat/HZm-VAAFTrIxoxQQ) 25 | 26 | > 目录中方括号里的是前置技能。 27 | 28 | ## 测试所有用例 29 | 30 | ``` shell script 31 | $ dune exec ./magic.exe 32 | ``` 33 | 34 | ## 类型系统 35 | 36 | [偏易|代数数据类型(Algebraic Data Type)[OCaml 基础]](TypeSystem/ADT.md) 37 | 38 | [偏易|广义代数数据类型(Generalized Algebriac Data Type)[OCaml 基础，ADT]](TypeSystem/GADT.md) 39 | 40 | [偏易|余代数数据类型(Coalgebraic Data Type)[OCaml 基础，ADT]](TypeSystem/CoData.md) 41 | 42 | [偏易|单位半群(Monoid)[OCaml 基础]](TypeSystem/Monoid.md) 43 | 44 | [较难|高阶类型(Higher Kinded Type)[OCaml 基础]](TypeSystem/HKT.md) 45 | 46 | [中等|单子(Monad)[OCaml 基础，HKT]](TypeSystem/Monad.md) 47 | 48 | [较难|状态单子(State Monad)[OCaml 基础，HKT，Monad]](TypeSystem/StateMonad.md) 49 | 50 | [中等|简单类型 λ 演算(Simply-Typed Lambda Calculus)[Java 基础，ADT，λ 演算]](doc/STLC.md) 51 | 52 | [中等|系统 F(System F)[Java 基础，ADT，简单类型 λ 演算]](doc/SystemF.md) 53 | 54 | [中等|系统 Fω(System Fω)[Java 基础，ADT，系统 F]](doc/SysFO.md) 55 | 56 | [较难|构造演算(Calculus of Construction)[Java 基础，ADT，系统 Fω]](doc/CoC.md) 57 | 58 | [偏易|π 类型和 Σ 类型(Pi type & Sigma type)[ADT，构造演算]](doc/PiSigma.md) 59 | 60 | ## 计算理论 61 | 62 | [较难|λ演算(Lambda Calculus)[Java基础，ADT]](TheoryOfComputation/Lambda.md) 63 | 64 | [偏易|求值策略(Evaluation Strategy)[Java基础，λ演算]](TheoryOfComputation/EvalStrategy.md) 65 | 66 | [较难|丘奇编码(Church Encoding)[λ 演算]](TheoryOfComputation/ChurchE.md) 67 | 68 | [很难|斯科特编码(Scott Encoding)[OCaml基础，构造演算，ADT，μ]](TheoryOfComputation/ScottE.md) 69 | 70 | [中等|Y 组合子(Y Combinator)[Java 基础，λ 演算，λ 演算编码]](TheoryOfComputation/YCombinator.md) 71 | 72 | [中等|μ(Mu)[Java 基础，构造演算， Y 组合子]](TheoryOfComputation/Mu.md) 73 | 74 | [中等|向量和有限集(Vector & FinSet)[构造演算， ADT ，依赖类型模式匹配]](TheoryOfComputation/VecFin.md) 75 | 76 | ## 形式化验证 77 | 78 | [偏易|Curry-Howard 同构(Curry-Howard Isomorphism)[构造演算]](src/CHIso.md) 79 | 80 | ## 编程范式 81 | 82 | [简单|表驱动编程(Table-Driven Programming)[简单 OCaml 基础]](Paradigms/TableDriven.md) 83 | 84 | [简单|续延(Continuation)[简单 OCaml 基础]](Paradigms/Continuation.md) 85 | 86 | [中等|代数作用(Algebraic Effect)[简单 OCaml 基础，续延]](Paradigms/Algeff.md) 87 | 88 | [中等|依赖注入(Dependency Injection)[Java基础，Monad，代数作用]](Paradigms/DepsInj.md) 89 | 90 | [中等|提升(Lifting)[OCaml 基础，HKT，Monad]](Paradigms/Lifting.md) 91 | 92 | ## 编译原理 93 | 94 | [较难|解析器单子(Parser Monad)[Java基础，HKT，Monad]](doc/ParserM.md) 95 | 96 | [中等|解析器组合子(Parser Combinator)[Java基础，HKT，Monad]](doc/Parsec.md) -------------------------------------------------------------------------------- /TypeSystem/Monoid.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：单位半群 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础 6 | 7 | ## 半群（Semigroup） 8 | 9 | 半群是一种代数结构，在集合 `A` 上包含一个将两个 `A` 的元素映射到 `A` 上的运算即 `<> : (A, A) -> A` ，同时该运算满足**结合律**即 `(a <> b) <> c == a <> (b <> c)` ，那么代数结构 `{<>, A}` 就是一个半群。 10 | 11 | 比如在自然数集上的加法或者减法可以构成一个半群，再比如字符串集上字符串的连接构成一个半群。 12 | 13 | 用 OCaml 代码可以表示为： 14 | 15 | ```ocaml 16 | module type SEMI_GROUP = sig 17 | type t 18 | val (<+>) : t -> t -> t 19 | end 20 | ``` 21 | 22 | > 注： 23 | > 24 | > 此处的 `<+>` 即一个二元运算符，其类型签名可以概括它的意图。 25 | 26 | ## 单位半群（Monoid） 27 | 28 | 单位半群是一种带单位元的半群，对于集合 `A` 上的半群 `{<>, A}` ，`A`中的元素`a`使`A`中的所有元素`x`满足 `x <> a` 和 `a <> x` 都等于 `x`，则 `a` 就是 `{<>, A}` 上的单位元。 29 | 30 | > 注：单位半群有另一个常用的名字叫“幺半群”，其中幺作数字一之解。 31 | 32 | 举个例子，`{+, 自然数集}`的单位元就是0，`{*, 自然数集}`的单位元就是1，`{+, 字符串集}`的单位元就是空串`""`。 33 | 34 | 用 OCaml 代码可以表示为： 35 | 36 | ```ocaml 37 | module type MONOID = sig 38 | type t 39 | include SEMI_GROUP with type t := t 40 | val unit : t 41 | end 42 | ``` 43 | 44 | ## 应用：`option` 45 | 46 | 在 OCaml 中有类型`option`可以用来表示可能有值的类型，而我们可以将它定义为 Monoid： 47 | 48 | ```ocaml 49 | module type GENERIC_TYPE_WORKAROUND = sig type t end 50 | 51 | module OptionM (T: GENERIC_TYPE_WORKAROUND) 52 | : (MONOID with type t = T.t option) 53 | = struct 54 | type t = T.t option 55 | let unit = None 56 | let (<+>) a b = 57 | match a with 58 | | Some _ -> a 59 | | None -> b 60 | end 61 | ``` 62 | 63 | > 注： 64 | > 65 | > 很不幸， OCaml 对 higher kinded type 并没有提供一等支持，因此我们需要用 `GENERIC_TYPE_WORKAROUND` 做一些小手脚。 66 | 67 | 这样对于 `<+>` 来说我们将获得一串 Option 中第一个不为空的值，对于需要进行一连串尝试操作可以这样写： 68 | 69 | ```ocaml 70 | let open OptionM(Int) in 71 | unit <+> (Some 1) <+> (Some 2) 72 | ``` 73 | 74 | ## 应用：Ordering 75 | 76 | 可以利用 Monoid 实现带优先级的比较 77 | 78 | ```ocaml 79 | module OrderingM : MONOID with type t = int = struct 80 | type t = int 81 | (* Equality is 0, Less than is < 0, Greater than is > 0 *) 82 | let unit = 0 83 | let (<+>) a b = 84 | if a = 0 then b else a 85 | end 86 | ``` 87 | 88 | 同样如果有一串带有优先级的比较操作就可以用 `<+>` 串起来，比如： 89 | 90 | ```ocaml 91 | module Student = struct 92 | type t = { 93 | name : string; 94 | sex : string; 95 | from : string; 96 | } 97 | let compare a b = 98 | let open OrderingM in 99 | unit 100 | <+> String.compare a.name b.name 101 | <+> String.compare a.sex b.sex 102 | <+> String.compare a.from b.from 103 | end 104 | ``` 105 | 106 | 这样的写法比一连串`if-else`优雅太多。 107 | 108 | ```ocaml 109 | let open Student in 110 | let st_1 = { name = "Alice"; sex = "Female"; from = "Utopia" } in 111 | let st_2 = { name = "Dorothy"; sex = "Female"; from = "Utopia" } in 112 | let st_3 = { name = "Alice"; sex = "Female"; from = "Vulcan" } in 113 | assert begin 114 | (Student.compare st_1 st_2) < 0 115 | && (Student.compare st_3 st_1) > 0 116 | && (Student.compare st_1 st_3) < 0 117 | && (Student.compare st_1 st_1) = 0 118 | end; 119 | ``` 120 | 121 | 122 | ## 扩展 123 | 124 | 这部分代码使用了 Java 的 `Runnable`，而这在 OCaml 中并没有很好的直接对应或替代， 125 | 建议参考[原版](https://github.com/goldimax/magic-in-ten-mins/blob/main/doc/Monoid.md#%E6%89%A9%E5%B1%95)。 126 | 127 | > 注：上面 Option 的实现并不是 lazy 的，实际运用中加上非空短路能提高效率。 -------------------------------------------------------------------------------- /TypeSystem/ADT.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：代数数据类型 (ADT) 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础 6 | 7 | 8 | ## 积类型（Product type） 9 | 10 | 积类型是指同时包括多个值的类型，比如 OCaml 中的 record 就会包括多个字段： 11 | 12 | ```ocaml 13 | type student = { 14 | name: string; 15 | id: int; 16 | } 17 | ``` 18 | 19 | 而上面这段代码中 `student` 的类型中既有 `string` 类型的值也有 `int` 类型的值。这种情况我们称其为 `string` 和 `int` 的「积」，即`string * int`。 20 | 21 | ## 和类型（Sum type） 22 | 23 | 和类型是指可以是某一些类型之一的类型，在 OCaml 中可以用 custom type 来表示： 24 | 25 | ```ocaml 26 | type school_person = 27 | | Student of { 28 | name: string; 29 | id: int; 30 | } 31 | | Teacher of { 32 | name: string; 33 | office: string; 34 | } 35 | ``` 36 | 37 | school_person 可能是 Student 也可能是 Teacher。这种类型存在多种“变体”的情形，我们称之为 Student 和 Teacher 的「和」，即`string * int + string * string`。使用时可以通过 Pattern Matching 知道当前的 school_person 具体是 Student 还是 Teacher，例如： 38 | 39 | ```ocaml 40 | let sp = Student { name = "zhang san"; id = 519370010001 } in 41 | match sp with 42 | | Student { name; _ } -> name 43 | | Teacher { name; _ } -> name 44 | ``` 45 | 46 | > OCaml 本就对 和类型 和 积类型 有较好的支持，如 47 | > 48 | > ```ocaml 49 | > type student = string * int 50 | > type teacher = string * string 51 | > type school_person = 52 | > | Student of student 53 | > | Teacher of teacher 54 | > ``` 55 | 56 | ## 代数数据类型（ADT, Algebraic Data Type） 57 | 58 | 由和类型与积类型组合构造出的类型就是代数数据类型，其中代数指的就是和与积的操作。 59 | 60 | ### 布尔类型 61 | 62 | 利用和类型的枚举特性与积类型的组合特性，我们可以构造出 OCaml 中本来很基础的基础类型，比如枚举布尔的两个量来构造布尔类型： 63 | 64 | ```ocaml 65 | type bool = 66 | | True 67 | | False 68 | ``` 69 | 70 | 模式匹配可以用来判定某个 Bool 类型的值是 True 还是 False。 71 | 72 | ```ocaml 73 | let b = True in 74 | match b with 75 | | True -> true 76 | | False -> false 77 | ``` 78 | 79 | ### 自然数 80 | 81 | 让我们看一些更有趣的结构。我们知道，一个自然数要么是 0，要么是另一个自然数 +1。如果理解上有困难，可以将其看作是一种“一进制”的计数方法。这种自然数的构造法被称为皮亚诺结构。利用 ADT，我们可以轻易表达出这种结构： 82 | 83 | ```ocaml 84 | type nat = 85 | | S of nat 86 | | O 87 | ``` 88 | 89 | 其中，`O` 表示自然数 0，而 `S` 则代表某个自然数的后继（即+1）。例如，3 可以用`(S (S (S O)))`来表示。 90 | 91 | ```ocaml 92 | let rec nat_to_int n = 93 | match n with 94 | | S n -> nat_to_int n + 1 95 | | O -> 0 96 | 97 | let nat_to_string n = 98 | Int.to_string (nat_to_int n) 99 | ``` 100 | 101 | 102 | ### 链表 103 | 104 | ```ocaml 105 | type 'a list = 106 | | Nil 107 | | Cons of 'a * 'a list 108 | 109 | let nil = Nil 110 | let cons x xs = Cons (x, xs) 111 | ``` 112 | 113 | `[1, 3, 4]`可以被表示为 `cons 1 (cons 3 (cons 4 nil))` 114 | 115 | ## 何以代数? 116 | 117 | 代数数据类型之所以被称为“代数”，是因为其可以像代数一样进行运算。其实，每种代数数据类型都对应着一个值，即这种数据类型可能的实例数量。 118 | 119 | 显然，积类型的实例数量来自各个字段可能情况的组合，也就是各字段实例数量相乘。而和类型的实例数量，就是各种可能类型的实例数量之和。 120 | 121 | 例如，`Bool`的实例只有`True`和`False`两种情况，其对应的值就是`1+1`。而`nat`除了最初的`O`以外，对于每个`nat`值`n`都存在`S(n)`，其也是`nat`类型的值。那么，我们可以将`nat`对应到`1+1+1+...`，其中每一个 1 都代表一个自然数。至于 `list` 的类型就是`1+x(1+x(...))`也就是`1+x^2+x^3...`其中 `x `就是 `list` 所存类型的实例数量。 122 | 123 | 到现在为止，我们已经通过代数数据类型粗略定义出了加法与乘法。其实，我们还可以定义出零值以及指数计算。另外，加法的交换率等定理可以通过这套类型系统进行证明。感兴趣的读者可以查询相关资料，进一步进行探究。 124 | 125 | ## 实际运用 126 | 127 | ADT 最适合构造树状的结构，比如解析 JSON 出的结果需要一个聚合数据结构。 128 | 129 | ```ocaml 130 | module StringMap = Map.Make(String) 131 | 132 | type json_value = 133 | | JsonBool of bool 134 | | JsonInt of int 135 | | JsonStr of string 136 | | JsonArr of json_value list 137 | | JsonMap of json_value StringMap.t 138 | ``` 139 | -------------------------------------------------------------------------------- /Paradigms/TableDriven.ml: -------------------------------------------------------------------------------- 1 | module GetLevel = struct 2 | let get_level_naive score = 3 | if score >= 90 then "A" else 4 | if score >= 80 then "B" else 5 | if score >= 70 then "C" else 6 | if score >= 60 then "D" else 7 | "E" 8 | let get_level_match score = 9 | match score with 10 | | s when s >= 90 -> "A" 11 | | s when s >= 80 -> "B" 12 | | s when s >= 70 -> "C" 13 | | s when s >= 60 -> "D" 14 | | _ -> "E" 15 | let get_level_table score = 16 | let tbl = [ 17 | (60, "D"); 18 | (70, "C"); 19 | (80, "B"); 20 | (90, "A"); 21 | ] in 22 | List.fold_left (fun current (lb, grade) -> ( 23 | if score >= lb then grade else current 24 | )) "E" tbl 25 | end 26 | 27 | module ShopList = struct 28 | type item = { 29 | name : string; 30 | price : int; 31 | count : int; 32 | } 33 | type t = item list 34 | let create_item name price = { 35 | name; price; count = 0 36 | } 37 | let create = [ 38 | create_item "water" 1; 39 | create_item "cola" 2; 40 | create_item "choco" 5; 41 | ] 42 | let buy (shop_list: t) (name': string): t = 43 | List.map (fun ({ name; price; count } as item) -> ( 44 | if name = name' then { name; price; count = count + 1 } 45 | else item 46 | )) shop_list 47 | let to_string (shop_list: t): string = 48 | shop_list 49 | |> List.map (fun { name; price; count } -> ( 50 | Printf.sprintf "%s ($%d/per): %d" name price count 51 | )) 52 | |> String.concat "\n" 53 | end 54 | 55 | module SimpleUI = struct 56 | type shop_list = ShopList.t 57 | type output = 58 | | ShopList of shop_list 59 | | Print 60 | | Exit 61 | type t = { 62 | shop_list : shop_list; 63 | events : (shop_list -> output) list 64 | } 65 | let create = { 66 | shop_list = ShopList.create; 67 | events = [ 68 | (fun s -> ShopList (ShopList.buy s "water")); 69 | (fun s -> ShopList (ShopList.buy s "cola")); 70 | (fun _ -> Print); 71 | (fun _ -> Exit); 72 | ] 73 | } 74 | let run_event ui event = 75 | let { events; shop_list } = ui in 76 | match (List.nth events event) shop_list with 77 | | ShopList s -> { events; shop_list = s } 78 | | Print -> 79 | Printf.printf "%s\n" (ShopList.to_string shop_list); 80 | ui 81 | | Exit -> exit 0 82 | end 83 | 84 | module ComplexUI = struct 85 | (* Todo.. *) 86 | end 87 | 88 | module Test = Utils.MakeTest(struct 89 | let name = "TableDriven" 90 | let aloud = false 91 | 92 | let test () = 93 | (* GetLevel *) 94 | let open GetLevel in 95 | assert begin 96 | get_level_naive 85 = "B" 97 | && get_level_match 85 = "B" 98 | && get_level_table 85 = "B" 99 | end; 100 | (* ShopList *) 101 | assert begin 102 | let shop_list = ShopList.create in 103 | let shop_list = ShopList.buy shop_list "cola" in 104 | if aloud then Printf.printf "%s\n" (ShopList.to_string shop_list); 105 | String.equal 106 | (ShopList.to_string shop_list) 107 | "water ($1/per): 0\ncola ($2/per): 1\nchoco ($5/per): 0" 108 | end; 109 | (* SimpleUI *) 110 | assert begin 111 | let ui = SimpleUI.create in 112 | let ui = SimpleUI.run_event ui 1 in 113 | let ui = SimpleUI.run_event ui 1 in 114 | let ui = SimpleUI.run_event ui 1 in 115 | if aloud then begin 116 | let _ = SimpleUI.run_event ui 2 in () 117 | end; 118 | String.equal 119 | (ShopList.to_string ui.shop_list) 120 | "water ($1/per): 0\ncola ($2/per): 3\nchoco ($5/per): 0" 121 | end; 122 | () 123 | end) 124 | -------------------------------------------------------------------------------- /TypeSystem/StateMonad.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：状态单子 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：OCaml 基础，HKT，Monad 6 | 7 | 8 | ## 函数容器 9 | 10 | OCaml 中的不少容器都是可以看成是单子的，上节中 `List Monad` 的实现就是 `List.concat_map` 的一层 wrapper，而 `Option Monad` 我们也在标准库中找到了等价物。 11 | 12 | 不过单子不仅仅可以是实例意义上的容器，也可以是其他抽象意义上的容器，比如函数。 13 | 14 | 对于一个形如 `S.t -> result` 形式的函数来说，我们可以把它看成包含了一个 `result` 的惰性容器，只有在给出 `S.t` 的时候才能知道 `result` 的值。对于这样形式的函数我们同样能写出对应的 `bind` ，这里就拿状态单子举例子。 15 | 16 | ## 状态单子 17 | 18 | 状态单子（State Monad）是一种可以包含一个“可变”状态的单子，尽管状态随着逻辑流在变化，但是在内存里面实际上都是不变量。 19 | 20 | 其本质就是在每次状态变化的时候将新状态作为代表接下来逻辑的函数的输入。比如对于： 21 | 22 | ```ocaml 23 | let i = ref 0 in 24 | i := !i + 1; (* i = 1 *) 25 | Printf.printf "%d\n" !i 26 | ``` 27 | 28 | 可以用状态单子的思路改写成： 29 | 30 | ```ocaml 31 | let i = 0 in 32 | (fun v -> Printf.printf "%d\n" v) (i + 1); 33 | ``` 34 | 35 | State 是一个类型为 `type 'r t = S.t -> 'r * S.t` 的 Monad，它将某个初态映射到 (终值, 末态)，即 `S.t -> 'r * S.t`， 而通过组合可以使变化的状态在逻辑间传递： 36 | 37 | ```ocaml 38 | type 'r t = S.t -> 'r * S.t 39 | let return v = (fun s -> (v, s)) 40 | let bind (o : 'r t) (f: 'r -> 'rr t) = 41 | (fun s -> ( 42 | let (v', s') = o s in 43 | (f v') s' 44 | )) 45 | ``` 46 | 47 | `return` 操作直接返回当前状态和给定的值， `bind` 操作只需要把 `o` 中的 `'r` 取出来然后传给 `f` ，并处理好 `state` 。 48 | 49 | > 注 50 | > 51 | > `bind` 其实是将两个 State 进行组合，前一个 State 的终值成为了 f 的参数得到一个新的 State， 52 | > 然后向新的 State 输入前一 State 的终态可以得到组合后 State 的终值和终态。 53 | 54 | 仅仅这样的话 `State` 使用起来并不方便，还需要定义一些常用的操作来读取写入状态： 55 | 56 | ```ocaml 57 | let get = (fun v -> (v, v)) 58 | let put s = (fun _ -> ((), s)) 59 | let modify f = 60 | bind get (fun x -> put (f x)) 61 | let run o s = o s 62 | let eval o s = 63 | let (v, _) = run o s in v 64 | ``` 65 | 66 | ## 使用例 67 | 68 | 求斐波那契数列： 69 | 70 | ```ocaml 71 | module FibState = State(struct type t = int * int end) 72 | open FibState 73 | 74 | let fib n = 75 | let rec fib (n : int) : int FibState.t = 76 | match n with 77 | | 0 -> bind get (fun (x, _) -> return x) 78 | | _ -> 79 | bind (modify (fun (x, y) -> (y, x + y))) (fun _ -> fib (n - 1)) 80 | in 81 | eval (fib n) (1, 1) 82 | ``` 83 | 84 | `fib` 函数对应的 Haskell 代码是： 85 | 86 | ```haskell 87 | fib :: Int -> State (Int, Int) Int 88 | fib 0 = do 89 | (_, x) <- get 90 | pure x 91 | fib n = do 92 | modify (\(a, b) -> (b, a + b)) 93 | fib (n - 1) 94 | ``` 95 | 96 | ~~看上去简单很多~~ 97 | 98 | > 注： 99 | > 100 | > 那只是因为我们没有使用语法糖啦！ 101 | 102 | ```ocaml 103 | open Monad.Syntax(FibState) 104 | 105 | let fib_let_star n = 106 | let rec fib (n : int) : int FibState.t = 107 | match n with 108 | | 0 -> 109 | let* (x, _) = get in 110 | return x 111 | | _ -> 112 | let* _ = modify (fun (x, y) -> (y, x + y)) in 113 | fib (n - 1) 114 | in 115 | eval (fib n) (1, 1) 116 | ``` 117 | 118 | 可以看到主要逻辑一模一样。 119 | 120 | ## 有什么用 121 | 122 | 求斐波那契数列有着更简单的写法： 123 | 124 | ```ocaml 125 | let imp_fib n = 126 | let a = Array.of_list [0; 1; 1] in 127 | for i = 0 to n - 1 do 128 | a.((i+2) mod 3) <- 129 | a.((i+1) mod 3) + a.(i mod 3) 130 | done; 131 | a.(n mod 3) 132 | ``` 133 | 134 | 两种实现的区别体现在： 135 | 136 | - 使用了可变对象，而 `State Monad` 仅使用了不可变对象，使得函数是纯函数，但又存储了变化的状态。 137 | 138 | - 非递归，如果改写成递归形式需要在 `fib` 上加一个状态参数，`State Monad` 则已经携带。 139 | 140 | - `State Monad` 的实现是 **可组合** 的，即可以将任意两个状态类型相同的 `State Monad` 组合起来。 141 | 142 | > 注： 143 | > 144 | > 当然还有更 naive 的，无需可变对象，无需传递状态，纯函数的写法，但是其时间复杂度不是线性的 145 | 146 | ```ocaml 147 | let rec naive_fib n = 148 | match n with 149 | | 0 | 1 -> n 150 | | _ -> naive_fib (n-1) + naive_fib (n-2) 151 | ``` 152 | 153 | 对应的 Haskell 代码是 154 | 155 | ```haskell 156 | fib 0 = 0 157 | fib 1 = 1 158 | fib n = fib (n-1) + fib (n-2) 159 | ``` 160 | 161 | ```ocaml 162 | assert begin 163 | fib 10 = 55 164 | && fib_let_star 10 = 55 165 | && imp_fib 10 = 55 166 | && naive_fib 10 = 55 167 | end 168 | ``` -------------------------------------------------------------------------------- /Paradigms/Continuation.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：续延 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：简单 OCaml 基础 6 | 7 | ## 续延 8 | 9 | 续延（Continuation）是指代表一个程序未来的函数，其参数是一个程序过去计算的结果。 10 | 11 | 比如对于这个程序： 12 | 13 | ```ocaml 14 | let demo () = 15 | let i = ref 1 in 16 | i := !i + 1; 17 | Printf.printf "%d\n" !i 18 | ``` 19 | 20 | 它第二行以及之后的续延就是： 21 | 22 | ```ocaml 23 | let _cont2 i = 24 | i := !i + 1; 25 | Printf.printf "%d\n" !i 26 | ``` 27 | 28 | 而第三行之后的续延是： 29 | 30 | ```ocaml 31 | let _cont3 i = 32 | Printf.printf "%d\n" !i 33 | ``` 34 | 35 | 实际上可以把这整个程序的每一行改成一个续延然后用函数调用串起来变成和刚才的程序一样的东西： 36 | 37 | ```ocaml 38 | let rec cont1 () = 39 | let i = ref 1 in 40 | cont2 i 41 | and cont2 i = 42 | i := !i + 1; 43 | cont3 i 44 | and cont3 i = 45 | Printf.printf "%d\n" !i 46 | 47 | let demo_cont () = 48 | cont1 () 49 | ``` 50 | 51 | ## 续延传递风格 52 | 53 | 续延传递风格（Continuation-Passing Style, CPS）是指把程序的续延作为函数的参数来获取函数返回值的编程思路。 54 | 55 | 听上去很难理解，把上面的三个 `cont` 函数改成CPS就很好理解了： 56 | 57 | ```ocaml 58 | let logic1 f = 59 | let i = ref 1 in 60 | f i 61 | let logic2 i f = 62 | i := !i + 1; 63 | f i 64 | let logic3 i f = 65 | Printf.printf "%d\n" !i; 66 | f i 67 | 68 | let demo_cps () = 69 | logic1 ( (* retrieve the return value i *) 70 | fun i -> logic2 i ( 71 | fun i -> logic3 i ( 72 | fun _i -> ()))) 73 | ``` 74 | 75 | 每个 `logic_n` 函数的最后一个参数 `f` 就是整个程序的续延，而在每个函数的逻辑结束后整个程序的续延也就是未来会被调用。而 `demo_cps` 函数把整个程序组装起来。 76 | 77 | 读者可能已经注意到，`demo_cps` 函数写法很像 Monad。实际上这个写法就是 Monad 的写法， Monad 的写法就是 CPS。 78 | 79 | 另一个角度来说，这也是回调函数的写法，每个 `logic_n` 函数完成逻辑后调用了回调函数 `f` 来完成剩下的逻辑。实际上，异步回调思想很大程度上就是 CPS 。 80 | 81 | > 注： 82 | > 83 | > 个人理解所有的 CPS 应该都可以被改写成 Monad，而 Monad 调整一下类型应该也可以改写成 CPS。 84 | 85 | ## 有界续延 86 | 87 | 考虑有另一个函数 `call_t` 调用了 `demo_cps` 函数，如： 88 | 89 | ```ocaml 90 | let call_t () = 91 | CPS.demo_cps (); 92 | Printf.printf "3\n" 93 | } 94 | ``` 95 | 96 | 那么对于 `logic` 函数来说调用的 `f` 这个续延并不包括 `call_t` 中的打印语句，那么实际上 `f` 这个续延并不是整个函数的未来而是 `demo_cps` 这个函数局部的未来。 97 | 98 | 这样代表局部程序的未来的函数就叫有界续延（Delimited Continuation）。 99 | 100 | 实际上在大多时候用的比较多的还是有界续延，因为在获取整个程序的续延还是比较困难的，这需要全用 CPS 的写法。 101 | 102 | ## 异常 103 | 104 | 拿到了有界续延我们就能实现一大堆控制流魔法，这里拿异常处理举个例子，通过CPS写法自己实现一个 `try-throw` 。 105 | 106 | 首先最基本的想法是把每次调用 `try` 的 `throw` 函数保存起来，由于 `try` 可层层嵌套所以每次压入栈中，然后 `throw` 的时候将最近的 `throw` 函数取出来调用即可 107 | 108 | ```ocaml 109 | (* try and else is OCaml keyword so (as usual) we'll append `_` *) 110 | 111 | (* A type safe version of try_throw *) 112 | type ('r, 'e, 'o) body = ('e, 'o) throw -> ('r, 'o) else_ -> 'o final -> 'o 113 | and ('e, 'o) throw = 'e -> 'o final -> 'o 114 | and ('r, 'o) else_ = 'r -> 'o final -> 'o 115 | and 'o final = 'o -> 'o 116 | 117 | type ('r, 'e, 'o) try_throw = { 118 | body : ('r, 'e, 'o) body; 119 | throw : ('e, 'o) throw; 120 | else_ : ('r, 'o) else_; 121 | final : 'o final; 122 | } 123 | ``` 124 | 125 | 这里 `body` 的所有参数和 `throw` 和 `else_` 的第二个传入参数都是有界续延。如果 `body` 不能正确处理，可以调用 `throw` 来处理错误；若可以正确处理，可以调用 `else_` 126 | 127 | 有了 `try-throw` 就可以按照CPS风格调用它们来达到处理异常的目的： 128 | 129 | ```ocaml 130 | let try_ { body; throw; else_; final } = 131 | body throw else_ final 132 | 133 | type div_with_zero = unit 134 | let div_with_zero = () 135 | 136 | let try_div (a: int) (b: int): int option = 137 | try_ { 138 | body = (fun throw else_ final -> ( 139 | Printf.printf "try\n"; 140 | if b = 0 then (throw div_with_zero final) else (else_ (a / b) final) 141 | )); 142 | throw = (fun () final -> ( 143 | Printf.printf "caught\n"; 144 | final None 145 | )); 146 | else_ = (fun i final -> ( 147 | Printf.printf "else: %d\n" i; 148 | final (Some i) 149 | )); 150 | final = (fun o -> ( 151 | Printf.printf "final\n"; 152 | o 153 | )); 154 | } 155 | ``` 156 | 157 | 调用 `try_div 4 0` 会得到： 158 | 159 | ``` 160 | try 161 | caught 162 | final 163 | ``` 164 | 165 | 而调用 `try_div 4 2` 会得到： 166 | 167 | ``` 168 | try 169 | else: 2 170 | final 171 | ``` 172 | 173 | > 注： 174 | > 175 | > 异常其实在 OCaml 中拥有对应的类型，即 Extensible variant types （可扩展变体类型？编者并不知道它的正式名称，欢迎 Issue / PR 直接修改此段）。因篇幅限制，此处使用了 `unit` 代替。感兴趣的读者可以阅读下方的链接 （不建议人脑 parse sytax tree，最好先从底下的例子入手）。 176 | > 177 | > 参考： 178 | > 179 | > [OCaml 官方文档](https://ocaml.org/manual/extensiblevariants.html) 180 | -------------------------------------------------------------------------------- /TheoryOfComputation/ScottE.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：斯科特编码 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能：构造演算， ADT ，μ 6 | 7 | > 注： 8 | > 9 | > 得益于 OCaml 优秀 (?) 的类型系统，本章中我们可以使用 OCaml 直接演示这些魔法的具体实现——也就是说，和别的改写版本不同，我们可以方便地在此章中运行我们写出的魔法。但愿这会极大地方便各位读者的理解。 10 | > 11 | > 再注： 12 | > 13 | > 编者并不认同本章的难度；其实，在接触过 System-F 后，本章的内容应当是显而易见的，而且只要见过一次就会印象深刻。或许这是偏见吧。总之，希望您能看的开心。 14 | 15 | 斯科特编码（Scott Encoding）可以在 λ 演算上编码 ADT 。其核心思想就是利用解构函数来处理和类型不同的分支，比如对于如下类型： 16 | 17 | ```ocaml 18 | type ('a, 'b) either = 19 | | Left of 'a 20 | | Right of 'b 21 | ``` 22 | 23 | 在构造演算中拥有类型： 24 | 25 | ``` 26 | Either = λ A: *. λ B: *. (C: *) → (A → C) → (B → C) → C 27 | ``` 28 | 29 | 它接受两个解构函数，分别用来处理 Left 分支和 Right 分支然后返回其中一个分支的处理结果。 30 | 31 | 翻译成 OCaml 代码的话： 32 | 33 | ```ocaml 34 | type ('a, 'b, 'r) either = ('a -> 'r) -> ('b -> 'r) -> 'r 35 | ``` 36 | 37 | 可以按照这个类型签名构造出以下两个类型构造器： 38 | 39 | ``` 40 | Left = λ A: *. λ B: *. λ val: A. (λ C: *. λ l: A → C. λ r: B → C. l val) 41 | Right = λ A: *. λ B: *. λ val: B. (λ C: *. λ l: A → C. λ r: B → C. r val) 42 | ``` 43 | 44 | 乍一看挺复杂的，不过两个构造器具有非常相似的结构，区别仅仅是 `val` 的类型和最内侧调用的函数。实际上构造一个 `Left` 的值时先填入对应 `Either` 的类型参数然后再填入储存的值就可以得到一个符合 `Either` 类型签名的实例，解构时填入不同分支的解构函数就一定会得到 `Left` 分支解构函数处理的结果。 45 | 46 | 翻译成 OCaml 代码的话： 47 | 48 | ```ocaml 49 | let left: 'a -> ('a, 'b, 'r) either = 50 | fun v -> (fun l -> fun _r -> l v) 51 | let right: 'b -> ('a, 'b, 'r) either = 52 | fun v -> (fun _l -> fun r -> r v) 53 | ``` 54 | 55 | 注意到原本函数传入时的很多类型参数（比如 `A`）被 OCaml 自动省去了，因为 OCaml 的 type checker 会帮我们自动推导出需要传入什么类型参数。多是一件美事啊。不过在定义类型时（如 `type either`）就必须悉数列出了。 56 | 57 | > 注： 58 | > 59 | > 请读者思考解构函数 `case` 的类型签名和实现方式。答案见对应 `.ml` 文件。 60 | 61 | 再举个 `List` 的例子： 62 | 63 | ``` 64 | List = λ T: *. (μ L: *. (R: *) → R → (T → L → R) → R) 65 | 66 | Nil = λ T: *. (λ R: *. λ nil: R. λ cons: T → List T → R. nil) 67 | Cons = λ T: *. λ val: T. λ next: List T. 68 | (λ R: *. λ nil: R. λ cons: T → List T → T. cons val next) 69 | 70 | map = λ A: *. λ B: *. λ f: A → B. μ m: List A → List B. 71 | λ list: List A. 72 | list (List B) 73 | (Nil B) 74 | (λ x: A. λ xs: List A. Cons B (f x) (m xs)) 75 | ``` 76 | 77 | 其 OCaml 版本为： 78 | 79 | ```ocaml 80 | module List = struct 81 | type ('t, 'r) list = 'r -> ('t -> 'r -> 'r) -> 'r 82 | let nil: ('t, 'r) list = 83 | fun base -> fun _f -> base 84 | let cons: 't -> ('t, 'r) list -> ('t, 'r) list = 85 | fun t list -> 86 | fun base -> fun f -> 87 | f t (list base f) 88 | let map: ('a -> 'b) -> ('a, 'r) list -> ('b, 'rr) list = 89 | fun f list -> 90 | list nil (fun x xs -> cons (f x) xs) 91 | let fold: ('r, 't) list -> 'r -> ('t -> 'r -> 'r) -> 'r = 92 | fun list base f -> 93 | list base f 94 | end 95 | ``` 96 | 97 | > 注： 98 | > 99 | > 这里的翻译大多非常直白，但有一个小坑，那就是 `map` 的类型签名。 100 | > 101 | > `val map: ('a -> 'b) -> ('a, 'r) list -> ('b, 'rr) list` 102 | > 103 | > 注意到这两个 `list` 的 result `'r` 不应当是同一个类型，因为这是两个不同的 `list`。编者此前就写错了，导致一直类型报错，过了好久才意识过来 (⋟﹏⋞) 104 | 105 | 也就是说，积类型 `A * B * ... * Z` 会被翻译为 106 | 107 | ``` 108 | (A: *) → (B: *) → ... → (Z: *) → 109 | (Res: *) → (A → B → ... → Z → Res) → Res 110 | ``` 111 | 112 | ```ocaml 113 | type ('a, 'b, ..., 'r) prod = 'a -> 'b -> ... -> 'r 114 | ``` 115 | 116 | 和类型 `A + B + ... + Z` 会被翻译为 117 | 118 | ``` 119 | (A: *) → (B: *) → ... → (Z: *) → 120 | (Res: *) → (A → Res) → (B → Res) → ... → (Z → Res) → Res 121 | ``` 122 | 123 | ```ocaml 124 | type ('a, 'b, ..., 'r) sum = ('a -> 'r) -> ('b -> 'r) -> ... -> 'r 125 | ``` 126 | 127 | 并且两者可以互相嵌套从而构成复杂的类型。 128 | 129 | 如果给和类型的每个分支取个名字，并且允许在解构调用的时候按照名字索引，随意改变分支顺序，在解糖阶段把解构函数调整成正确的顺序那么就可以得到很多函数式语言里面的模式匹配（Pattern match）。然后就可以像这样表示 `List` ： 130 | 131 | ``` 132 | type List: * → * 133 | | Nil: (T: *) → List T 134 | | Cons: (T: *) → T → List T → List T 135 | ``` 136 | 137 | > 注： 138 | > 139 | > 像，太像了。 140 | 141 | 解糖的时候利用类型签名可以重建构造函数。像这样使用 `List` ： 142 | 143 | ``` 144 | map = λ A: *. λ B: *. λ f: A → B. μ m: List A → List B. 145 | λ list: List A. 146 | match list (List B) 147 | | Cons _ x xs → Cons B (f x) (m xs) 148 | | Nil _ → Nil B 149 | ``` 150 | 151 | > 注： 152 | > 153 | > 坚持到这里的读者，恭喜你重新（至少在概念上）发明了 OCaml，或者说 meta language。 154 | > 155 | > ……其实准确说是体验了一番 HM 类型系统（[Hindley–Milner type system](https://en.wikipedia.org/wiki/Hindley%E2%80%93Milner_type_system)）。 156 | -------------------------------------------------------------------------------- /Paradigms/TableDriven.md: -------------------------------------------------------------------------------- 1 | # 十分钟魔法练习：表驱动编程 2 | 3 | ### By 「玩火」 改写 「光吟」 4 | 5 | > 前置技能： 简单 OCaml 基础 6 | 7 | ## Intro 8 | 9 | 表驱动编程被称为是普通程序员和高级程序员的分水岭，而它本身并没有那么难，本身是一种比较基础的写法，甚至很多时候不知道的人也能常常重新发明它。 10 | 11 | 而它本身是锻炼抽象思维的良好途径，几乎所有复杂的系统都能利用表驱动法来进行进一步抽象优化，而这也非常考验程序员的水平。 12 | 13 | ## 数据表 14 | 15 | 学编程最开始总会遇到这样的经典习题： 16 | 17 | > 输入成绩，返回等第，90 以上 A ，80 以上 B ，70 以上 C ，60 以上 D ，否则为 E 18 | 19 | 作为一道考察 `if` 语句的习题初学者总是会写出这样的代码： 20 | 21 | ```ocaml 22 | let get_level_naive score = 23 | if score >= 90 then "A" else 24 | if score >= 80 then "B" else 25 | if score >= 70 then "C" else 26 | if score >= 60 then "D" else 27 | "E" 28 | ``` 29 | 30 | 等学了 `match` 语句以后可以将它改成： 31 | 32 | ```ocaml 33 | let get_level_match score = 34 | match score with 35 | | s when s >= 90 -> "A" 36 | | s when s >= 80 -> "B" 37 | | s when s >= 70 -> "C" 38 | | s when s >= 60 -> "D" 39 | | _ -> "E" 40 | ``` 41 | 42 | > 注：真的会有除了我这种代码洁癖以外的人这么写代码吗 ( •︠ˍ•︡ ) 43 | 44 | 更聪明的人可能会把它改写成 `match (s / 10) with ...` 的形式。 45 | 46 | 但是这些写法都有个同样的问题：如果需要不断添加等第个数那最终 `get_level(_naive)` 函数就会变得很长很长，最终变得不可维护。 47 | 48 | 学会循环和数组后回头再看这个程序，会发现这个程序由反复的 `if score >= _ { return _; }` 构成，可以改成循环结构，把对应的数据塞进数组： 49 | 50 | ```ocaml 51 | let get_level_table score = 52 | let tbl = [ 53 | (60, "D"); 54 | (70, "C"); 55 | (80, "B"); 56 | (90, "A"); 57 | ] in 58 | List.fold_left (fun current (lb, grade) -> ( 59 | if score >= lb then grade else current 60 | )) "E" tbl 61 | ``` 62 | 63 | 这样的好处是只需要在两个数组中添加一个值就能加一组等第而不需要碰 `get_level` 的逻辑代码。 64 | 65 | 而且进一步讲，数组可以被存在外部文件中作为配置文件，与源代码分离，这样不用重新编译就能轻松添加一组等第。 66 | 67 | 这就是表驱动编程最初阶的形式，通过抽取相似的逻辑并把不同的数据放入表中来避免逻辑重复，提高可读性和可维护性。 68 | 69 | 再举个带状态修改的例子，写一个有特定商品的购物车： 70 | 71 | ```ocaml 72 | module ShopList = struct 73 | type item = { 74 | name : string; 75 | price : int; 76 | count : int; 77 | } 78 | type t = item list 79 | let create_item name price = { 80 | name; price; count = 0 81 | } 82 | let create = [ 83 | create_item "water" 1; 84 | create_item "cola" 2; 85 | create_item "choco" 5; 86 | ] 87 | let buy (shop_list: t) (name': string): t = 88 | List.map (fun ({ name; price; count } as item) -> ( 89 | if name = name' then { name; price; count = count + 1 } 90 | else item 91 | )) shop_list 92 | let to_string (shop_list: t): string = 93 | shop_list 94 | |> List.map (fun { name; price; count } -> ( 95 | Printf.sprintf "%s ($%d/per): %d" name price count 96 | )) 97 | |> String.concat "\n" 98 | end 99 | assert begin 100 | let shop_list = ShopList.create in 101 | let shop_list = ShopList.buy shop_list "cola" in 102 | String.equal 103 | (ShopList.to_string shop_list) 104 | "water ($1/per): 0\ncola ($2/per): 1\nchoco ($5/per): 0" 105 | end; 106 | ``` 107 | 108 | > 注： 109 | > 110 | > 本例中虽然有状态修改，但我们并没有使用 OCaml 的可变特性（比如 `ref`）。这是因为可变性在函数式语言的多数数据结构中是可选的。 111 | > 112 | > 从内存的角度来考虑： 113 | > 114 | > 1. 当数据需要被“改变”时，可以改为返回一个新的数据 115 | > 2. 当数据被创造时，我们不需要新的实例；我们只需要保留一个全局的empty实例。 116 | > 3. 当数据被销毁时，我们只需要单纯地不再使用它；垃圾回收器（Garbage Collector）会负责在其生命周期结束后回收其内存。 117 | > 118 | > 换个角度来说，可变性其实提供了副作用，让函数调用看起来更像命令而非数据的映射。这会带来很深远的影响：我们不再可以借助类型系统来检查我们的函数是否正确（过一会我们会深入这个话题）。反过来说，选择了不可变的数据结构就意味着要向类型检查器证明类型的正确，很不幸，有时这不是免费的。 119 | > 120 | > 话说回来，两者其实在 OCaml 标准库里都有使用，如 `Hashtbl` 是可变的，而 `Map` 是不可变的。多数时候两者在性能上不会体现出差异，而且不可变的版本也可以轻易包装成可变的版本。当然，可以认为此处选择不可变版本纯粹是改编者的喜好。 121 | 122 | ## 逻辑表 123 | 124 | 初学者在写习题的时候还会碰到另一种没啥规律的东西，比如： 125 | 126 | > 用户输入 0 时购买 water ，输入 1 时购买 cola ，输入 2 时打印购买的情况，输入 3 退出系统。 127 | 128 | 看似没有可以抽取数据的相似逻辑。但是细想一下，真的没有公共逻辑吗？实际上公共的逻辑在于这些都是在同一个用户输入情况下触发的事件，区别就在于不同输入触发的逻辑不一样，那么其实可以就把逻辑制成表： 129 | 130 | ```ocaml 131 | module SimpleUI = struct 132 | type shop_list = ShopList.t 133 | type output = 134 | | ShopList of shop_list 135 | | Print 136 | | Exit 137 | type t = { 138 | shop_list : shop_list; 139 | events : (shop_list -> output) list 140 | } 141 | let create = { 142 | shop_list = ShopList.create; 143 | events = [ 144 | (fun s -> ShopList (ShopList.buy s "water")); 145 | (fun s -> ShopList (ShopList.buy s "cola")); 146 | (fun _ -> Print); 147 | (fun _ -> Exit); 148 | ] 149 | } 150 | let run_event ui event = 151 | let { events; shop_list } = ui in 152 | match (List.nth events event) shop_list with 153 | | ShopList s -> { events; shop_list = s } 154 | | Print -> 155 | Printf.printf "%s\n" (ShopList.to_string shop_list); 156 | ui 157 | | Exit -> exit 0 158 | end 159 | ``` 160 | 161 | 这样如果需要添加一个用户输入指令只需要在 `event` 表中添加对应逻辑和索引， 修改用户的指令对应的逻辑也变得非常方便。 这样用户输入和时间触发两个逻辑就不会串在一起，维护起来更加方便。 162 | 163 | > 注： 164 | > 165 | > 编者在此处为自己此前的选择买了单。由于不希望选择带副作用的版本，我们需要把“副作用”编码进类型系统来通过类型检查。因此相比 Java 版本，此处多出了 166 | > 167 | > ```ocaml 168 | > type output = 169 | > | ShopList of shop_list 170 | > | Print 171 | > | Exit 172 | > ``` 173 | > 174 | > 这是一个把输出内嵌到类型系统里的例子。虽然输入 `2` / `3` 的时候不会改变数据，但是我们需要表示出将要做的行为，并在run的时候体现出来。 175 | > 176 | > 聪明的读者可以尝试改写 `create` 里的表和 `run_event` 来移除 `type output`。 177 | 178 | ## 自动机 179 | 180 | 如果再加个逻辑表能修改的跳转状态就构成了自动机（Automaton）。这里举个例子，利用自动机实现了一个复杂的 UI ，在 `menu` 界面可以选择开始玩或者退出，在 `move` 界面可以选择移动或者打印位置或者返回 `menu` 181 | 界面： 182 | 183 | // Todo.. 184 | 185 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Attribution 4.0 International 2 | 3 | ======================================================================= 4 | 5 | Creative Commons Corporation ("Creative Commons") is not a law firm and 6 | does not provide legal services or legal advice. Distribution of 7 | Creative Commons public licenses does not create a lawyer-client or 8 | other relationship. Creative Commons makes its licenses and related 9 | information available on an "as-is" basis. Creative Commons gives no 10 | warranties regarding its licenses, any material licensed under their 11 | terms and conditions, or any related information. Creative Commons 12 | disclaims all liability for damages resulting from their use to the 13 | fullest extent possible. 14 | 15 | Using Creative Commons Public Licenses 16 | 17 | Creative Commons public licenses provide a standard set of terms and 18 | conditions that creators and other rights holders may use to share 19 | original works of authorship and other material subject to copyright 20 | and certain other rights specified in the public license below. The 21 | following considerations are for informational purposes only, are not 22 | exhaustive, and do not form part of our licenses. 23 | 24 | Considerations for licensors: Our public licenses are 25 | intended for use by those authorized to give the public 26 | permission to use material in ways otherwise restricted by 27 | copyright and certain other rights. Our licenses are 28 | irrevocable. Licensors should read and understand the terms 29 | and conditions of the license they choose before applying it. 30 | Licensors should also secure all rights necessary before 31 | applying our licenses so that the public can reuse the 32 | material as expected. Licensors should clearly mark any 33 | material not subject to the license. This includes other CC- 34 | licensed material, or material used under an exception or 35 | limitation to copyright. More considerations for licensors: 36 | wiki.creativecommons.org/Considerations_for_licensors 37 | 38 | Considerations for the public: By using one of our public 39 | licenses, a licensor grants the public permission to use the 40 | licensed material under specified terms and conditions. If 41 | the licensor's permission is not necessary for any reason--for 42 | example, because of any applicable exception or limitation to 43 | copyright--then that use is not regulated by the license. Our 44 | licenses grant only permissions under copyright and certain 45 | other rights that a licensor has authority to grant. Use of 46 | the licensed material may still be restricted for other 47 | reasons, including because others have copyright or other 48 | rights in the material. A licensor may make special requests, 49 | such as asking that all changes be marked or described. 50 | Although not required by our licenses, you are encouraged to 51 | respect those requests where reasonable. More considerations 52 | for the public: 53 | wiki.creativecommons.org/Considerations_for_licensees 54 | 55 | ======================================================================= 56 | 57 | Creative Commons Attribution 4.0 International Public License 58 | 59 | By exercising the Licensed Rights (defined below), You accept and agree 60 | to be bound by the terms and conditions of this Creative Commons 61 | Attribution 4.0 International Public License ("Public License"). To the 62 | extent this Public License may be interpreted as a contract, You are 63 | granted the Licensed Rights in consideration of Your acceptance of 64 | these terms and conditions, and the Licensor grants You such rights in 65 | consideration of benefits the Licensor receives from making the 66 | Licensed Material available under these terms and conditions. 67 | 68 | 69 | Section 1 -- Definitions. 70 | 71 | a. Adapted Material means material subject to Copyright and Similar 72 | Rights that is derived from or based upon the Licensed Material 73 | and in which the Licensed Material is translated, altered, 74 | arranged, transformed, or otherwise modified in a manner requiring 75 | permission under the Copyright and Similar Rights held by the 76 | Licensor. For purposes of this Public License, where the Licensed 77 | Material is a musical work, performance, or sound recording, 78 | Adapted Material is always produced where the Licensed Material is 79 | synched in timed relation with a moving image. 80 | 81 | b. Adapter's License means the license You apply to Your Copyright 82 | and Similar Rights in Your contributions to Adapted Material in 83 | accordance with the terms and conditions of this Public License. 84 | 85 | c. Copyright and Similar Rights means copyright and/or similar rights 86 | closely related to copyright including, without limitation, 87 | performance, broadcast, sound recording, and Sui Generis Database 88 | Rights, without regard to how the rights are labeled or 89 | categorized. For purposes of this Public License, the rights 90 | specified in Section 2(b)(1)-(2) are not Copyright and Similar 91 | Rights. 92 | 93 | d. Effective Technological Measures means those measures that, in the 94 | absence of proper authority, may not be circumvented under laws 95 | fulfilling obligations under Article 11 of the WIPO Copyright 96 | Treaty adopted on December 20, 1996, and/or similar international 97 | agreements. 98 | 99 | e. Exceptions and Limitations means fair use, fair dealing, and/or 100 | any other exception or limitation to Copyright and Similar Rights 101 | that applies to Your use of the Licensed Material. 102 | 103 | f. Licensed Material means the artistic or literary work, database, 104 | or other material to which the Licensor applied this Public 105 | License. 106 | 107 | g. Licensed Rights means the rights granted to You subject to the 108 | terms and conditions of this Public License, which are limited to 109 | all Copyright and Similar Rights that apply to Your use of the 110 | Licensed Material and that the Licensor has authority to license. 111 | 112 | h. Licensor means the individual(s) or entity(ies) granting rights 113 | under this Public License. 114 | 115 | i. Share means to provide material to the public by any means or 116 | process that requires permission under the Licensed Rights, such 117 | as reproduction, public display, public performance, distribution, 118 | dissemination, communication, or importation, and to make material 119 | available to the public including in ways that members of the 120 | public may access the material from a place and at a time 121 | individually chosen by them. 122 | 123 | j. Sui Generis Database Rights means rights other than copyright 124 | resulting from Directive 96/9/EC of the European Parliament and of 125 | the Council of 11 March 1996 on the legal protection of databases, 126 | as amended and/or succeeded, as well as other essentially 127 | equivalent rights anywhere in the world. 128 | 129 | k. You means the individual or entity exercising the Licensed Rights 130 | under this Public License. Your has a corresponding meaning. 131 | 132 | 133 | Section 2 -- Scope. 134 | 135 | a. License grant. 136 | 137 | 1. Subject to the terms and conditions of this Public License, 138 | the Licensor hereby grants You a worldwide, royalty-free, 139 | non-sublicensable, non-exclusive, irrevocable license to 140 | exercise the Licensed Rights in the Licensed Material to: 141 | 142 | a. reproduce and Share the Licensed Material, in whole or 143 | in part; and 144 | 145 | b. produce, reproduce, and Share Adapted Material. 146 | 147 | 2. Exceptions and Limitations. For the avoidance of doubt, where 148 | Exceptions and Limitations apply to Your use, this Public 149 | License does not apply, and You do not need to comply with 150 | its terms and conditions. 151 | 152 | 3. Term. The term of this Public License is specified in Section 153 | 6(a). 154 | 155 | 4. Media and formats; technical modifications allowed. The 156 | Licensor authorizes You to exercise the Licensed Rights in 157 | all media and formats whether now known or hereafter created, 158 | and to make technical modifications necessary to do so. The 159 | Licensor waives and/or agrees not to assert any right or 160 | authority to forbid You from making technical modifications 161 | necessary to exercise the Licensed Rights, including 162 | technical modifications necessary to circumvent Effective 163 | Technological Measures. For purposes of this Public License, 164 | simply making modifications authorized by this Section 2(a) 165 | (4) never produces Adapted Material. 166 | 167 | 5. Downstream recipients. 168 | 169 | a. Offer from the Licensor -- Licensed Material. Every 170 | recipient of the Licensed Material automatically 171 | receives an offer from the Licensor to exercise the 172 | Licensed Rights under the terms and conditions of this 173 | Public License. 174 | 175 | b. No downstream restrictions. You may not offer or impose 176 | any additional or different terms or conditions on, or 177 | apply any Effective Technological Measures to, the 178 | Licensed Material if doing so restricts exercise of the 179 | Licensed Rights by any recipient of the Licensed 180 | Material. 181 | 182 | 6. No endorsement. Nothing in this Public License constitutes or 183 | may be construed as permission to assert or imply that You 184 | are, or that Your use of the Licensed Material is, connected 185 | with, or sponsored, endorsed, or granted official status by, 186 | the Licensor or others designated to receive attribution as 187 | provided in Section 3(a)(1)(A)(i). 188 | 189 | b. Other rights. 190 | 191 | 1. Moral rights, such as the right of integrity, are not 192 | licensed under this Public License, nor are publicity, 193 | privacy, and/or other similar personality rights; however, to 194 | the extent possible, the Licensor waives and/or agrees not to 195 | assert any such rights held by the Licensor to the limited 196 | extent necessary to allow You to exercise the Licensed 197 | Rights, but not otherwise. 198 | 199 | 2. Patent and trademark rights are not licensed under this 200 | Public License. 201 | 202 | 3. To the extent possible, the Licensor waives any right to 203 | collect royalties from You for the exercise of the Licensed 204 | Rights, whether directly or through a collecting society 205 | under any voluntary or waivable statutory or compulsory 206 | licensing scheme. In all other cases the Licensor expressly 207 | reserves any right to collect such royalties. 208 | 209 | 210 | Section 3 -- License Conditions. 211 | 212 | Your exercise of the Licensed Rights is expressly made subject to the 213 | following conditions. 214 | 215 | a. Attribution. 216 | 217 | 1. If You Share the Licensed Material (including in modified 218 | form), You must: 219 | 220 | a. retain the following if it is supplied by the Licensor 221 | with the Licensed Material: 222 | 223 | i. identification of the creator(s) of the Licensed 224 | Material and any others designated to receive 225 | attribution, in any reasonable manner requested by 226 | the Licensor (including by pseudonym if 227 | designated); 228 | 229 | ii. a copyright notice; 230 | 231 | iii. a notice that refers to this Public License; 232 | 233 | iv. a notice that refers to the disclaimer of 234 | warranties; 235 | 236 | v. a URI or hyperlink to the Licensed Material to the 237 | extent reasonably practicable; 238 | 239 | b. indicate if You modified the Licensed Material and 240 | retain an indication of any previous modifications; and 241 | 242 | c. indicate the Licensed Material is licensed under this 243 | Public License, and include the text of, or the URI or 244 | hyperlink to, this Public License. 245 | 246 | 2. You may satisfy the conditions in Section 3(a)(1) in any 247 | reasonable manner based on the medium, means, and context in 248 | which You Share the Licensed Material. For example, it may be 249 | reasonable to satisfy the conditions by providing a URI or 250 | hyperlink to a resource that includes the required 251 | information. 252 | 253 | 3. If requested by the Licensor, You must remove any of the 254 | information required by Section 3(a)(1)(A) to the extent 255 | reasonably practicable. 256 | 257 | 4. If You Share Adapted Material You produce, the Adapter's 258 | License You apply must not prevent recipients of the Adapted 259 | Material from complying with this Public License. 260 | 261 | 262 | Section 4 -- Sui Generis Database Rights. 263 | 264 | Where the Licensed Rights include Sui Generis Database Rights that 265 | apply to Your use of the Licensed Material: 266 | 267 | a. for the avoidance of doubt, Section 2(a)(1) grants You the right 268 | to extract, reuse, reproduce, and Share all or a substantial 269 | portion of the contents of the database; 270 | 271 | b. if You include all or a substantial portion of the database 272 | contents in a database in which You have Sui Generis Database 273 | Rights, then the database in which You have Sui Generis Database 274 | Rights (but not its individual contents) is Adapted Material; and 275 | 276 | c. You must comply with the conditions in Section 3(a) if You Share 277 | all or a substantial portion of the contents of the database. 278 | 279 | For the avoidance of doubt, this Section 4 supplements and does not 280 | replace Your obligations under this Public License where the Licensed 281 | Rights include other Copyright and Similar Rights. 282 | 283 | 284 | Section 5 -- Disclaimer of Warranties and Limitation of Liability. 285 | 286 | a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE 287 | EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS 288 | AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF 289 | ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS, 290 | IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION, 291 | WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR 292 | PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS, 293 | ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT 294 | KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT 295 | ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU. 296 | 297 | b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE 298 | TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, 299 | NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT, 300 | INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES, 301 | COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR 302 | USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN 303 | ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR 304 | DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR 305 | IN PART, THIS LIMITATION MAY NOT APPLY TO YOU. 306 | 307 | c. The disclaimer of warranties and limitation of liability provided 308 | above shall be interpreted in a manner that, to the extent 309 | possible, most closely approximates an absolute disclaimer and 310 | waiver of all liability. 311 | 312 | 313 | Section 6 -- Term and Termination. 314 | 315 | a. This Public License applies for the term of the Copyright and 316 | Similar Rights licensed here. However, if You fail to comply with 317 | this Public License, then Your rights under this Public License 318 | terminate automatically. 319 | 320 | b. Where Your right to use the Licensed Material has terminated under 321 | Section 6(a), it reinstates: 322 | 323 | 1. automatically as of the date the violation is cured, provided 324 | it is cured within 30 days of Your discovery of the 325 | violation; or 326 | 327 | 2. upon express reinstatement by the Licensor. 328 | 329 | For the avoidance of doubt, this Section 6(b) does not affect any 330 | right the Licensor may have to seek remedies for Your violations 331 | of this Public License. 332 | 333 | c. For the avoidance of doubt, the Licensor may also offer the 334 | Licensed Material under separate terms or conditions or stop 335 | distributing the Licensed Material at any time; however, doing so 336 | will not terminate this Public License. 337 | 338 | d. Sections 1, 5, 6, 7, and 8 survive termination of this Public 339 | License. 340 | 341 | 342 | Section 7 -- Other Terms and Conditions. 343 | 344 | a. The Licensor shall not be bound by any additional or different 345 | terms or conditions communicated by You unless expressly agreed. 346 | 347 | b. Any arrangements, understandings, or agreements regarding the 348 | Licensed Material not stated herein are separate from and 349 | independent of the terms and conditions of this Public License. 350 | 351 | 352 | Section 8 -- Interpretation. 353 | 354 | a. For the avoidance of doubt, this Public License does not, and 355 | shall not be interpreted to, reduce, limit, restrict, or impose 356 | conditions on any use of the Licensed Material that could lawfully 357 | be made without permission under this Public License. 358 | 359 | b. To the extent possible, if any provision of this Public License is 360 | deemed unenforceable, it shall be automatically reformed to the 361 | minimum extent necessary to make it enforceable. If the provision 362 | cannot be reformed, it shall be severed from this Public License 363 | without affecting the enforceability of the remaining terms and 364 | conditions. 365 | 366 | c. No term or condition of this Public License will be waived and no 367 | failure to comply consented to unless expressly agreed to by the 368 | Licensor. 369 | 370 | d. Nothing in this Public License constitutes or may be interpreted 371 | as a limitation upon, or waiver of, any privileges and immunities 372 | that apply to the Licensor or You, including from the legal 373 | processes of any jurisdiction or authority. 374 | 375 | 376 | ======================================================================= 377 | 378 | Creative Commons is not a party to its public licenses. 379 | Notwithstanding, Creative Commons may elect to apply one of its public 380 | licenses to material it publishes and in those instances will be 381 | considered the “Licensor.” The text of the Creative Commons public 382 | licenses is dedicated to the public domain under the CC0 Public Domain 383 | Dedication. Except for the limited purpose of indicating that material 384 | is shared under a Creative Commons public license or as otherwise 385 | permitted by the Creative Commons policies published at 386 | creativecommons.org/policies, Creative Commons does not authorize the 387 | use of the trademark "Creative Commons" or any other trademark or logo 388 | of Creative Commons without its prior written consent including, 389 | without limitation, in connection with any unauthorized modifications 390 | to any of its public licenses or any other arrangements, 391 | understandings, or agreements concerning use of licensed material. For 392 | the avoidance of doubt, this paragraph does not form part of the public 393 | licenses. 394 | 395 | Creative Commons may be contacted at creativecommons.org. --------------------------------------------------------------------------------