From 87632f82cb1cfffd56741e9f2356c1161323872e Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 20 Nov 2023 11:14:35 +0100 Subject: [PATCH 01/53] Empty commit From f0f931cddf9fe41d1b428ef37f20b62352a0383b Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 20 Nov 2023 16:12:30 +0100 Subject: [PATCH 02/53] New text on functors --- data/tutorials/language/1ms_01_functors.md | 510 ++++++++++++++------- 1 file changed, 354 insertions(+), 156 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 05f968fbae..6d745bd590 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -7,183 +7,381 @@ description: > category: "Module System" --- -Functors are probably one of the most complex features of OCaml, but you don't -have to use them extensively to be a successful OCaml programmer. Actually, -you may never have to define a functor yourself, but you will surely encounter -them in the standard library. They are the only way of using the Set and Map -modules, but using them is not so difficult. +## Introduction -## What Are Functors and Why Do We Need Them? +Learning goals: +- How to use a functor +- How to write a functor +- When to use a functor, some cases -A functor is a module that is parametrised by another module, just like a -function is a value which is parametrised by other values, the arguments. +A functor is just a parametrized module. -It allows one to parametrise a type by a value, which is not possible directly -in OCaml without functors. For example, we can define a functor that takes an -`int n` and returns a collection of array operations that work exclusively on -arrays of length `n`. If by mistake the programmer passes a regular array to one -of those functions, it will result in a compilation error. If we were not using -this functor but the standard array type, the compiler would not be able to -detect the error, and we would get a runtime error at some undetermined date in -the future, which is much worse. +**Prerequisites**: Transitive closure leading to modules. -## Using an Existing Functor +## Project Setup -The standard library defines a `Set` module, which provides a `Make` functor. -This functor takes one argument, which is a module that provides (at least) two -things: the type of elements, given as `t` and the comparison function given as -`compare`. The point of the functor is to ensure that the same comparison -function will always be used, even if the programmer makes a mistake. +This tutorial uses the [Dune](https://dune.build) build tool. Make sure to have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, `funkt.opam` and `funkt.ml`, the latter two are created empty. +```shell +$ mkdir funkt; cd funkt -For example, if we want to use sets of `ints`, we would do this: +$ touch funkt.opam funkt.ml +``` + +**`dune-project`** +```lisp +(lang dune 3.7) +``` + +**`dune`** +```lisp +(executable + (name funkt) + (public_name funkt) + (libraries str)) +``` + +Check this works using the `dune exec funkt` command, it shouldn't do anything (the empty file is valid OCaml syntax) but it shouldn't fail either. The stanza `libraries str` will be used later. + +## Using an Existing Functor: `Set.Make` + +The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows operations like union and intersection. To use the provided type and its associated [functions](/api/Set.S.html), it is required to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`. +```ocaml +module type OrderedType = sig + type t + val compare : t -> t -> int +end + +module type S = sig + (* ... *) +end + +module Make : functor (Ord : OrderedType) -> S +``` + +The functor `Set.Make` needs to be passed a module of type `Set.OrderedType` to produce a module of type `Set.S`. Here is how it can look like in our project: + +**`funkt.ml`** +```ocaml +module StringSet = Set.Make(String) +``` + +With this, the command `dune exec funkt` shouldn't do anything but it shouldn't fail either. Here is the meaning of that statement +- The module `funkt.StringSet` is defined +- The module `String` (from the standard library) is applied to the functor `Set.Make`. This is allowed because the `String` module satisfies the interface `Set.OrderedSet` + - It defines a type name `t` (which is an alias for `string`) + - It defines a function `compare` of type `t -> t -> bool`, that is the function `String.compare` +- The result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, it has the signature `Set.S`. + +Add some code to the `funkt.ml` file to produce an executable that does something and check the result. + +**`funkt.ml`** +```ocaml +module StringSet = Set.Make(String) + +let _ = + In_channel.input_lines stdin + |> List.concat_map Str.(split (regexp "[ \t.,;:()]+")) + |> StringSet.of_list + |> StringSet.iter print_endline +``` + +Here are the types of the functions used throughout the pipe +- `In_channel.input_lines : in_channel -> string list` +- `Str.(split (regexp "[ \t.,;:()]+")) : string -> string list` +- `List.concat_map : ('a -> 'b list) -> 'a list -> 'b list` +- `StringSet.of_list : string list -> StringSet.t` and +- `StringSet.iter : StringSet.t -> unit` + +This reads the following way: +- Read lines of text from standard input, produce a list of strings +- Split each string using a regular expression, flatten the list of lists into a list +- Convert the list of strings into a set +- Display each element of the set + +The functions `StringSet.of_list` and `StringSet.iter` are available as the result of the functor application. + +```shell +$ dune exec funkt < dune +executable +libraries +name +public_name +str +funkt +``` + +There are no duplicates in a `Set`. Therefore, the string `"funkt"` is only displayed once although it appears twice in the file `dune`. + +## Extending a Module with a Functor + +Using the `include` statement, here is an alternate way to expose the module created by `Set.Make(String)`. + +**`funkt.ml`** +```ocaml +module String = struct + include String + module Set = Set.Make(String) +end + +let _ = + stdin + |> In_channel.input_lines + |> List.concat_map Str.(split (regexp "[ \t.,;:()]+")) + |> String.Set.of_list + |> String.Set.iter print_endline +``` + +This allows seemingly extending the module `String` with a submodule `Set`. Check the behaviour using `dune exec funkt < dune`. + +## Parametrized Implementations + +### The Standard Library: `Set`, `Map` and `Hashtbl` + +Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrized, in other words, functors. That's the case for the sets, maps and hash tables provided by the standard library. It works in a contract way: +* if you provide a module that implements what is expected (the parameter interface); +* the functor returns a module that implements what is promised (the result interface) + +Here is the signature of the module that the functors `Set.Make` and `Map.Make` expect: +```ocaml +module type OrderedType = sig + type t + val compare : t -> t -> int +end +``` + +Here is the signature of the module that the functor `Hashtbl.Make` expects: +```ocaml +module type HashedType = sig + type t + val equal : t -> t -> bool + val hash : t -> int +end +``` + +**Note**: `Ordered.t` is a type of set elements or map keys, `Set.S.t` is a type of set and `Map.S.t` is a type of mapping. `HashedType.t` is a type of hash table keys and `Hashtbl.S.t` is a type of hash table. + +The functors `Set.Make`, `Map.Make` and `Hashtbl.Make` return modules satisfying the interfaces `Set.S`, `Map.S` and `Hashtbl.S` (respectively) that all contain an abstract type `t` and associated functions. Refer to the documentation for the details about what they provide: +* [`Set.S`](/api/Set.S.html) +* [`Map.S`](/api/Map.S.html) +* [`Hashtbl.S`](/api/Hashtbl.S.html) + +## Custom Parametrized Implementation + +There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Example include binary heaps, leftist heaps, binomial heaps or Fibonacci heaps. + +What kind of data structures and algorithms are used to implement a heap is not discussed in this document. + +The common prerequisite to implementing any kind of heap is the availability of a means to compare the elements they contain. That's the same signature as the parameter of `Set.Make` and `Map.Make`: +```ocaml +module type OrderedType = sig + type t + val compare : t -> t -> int +end +``` +Using such a parameter, a heap implementation must provide at least this interface ```ocaml -# module Int_set = - Set.Make (struct - type t = int - let compare = compare - end);; -module Int_set : - sig - type elt = int - type t - val empty : t - val is_empty : t -> bool - val mem : elt -> t -> bool - val add : elt -> t -> t - val singleton : elt -> t - val remove : elt -> t -> t - val union : t -> t -> t - val inter : t -> t -> t - val disjoint : t -> t -> bool - val diff : t -> t -> t - val compare : t -> t -> elt - val equal : t -> t -> bool - val subset : t -> t -> bool - val iter : (elt -> unit) -> t -> unit - val map : (elt -> elt) -> t -> t - val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a - val for_all : (elt -> bool) -> t -> bool - val exists : (elt -> bool) -> t -> bool - val filter : (elt -> bool) -> t -> t - val filter_map : (elt -> elt option) -> t -> t - val partition : (elt -> bool) -> t -> t * t - val cardinal : t -> elt - val elements : t -> elt list - val min_elt : t -> elt - val min_elt_opt : t -> elt option - val max_elt : t -> elt - val max_elt_opt : t -> elt option - val choose : t -> elt - val choose_opt : t -> elt option - val split : elt -> t -> t * bool * t - val find : elt -> t -> elt - val find_opt : elt -> t -> elt option - val find_first : (elt -> bool) -> t -> elt - val find_first_opt : (elt -> bool) -> t -> elt option - val find_last : (elt -> bool) -> t -> elt - val find_last_opt : (elt -> bool) -> t -> elt option - val of_list : elt list -> t - val to_seq_from : elt -> t -> elt Seq.t - val to_seq : t -> elt Seq.t - val to_rev_seq : t -> elt Seq.t - val add_seq : elt Seq.t -> t -> t - val of_seq : elt Seq.t -> t - end -``` - -For sets of strings, it is even easier because the standard library provides a -`String` module with a type `t` and a function `compare`. If you were following -carefully, by now you must have guessed how to create a module to -manipulate string sets: +module type HeapType = sig + type elt + type t + val empty : t + val is_empty : t -> bool + val insert : t -> elt -> t + val merge : t -> t -> t + val find : t -> elt + val delete : t -> t +end +``` + +Heap implementations can be represented as functors from `OrderedType` into `HeapType`. Each kind of heap would be a different functor. +Here is the skeleton of a possible implementation. + +**heap.ml** ```ocaml -# module String_set = Set.Make (String);; -module String_set : - sig - type elt = string - type t = Set.Make(String).t - val empty : t - val is_empty : t -> bool - val mem : elt -> t -> bool - val add : elt -> t -> t - val singleton : elt -> t - val remove : elt -> t -> t - val union : t -> t -> t - val inter : t -> t -> t - val disjoint : t -> t -> bool - val diff : t -> t -> t - val compare : t -> t -> int - val equal : t -> t -> bool - val subset : t -> t -> bool - val iter : (elt -> unit) -> t -> unit - val map : (elt -> elt) -> t -> t - val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a - val for_all : (elt -> bool) -> t -> bool - val exists : (elt -> bool) -> t -> bool - val filter : (elt -> bool) -> t -> t - val filter_map : (elt -> elt option) -> t -> t - val partition : (elt -> bool) -> t -> t * t - val cardinal : t -> int - val elements : t -> elt list - val min_elt : t -> elt - val min_elt_opt : t -> elt option - val max_elt : t -> elt - val max_elt_opt : t -> elt option - val choose : t -> elt - val choose_opt : t -> elt option - val split : elt -> t -> t * bool * t - val find : elt -> t -> elt - val find_opt : elt -> t -> elt option - val find_first : (elt -> bool) -> t -> elt - val find_first_opt : (elt -> bool) -> t -> elt option - val find_last : (elt -> bool) -> t -> elt - val find_last_opt : (elt -> bool) -> t -> elt option - val of_list : elt list -> t - val to_seq_from : elt -> t -> elt Seq.t - val to_seq : t -> elt Seq.t - val to_rev_seq : t -> elt Seq.t - val add_seq : elt Seq.t -> t -> t - val of_seq : elt Seq.t -> t - end -``` - -(the parentheses are necessary) - -## Defining Functors - -A functor with one argument can be defined like this: - - +module type OrderedType = sig + type t + val compare : t -> t -> int +end + +module type S = sig + type elt + type t + val empty : t + val is_empty : t -> bool + val insert : t -> elt -> t + val merge : t -> t -> t + val find : t -> elt + val delete : t -> t +end + +module Binary(Elt: OrderedType) : S = struct + type elt = | (* Replace by your own *) + type t = | (* Replace by your own *) + (* Add private functions here *) + let is_empty h = failwith "Not yet implemented" + let insert h e = failwith "Not yet implemented" + let merge h1 h2 = failwith "Not yet implemented" + let find h = failwith "Not yet implemented" + let delete h = failwith "Not yet implemented" +end +``` + +Here binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each (e.g. `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc.) + +## Injecting Dependencies Using Functors + +### Module Dependencies + +Here is a new version of the `funkt` program. + +**`funkt.ml`** ```ocaml -module F (X : X_type) = struct - ... +module StringSet = Set.Make(String) + +module IterPrint : sig + val f : string list -> unit +end = struct + let f = List.iter (fun s -> Out_channel.output_string stdout (s ^ "\n")) end + +let _ = + stdin + |> In_channel.input_lines + |> List.concat_map Str.(split (regexp "[ \t.,;:()]+")) + |> StringSet.of_list + |> StringSet.elements + |> IterPrint.f ``` -where `X` is the module that will be passed as argument, and `X_type` is its -signature, which is mandatory. +It embeds an additional `IterPrint` module that exposes a single function `f` of type `string list -> unit` and has two dependencies: + - Module `List` through `List.iter` and the type of its `f` function + - Module `Out_channel` through `Out_channel.output_string` + +Check the behaviour of the program using `dune exec funkt < dune`. -The signature of the returned module itself can be constrained, using this -syntax: +### Dependency Injection - +This is a dependency injection refactoring of module `IterPrint`. + +**`iterPrint.ml`** ```ocaml -module F (X : X_type) : Y_type = -struct - ... +module type Iterable = sig + type 'a t + val iter : ('a -> unit) -> 'a t -> unit +end + +module type S = sig + type 'a t + val f : string t -> unit +end + +module Make(Dep: Iterable) : S with type 'a t := 'a Dep.t = struct + let f = Dep.iter (fun s -> Out_channel.output_string stdout (s ^ "\n")) end ``` -or by specifying this in the `.mli` file: +The module `IterPrint` is refactored into a functor that takes the dependency providing `iter` as a parameter. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency; at the time it is compiled, no implementation of function `iter` is available yet. + +**Note**: An OCaml interface file must be a module, not a functor. Functors must be embedded inside modules. Therefore, it is customary to call them `Make`. + +**`funkt.ml`** - ```ocaml -module F (X : X_type) : Y_type +module StringSet = Set.Make(String) +module IterPrint = IterPrint.Make(List) + +let _ = + stdin + |> In_channel.input_lines + |> List.concat_map Str.(split (regexp "[ \t.,;:()]+")) + |> StringSet.of_list + |> StringSet.elements + |> IterPrint.f ``` -Overall, the syntax of functors is hard to grasp. The best may be to look at -the source files -[`set.ml`](https://github.com/ocaml/ocaml/blob/trunk/stdlib/set.ml) or -[`map.ml`](https://github.com/ocaml/ocaml/blob/trunk/stdlib/map.ml) of the -standard library. +The dependency `List` is _injected_ when compiling module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the behaviour of the program using `dune exec funkt < dune`. + +### Dependency Substitution + +Now, replacing the implementation of `iter` inside `IterListPrint` is no longer a refactoring, it is another functor application with another dependency. Here, `Array` replaces `List`. + +**`funkt.ml`** +```ocaml +module StringSet = Set.Make(String) +module IterPrint = IterPrint.Make(Array) + +let _ = + stdin + |> In_channel.input_lines + |> List.concat_map Str.(split (regexp "[ \t.,;:()]+")) + |> StringSet.of_list + |> StringSet.elements + |> Array.of_list + |> IterPrint.f +``` + +Check the behaviour of the program using `dune exec funkt < dune`. + +**Note**: The functor `IterPrint.Make` returns a module that exposes the type of the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e. in the type of `IterMake.f`), that constraint wouldn't be needed and the call site of `IterPrint.f` would be unchanged when injecting another dependency. + +## Custom Module Extension + +In this section we define a functor to extend another module. This is the same idea as in the [Extending a Module with a Functor](#extending-a-module-with-a-functor), except we write the functor ourselves. + +Create a fresh directory with the following files: + +**`dune-project`** +```lisp +(lang dune 3.7) +``` +**`dune`** +```lisp +(library (name scanLeft)) +``` + +**`scanLeft.ml`** +```ocaml +module type LeftFoldable = sig + type 'a t + val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b + val of_list : 'a list -> 'a t +end + +module type S = sig + type 'a t + val scan_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t +end + +module Make(F: LeftFoldable) : S with type 'a t := 'a F.t = struct + let scan_left f b u = + let f (b, u) a = let b' = f b a in (b', b' :: u) in + u |> F.fold_left f (b, []) |> snd |> List.rev |> F.of_list +end +``` + +Run the `dune utop` command, and inside the toplevel enter the following commands. For brievety, the output of the first two toplevel commands is not shown here. +```ocaml +# module Array = struct + include Stdlib.Array + include ScanLeft.Make(Stdlib.Array) + end;; + +# module List = struct + include List + include ScanLeft.Make(struct + include List + let of_list = Fun.id + end) + end;; + +# Array.init 10 Fun.id |> Array.scan_left ( + ) 0;; +- : int array = [|0; 1; 3; 6; 10; 15; 21; 28; 36; 45|] + +# List.init 10 Fun.id |> List.scan_left ( + ) 0;; +- : int list = [0; 1; 3; 6; 10; 15; 21; 28; 36; 45] +``` + +Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. + +## Conclusion \ No newline at end of file From 9ae00e3aec7dc29a00e29a0d57f0767066403723 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 11 Dec 2023 12:42:54 +0100 Subject: [PATCH 03/53] Light refresh of the module tutorial --- data/tutorials/language/1ms_00_modules.md | 269 ++++------------------ 1 file changed, 40 insertions(+), 229 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 4273ab1f8a..e53a0c00ef 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -13,7 +13,7 @@ category: "Module System" In OCaml, every piece of code is wrapped into a module. Optionally, a module itself can be a submodule of another module, pretty much like directories in a -file system - but we don't do this very often. +file system. When you write a program, let's say using two files `amodule.ml` and `bmodule.ml`, each of these files automatically defines a module named @@ -21,34 +21,28 @@ When you write a program, let's say using two files `amodule.ml` and files. Here is the code that we have in our file `amodule.ml`: - ```ocaml let hello () = print_endline "Hello" ``` And here is what we have in `bmodule.ml`: - ```ocaml let () = Amodule.hello () ``` -### Automatised Compilation - -In order to compile them using the [Dune](https://dune.build/) build system, -which is now the standard on OCaml, at least two configuration files are -required: +In order to compile them using the [Dune](https://dune.build/) build system, at least two configuration files are required: -* The `dune-project` file, which contains project-wide configuration data. +* The `dune-project` file contains project-wide configuration data. Here's a very minimal one: + ```lisp + (lang dune 3.7) ``` - (lang dune 3.4) - ``` -* The `dune` file, which contains actual build directives. A project may have several +* The `dune` file contains actual build directives. A project may have several of them, depending on the organisation of the sources. This is sufficient for our example: - ``` + ```lisp (executable (name bmodule)) ``` @@ -56,7 +50,7 @@ Here is how to create the configuration files, build the source, and run the executable. ```bash -$ echo "(lang dune 3.4)" > dune-project +$ echo "(lang dune 3.7)" > dune-project $ echo "(executable (name bmodule))" > dune $ opam exec -- dune build $ opam exec -- dune exec ./bmodule.exe @@ -73,39 +67,9 @@ In a real-world project, it is preferable to start by creating the `dune` configuration files and directory structure using the `dune init project` command. -### Manual Compilation - -Alternatively, it is possible, but not recommended, to compile the files by -directly calling the compiler, either by using a single command: - - -```sh -$ ocamlopt -o hello amodule.ml bmodule.ml -``` - -Or, as a build system does, one by one: - - -```sh -$ ocamlopt -c amodule.ml -$ ocamlopt -c bmodule.ml -$ ocamlopt -o hello amodule.cmx bmodule.cmx -``` - -In both cases, a standalone executable is created - -```sh -$ ./hello -Hello -``` - -Note: It's necessary to place the source files in the correct order. The dependencies must come before -the dependent. In the first example above, putting `bmodule.ml` before `amodule.ml` -will result in an `Unbound module` error. - ### Naming and Scoping -Now we have an executable that prints `Hello`. As you can see, if you want to +Now we have an executable that prints `Hello`. If you want to access anything from a given module, use the name of the module (always starting with a capital letter) followed by a dot and the thing that you want to use. It may be a value, a type constructor, or anything else that a given module can @@ -140,15 +104,15 @@ let () = List.iter (printf "%s\n") data There are also local `open`s: ```ocaml -# let map_3d_matrix f m = - let open Array in - map (map (map f)) m;; -val map_3d_matrix : - ('a -> 'b) -> 'a array array array -> 'b array array array = -# let map_3d_matrix' f = - Array.(map (map (map f)));; -val map_3d_matrix' : - ('a -> 'b) -> 'a array array array -> 'b array array array = +# let sum_sq m = + let open List in + init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0;; +val sum_sq : int -> int = + +# let sym_sq' m = + Array.(init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0);; +val sum_sq' : int -> int = + ``` ## Interfaces and Signatures @@ -161,8 +125,8 @@ is better that a module only provides what it is meant to provide, not any of the auxiliary functions and types that are used internally. For this, we have to define a module interface, which will act as a mask over -the module's implementation. Just like a module derives from an `.ml` file, the -corresponding module interface or signature derives from an `.mli` file. It +the module's implementation. Just like a module derives from a `.ml` file, the +corresponding module interface or signature derives from a `.mli` file. It contains a list of values with their type. Let's rewrite our `amodule.ml` file to something called `amodule2.ml`: @@ -203,7 +167,7 @@ let () = Amodule2.hello () The .`mli` files must be compiled before the matching `.ml` files. This is done automatically by Dune. We update the `dune` file to allow the compilation -of this example aside of the previous one. +of this example aside from the previous one. ```bash @@ -215,22 +179,6 @@ $ opam exec -- dune exec ./bmodule2.exe Hello 2 ``` -Here is how the same result can be achieved by calling the compiler manually. -Notice the `.mli` file is compiled using bytecode compiler `ocamlc`, while -`.ml` files are compiled to native code using `ocamlopt`: - - -```sh -$ ocamlc -c amodule2.mli -$ ocamlopt -c amodule2.ml -$ ocamlopt -c bmodule2.ml -$ ocamlopt -o hello2 amodule2.cmx bmodule2.cmx -$ ./hello -Hello -$ ./hello2 -Hello 2 -``` - ## Abstract Types What about type definitions? We saw that values such as functions can be @@ -370,175 +318,38 @@ interfaces. ### Displaying the Interface of a Module You can use the OCaml toplevel to visualise the contents of an existing -module, such as `List`: +module, such as `Fun`: ```ocaml -# #show List;; -module List : +# #show Fun;; +module Fun : sig - type 'a t = 'a list = [] | (::) of 'a * 'a list - val length : 'a t -> int - val compare_lengths : 'a t -> 'b t -> int - val compare_length_with : 'a t -> int -> int - val cons : 'a -> 'a t -> 'a t - val hd : 'a t -> 'a - val tl : 'a t -> 'a t - val nth : 'a t -> int -> 'a - val nth_opt : 'a t -> int -> 'a option - val rev : 'a t -> 'a t - val init : int -> (int -> 'a) -> 'a t - val append : 'a t -> 'a t -> 'a t - val rev_append : 'a t -> 'a t -> 'a t - val concat : 'a t t -> 'a t - val flatten : 'a t t -> 'a t - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val iter : ('a -> unit) -> 'a t -> unit - val iteri : (int -> 'a -> unit) -> 'a t -> unit - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t - val rev_map : ('a -> 'b) -> 'a t -> 'b t - val filter_map : ('a -> 'b option) -> 'a t -> 'b t - val concat_map : ('a -> 'b t) -> 'a t -> 'b t - val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b t -> 'a * 'c t - val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a - val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit - val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val rev_map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b t -> 'c t -> 'a - val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a t -> 'b t -> 'c -> 'c - val for_all : ('a -> bool) -> 'a t -> bool - val exists : ('a -> bool) -> 'a t -> bool - val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool - val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool - val mem : 'a -> 'a t -> bool - val memq : 'a -> 'a t -> bool - val find : ('a -> bool) -> 'a t -> 'a - val find_opt : ('a -> bool) -> 'a t -> 'a option - val find_map : ('a -> 'b option) -> 'a t -> 'b option - val filter : ('a -> bool) -> 'a t -> 'a t - val find_all : ('a -> bool) -> 'a t -> 'a t - val filteri : (int -> 'a -> bool) -> 'a t -> 'a t - val partition : ('a -> bool) -> 'a t -> 'a t * 'a t - val partition_map : ('a -> ('b, 'c) Either.t) -> 'a t -> 'b t * 'c t - val assoc : 'a -> ('a * 'b) t -> 'b - val assoc_opt : 'a -> ('a * 'b) t -> 'b option - val assq : 'a -> ('a * 'b) t -> 'b - val assq_opt : 'a -> ('a * 'b) t -> 'b option - val mem_assoc : 'a -> ('a * 'b) t -> bool - val mem_assq : 'a -> ('a * 'b) t -> bool - val remove_assoc : 'a -> ('a * 'b) t -> ('a * 'b) t - val remove_assq : 'a -> ('a * 'b) t -> ('a * 'b) t - val split : ('a * 'b) t -> 'a t * 'b t - val combine : 'a t -> 'b t -> ('a * 'b) t - val sort : ('a -> 'a -> int) -> 'a t -> 'a t - val stable_sort : ('a -> 'a -> int) -> 'a t -> 'a t - val fast_sort : ('a -> 'a -> int) -> 'a t -> 'a t - val sort_uniq : ('a -> 'a -> int) -> 'a t -> 'a t - val merge : ('a -> 'a -> int) -> 'a t -> 'a t -> 'a t - val to_seq : 'a t -> 'a Seq.t - val of_seq : 'a Seq.t -> 'a t + external id : 'a -> 'a = "%identity" + val const : 'a -> 'b -> 'a + val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c + val negate : ('a -> bool) -> 'a -> bool + val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a + exception Finally_raised of exn end ``` -There is online documentation for each library. +There is online documentation for each library, for instance [`Fun`](/api/Fun.html) ### Module Inclusion Let's say we feel that a function is missing from the standard `List` module, -but we really want it as if it were part of it. In an `extensions.ml` file, we +but we really want it as if it were part of it. In an `extlib.ml` file, we can achieve this effect by using the `include` directive: ```ocaml -# module List = struct +module List = struct include List - let rec optmap f = function - | [] -> [] - | hd :: tl -> - match f hd with - | None -> optmap f tl - | Some x -> x :: optmap f tl - end;; -module List : - sig - type 'a t = 'a list = [] | (::) of 'a * 'a list - val length : 'a t -> int - val compare_lengths : 'a t -> 'b t -> int - val compare_length_with : 'a t -> int -> int - val cons : 'a -> 'a t -> 'a t - val hd : 'a t -> 'a - val tl : 'a t -> 'a t - val nth : 'a t -> int -> 'a - val nth_opt : 'a t -> int -> 'a option - val rev : 'a t -> 'a t - val init : int -> (int -> 'a) -> 'a t - val append : 'a t -> 'a t -> 'a t - val rev_append : 'a t -> 'a t -> 'a t - val concat : 'a t t -> 'a t - val flatten : 'a t t -> 'a t - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val iter : ('a -> unit) -> 'a t -> unit - val iteri : (int -> 'a -> unit) -> 'a t -> unit - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t - val rev_map : ('a -> 'b) -> 'a t -> 'b t - val filter_map : ('a -> 'b option) -> 'a t -> 'b t - val concat_map : ('a -> 'b t) -> 'a t -> 'b t - val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b t -> 'a * 'c t - val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a - val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit - val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val rev_map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t - val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b t -> 'c t -> 'a - val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a t -> 'b t -> 'c -> 'c - val for_all : ('a -> bool) -> 'a t -> bool - val exists : ('a -> bool) -> 'a t -> bool - val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool - val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool - val mem : 'a -> 'a t -> bool - val memq : 'a -> 'a t -> bool - val find : ('a -> bool) -> 'a t -> 'a - val find_opt : ('a -> bool) -> 'a t -> 'a option - val find_map : ('a -> 'b option) -> 'a t -> 'b option - val filter : ('a -> bool) -> 'a t -> 'a t - val find_all : ('a -> bool) -> 'a t -> 'a t - val filteri : (int -> 'a -> bool) -> 'a t -> 'a t - val partition : ('a -> bool) -> 'a t -> 'a t * 'a t - val partition_map : ('a -> ('b, 'c) Either.t) -> 'a t -> 'b t * 'c t - val assoc : 'a -> ('a * 'b) t -> 'b - val assoc_opt : 'a -> ('a * 'b) t -> 'b option - val assq : 'a -> ('a * 'b) t -> 'b - val assq_opt : 'a -> ('a * 'b) t -> 'b option - val mem_assoc : 'a -> ('a * 'b) t -> bool - val mem_assq : 'a -> ('a * 'b) t -> bool - val remove_assoc : 'a -> ('a * 'b) t -> ('a * 'b) t - val remove_assq : 'a -> ('a * 'b) t -> ('a * 'b) t - val split : ('a * 'b) t -> 'a t * 'b t - val combine : 'a t -> 'b t -> ('a * 'b) t - val sort : ('a -> 'a -> int) -> 'a t -> 'a t - val stable_sort : ('a -> 'a -> int) -> 'a t -> 'a t - val fast_sort : ('a -> 'a -> int) -> 'a t -> 'a t - val sort_uniq : ('a -> 'a -> int) -> 'a t -> 'a t - val merge : ('a -> 'a -> int) -> 'a t -> 'a t -> 'a t - val to_seq : 'a t -> 'a Seq.t - val of_seq : 'a Seq.t -> 'a t - val optmap : ('a -> 'b option) -> 'a t -> 'b t - end + let uncons = function + | [] -> None + | hd :: tl -> Some (hd, tl) +end ``` -It creates a module `Extensions.List` that has everything the standard `List` -module has, plus a new `optmap` function. From another file, all we have to do -to override the default `List` module is `open Extensions` at the beginning of -the `.ml` file: - - -```ocaml -open Extensions - -... - -List.optmap ... -``` +It creates a module `Extlib.List` that has everything the standard `List` +module has, plus a new `uncons` function. From another `.ml` file, all we have to do +to override the default `List` module is add `open Extlib` at the beginning. From 6cb138877718ed6b2fbf6f607a7734a6373113b3 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 12 Dec 2023 12:59:09 +0100 Subject: [PATCH 04/53] Review functors --- data/tutorials/language/1ms_01_functors.md | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 6d745bd590..ed2b49c57b 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -58,6 +58,8 @@ end module Make : functor (Ord : OrderedType) -> S ``` +**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter (like in `Array.sort` for instance) would add a lot of boilerplate. Providing set operations as a functor allows specifying the comparison function only once. + The functor `Set.Make` needs to be passed a module of type `Set.OrderedType` to produce a module of type `Set.S`. Here is how it can look like in our project: **`funkt.ml`** @@ -72,7 +74,7 @@ With this, the command `dune exec funkt` shouldn't do anything but it shouldn't - It defines a function `compare` of type `t -> t -> bool`, that is the function `String.compare` - The result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, it has the signature `Set.S`. -Add some code to the `funkt.ml` file to produce an executable that does something and check the result. +Add some code to the `funkt.ml` file to produce an executable that does something and checks the result. **`funkt.ml`** ```ocaml @@ -85,7 +87,7 @@ let _ = |> StringSet.iter print_endline ``` -Here are the types of the functions used throughout the pipe +Here are the types of functions used throughout the pipe - `In_channel.input_lines : in_channel -> string list` - `Str.(split (regexp "[ \t.,;:()]+")) : string -> string list` - `List.concat_map : ('a -> 'b list) -> 'a list -> 'b list` @@ -262,7 +264,7 @@ Check the behaviour of the program using `dune exec funkt < dune`. ### Dependency Injection -This is a dependency injection refactoring of module `IterPrint`. +This is a dependency injection refactoring of the module `IterPrint`. **`iterPrint.ml`** ```ocaml @@ -300,7 +302,7 @@ let _ = |> IterPrint.f ``` -The dependency `List` is _injected_ when compiling module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the behaviour of the program using `dune exec funkt < dune`. +The dependency `List` is _injected_ when compiling the module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the behaviour of the program using `dune exec funkt < dune`. ### Dependency Substitution @@ -327,7 +329,7 @@ Check the behaviour of the program using `dune exec funkt < dune`. ## Custom Module Extension -In this section we define a functor to extend another module. This is the same idea as in the [Extending a Module with a Functor](#extending-a-module-with-a-functor), except we write the functor ourselves. +In this section, we define a functor to extend another module. This is the same idea as in the [Extending a Module with a Functor](#extending-a-module-with-a-functor), except we write the functor ourselves. Create a fresh directory with the following files: From 113861f136469c7f1a4b911d98c1a8b21374c52c Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Thu, 14 Dec 2023 16:33:46 +0100 Subject: [PATCH 05/53] Update Functors and Add Libraries --- data/tutorials/language/1ms_01_functors.md | 29 ++- data/tutorials/language/1ms_02_dune.md | 241 +++++++++++++++++++++ 2 files changed, 260 insertions(+), 10 deletions(-) create mode 100644 data/tutorials/language/1ms_02_dune.md diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index ed2b49c57b..b176fd9b14 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -63,6 +63,13 @@ module Make : functor (Ord : OrderedType) -> S The functor `Set.Make` needs to be passed a module of type `Set.OrderedType` to produce a module of type `Set.S`. Here is how it can look like in our project: **`funkt.ml`** +```ocaml +module StringSet = Set.Make(struct + type t = string + let compare = String.compare +end) +``` + ```ocaml module StringSet = Set.Make(String) ``` @@ -114,7 +121,7 @@ funkt There are no duplicates in a `Set`. Therefore, the string `"funkt"` is only displayed once although it appears twice in the file `dune`. -## Extending a Module with a Functor +## Extending a Module with a Standard Library Functor Using the `include` statement, here is an alternate way to expose the module created by `Set.Make(String)`. @@ -135,9 +142,9 @@ let _ = This allows seemingly extending the module `String` with a submodule `Set`. Check the behaviour using `dune exec funkt < dune`. -## Parametrized Implementations +## Functors are Parametrized Modules -### The Standard Library: `Set`, `Map` and `Hashtbl` +### Functors from the Standard Library Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrized, in other words, functors. That's the case for the sets, maps and hash tables provided by the standard library. It works in a contract way: * if you provide a module that implements what is expected (the parameter interface); @@ -167,7 +174,7 @@ The functors `Set.Make`, `Map.Make` and `Hashtbl.Make` return modules satisfyin * [`Map.S`](/api/Map.S.html) * [`Hashtbl.S`](/api/Hashtbl.S.html) -## Custom Parametrized Implementation +### Writing your own Functors There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Example include binary heaps, leftist heaps, binomial heaps or Fibonacci heaps. @@ -233,7 +240,7 @@ Here binary heaps is the only implementation suggested. This can be extended to ## Injecting Dependencies Using Functors -### Module Dependencies +**Dependencies Between Modules** Here is a new version of the `funkt` program. @@ -262,9 +269,11 @@ It embeds an additional `IterPrint` module that exposes a single function `f` of Check the behaviour of the program using `dune exec funkt < dune`. -### Dependency Injection +**Dependency Injection** + +[Dependency injection](https://en.wikipedia.org/wiki/Dependency_injection) is a way to parametrize over a dependency. -This is a dependency injection refactoring of the module `IterPrint`. +Here is a refactoring of the module `IterPrint` to make of this technique. **`iterPrint.ml`** ```ocaml @@ -304,7 +313,7 @@ let _ = The dependency `List` is _injected_ when compiling the module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the behaviour of the program using `dune exec funkt < dune`. -### Dependency Substitution +**Replacing a Dependency** Now, replacing the implementation of `iter` inside `IterListPrint` is no longer a refactoring, it is another functor application with another dependency. Here, `Array` replaces `List`. @@ -327,9 +336,9 @@ Check the behaviour of the program using `dune exec funkt < dune`. **Note**: The functor `IterPrint.Make` returns a module that exposes the type of the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e. in the type of `IterMake.f`), that constraint wouldn't be needed and the call site of `IterPrint.f` would be unchanged when injecting another dependency. -## Custom Module Extension +## Write a Functor to Extend Modules -In this section, we define a functor to extend another module. This is the same idea as in the [Extending a Module with a Functor](#extending-a-module-with-a-functor), except we write the functor ourselves. +In this section, we define a functor to extend several modules in the same way. This is the same idea as in the [Extending a Module with a Standard Library Functor](#extending-a-module-with-a-standard-library-functor), except we write the functor ourselves. Create a fresh directory with the following files: diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md new file mode 100644 index 0000000000..64fede4f2a --- /dev/null +++ b/data/tutorials/language/1ms_02_dune.md @@ -0,0 +1,241 @@ +--- +id: modules-libraries-dune +title: Modules and Libraries in Dune +description: > + Learn about the features of Dune that interact with the OCaml module system +category: "Module System" +--- + +# Modules and Libraries in Dune + +## Introduction + +The goal of this tutorial is + +This tutorial uses the [Dune](https://dune.build) build tool. Make sure to have installed version 3.7 or later. + +**Requirements**: Modules and Functors + +## Minimum Project Setup + + +This section details the structure of an almost minimum Dune project setup. Check [Your First OCaml Program](/docs/your-first-program) for automatic setup using the `dune init proj` command. +```shell +$ mkdir mixtli; cd mixtli + +$ touch mixtli.opam +``` + +In this directory, create four more files: `dune-project`, `dune`, `cloud.ml`, and `wmo.ml`: + +**`dune-project`** +```lisp +(lang dune 3.7) +``` + +This file contains the global project configuration. Here we keep to the bare minimum, the `lang dune` stanza that specifies the version of Dune that is required. + +**`dune`** +```lisp +(executable + (name cloud) + (public_name nube)) +``` + +A `dune` file is required in each folder containing files that require some sort of build. The `executable` stanza means an executable program is built. +- The `name cloud` stanza means the file `cloud.ml` contains the executable +- The `public_name nube` stanza means the executable is made available using the `nube` name (cloud in spanish). + +**`wmo.ml`** +```ocaml +module Stratus = struct + let cumulus = "stratocumulus (Sc)" +end + +module Cumulus = struct + let stratus = "stratocumulus (Sc)" +end +``` + +**`cloud.ml`** +```ocaml +let () = + Wmo.Stratus.cumulus |> String.capitalize_ascii |> print_endline; + Wmo.Cumulus.stratus |> String.capitalize_ascii |> print_endline +``` + +Here is the resulting output: +```shell +$ dune exec nube +Stratocumulus (Sc) +Stratocumulus (Sc) +``` + + +Here is the folder contents: +```shell +$ tree +. +├── mixtli.opam +├── dune +├── dune-project +├── cloud.ml +└── wmo.ml +``` + +This is sufficient to build and execute the project: +```shell +$ dune exec nube +Cumulostratus (Cb) +Cumulostratus (Cb) +``` + +Dune stores the files it creates in a folder named `_build`. In a project managed using Git, the `_build` folder should be ignored +```shell +$ echo _build >> .gitignore +``` + +In OCaml, each source file is compiled into a module. In the `mixtli` project, the file `cloud.ml` creates a module named `Cloud`. + +Observe the roles of the different names: +* `mixtli` is the name of the project (meaning cloud in Nahuatl) +* `cloud.ml` is the name of the OCaml source file, referred as `cloud` in the `dune` file +* `nube` is the name of the executable command +* `Cloud` is the name of the module associated with the file `cloud.ml` + +The `dune describe` command allows having a look at the module structure of the project. Here is its output: +```lisp +((root /home/cuihtlauac/mixtli) + (build_context _build/default) + (executables + ((names (cloud)) + (requires ()) + (modules + (((name Cloud) + (impl (_build/default/cloud.ml)) + (intf ()) + (cmt (_build/default/.cloud.eobjs/byte/cloud.cmt)) + (cmti ())))) + (include_dirs (_build/default/.cloud.eobjs/byte))))) +``` + +## Libraries + + +When using Dune (with its default settings), an OCaml _library_ is a module aggregating other modules, bottom-up. This contrasts with the `struct ... end` syntax where modules are aggregated top-down, by nesting submodules into container modules. Dune creates libraries from folders such as the following one: +```shell +$ mkdir lib +$ rm wmo.ml +``` + +**`lib/dune`** +```lisp +(library (name wmo)) +``` + +All the modules found in the `lib` folder are bundled into the `Wmo` module. + +**`lib/cumulus.mli`** +```ocaml +val v : string +val stratus : string +``` + +**`lib/cumulus.ml`** +```ocaml +let latin_root = "cumul" +let v = latin_root ^ "us (Cu)" +let stratus = "strato" ^ latin_root ^ "us (Sc)" +``` + +**`lib/stratus.mli`** +```ocaml +val v : string +val cumulus : string +``` +**`lib/stratus.ml`** +```ocaml +let latin_root = "strat" +let v = latin_root ^ "us (St)" +let cumulus = latin_root ^ "ocumulus (Sc)" +``` + +The executable and the corresponding `dune` file need to be updated to use the defined library as a dependency. + +**`dune`** +```lisp +(executable + (name cloud) + (public_name nube) + (libraries wmo)) +``` + + + +**Observations**: +* Dune creates a module `Wmo` from the contents of folder `lib` +* The name of the folder (here `lib`) is irrelevant +* The name of the library appears uncapitalized (`wmo`) in `dune` files: + - In its definition, in `lib/dune` + - When used as a dependency in `dune` + +## Library Wrapper Modules + + +By default, modules bundled into a library by Dune are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. + +This `lib/wmo.ml` file corresponds to the module automatically generated by Dune in the previous section. + +**`lib/wmo.ml`** +```ocaml +module Cumulus = Cumulus +module Stratus = Stratus +``` + +Here is how this makes sense of these module definitions: +- On the left-hand side, `module Cumulus` means module `Wmo` contains a submodule named `Cumulus` +- On the right-hand side, `Cumulus` refers to the module defined in the files `lib/cumulus.ml` and `lib/cumulus.mli` + +Check with `dune exec nube` that the behaviour of the program is the same as in the previous section. + +When a library folder contains a wrapper module (here `wmo.ml`), it is the only one exposed. A file-based module that does not appear in the wrapper module is private. + +Using a wrapper file makes several things possible: +- Have different public and internal names, `module CumulusCloud = Cumulus` +- Define values in the wrapper module, `let ... = ` +- Expose module resulting from functor application, `module StringSet = Set.Make(String)` +- Apply the same interface type to several modules without duplicating files. + +## Include Subdirectories + +By default, Dune builds libraries from modules found in folders, but it doesn't look into subfolders. It is possible to change this behaviour. + +In this example, we create subdirectories and move files there. +```shell +$ mkdir lib/cumulus lib/stratus +$ mv lib/cumulus.ml lib/cumulus/m.ml +$ mv lib/cumulus.mli lib/cumulus/m.mli +$ mv lib/stratus.ml lib/stratus/m.ml +$ mv lib/stratus.mli lib/stratus/m.mli +``` + +Change from the default behaviour with the `include_subdirs` stanza. + +**`lib/dune`** +```lisp +(include_subdirs qualified) +(library (name wmo)) +``` + +Update the library wrapper to expose the modules created from the subdirectories. + +**`wmo.ml`** +```ocaml +module Cumulus = Cumulus.M +module Stratus = Stratus.M +``` + +Check with `dune exec nube` that the behaviour of the program is the same as in the previous sections. + +## Conclusion + From 0c56f458c30e77ad6c65bf7e8db26550f083a581 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 18 Dec 2023 05:48:50 -0800 Subject: [PATCH 06/53] syntax, 2nd person --- data/tutorials/language/1ms_02_dune.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 64fede4f2a..587c624955 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -12,7 +12,7 @@ category: "Module System" The goal of this tutorial is -This tutorial uses the [Dune](https://dune.build) build tool. Make sure to have installed version 3.7 or later. +This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have version 3.7 or later installed. **Requirements**: Modules and Functors From 399b711915f0986174639d0a65c0a6a351950ccc Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 18 Dec 2023 05:52:47 -0800 Subject: [PATCH 07/53] Tightening syntax --- data/tutorials/language/1ms_02_dune.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 587c624955..1e1e0ed086 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -33,7 +33,7 @@ In this directory, create four more files: `dune-project`, `dune`, `cloud.ml`, a (lang dune 3.7) ``` -This file contains the global project configuration. Here we keep to the bare minimum, the `lang dune` stanza that specifies the version of Dune that is required. +This file contains the global project configuration. It's kept to the bare minimum, including the `lang dune` stanza that specifies the required Dune version. **`dune`** ```lisp @@ -42,9 +42,9 @@ This file contains the global project configuration. Here we keep to the bare mi (public_name nube)) ``` -A `dune` file is required in each folder containing files that require some sort of build. The `executable` stanza means an executable program is built. -- The `name cloud` stanza means the file `cloud.ml` contains the executable -- The `public_name nube` stanza means the executable is made available using the `nube` name (cloud in spanish). +Each folder that requires some sort of build must contain a `dune` file. The `executable` stanza means an executable program is built. +- The `name cloud` stanza means the file `cloud.ml` contains the executable. +- The `public_name nube` stanza means the executable is made available using the `nube` name (cloud in Spanish). **`wmo.ml`** ```ocaml From 086ffc2cf371459145fc7bf49ac2e62b6aa5b411 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 18 Dec 2023 06:05:33 -0800 Subject: [PATCH 08/53] tighten syntax & grammar --- data/tutorials/language/1ms_02_dune.md | 30 +++++++++++++------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 1e1e0ed086..bbd65b261f 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -44,7 +44,7 @@ This file contains the global project configuration. It's kept to the bare minim Each folder that requires some sort of build must contain a `dune` file. The `executable` stanza means an executable program is built. - The `name cloud` stanza means the file `cloud.ml` contains the executable. -- The `public_name nube` stanza means the executable is made available using the `nube` name (cloud in Spanish). +- The `public_name nube` stanza means the executable is made available using the name `nube` (Spanish for *cloud*). **`wmo.ml`** ```ocaml @@ -98,12 +98,12 @@ $ echo _build >> .gitignore In OCaml, each source file is compiled into a module. In the `mixtli` project, the file `cloud.ml` creates a module named `Cloud`. Observe the roles of the different names: -* `mixtli` is the name of the project (meaning cloud in Nahuatl) -* `cloud.ml` is the name of the OCaml source file, referred as `cloud` in the `dune` file -* `nube` is the name of the executable command -* `Cloud` is the name of the module associated with the file `cloud.ml` +* `mixtli` is the project's name (it means *cloud* in Nahuatl). +* `cloud.ml` is the OCaml source file's name, referred as `cloud` in the `dune` file. +* `nube` is the executable command's name. +* `Cloud` is the name of the module associated with the file `cloud.ml`. -The `dune describe` command allows having a look at the module structure of the project. Here is its output: +The `dune describe` command allows having a look at the project's module structure. Here is its output: ```lisp ((root /home/cuihtlauac/mixtli) (build_context _build/default) @@ -122,7 +122,7 @@ The `dune describe` command allows having a look at the module structure of the ## Libraries -When using Dune (with its default settings), an OCaml _library_ is a module aggregating other modules, bottom-up. This contrasts with the `struct ... end` syntax where modules are aggregated top-down, by nesting submodules into container modules. Dune creates libraries from folders such as the following one: +When using Dune (with its default settings), an OCaml _library_ is a module aggregating other modules, bottom-up. This contrasts with the `struct ... end` syntax where modules are aggregated top-down by nesting submodules into container modules. Dune creates libraries from folders, like the following: ```shell $ mkdir lib $ rm wmo.ml @@ -173,9 +173,9 @@ The executable and the corresponding `dune` file need to be updated to use the d **Observations**: -* Dune creates a module `Wmo` from the contents of folder `lib` -* The name of the folder (here `lib`) is irrelevant -* The name of the library appears uncapitalized (`wmo`) in `dune` files: +* Dune creates a module `Wmo` from the contents of folder `lib`. +* The folder's name (here `lib`) is irrelevant. +* The library name appears uncapitalised (`wmo`) in `dune` files: - In its definition, in `lib/dune` - When used as a dependency in `dune` @@ -184,7 +184,7 @@ The executable and the corresponding `dune` file need to be updated to use the d By default, modules bundled into a library by Dune are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. -This `lib/wmo.ml` file corresponds to the module automatically generated by Dune in the previous section. +This `lib/wmo.ml` file corresponds to the module that Dune automatically generated in the previous section. **`lib/wmo.ml`** ```ocaml @@ -193,10 +193,10 @@ module Stratus = Stratus ``` Here is how this makes sense of these module definitions: -- On the left-hand side, `module Cumulus` means module `Wmo` contains a submodule named `Cumulus` -- On the right-hand side, `Cumulus` refers to the module defined in the files `lib/cumulus.ml` and `lib/cumulus.mli` +- On the left-hand side, `module Cumulus` means module `Wmo` contains a submodule named `Cumulus`. +- On the right-hand side, `Cumulus` refers to the module defined in the files `lib/cumulus.ml` and `lib/cumulus.mli`. -Check with `dune exec nube` that the behaviour of the program is the same as in the previous section. +Check with `dune exec nube` to ensure the program's behaviour is the same as in the previous section. When a library folder contains a wrapper module (here `wmo.ml`), it is the only one exposed. A file-based module that does not appear in the wrapper module is private. @@ -204,7 +204,7 @@ Using a wrapper file makes several things possible: - Have different public and internal names, `module CumulusCloud = Cumulus` - Define values in the wrapper module, `let ... = ` - Expose module resulting from functor application, `module StringSet = Set.Make(String)` -- Apply the same interface type to several modules without duplicating files. +- Apply the same interface type to several modules without duplicating files ## Include Subdirectories From 27dd4360ef54bc239c836b7604af75520e53aac7 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 18 Dec 2023 07:08:20 -0800 Subject: [PATCH 09/53] line editing --- data/tutorials/language/1ms_01_functors.md | 90 +++++++++++----------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index b176fd9b14..aa3fdc3c74 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -14,13 +14,13 @@ Learning goals: - How to write a functor - When to use a functor, some cases -A functor is just a parametrized module. +A functor is just a parametrised module. -**Prerequisites**: Transitive closure leading to modules. +**Prerequisites**: Transitive closure leading to modules ## Project Setup -This tutorial uses the [Dune](https://dune.build) build tool. Make sure to have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, `funkt.opam` and `funkt.ml`, the latter two are created empty. +This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, `funkt.opam`, and `funkt.ml`. The latter two are created empty. ```shell $ mkdir funkt; cd funkt @@ -44,7 +44,7 @@ Check this works using the `dune exec funkt` command, it shouldn't do anything ( ## Using an Existing Functor: `Set.Make` -The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows operations like union and intersection. To use the provided type and its associated [functions](/api/Set.S.html), it is required to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`. +The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows operations like union and intersection. To use the provided type and its associated [functions](/api/Set.S.html), it's necessary to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`: ```ocaml module type OrderedType = sig type t @@ -58,7 +58,7 @@ end module Make : functor (Ord : OrderedType) -> S ``` -**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter (like in `Array.sort` for instance) would add a lot of boilerplate. Providing set operations as a functor allows specifying the comparison function only once. +**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter (like in `Array.sort`, for instance) would add a lot of boilerplate. Providing set operations as a functor allows specifying the comparison function only once. The functor `Set.Make` needs to be passed a module of type `Set.OrderedType` to produce a module of type `Set.S`. Here is how it can look like in our project: @@ -74,12 +74,12 @@ end) module StringSet = Set.Make(String) ``` -With this, the command `dune exec funkt` shouldn't do anything but it shouldn't fail either. Here is the meaning of that statement -- The module `funkt.StringSet` is defined -- The module `String` (from the standard library) is applied to the functor `Set.Make`. This is allowed because the `String` module satisfies the interface `Set.OrderedSet` - - It defines a type name `t` (which is an alias for `string`) - - It defines a function `compare` of type `t -> t -> bool`, that is the function `String.compare` -- The result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, it has the signature `Set.S`. +With this, the command `dune exec funkt` shouldn't do anything, but it shouldn't fail either. Here is the meaning of that statement: +- The module `funkt.StringSet` is defined. +- The module `String` (from the standard library) is applied to the functor `Set.Make`. This is allowed because the `String` module satisfies the interface `Set.OrderedSet`. + - It defines a type name `t` (which is an alias for `string`). + - It defines a function `compare` of type `t -> t -> bool`, that is the function `String.compare`. +- The result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, and it has the signature `Set.S`. Add some code to the `funkt.ml` file to produce an executable that does something and checks the result. @@ -94,18 +94,18 @@ let _ = |> StringSet.iter print_endline ``` -Here are the types of functions used throughout the pipe -- `In_channel.input_lines : in_channel -> string list` -- `Str.(split (regexp "[ \t.,;:()]+")) : string -> string list` -- `List.concat_map : ('a -> 'b list) -> 'a list -> 'b list` -- `StringSet.of_list : string list -> StringSet.t` and -- `StringSet.iter : StringSet.t -> unit` +Here are the types of functions used throughout the pipe: +- `In_channel.input_lines : in_channel -> string list`, +- `Str.(split (regexp "[ \t.,;:()]+")) : string -> string list`, +- `List.concat_map : ('a -> 'b list) -> 'a list -> 'b list`, +- `StringSet.of_list : string list -> StringSet.t`, and +- `StringSet.iter : StringSet.t -> unit`. This reads the following way: -- Read lines of text from standard input, produce a list of strings -- Split each string using a regular expression, flatten the list of lists into a list -- Convert the list of strings into a set -- Display each element of the set +- Read lines of text from standard input, produce a list of strings. +- Split each string using a regular expression, flatten the list of lists into a list. +- Convert the list of strings into a set. +- Display each element of the set. The functions `StringSet.of_list` and `StringSet.iter` are available as the result of the functor application. @@ -119,11 +119,11 @@ str funkt ``` -There are no duplicates in a `Set`. Therefore, the string `"funkt"` is only displayed once although it appears twice in the file `dune`. +There are no duplicates in a `Set`. Therefore, the string `"funkt"` is only displayed once, although it appears twice in the `dune` file. ## Extending a Module with a Standard Library Functor -Using the `include` statement, here is an alternate way to expose the module created by `Set.Make(String)`. +Using the `include` statement, here is an alternate way to expose the module created by `Set.Make(String)`: **`funkt.ml`** ```ocaml @@ -140,15 +140,15 @@ let _ = |> String.Set.iter print_endline ``` -This allows seemingly extending the module `String` with a submodule `Set`. Check the behaviour using `dune exec funkt < dune`. +This allows the user to seemingly extend the module `String` with a submodule `Set`. Check the behaviour using `dune exec funkt < dune`. -## Functors are Parametrized Modules +## Functors are Parametrised Modules ### Functors from the Standard Library -Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrized, in other words, functors. That's the case for the sets, maps and hash tables provided by the standard library. It works in a contract way: -* if you provide a module that implements what is expected (the parameter interface); -* the functor returns a module that implements what is promised (the result interface) +Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrised, in other words, functors. That's the case for the sets, maps, and hash tables provided by the standard library. It works in a contract way: +* If you provide a module that implements what is expected (the parameter interface) +* The functor returns a module that implements what is promised (the result interface) Here is the signature of the module that the functors `Set.Make` and `Map.Make` expect: ```ocaml @@ -167,18 +167,18 @@ module type HashedType = sig end ``` -**Note**: `Ordered.t` is a type of set elements or map keys, `Set.S.t` is a type of set and `Map.S.t` is a type of mapping. `HashedType.t` is a type of hash table keys and `Hashtbl.S.t` is a type of hash table. +**Note**: `Ordered.t` is a type of set elements or map keys, `Set.S.t` is a type of set, and `Map.S.t` is a type of mapping. `HashedType.t` is a type of hash table keys, and `Hashtbl.S.t` is a type of hash table. -The functors `Set.Make`, `Map.Make` and `Hashtbl.Make` return modules satisfying the interfaces `Set.S`, `Map.S` and `Hashtbl.S` (respectively) that all contain an abstract type `t` and associated functions. Refer to the documentation for the details about what they provide: +The functors `Set.Make`, `Map.Make`, and `Hashtbl.Make` return modules satisfying the interfaces `Set.S`, `Map.S`, and `Hashtbl.S` (respectively), which all contain an abstract type `t` and associated functions. Refer to the documentation for the details about what they provide: * [`Set.S`](/api/Set.S.html) * [`Map.S`](/api/Map.S.html) * [`Hashtbl.S`](/api/Hashtbl.S.html) -### Writing your own Functors +### Writing Your Own Functors -There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Example include binary heaps, leftist heaps, binomial heaps or Fibonacci heaps. +There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Example include binary heaps, leftist heaps, binomial heaps, or Fibonacci heaps. -What kind of data structures and algorithms are used to implement a heap is not discussed in this document. +The kind of data structures and algorithms used to implement a heap is not discussed in this document. The common prerequisite to implementing any kind of heap is the availability of a means to compare the elements they contain. That's the same signature as the parameter of `Set.Make` and `Map.Make`: ```ocaml @@ -188,7 +188,7 @@ module type OrderedType = sig end ``` -Using such a parameter, a heap implementation must provide at least this interface +Using such a parameter, a heap implementation must provide at least this interface: ```ocaml module type HeapType = sig type elt @@ -204,7 +204,7 @@ end Heap implementations can be represented as functors from `OrderedType` into `HeapType`. Each kind of heap would be a different functor. -Here is the skeleton of a possible implementation. +Here is the skeleton of a possible implementation: **heap.ml** ```ocaml @@ -236,13 +236,13 @@ module Binary(Elt: OrderedType) : S = struct end ``` -Here binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each (e.g. `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc.) +Here, binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each (e.g., `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc.). ## Injecting Dependencies Using Functors **Dependencies Between Modules** -Here is a new version of the `funkt` program. +Here is a new version of the `funkt` program: **`funkt.ml`** ```ocaml @@ -271,9 +271,9 @@ Check the behaviour of the program using `dune exec funkt < dune`. **Dependency Injection** -[Dependency injection](https://en.wikipedia.org/wiki/Dependency_injection) is a way to parametrize over a dependency. +[Dependency injection](https://en.wikipedia.org/wiki/Dependency_injection) is a way to parametrise over a dependency. -Here is a refactoring of the module `IterPrint` to make of this technique. +Here is a refactoring of the module `IterPrint` to make of this technique: **`iterPrint.ml`** ```ocaml @@ -311,11 +311,11 @@ let _ = |> IterPrint.f ``` -The dependency `List` is _injected_ when compiling the module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the behaviour of the program using `dune exec funkt < dune`. +The dependency `List` is _injected_ when compiling the module `Funkt`. Observe that the code using `IterPrint` is unchanged. Check the program's behaviour using `dune exec funkt < dune`. **Replacing a Dependency** -Now, replacing the implementation of `iter` inside `IterListPrint` is no longer a refactoring, it is another functor application with another dependency. Here, `Array` replaces `List`. +Now, replacing the implementation of `iter` inside `IterListPrint` is no longer a refactoring; it is another functor application with another dependency. Here, `Array` replaces `List`: **`funkt.ml`** ```ocaml @@ -332,9 +332,9 @@ let _ = |> IterPrint.f ``` -Check the behaviour of the program using `dune exec funkt < dune`. +Check the program's behaviour using `dune exec funkt < dune`. -**Note**: The functor `IterPrint.Make` returns a module that exposes the type of the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e. in the type of `IterMake.f`), that constraint wouldn't be needed and the call site of `IterPrint.f` would be unchanged when injecting another dependency. +**Note**: The functor `IterPrint.Make` returns a module that exposes the type of the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e., in the type of `IterMake.f`), that constraint wouldn't be needed, and the call site of `IterPrint.f` would be unchanged when injecting another dependency. ## Write a Functor to Extend Modules @@ -371,7 +371,7 @@ module Make(F: LeftFoldable) : S with type 'a t := 'a F.t = struct end ``` -Run the `dune utop` command, and inside the toplevel enter the following commands. For brievety, the output of the first two toplevel commands is not shown here. +Run the `dune utop` command. Once inside the toplevel, enter the following commands. For brievety, the output of the first two toplevel commands is not shown here. ```ocaml # module Array = struct include Stdlib.Array @@ -395,4 +395,4 @@ Run the `dune utop` command, and inside the toplevel enter the following command Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. -## Conclusion \ No newline at end of file +## Conclusion From 297255e032cff23592d12a468b1db5a4f0571f7e Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 18 Dec 2023 07:36:45 -0800 Subject: [PATCH 10/53] line editing --- data/tutorials/language/1ms_00_modules.md | 43 +++++++++++------------ 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index e53a0c00ef..894e383600 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -15,9 +15,9 @@ In OCaml, every piece of code is wrapped into a module. Optionally, a module itself can be a submodule of another module, pretty much like directories in a file system. -When you write a program, let's say using two files `amodule.ml` and -`bmodule.ml`, each of these files automatically defines a module named -`Amodule` and a module named `Bmodule` that provide whatever you put into the +When you write a program, let's say using the two files `amodule.ml` and +`bmodule.ml`, each automatically defines a module named +`Amodule` and a module named `Bmodule`, which provides whatever you put into the files. Here is the code that we have in our file `amodule.ml`: @@ -26,7 +26,7 @@ Here is the code that we have in our file `amodule.ml`: let hello () = print_endline "Hello" ``` -And here is what we have in `bmodule.ml`: +This is what we have in `bmodule.ml`: ```ocaml let () = Amodule.hello () @@ -34,12 +34,12 @@ let () = Amodule.hello () In order to compile them using the [Dune](https://dune.build/) build system, at least two configuration files are required: -* The `dune-project` file contains project-wide configuration data. +* The `dune-project` file, which contains project-wide configuration data. Here's a very minimal one: ```lisp (lang dune 3.7) ``` -* The `dune` file contains actual build directives. A project may have several +* The `dune` file, which contains actual build directives. A project may have several of them, depending on the organisation of the sources. This is sufficient for our example: ```lisp @@ -47,7 +47,7 @@ In order to compile them using the [Dune](https://dune.build/) build system, at ``` Here is how to create the configuration files, build the source, and run the -executable. +executable: ```bash $ echo "(lang dune 3.7)" > dune-project @@ -71,12 +71,12 @@ command. Now we have an executable that prints `Hello`. If you want to access anything from a given module, use the name of the module (always -starting with a capital letter) followed by a dot and the thing that you want to use. +starting with a capital letter) followed by a dot and the thing you want to use. It may be a value, a type constructor, or anything else that a given module can provide. Libraries, starting with the standard library, provide collections of modules. -for example, `List.iter` designates the `iter` function from the `List` module. +For example, `List.iter` designates the `iter` function from the `List` module. If you are using a given module heavily, you may want to make its contents directly accessible. For this, we use the `open` directive. In our example, @@ -89,7 +89,7 @@ let () = hello () ``` Using `open` or not is a matter of personal taste. Some modules provide names -that are used in many other modules. This is the case of the `List` module for +that are used in many other modules. This is the case of the `List` module, for instance. Usually, we don't do `open List`. Other modules like `Printf` provide names that normally aren't subject to conflicts, such as `printf`. In order to avoid writing `Printf.printf` all over the place, it often makes sense to place @@ -118,7 +118,7 @@ val sum_sq' : int -> int = ## Interfaces and Signatures A module can provide a certain number of things (functions, types, submodules, -etc.) to the rest of the program that is using it. If nothing special is done, +etc.) to the rest of the program using it. If nothing special is done, everything that's defined in a module will be accessible from the outside. That's often fine in small personal programs, but there are many situations where it is better that a module only provides what it is meant to provide, not any of @@ -154,9 +154,9 @@ val hello : unit -> unit (** Displays a greeting message. *) ``` -(note the double asterisk at the beginning of the comment. It is a good habit +Note the double asterisk at the beginning of the comment. It is a good habit to document `.mli` files using the format supported by -[ocamldoc](/releases/4.14/htmlman/ocamldoc.html)) +[ocamldoc](/releases/4.14/htmlman/ocamldoc.html) The corresponding module `Bmodule2` is defined in file `bmodule2.ml`: @@ -182,7 +182,7 @@ Hello 2 ## Abstract Types What about type definitions? We saw that values such as functions can be -exported by placing their name and their type in an `.mli` file, e.g., +exported by placing their name and their type in an `.mli` file, e.g.: ```ocaml @@ -201,7 +201,7 @@ There are four options when it comes to writing the `.mli` file: 1. The type is completely omitted from the signature. 2. The type definition is copy-pasted into the signature. 3. The type is made abstract: only its name is given. -4. The record fields are made read-only: `type date = private { ... }` +4. The record fields are made read-only: `type date = private { ... }`. Case 3 would look like this: @@ -229,8 +229,8 @@ val years : date -> float The point is that only `create` and `sub` can be used to create `date` records. Therefore, it is not possible for the user to create ill-formed records. Actually, our implementation uses a record, but we could change it and -be sure that it will not break any code that relies on this module! This makes -a lot of sense in a library since subsequent versions of the same library can +be sure that it will not break any code relying on this module! This makes +a lot of sense in a library because subsequent versions of it can continue to expose the same interface while internally changing the implementation, including data structures. @@ -238,9 +238,9 @@ implementation, including data structures. ### Submodule Implementation -We saw that one `example.ml` file results automatically in one module +We saw that one `example.ml` file results automatically in the module implementation named `Example`. Its module signature is automatically derived -and is the broadest possible, or can be restricted by writing an `example.mli` +and is the broadest possible, or it can be restricted by writing an `example.mli` file. That said, a given module can also be defined explicitly from within a file. @@ -296,7 +296,7 @@ let hello_goodbye () = The definition of the `Hello` module above is the equivalent of a `hello.mli`/`hello.ml` pair of files. Writing all of that in one block of code -is not elegant so, in general, we prefer to define the module signature +is not elegant, so in general, we prefer to define the module signature separately: @@ -351,5 +351,4 @@ end ``` It creates a module `Extlib.List` that has everything the standard `List` -module has, plus a new `uncons` function. From another `.ml` file, all we have to do -to override the default `List` module is add `open Extlib` at the beginning. +module has, plus a new `uncons` function. In order to override the default `List` module from another `.ml` file, we merely need to add `open Extlib` at the beginning. From c71bb0d6c738a5a2dabe28bbcea910cd9a3b9403 Mon Sep 17 00:00:00 2001 From: Cuihtlauac Alvarado Date: Mon, 18 Dec 2023 16:39:09 +0100 Subject: [PATCH 11/53] Apply suggestions from code review Co-authored-by: Christine Rose --- data/tutorials/language/1ms_02_dune.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index bbd65b261f..89be5987f3 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -19,7 +19,7 @@ This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have ## Minimum Project Setup -This section details the structure of an almost minimum Dune project setup. Check [Your First OCaml Program](/docs/your-first-program) for automatic setup using the `dune init proj` command. +This section details the structure of an almost-minimum Dune project setup. Check [Your First OCaml Program](/docs/your-first-program) for automatic setup using the `dune init proj` command. ```shell $ mkdir mixtli; cd mixtli @@ -182,7 +182,7 @@ The executable and the corresponding `dune` file need to be updated to use the d ## Library Wrapper Modules -By default, modules bundled into a library by Dune are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. +By default, when Dune bundles modules bundled into a library, they are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. This `lib/wmo.ml` file corresponds to the module that Dune automatically generated in the previous section. From 6267837582e40ac0aecb580be92c4598af45fd5a Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 18 Dec 2023 16:49:28 +0100 Subject: [PATCH 12/53] Resolve questions --- data/tutorials/language/1ms_02_dune.md | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 89be5987f3..2ea24c5763 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -10,14 +10,13 @@ category: "Module System" ## Introduction -The goal of this tutorial is +The goal of this tutorial is to teach the mechanisms built in Dune that allow the processing of OCaml modules. This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have version 3.7 or later installed. -**Requirements**: Modules and Functors +**Requirements**: [Modules](/docs/modules) and [Functors](/docs/modules). ## Minimum Project Setup - This section details the structure of an almost-minimum Dune project setup. Check [Your First OCaml Program](/docs/your-first-program) for automatic setup using the `dune init proj` command. ```shell @@ -44,7 +43,7 @@ This file contains the global project configuration. It's kept to the bare minim Each folder that requires some sort of build must contain a `dune` file. The `executable` stanza means an executable program is built. - The `name cloud` stanza means the file `cloud.ml` contains the executable. -- The `public_name nube` stanza means the executable is made available using the name `nube` (Spanish for *cloud*). +- The `public_name nube` stanza means the executable is made available using the name `nube`. **`wmo.ml`** ```ocaml @@ -120,7 +119,6 @@ The `dune describe` command allows having a look at the project's module structu ``` ## Libraries - When using Dune (with its default settings), an OCaml _library_ is a module aggregating other modules, bottom-up. This contrasts with the `struct ... end` syntax where modules are aggregated top-down by nesting submodules into container modules. Dune creates libraries from folders, like the following: ```shell @@ -180,11 +178,10 @@ The executable and the corresponding `dune` file need to be updated to use the d - When used as a dependency in `dune` ## Library Wrapper Modules - -By default, when Dune bundles modules bundled into a library, they are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. +By default, when Dune bundles modules into a library, they are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. -This `lib/wmo.ml` file corresponds to the module that Dune automatically generated in the previous section. +This `lib/wmo.ml` is the wrapper file that corresponds to the module that Dune automatically generated in the previous section. **`lib/wmo.ml`** ```ocaml @@ -192,7 +189,7 @@ module Cumulus = Cumulus module Stratus = Stratus ``` -Here is how this makes sense of these module definitions: +Here is how to make sense of these module definitions: - On the left-hand side, `module Cumulus` means module `Wmo` contains a submodule named `Cumulus`. - On the right-hand side, `Cumulus` refers to the module defined in the files `lib/cumulus.ml` and `lib/cumulus.mli`. @@ -239,3 +236,5 @@ Check with `dune exec nube` that the behaviour of the program is the same as in ## Conclusion +The OCaml module system allows organizing a project in many ways. Dune provides a means to generate modules embodying some possible ways. + From 8f613458f784175e6a4ccf91309f4768da329ce1 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 18 Dec 2023 16:50:22 +0100 Subject: [PATCH 13/53] Add conclusion --- data/tutorials/language/1ms_02_dune.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 2ea24c5763..92d80793d0 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -236,5 +236,5 @@ Check with `dune exec nube` that the behaviour of the program is the same as in ## Conclusion -The OCaml module system allows organizing a project in many ways. Dune provides a means to generate modules embodying some possible ways. +The OCaml module system allows organizing a project in many ways. Dune provides several means to generate modules embodying some possible ways. From aaa2d807555a03d4dc2e99a9447f91c612798b7f Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 18 Dec 2023 18:05:08 +0100 Subject: [PATCH 14/53] Answer comments from review --- data/tutorials/language/1ms_01_functors.md | 63 +++++++++++++--------- 1 file changed, 39 insertions(+), 24 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index aa3fdc3c74..255bdfcddd 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -9,14 +9,14 @@ category: "Module System" ## Introduction -Learning goals: -- How to use a functor -- How to write a functor -- When to use a functor, some cases +Here are the goals of this tutorial +- Learn how to use a functor +- Learn how to write a functor +- Learn some of the cases, when to use a functor -A functor is just a parametrised module. +As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor is a parametrised module. -**Prerequisites**: Transitive closure leading to modules +**Prerequisites**: [Modules](/docs/modules). ## Project Setup @@ -58,11 +58,20 @@ end module Make : functor (Ord : OrderedType) -> S ``` -**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter (like in `Array.sort`, for instance) would add a lot of boilerplate. Providing set operations as a functor allows specifying the comparison function only once. +Here is how this reads (starting from the bottom-up, then going up): +* Like a function (indicated by the arrow `->`), the functor `Set.Make` + - takes a module having `Set.OrderedType` as signature and + - returns a module having `Set.S` as signature +* The module type `Set.S` is the signature of some sort of set +* The module type `Set.OrderedType` is the signature of elements of a -The functor `Set.Make` needs to be passed a module of type `Set.OrderedType` to produce a module of type `Set.S`. Here is how it can look like in our project: +**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter, as done in `Array.sort`, for example, would add a lot of boilerplate code. Providing set operations as a functor allows specifying the comparison function only once. + + +Here is how it can look like in our project: **`funkt.ml`** + ```ocaml module StringSet = Set.Make(struct type t = string @@ -70,16 +79,22 @@ module StringSet = Set.Make(struct end) ``` +This defines a module `Funkt.StringSet`. What `Set.Make` needs is: +- A type `t`, here `string` +- A function allowing to compare two values of type `t`, here `String.compare` + +However, since the module `String` defines +- A type name `t`, which is an alias for `string` +- A function `compare` of type `t -> t -> bool` that allows to compare two strings + +The above can be simplified into this: ```ocaml module StringSet = Set.Make(String) ``` -With this, the command `dune exec funkt` shouldn't do anything, but it shouldn't fail either. Here is the meaning of that statement: -- The module `funkt.StringSet` is defined. -- The module `String` (from the standard library) is applied to the functor `Set.Make`. This is allowed because the `String` module satisfies the interface `Set.OrderedSet`. - - It defines a type name `t` (which is an alias for `string`). - - It defines a function `compare` of type `t -> t -> bool`, that is the function `String.compare`. -- The result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, and it has the signature `Set.S`. +In both versions, the result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, and it has the signature `Set.S`. The module `StringSet` provides set operations and is parametrized by the module `String`. This means the function `String.compare` is used internally by `StringSet`, inside the implementation of the functions it provides. Making a group of functions (here those provided by `StringSet`) use another group of functions (here only `String.compare`) is the role of a functor. + +With this, the command `dune exec funkt` shouldn't do anything, but it shouldn't fail either. Add some code to the `funkt.ml` file to produce an executable that does something and checks the result. @@ -102,8 +117,8 @@ Here are the types of functions used throughout the pipe: - `StringSet.iter : StringSet.t -> unit`. This reads the following way: -- Read lines of text from standard input, produce a list of strings. -- Split each string using a regular expression, flatten the list of lists into a list. +- Read lines of text from standard input, that produces a list of strings. +- Split each string using a regular expression and flatten the resulting list of lists into a list. - Convert the list of strings into a set. - Display each element of the set. @@ -146,11 +161,11 @@ This allows the user to seemingly extend the module `String` with a submodule `S ### Functors from the Standard Library -Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrised, in other words, functors. That's the case for the sets, maps, and hash tables provided by the standard library. It works in a contract way: +Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrised, in other words, functors. That's the case for the sets, maps, and hash tables provided by the standard library. It works like a contract between the functor and the developer: * If you provide a module that implements what is expected (the parameter interface) * The functor returns a module that implements what is promised (the result interface) -Here is the signature of the module that the functors `Set.Make` and `Map.Make` expect: +Here is the module's signature that the functors `Set.Make` and `Map.Make` expect: ```ocaml module type OrderedType = sig type t @@ -158,7 +173,7 @@ module type OrderedType = sig end ``` -Here is the signature of the module that the functor `Hashtbl.Make` expects: +Here is the module's signature that the functor `Hashtbl.Make` expects: ```ocaml module type HashedType = sig type t @@ -180,7 +195,7 @@ There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structur The kind of data structures and algorithms used to implement a heap is not discussed in this document. -The common prerequisite to implementing any kind of heap is the availability of a means to compare the elements they contain. That's the same signature as the parameter of `Set.Make` and `Map.Make`: +The common prerequisite to implement any heap is a means to compare the elements they contain. That's the same signature as the parameter of `Set.Make` and `Map.Make`: ```ocaml module type OrderedType = sig type t @@ -292,7 +307,7 @@ module Make(Dep: Iterable) : S with type 'a t := 'a Dep.t = struct end ``` -The module `IterPrint` is refactored into a functor that takes the dependency providing `iter` as a parameter. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency; at the time it is compiled, no implementation of function `iter` is available yet. +The module `IterPrint` is refactored into a functor that takes as a parameter a module providing the function `iter`. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency; at the time it is compiled, no implementation of function `iter` is available yet. **Note**: An OCaml interface file must be a module, not a functor. Functors must be embedded inside modules. Therefore, it is customary to call them `Make`. @@ -334,7 +349,7 @@ let _ = Check the program's behaviour using `dune exec funkt < dune`. -**Note**: The functor `IterPrint.Make` returns a module that exposes the type of the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e., in the type of `IterMake.f`), that constraint wouldn't be needed, and the call site of `IterPrint.f` would be unchanged when injecting another dependency. +**Note**: The functor `IterPrint.Make` returns a module that exposes the type from the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e., in the type of `IterMake.f`), that constraint wouldn't be needed, and the call site of `IterPrint.f` would be unchanged when injecting another dependency. ## Write a Functor to Extend Modules @@ -371,7 +386,7 @@ module Make(F: LeftFoldable) : S with type 'a t := 'a F.t = struct end ``` -Run the `dune utop` command. Once inside the toplevel, enter the following commands. For brievety, the output of the first two toplevel commands is not shown here. +Run the `dune utop` command. Once inside the toplevel, enter the following commands. ```ocaml # module Array = struct include Stdlib.Array @@ -393,6 +408,6 @@ Run the `dune utop` command. Once inside the toplevel, enter the following comma - : int list = [0; 1; 3; 6; 10; 15; 21; 28; 36; 45] ``` -Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. +Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. For brievety, the output of the first two toplevel commands is not shown here. ## Conclusion From c334fd33f2a32b64215b7186ca5fed2b769e217c Mon Sep 17 00:00:00 2001 From: Cuihtlauac Alvarado Date: Tue, 19 Dec 2023 09:33:02 +0100 Subject: [PATCH 15/53] Update data/tutorials/language/1ms_01_functors.md Co-authored-by: Leandro Ostera --- data/tutorials/language/1ms_01_functors.md | 1 + 1 file changed, 1 insertion(+) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 255bdfcddd..30e289c6da 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -51,6 +51,7 @@ module type OrderedType = sig val compare : t -> t -> int end +(** This is the signature of the module returned by applying `Make` *) module type S = sig (* ... *) end From a80be1c65d95ee80e3eb19b8ad0cca6f3241f861 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 19 Dec 2023 09:55:57 +0100 Subject: [PATCH 16/53] Edits --- data/tutorials/language/1ms_01_functors.md | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 30e289c6da..d4f572c2ee 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -51,9 +51,8 @@ module type OrderedType = sig val compare : t -> t -> int end -(** This is the signature of the module returned by applying `Make` *) module type S = sig - (* ... *) + (** This is the signature of the module returned by applying `Make` *) end module Make : functor (Ord : OrderedType) -> S @@ -68,8 +67,7 @@ Here is how this reads (starting from the bottom-up, then going up): **Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter, as done in `Array.sort`, for example, would add a lot of boilerplate code. Providing set operations as a functor allows specifying the comparison function only once. - -Here is how it can look like in our project: +Here is what it can look like in our project: **`funkt.ml`** From 9b88fdbefe2164429624d2832ee9ad003cb51ba7 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Tue, 19 Dec 2023 04:10:58 -0800 Subject: [PATCH 17/53] typo --- data/tutorials/language/1ms_01_functors.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index d4f572c2ee..f9c8547d55 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -407,6 +407,6 @@ Run the `dune utop` command. Once inside the toplevel, enter the following comma - : int list = [0; 1; 3; 6; 10; 15; 21; 28; 36; 45] ``` -Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. For brievety, the output of the first two toplevel commands is not shown here. +Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. For brevity, the output of the first two toplevel commands is not shown here. ## Conclusion From 713339b2821bc00fe3b7ae234f3a741472d704cc Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 19 Dec 2023 15:28:23 +0100 Subject: [PATCH 18/53] Review edits --- data/tutorials/language/1ms_01_functors.md | 18 ++++- data/tutorials/language/1ms_02_dune.md | 79 +++++++++++----------- 2 files changed, 53 insertions(+), 44 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index f9c8547d55..a8d3254579 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -72,10 +72,12 @@ Here is what it can look like in our project: **`funkt.ml`** ```ocaml -module StringSet = Set.Make(struct +module StringCompare = struct type t = string let compare = String.compare -end) +end + +module StringSet = Set.Make(StringCompare) ``` This defines a module `Funkt.StringSet`. What `Set.Make` needs is: @@ -86,7 +88,17 @@ However, since the module `String` defines - A type name `t`, which is an alias for `string` - A function `compare` of type `t -> t -> bool` that allows to compare two strings -The above can be simplified into this: +This can be simplified using an _anonymous module_ expression: +```ocaml +module StringSet = Set.Make(struct + type t = string + let compare = String.compare +end) +``` + +The module expression `struct ... end` is inlined in the call to `Set.Make`. + +The be simplified even further into this: ```ocaml module StringSet = Set.Make(String) ``` diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 92d80793d0..bb8ecc2ae3 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -10,7 +10,7 @@ category: "Module System" ## Introduction -The goal of this tutorial is to teach the mechanisms built in Dune that allow the processing of OCaml modules. +The goal of this tutorial is to teach the mechanisms built in Dune that allow structuring projects with libraries that contain modules. This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have version 3.7 or later installed. @@ -48,26 +48,26 @@ Each folder that requires some sort of build must contain a `dune` file. The `ex **`wmo.ml`** ```ocaml module Stratus = struct - let cumulus = "stratocumulus (Sc)" + let nimbus = "Nimbostratus (Ns)" end module Cumulus = struct - let stratus = "stratocumulus (Sc)" + let nimbus = "Cumulonimbus (Cb)" end ``` **`cloud.ml`** ```ocaml let () = - Wmo.Stratus.cumulus |> String.capitalize_ascii |> print_endline; - Wmo.Cumulus.stratus |> String.capitalize_ascii |> print_endline + Wmo.Stratus.nimbus |> print_endline; + Wmo.Cumulus.nimbus |> print_endline ``` Here is the resulting output: ```shell $ dune exec nube -Stratocumulus (Sc) -Stratocumulus (Sc) +Nimbostratus (Ns) +Cumulonimbus (Cb) ``` @@ -82,25 +82,19 @@ $ tree └── wmo.ml ``` -This is sufficient to build and execute the project: -```shell -$ dune exec nube -Cumulostratus (Cb) -Cumulostratus (Cb) -``` - Dune stores the files it creates in a folder named `_build`. In a project managed using Git, the `_build` folder should be ignored ```shell $ echo _build >> .gitignore ``` -In OCaml, each source file is compiled into a module. In the `mixtli` project, the file `cloud.ml` creates a module named `Cloud`. +In OCaml, each source file is compiled into a module. In the `mixtli` project, the file `cloud.ml` creates a module named `Cloud`, the file `wmo.ml` creates a module `Wmo` that contains two submodules: `Stratus` and `Cumulus`. -Observe the roles of the different names: +Here are the different names: * `mixtli` is the project's name (it means *cloud* in Nahuatl). * `cloud.ml` is the OCaml source file's name, referred as `cloud` in the `dune` file. -* `nube` is the executable command's name. +* `nube` is the executable command's name (it means *cloud* in Spanish). * `Cloud` is the name of the module associated with the file `cloud.ml`. +* `Wmo` is the name of the module associated with the file `wmo.ml`. The `dune describe` command allows having a look at the project's module structure. Here is its output: ```lisp @@ -117,48 +111,49 @@ The `dune describe` command allows having a look at the project's module structu (cmti ())))) (include_dirs (_build/default/.cloud.eobjs/byte))))) ``` + ## Libraries -When using Dune (with its default settings), an OCaml _library_ is a module aggregating other modules, bottom-up. This contrasts with the `struct ... end` syntax where modules are aggregated top-down by nesting submodules into container modules. Dune creates libraries from folders, like the following: + +In OCaml, a library is a collection of modules. By default, when Dune builds a library, it wraps the bundled modules into a module. Dune creates libraries from folders. Let's look at an example, here the folder is `lib`: ```shell $ mkdir lib -$ rm wmo.ml ``` +The `lib` folder is populated with the following files. + **`lib/dune`** ```lisp (library (name wmo)) ``` -All the modules found in the `lib` folder are bundled into the `Wmo` module. - **`lib/cumulus.mli`** ```ocaml -val v : string val stratus : string ``` - + **`lib/cumulus.ml`** ```ocaml -let latin_root = "cumul" -let v = latin_root ^ "us (Cu)" -let stratus = "strato" ^ latin_root ^ "us (Sc)" +let nimbus = "Cumulonimbus (Cb)" ``` **`lib/stratus.mli`** ```ocaml -val v : string val cumulus : string ``` + **`lib/stratus.ml`** ```ocaml -let latin_root = "strat" -let v = latin_root ^ "us (St)" -let cumulus = latin_root ^ "ocumulus (Sc)" +let nimbus = "Nimbostratus (Ns)" +``` + +All the modules found in the `lib` folder are bundled into the `Wmo` module. This module is the same as what we had in the `wmo.ml` file. To avoid redundancy, we delete it: +```shell +$ rm wmo.ml ``` -The executable and the corresponding `dune` file need to be updated to use the defined library as a dependency. +We update the `dune` file building the executable to use the library as a dependency. **`dune`** ```lisp @@ -168,8 +163,6 @@ The executable and the corresponding `dune` file need to be updated to use the d (libraries wmo)) ``` - - **Observations**: * Dune creates a module `Wmo` from the contents of folder `lib`. * The folder's name (here `lib`) is irrelevant. @@ -179,9 +172,9 @@ The executable and the corresponding `dune` file need to be updated to use the d ## Library Wrapper Modules -By default, when Dune bundles modules into a library, they are wrapped into a module. It is possible to bypass Dune's behaviour by manually writing the wrapper file. +By default, when Dune bundles modules into a library, they are automatically wrapped into a module. It is possible to manually write the wrapper file. The wrapper file must have the same name as the library. -This `lib/wmo.ml` is the wrapper file that corresponds to the module that Dune automatically generated in the previous section. +Here, we are creating a wrapper file for the `wmo` library from the previous section. **`lib/wmo.ml`** ```ocaml @@ -191,21 +184,23 @@ module Stratus = Stratus Here is how to make sense of these module definitions: - On the left-hand side, `module Cumulus` means module `Wmo` contains a submodule named `Cumulus`. -- On the right-hand side, `Cumulus` refers to the module defined in the files `lib/cumulus.ml` and `lib/cumulus.mli`. +- On the right-hand side, `Cumulus` refers to the module defined in the file `lib/cumulus.ml`. + -Check with `dune exec nube` to ensure the program's behaviour is the same as in the previous section. +Run `dune exec nube` to see that the behaviour of the program is the same as in the previous section. -When a library folder contains a wrapper module (here `wmo.ml`), it is the only one exposed. A file-based module that does not appear in the wrapper module is private. +When a library folder contains a wrapper module (here `wmo.ml`), it is the only one exposed. All other file-based modules from that folder that do not appear in the wrapper module are private. Using a wrapper file makes several things possible: - Have different public and internal names, `module CumulusCloud = Cumulus` - Define values in the wrapper module, `let ... = ` - Expose module resulting from functor application, `module StringSet = Set.Make(String)` - Apply the same interface type to several modules without duplicating files +- Hide modules by not listing them ## Include Subdirectories -By default, Dune builds libraries from modules found in folders, but it doesn't look into subfolders. It is possible to change this behaviour. +By default, Dune builds a library from the modules found in the same folder as the `dune` file, but it doesn't look into subfolders. It is possible to change this behaviour. In this example, we create subdirectories and move files there. ```shell @@ -232,9 +227,11 @@ module Cumulus = Cumulus.M module Stratus = Stratus.M ``` -Check with `dune exec nube` that the behaviour of the program is the same as in the previous sections. +Run `dune exec nube` to see that the behaviour of the program is the same as in the two previous sections. + +The `include_subdirs qualified` stanza works recursively, except on subfolders containing a `dune` file. See the [Dune](https://dune.readthedocs.io/en/stable/dune-files.html#include-subdirs) [documentation](https://github.com/ocaml/dune/issues/1084) for [more](https://discuss.ocaml.org/t/upcoming-dune-feature-include-subdirs-qualified) on this [topic](https://github.com/ocaml/dune/tree/main/test/blackbox-tests/test-cases/include-qualified). ## Conclusion -The OCaml module system allows organizing a project in many ways. Dune provides several means to generate modules embodying some possible ways. +The OCaml module system allows organizing a project in many ways. Dune provides several means to arrange modules into libraries. From 116c93fc50af49265850d043e9e7250ca4c6d5f6 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 19 Dec 2023 15:42:16 +0100 Subject: [PATCH 19/53] Fix dune describe output --- data/tutorials/language/1ms_02_dune.md | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index bb8ecc2ae3..1779191f0e 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -98,13 +98,18 @@ Here are the different names: The `dune describe` command allows having a look at the project's module structure. Here is its output: ```lisp -((root /home/cuihtlauac/mixtli) +((root /home/cuihtlauac/caml/mixtli-dune) (build_context _build/default) (executables ((names (cloud)) (requires ()) (modules - (((name Cloud) + (((name Wmo) + (impl (_build/default/wmo.ml)) + (intf ()) + (cmt (_build/default/.cloud.eobjs/byte/wmo.cmt)) + (cmti ())) + ((name Cloud) (impl (_build/default/cloud.ml)) (intf ()) (cmt (_build/default/.cloud.eobjs/byte/cloud.cmt)) From da444164c1b9986db269d043a1ffcd2a7b9cee0b Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 20 Dec 2023 11:18:27 +0100 Subject: [PATCH 20/53] Add how-to dune empty project --- data/tutorials/language/1ms_02_dune.md | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 1779191f0e..f4726a74dc 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -236,6 +236,32 @@ Run `dune exec nube` to see that the behaviour of the program is the same as in The `include_subdirs qualified` stanza works recursively, except on subfolders containing a `dune` file. See the [Dune](https://dune.readthedocs.io/en/stable/dune-files.html#include-subdirs) [documentation](https://github.com/ocaml/dune/issues/1084) for [more](https://discuss.ocaml.org/t/upcoming-dune-feature-include-subdirs-qualified) on this [topic](https://github.com/ocaml/dune/tree/main/test/blackbox-tests/test-cases/include-qualified). + + ## Conclusion The OCaml module system allows organizing a project in many ways. Dune provides several means to arrange modules into libraries. From 018bdf12af6512aa8ca453bd6dfdd058bba914aa Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 20 Dec 2023 13:49:53 +0100 Subject: [PATCH 21/53] Add intros and conclusions --- data/tutorials/language/1ms_00_modules.md | 19 +++++++++++++++++++ data/tutorials/language/1ms_01_functors.md | 4 ++++ 2 files changed, 23 insertions(+) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 894e383600..d71673be25 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -7,6 +7,16 @@ description: > category: "Module System" --- +## Introduction + +Here are the goals of this tutorial +- Learn how to use modules +- Learn how to define modules + +Modules are collections of definitions grouped in a unit. This is the basic means to organize OCaml software. Separate concerns can and should be isolated into separate modules. + +**Prerequisites**: [Values and Functions](/docs/values-and-functions) and [Basic Data Types and Pattern Matching](/docs/basic-data-types) + ## Basic Usage ### File-Based Modules @@ -352,3 +362,12 @@ end It creates a module `Extlib.List` that has everything the standard `List` module has, plus a new `uncons` function. In order to override the default `List` module from another `.ml` file, we merely need to add `open Extlib` at the beginning. + +## Conclusion + +In OCaml, modules are the basic means of organizing software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module has an interface, which is the list of what a module exposes. By default, a module's interface exposes all its definitions, but this can be restricted using the interface syntax. + +Going further, here are the other means to handle OCaml software components: +- Functors, which act like functions from modules to modules +- Libraries, which are compiled modules bundled together into archives +- Packages, which are installation and distribution units diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index a8d3254579..8f8770d454 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -422,3 +422,7 @@ Run the `dune utop` command. Once inside the toplevel, enter the following comma Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. For brevity, the output of the first two toplevel commands is not shown here. ## Conclusion + +Functors are pretty unique to the ML family of programming languages. They provide a means to inject implementations of functions inside a module. The same behaviour can be achieved by passing the injected functions as high-order parameters. However, functors allow injection of groups of implementations throughout a whole module, not a single function, which is more convenient. + +These injections are functor applications, which essentially work the same way as function applications: passing parameters and getting results. Beyond comfort, it enables a design approach where concerns are not only separated in silos, this is enabled by modules, but also in stages stacked upon each other. From f2823133789e2e8479875de6e1479d1744fc72e2 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 20 Dec 2023 13:59:44 +0100 Subject: [PATCH 22/53] Fix typo --- data/tutorials/language/1ms_00_modules.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index d71673be25..a271b7be41 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -1,5 +1,5 @@ --- -id : modules +id: modules title: Modules short_title: Modules description: > From 0b2424e41b2e9ca5235387c921d2dc74d42f7645 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 20 Dec 2023 14:40:16 +0100 Subject: [PATCH 23/53] Review edits --- data/tutorials/language/1ms_00_modules.md | 12 +++++------- data/tutorials/language/1ms_01_functors.md | 15 ++++++--------- data/tutorials/language/1ms_02_dune.md | 10 +++++----- 3 files changed, 16 insertions(+), 21 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index a271b7be41..4db6ac75b4 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -3,17 +3,15 @@ id: modules title: Modules short_title: Modules description: > - Learn about OCaml modules and how they can be used to cleanly separate distinct parts of your program + Modules are collections of definitions grouped together. This is the basic means to organise OCaml software. category: "Module System" --- ## Introduction -Here are the goals of this tutorial -- Learn how to use modules -- Learn how to define modules +In this tutorial, we look at how to use and define modules. -Modules are collections of definitions grouped in a unit. This is the basic means to organize OCaml software. Separate concerns can and should be isolated into separate modules. +Modules are collections of definitions grouped together. This is the basic means to organise OCaml software. Separate concerns can and should be isolated into separate modules. **Prerequisites**: [Values and Functions](/docs/values-and-functions) and [Basic Data Types and Pattern Matching](/docs/basic-data-types) @@ -365,9 +363,9 @@ module has, plus a new `uncons` function. In order to override the default `List ## Conclusion -In OCaml, modules are the basic means of organizing software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module has an interface, which is the list of what a module exposes. By default, a module's interface exposes all its definitions, but this can be restricted using the interface syntax. +In OCaml, modules are the basic means of organising software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module has an interface, which is the list of definitions a module exposes. By default, a module's interface exposes all its definitions, but this can be restricted using the interface syntax. Going further, here are the other means to handle OCaml software components: - Functors, which act like functions from modules to modules -- Libraries, which are compiled modules bundled together into archives +- Libraries, which are compiled modules bundled together - Packages, which are installation and distribution units diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 8f8770d454..0ad12368ff 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -3,16 +3,13 @@ id: functors title: Functors short_title: Functors description: > - Learn about functors, modules parameterised by other modules + Functors essentially work the same way as functions. The difference is that we are passing modules instead of values. category: "Module System" --- ## Introduction -Here are the goals of this tutorial -- Learn how to use a functor -- Learn how to write a functor -- Learn some of the cases, when to use a functor +In this tutorial, we look at how to use a functor, how to write a functor, and show a couple of use cases involving functors. As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor is a parametrised module. @@ -52,7 +49,7 @@ module type OrderedType = sig end module type S = sig - (** This is the signature of the module returned by applying `Make` *) + (** This is the module's signature returned by applying `Make` *) end module Make : functor (Ord : OrderedType) -> S @@ -360,7 +357,7 @@ let _ = Check the program's behaviour using `dune exec funkt < dune`. -**Note**: The functor `IterPrint.Make` returns a module that exposes the type from the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that is not exposed in the signature of the initial version of `IterMake` (i.e., in the type of `IterMake.f`), that constraint wouldn't be needed, and the call site of `IterPrint.f` would be unchanged when injecting another dependency. +**Note**: The functor `IterPrint.Make` returns a module that exposes the type from the injected dependency (here first `List.t` then `Array.t`). That's why a `with type` constraint is needed. If the dependency was an _implementation detail_ that wasn't exposed in the signature of `IterMake`'s initial version (i.e., in the type of `IterMake.f`), that constraint wouldn't be needed. Plus, the call site of `IterPrint.f` would be unchanged when injecting another dependency. ## Write a Functor to Extend Modules @@ -423,6 +420,6 @@ Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.sca ## Conclusion -Functors are pretty unique to the ML family of programming languages. They provide a means to inject implementations of functions inside a module. The same behaviour can be achieved by passing the injected functions as high-order parameters. However, functors allow injection of groups of implementations throughout a whole module, not a single function, which is more convenient. +Functors are pretty unique to the ML family of programming languages. They provide a means to pass definitions inside a module. The same behaviour can be achieved with high-order parameters. However, functors allow passing several definitions at once, which is more convenient. -These injections are functor applications, which essentially work the same way as function applications: passing parameters and getting results. Beyond comfort, it enables a design approach where concerns are not only separated in silos, this is enabled by modules, but also in stages stacked upon each other. +Functor application essentially works the same way as function application: passing parameters and getting results. The difference is that we are passing modules instead of values. Beyond comfort, it enables a design approach where concerns are not only separated in silos, which is enabled by modules, but also in stages stacked upon each other. diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index f4726a74dc..20dbb6a697 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -1,16 +1,16 @@ --- -id: modules-libraries-dune -title: Modules and Libraries in Dune +id: libraries-dune +title: Libraries With Dune description: > - Learn about the features of Dune that interact with the OCaml module system + Dune provides several means to arrange modules into libraries. We look at Dune's mechanisms for structuring projects with libraries that contain modules. category: "Module System" --- -# Modules and Libraries in Dune +# Libraries With Dune ## Introduction -The goal of this tutorial is to teach the mechanisms built in Dune that allow structuring projects with libraries that contain modules. +Dune provides several means to arrange modules into libraries. We look at Dune's mechanisms for structuring projects with libraries that contain modules. This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have version 3.7 or later installed. From f1388288366e17e0f4f5ae7b3e343295149a8456 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 10 Jan 2024 16:57:26 +0100 Subject: [PATCH 24/53] Include feedback from @yawaramin Discuss post: https://discuss.ocaml.org/t/draft-tutorials-on-modules-functors-and-libraries/13686/2 --- data/tutorials/language/1ms_01_functors.md | 5 ++--- data/tutorials/language/1ms_02_dune.md | 11 ++++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 0ad12368ff..e93d1fec39 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -17,16 +17,15 @@ As suggested by the name, a _functor_ is almost like a function. However, while ## Project Setup -This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, `funkt.opam`, and `funkt.ml`. The latter two are created empty. +This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, and `funkt.ml`. The latter two are created empty. ```shell $ mkdir funkt; cd funkt - -$ touch funkt.opam funkt.ml ``` **`dune-project`** ```lisp (lang dune 3.7) +(package (name funkt)) ``` **`dune`** diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 20dbb6a697..8c3a874e68 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -21,8 +21,6 @@ This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have This section details the structure of an almost-minimum Dune project setup. Check [Your First OCaml Program](/docs/your-first-program) for automatic setup using the `dune init proj` command. ```shell $ mkdir mixtli; cd mixtli - -$ touch mixtli.opam ``` In this directory, create four more files: `dune-project`, `dune`, `cloud.ml`, and `wmo.ml`: @@ -30,9 +28,10 @@ In this directory, create four more files: `dune-project`, `dune`, `cloud.ml`, a **`dune-project`** ```lisp (lang dune 3.7) +(package (name wmo-clouds)) ``` -This file contains the global project configuration. It's kept to the bare minimum, including the `lang dune` stanza that specifies the required Dune version. +This file contains the global project configuration. It's kept almost to the minimum, including the `lang dune` stanza that specifies the required Dune version and the `package` stanza that makes this tutorial simpler. **`dune`** ```lisp @@ -75,7 +74,6 @@ Here is the folder contents: ```shell $ tree . -├── mixtli.opam ├── dune ├── dune-project ├── cloud.ml @@ -95,6 +93,7 @@ Here are the different names: * `nube` is the executable command's name (it means *cloud* in Spanish). * `Cloud` is the name of the module associated with the file `cloud.ml`. * `Wmo` is the name of the module associated with the file `wmo.ml`. +* `wmo-clouds` is the name of the package built by this project. The `dune describe` command allows having a look at the project's module structure. Here is its output: ```lisp @@ -121,7 +120,9 @@ The `dune describe` command allows having a look at the project's module structu ## Libraries -In OCaml, a library is a collection of modules. By default, when Dune builds a library, it wraps the bundled modules into a module. Dune creates libraries from folders. Let's look at an example, here the folder is `lib`: +In OCaml, a library is a collection of modules. By default, when Dune builds a library, it wraps the bundled modules into a module. This allows having several modules with the same name, inside different libraries, in the same project. That feature is known as [_namespaces_](https://en.wikipedia.org/wiki/Namespace) for module names. This is similar to what module do for definitions, they avoid name clashes. + +Dune creates libraries from folders. Let's look at an example, here the folder is `lib`: ```shell $ mkdir lib ``` From 8441932a16b8a23d8022422433ecdf607a285987 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 10 Jan 2024 18:31:42 +0100 Subject: [PATCH 25/53] Stateful modules --- data/tutorials/language/1ms_00_modules.md | 22 ++++++ data/tutorials/language/1ms_01_functors.md | 80 ++++++++++++++++++++++ 2 files changed, 102 insertions(+) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 4db6ac75b4..169e2e4a0b 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -361,6 +361,28 @@ end It creates a module `Extlib.List` that has everything the standard `List` module has, plus a new `uncons` function. In order to override the default `List` module from another `.ml` file, we merely need to add `open Extlib` at the beginning. +## Stateful Modules + +A module may have an internal state. This is the case of the `Random` module of the standard library. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is kept abstract. +```ocaml +# let s = Random.get_state ();; +val s : Random.State.t = + +# Random.bits ();; +- : int = 89809344 + +# Random.bits ();; +- : int = 994326685 + +# Random.set_state s;; +- : unit = () + +# Random.bits ();; +- : int = 89809344 +``` + +Values returned by `Random.bits` will differ in your setup, but the first and third calls return the same results, showing that the internal state was reset. + ## Conclusion In OCaml, modules are the basic means of organising software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module has an interface, which is the list of definitions a module exposes. By default, a module's interface exposes all its definitions, but this can be restricted using the interface syntax. diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index e93d1fec39..d0294ca600 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -417,6 +417,86 @@ Run the `dune utop` command. Once inside the toplevel, enter the following comma Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.scan_left`. For brevity, the output of the first two toplevel commands is not shown here. +## Initialisation of Stateful Modules + +Modules can hold a state. Functors can provide a means to initialize stateful modules. As an example of such, here is a possible way to handle random number generation seeds as a state. + +**`random.ml`** +```ocaml +module type SeedType : sig + val v : int array +end + +module type S : sig + val reset_state : unit -> unit + + val bits : unit -> int + val bits32 : unit -> int32 + val bits64 : unit -> int64 + val nativebits : unit -> nativeint + val int : int -> int + val int32 : int32 -> int32 + val int64 : int64 -> int64 + val nativeint : nativeint -> nativeint + val full_int : int -> int + val float : float -> float + val bool : unit -> bool + +end + +module Make(Seed: SeedType) : S = struct + let state = Seed.v |> Random.State.make |> ref + let reset_state () = state := Random.State.make Seed.v + + let bits () = Random.State.bits !state + let bits32 () = Random.State.bits32 !state + let bits64 () = Random.State.bits64 !state + let nativebits () = Random.State.nativebits !state + let int = Random.State.int !state + let int32 = Random.State.int32 !state + let int64 = Random.State.int64 !state + let nativeint = Random.State.nativeint !state + let full_int = Random.State.full_int !state + let float = Random.State.float !state + let bool () = Random.State.bool !state +end +``` + +Create this file and launch `utop`. +```ocaml +# #mod_use "random.ml";; + +# module R1 = Random.Make(struct let v = [|0; 1; 2; 3|] end);; + +# module R2 = Random.Make(struct let v = [|0; 1; 2; 3|] end);; + +# R1.bits ();; +- : int = 75783189 + +# R2.bits ();; +- : int = 75783189 + +# R1.bits ();; +- : int = 774473149 + +# R1.reset_state ();; +- : unit = () + +# R2.bits ();; +- : int = 774473149 + +# R1.bits ();; +- : int = 75783189 +``` + +Modules `R1` and `R2` are created with the same state, therefore, the first calls to `R1.bits` and `R2.bits` return the same value. + +The second call to `R1.bits` moves `R1`'s state one step and returns the corresponding bits. The call to `R1.reset_state` sets the `R1`'s state to its initial value. + +Calling `R2.bits` a second time shows the modules aren't sharing the state, otherwise, the value from the first calls to `bits` would have been returned. + +Calling `R1.bits` a third time returns the same result as the first call, which demonstrates the state has indeed been reset. + ## Conclusion Functors are pretty unique to the ML family of programming languages. They provide a means to pass definitions inside a module. The same behaviour can be achieved with high-order parameters. However, functors allow passing several definitions at once, which is more convenient. From ddbf25fa58b8f5b5a6572c91dc45e3c0ad18cbd4 Mon Sep 17 00:00:00 2001 From: Cuihtlauac Alvarado Date: Fri, 12 Jan 2024 11:26:02 +0100 Subject: [PATCH 26/53] Update data/tutorials/language/1ms_01_functors.md Co-authored-by: Christine Rose --- data/tutorials/language/1ms_01_functors.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index d0294ca600..760168c825 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -314,7 +314,7 @@ module Make(Dep: Iterable) : S with type 'a t := 'a Dep.t = struct end ``` -The module `IterPrint` is refactored into a functor that takes as a parameter a module providing the function `iter`. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency; at the time it is compiled, no implementation of function `iter` is available yet. +The module `IterPrint` is refactored into a functor that takes a module providing the function `iter` as a parameter. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency. At the time it is compiled, no implementation of function `iter` is available yet. **Note**: An OCaml interface file must be a module, not a functor. Functors must be embedded inside modules. Therefore, it is customary to call them `Make`. From f8d4dd5554d3cd094fd74b5d002ceca59dbed4f9 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 12 Jan 2024 09:16:38 +0100 Subject: [PATCH 27/53] Refer to Set tutorial --- data/tutorials/language/1ms_01_functors.md | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 760168c825..98a1b136f4 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -40,7 +40,7 @@ Check this works using the `dune exec funkt` command, it shouldn't do anything ( ## Using an Existing Functor: `Set.Make` -The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows operations like union and intersection. To use the provided type and its associated [functions](/api/Set.S.html), it's necessary to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`: +The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows set operations like union and intersection. You may check the [Set](/docs/sets) tutorial to learn more about this module, but it is not required to follow the present tutorial. To use the provided type and its associated [functions](/api/Set.S.html), it's necessary to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`: ```ocaml module type OrderedType = sig type t @@ -260,6 +260,23 @@ end Here, binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each (e.g., `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc.). + + + ## Injecting Dependencies Using Functors **Dependencies Between Modules** @@ -441,7 +458,6 @@ module type S : sig val full_int : int -> int val float : float -> float val bool : unit -> bool - end module Make(Seed: SeedType) : S = struct From 1db7ed211310635a8f0b7256fc8ebdadff4115f2 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 12 Jan 2024 13:07:32 +0100 Subject: [PATCH 28/53] Wording --- data/tutorials/language/1ms_01_functors.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 98a1b136f4..87f0e5fa9d 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -169,8 +169,8 @@ This allows the user to seemingly extend the module `String` with a submodule `S ### Functors from the Standard Library Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrised, in other words, functors. That's the case for the sets, maps, and hash tables provided by the standard library. It works like a contract between the functor and the developer: -* If you provide a module that implements what is expected (the parameter interface) -* The functor returns a module that implements what is promised (the result interface) +* If you provide a module that implements what is expected, as described the parameter interface +* The functor returns a module that implements what is promised, as described by the result interface Here is the module's signature that the functors `Set.Make` and `Map.Make` expect: ```ocaml @@ -518,3 +518,5 @@ Calling `R1.bits` a third time returns the same result as the first call, which Functors are pretty unique to the ML family of programming languages. They provide a means to pass definitions inside a module. The same behaviour can be achieved with high-order parameters. However, functors allow passing several definitions at once, which is more convenient. Functor application essentially works the same way as function application: passing parameters and getting results. The difference is that we are passing modules instead of values. Beyond comfort, it enables a design approach where concerns are not only separated in silos, which is enabled by modules, but also in stages stacked upon each other. + +When several implementations of the same interface are needed at runtime, functors allow sharing of their common parts. \ No newline at end of file From e3e340c7950e5a8da5c36b4c3d9ad88dd88476e8 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Sat, 13 Jan 2024 01:47:25 -0800 Subject: [PATCH 29/53] Minor grammar --- data/tutorials/language/1ms_02_dune.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 8c3a874e68..fb257afc2c 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -120,9 +120,9 @@ The `dune describe` command allows having a look at the project's module structu ## Libraries -In OCaml, a library is a collection of modules. By default, when Dune builds a library, it wraps the bundled modules into a module. This allows having several modules with the same name, inside different libraries, in the same project. That feature is known as [_namespaces_](https://en.wikipedia.org/wiki/Namespace) for module names. This is similar to what module do for definitions, they avoid name clashes. +In OCaml, a library is a collection of modules. By default, when Dune builds a library, it wraps the bundled modules into a module. This allows having several modules with the same name, inside different libraries, in the same project. That feature is known as [_namespaces_](https://en.wikipedia.org/wiki/Namespace) for module names. This is similar to what module do for definitions; they avoid name clashes. -Dune creates libraries from folders. Let's look at an example, here the folder is `lib`: +Dune creates libraries from folders. Let's look at an example. Here the folder is `lib`: ```shell $ mkdir lib ``` From 824b506e63eef25cacc445e0d4eb026387c5805d Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Sat, 13 Jan 2024 01:54:09 -0800 Subject: [PATCH 30/53] minor grammar --- data/tutorials/language/1ms_01_functors.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 87f0e5fa9d..7d11f66951 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -436,7 +436,7 @@ Modules `Array` and `List` appear augmented with `Array.scan_left` and `List.sca ## Initialisation of Stateful Modules -Modules can hold a state. Functors can provide a means to initialize stateful modules. As an example of such, here is a possible way to handle random number generation seeds as a state. +Modules can hold a state. Functors can provide a means to initialise stateful modules. As an example of such, here is a possible way to handle random number generation seeds as a state: **`random.ml`** ```ocaml @@ -505,11 +505,11 @@ Create this file and launch `utop`. - : int = 75783189 ``` -Modules `R1` and `R2` are created with the same state, therefore, the first calls to `R1.bits` and `R2.bits` return the same value. +Modules `R1` and `R2` are created with the same state; therefore, the first calls to `R1.bits` and `R2.bits` return the same value. The second call to `R1.bits` moves `R1`'s state one step and returns the corresponding bits. The call to `R1.reset_state` sets the `R1`'s state to its initial value. -Calling `R2.bits` a second time shows the modules aren't sharing the state, otherwise, the value from the first calls to `bits` would have been returned. +Calling `R2.bits` a second time shows the modules aren't sharing the state. Otherwise, the value from the first calls to `bits` would have been returned. Calling `R1.bits` a third time returns the same result as the first call, which demonstrates the state has indeed been reset. @@ -519,4 +519,4 @@ Functors are pretty unique to the ML family of programming languages. They provi Functor application essentially works the same way as function application: passing parameters and getting results. The difference is that we are passing modules instead of values. Beyond comfort, it enables a design approach where concerns are not only separated in silos, which is enabled by modules, but also in stages stacked upon each other. -When several implementations of the same interface are needed at runtime, functors allow sharing of their common parts. \ No newline at end of file +When several implementations of the same interface are needed at runtime, functors allow sharing of their common parts. From ab295ac167f9283f9097746122e5da9b2a165f70 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 12 Jan 2024 15:30:42 +0100 Subject: [PATCH 31/53] Mention cats functors --- data/tutorials/language/1ms_01_functors.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 7d11f66951..63586560ab 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -13,6 +13,8 @@ In this tutorial, we look at how to use a functor, how to write a functor, and s As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor is a parametrised module. +In mathematics, [functor](https://en.wikipedia.org/wiki/Functor) means something different. You don't need to know about those functors to understand OCaml's ones. + **Prerequisites**: [Modules](/docs/modules). ## Project Setup From d455c3f7bb679408b818cf05a787d6fba08f757c Mon Sep 17 00:00:00 2001 From: Cuihtlauac Alvarado Date: Tue, 23 Jan 2024 14:40:40 +0100 Subject: [PATCH 32/53] Update data/tutorials/language/1ms_01_functors.md Co-authored-by: Christine Rose --- data/tutorials/language/1ms_01_functors.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 63586560ab..006d2ccb9b 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -13,7 +13,7 @@ In this tutorial, we look at how to use a functor, how to write a functor, and s As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor is a parametrised module. -In mathematics, [functor](https://en.wikipedia.org/wiki/Functor) means something different. You don't need to know about those functors to understand OCaml's ones. +In mathematics, [functor](https://en.wikipedia.org/wiki/Functor) means something different. You don't need to know about those functors to understand OCaml's. **Prerequisites**: [Modules](/docs/modules). From 339d2a0b822917cdbbb21d177354feca473be678 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 24 Jan 2024 11:52:45 +0100 Subject: [PATCH 33/53] Refresh modules.md text --- .../examples/{amodule.ml => athens.ml} | 0 .../examples/{bmodule.ml => berlin.ml} | 0 .../examples/{amodule2.ml => cairo.ml} | 0 .../examples/{bmodule2.ml => delhi.ml} | 0 data/tutorials/language/1ms_00_modules.md | 121 ++++++++++-------- 5 files changed, 70 insertions(+), 51 deletions(-) rename data/tutorials/examples/{amodule.ml => athens.ml} (100%) rename data/tutorials/examples/{bmodule.ml => berlin.ml} (100%) rename data/tutorials/examples/{amodule2.ml => cairo.ml} (100%) rename data/tutorials/examples/{bmodule2.ml => delhi.ml} (100%) diff --git a/data/tutorials/examples/amodule.ml b/data/tutorials/examples/athens.ml similarity index 100% rename from data/tutorials/examples/amodule.ml rename to data/tutorials/examples/athens.ml diff --git a/data/tutorials/examples/bmodule.ml b/data/tutorials/examples/berlin.ml similarity index 100% rename from data/tutorials/examples/bmodule.ml rename to data/tutorials/examples/berlin.ml diff --git a/data/tutorials/examples/amodule2.ml b/data/tutorials/examples/cairo.ml similarity index 100% rename from data/tutorials/examples/amodule2.ml rename to data/tutorials/examples/cairo.ml diff --git a/data/tutorials/examples/bmodule2.ml b/data/tutorials/examples/delhi.ml similarity index 100% rename from data/tutorials/examples/bmodule2.ml rename to data/tutorials/examples/delhi.ml diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 169e2e4a0b..c8f24be9a1 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -3,7 +3,7 @@ id: modules title: Modules short_title: Modules description: > - Modules are collections of definitions grouped together. This is the basic means to organise OCaml software. + Modules are collections of definitions. This is the basic means to organise OCaml software. category: "Module System" --- @@ -23,35 +23,35 @@ In OCaml, every piece of code is wrapped into a module. Optionally, a module itself can be a submodule of another module, pretty much like directories in a file system. -When you write a program, let's say using the two files `amodule.ml` and -`bmodule.ml`, each automatically defines a module named -`Amodule` and a module named `Bmodule`, which provides whatever you put into the +When you write a program, let's say using the two files `athens.ml` and +`berlin.ml`, each automatically defines a module named +`Athens` and `Berlin`, which provides whatever you put into the files. -Here is the code that we have in our file `amodule.ml`: - +Here is the code that we have in our file `athens.ml`: + ```ocaml -let hello () = print_endline "Hello" +let hello () = print_endline "Hello from Athens" ``` -This is what we have in `bmodule.ml`: - +This is what we have in `berlin.ml`: + ```ocaml -let () = Amodule.hello () +let () = Athens.hello () ``` In order to compile them using the [Dune](https://dune.build/) build system, at least two configuration files are required: -* The `dune-project` file, which contains project-wide configuration data. +* The `dune-project` file contains project-wide configuration data. Here's a very minimal one: ```lisp (lang dune 3.7) ``` -* The `dune` file, which contains actual build directives. A project may have several +* The `dune` file contains actual build directives. A project may have several of them, depending on the organisation of the sources. This is sufficient for our example: ```lisp - (executable (name bmodule)) + (executable (name berlin)) ``` Here is how to create the configuration files, build the source, and run the @@ -59,16 +59,16 @@ executable: ```bash $ echo "(lang dune 3.7)" > dune-project -$ echo "(executable (name bmodule))" > dune -$ opam exec -- dune build -$ opam exec -- dune exec ./bmodule.exe +$ echo "(executable (name berlin))" > dune +$ opam exec -- une build +$ opam exec -- dune exec ./berlin.exe Hello ``` Actually, `dune build` is optional. Simply running `dune exec` would have -triggered the compilation. Note that in the `dune exec` command the argument -`./bmodule.exe` is not a file path. This command means “execute the content of -the file `./bmodule.ml`.” However, the actual executable file is stored and +triggered the compilation. Beware that in the `dune exec` command, as the parameter +`./berlin.exe` is not a file path. This command means “execute the content of +the file `./berlin.ml`.” However, the actual executable file is stored and named differently. In a real-world project, it is preferable to start by creating the `dune` @@ -77,7 +77,7 @@ command. ### Naming and Scoping -Now we have an executable that prints `Hello`. If you want to +Now we have an executable that prints `Hello from Athens`. If you want to access anything from a given module, use the name of the module (always starting with a capital letter) followed by a dot and the thing you want to use. It may be a value, a type constructor, or anything else that a given module can @@ -88,11 +88,11 @@ For example, `List.iter` designates the `iter` function from the `List` module. If you are using a given module heavily, you may want to make its contents directly accessible. For this, we use the `open` directive. In our example, -`bmodule.ml` could have been written: +`berlin.ml` could have been written: ```ocaml -open Amodule +open Athens let () = hello () ``` @@ -109,24 +109,26 @@ let data = ["a"; "beautiful"; "day"] let () = List.iter (printf "%s\n") data ``` -There are also local `open`s: + The standard library is a module called `Stdlib` where modules `List`, `Option`, `Either` and others are [submodules](#submodules). Implicitly, all OCaml begins with `open Stdlib` which avoids writing `Stdlib.List.map`, `Stdlib.Array` or using `Stdlib.` anywhere. + +There are also two means to open modules locally: ```ocaml -# let sum_sq m = +# let list_sum_sq m = let open List in init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0;; -val sum_sq : int -> int = +val list_sum_sq : int -> int = -# let sym_sq' m = +# let array_sum_sq m = Array.(init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0);; -val sum_sq' : int -> int = +val array_sum_sq : int -> int = ``` ## Interfaces and Signatures A module can provide a certain number of things (functions, types, submodules, -etc.) to the rest of the program using it. If nothing special is done, +etc.) to programs or libraries using it. If nothing special is done, everything that's defined in a module will be accessible from the outside. That's often fine in small personal programs, but there are many situations where it is better that a module only provides what it is meant to provide, not any of @@ -135,16 +137,16 @@ the auxiliary functions and types that are used internally. For this, we have to define a module interface, which will act as a mask over the module's implementation. Just like a module derives from a `.ml` file, the corresponding module interface or signature derives from a `.mli` file. It -contains a list of values with their type. Let's rewrite our `amodule.ml` file -to something called `amodule2.ml`: +contains a list of values with their type. Let's copy and change our `athens.ml` file +into something called `cairo.ml`: - + ```ocaml -let message = "Hello 2" +let message = "Hello from Cairo" let hello () = print_endline message ``` -As it is, `Amodule2` has the following interface: +As it is, `Cairo` has the following interface: ```ocaml @@ -154,9 +156,9 @@ val hello : unit -> unit Let's assume that accessing the `message` value directly is none of the other modules' business; we want it to be a private definition. We can hide it by -defining a restricted interface. This is our `amodule2.mli` file: +defining a restricted interface. This is our `cairo.mli` file: - + ```ocaml val hello : unit -> unit (** Displays a greeting message. *) @@ -165,26 +167,36 @@ val hello : unit -> unit Note the double asterisk at the beginning of the comment. It is a good habit to document `.mli` files using the format supported by [ocamldoc](/releases/4.14/htmlman/ocamldoc.html) + -The corresponding module `Bmodule2` is defined in file `bmodule2.ml`: +The `Cairo` calling program is defined in file `delhi.ml`: - + ```ocaml -let () = Amodule2.hello () +let () = Cairo.hello () ``` -The .`mli` files must be compiled before the matching `.ml` files. This is done +The `.mli` files must be compiled before the matching `.ml` files. This is done automatically by Dune. We update the `dune` file to allow the compilation of this example aside from the previous one. ```bash +<<<<<<< HEAD $ echo "(executables (names bmodule bmodule2))" > dune $ opam exec -- dune build $ opam exec -- dune exec ./bmodule.exe Hello $ opam exec -- dune exec ./bmodule2.exe Hello 2 +======= +$ echo "(executables (names berlin delhi))" > dune +$ dune build +$ dune exec ./berlin.exe +Hello from Athens +$ dune exec ./delhi.exe +Hello from Cairo +>>>>>>> 5196e1c0 (Refresh modules.md text) ``` ## Abstract Types @@ -197,7 +209,7 @@ exported by placing their name and their type in an `.mli` file, e.g.: val hello : unit -> unit ``` -But modules often define new types. Let's define a simple record type that +But modules often define new types. Let's define a record type that would represent a date: ```ocaml @@ -246,14 +258,14 @@ implementation, including data structures. ### Submodule Implementation -We saw that one `example.ml` file results automatically in the module -implementation named `Example`. Its module signature is automatically derived -and is the broadest possible, or it can be restricted by writing an `example.mli` +We saw that one `exeter.ml` file results automatically in the module +implementation named `Exeter`. Its module signature is automatically derived +and is the broadest possible, or it can be restricted by writing an `exeter.mli` file. That said, a given module can also be defined explicitly from within a file. That makes it a submodule of the current module. Let's consider this -`example.ml` file: +`exeter.ml` file: ```ocaml module Hello = struct @@ -268,20 +280,20 @@ let hello_goodbye () = goodbye () ``` -From another file, it is clear that we now have two levels of modules. We can +From another file, we now have two levels of modules. We can write: ```ocaml let () = - Example.Hello.hello (); - Example.goodbye () + Exeter.Hello.hello (); + Exeter.goodbye () ``` ### Submodule Interface We can also restrict the interface of a given submodule. It is called a module -type. Let's do it in our `example.ml` file: +type. Let's do it in our `exeter.ml` file: ```ocaml module Hello : sig @@ -303,7 +315,7 @@ let hello_goodbye () = ``` The definition of the `Hello` module above is the equivalent of a -`hello.mli`/`hello.ml` pair of files. Writing all of that in one block of code +`hello.mli`, `hello.ml` pair of files. Writing all of that in one block of code is not elegant, so in general, we prefer to define the module signature separately: @@ -341,7 +353,14 @@ module Fun : end ``` -There is online documentation for each library, for instance [`Fun`](/api/Fun.html) +There is online documentation for each library, for instance, [`Fun`](/api/Fun.html). + +The OCaml compiler tool chain can be used to dump a default interface from a `.ml` file. +```shell +$ ocamlc -c -i cairo.ml +val message : string +val hello : unit -> unit +``` ### Module Inclusion @@ -363,7 +382,7 @@ module has, plus a new `uncons` function. In order to override the default `List ## Stateful Modules -A module may have an internal state. This is the case of the `Random` module of the standard library. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is kept abstract. +A module may have an internal state. This is the case of the `Random` module of the standard library. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is nameless and has an abstract type. ```ocaml # let s = Random.get_state ();; val s : Random.State.t = From 5c51f5ab6d79f8042aa04e868988c9525840357b Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Wed, 24 Jan 2024 14:01:55 +0100 Subject: [PATCH 34/53] More refresh --- data/tutorials/language/1ms_00_modules.md | 39 ++++++++++------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index c8f24be9a1..0e91691e3e 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -127,8 +127,7 @@ val array_sum_sq : int -> int = ## Interfaces and Signatures -A module can provide a certain number of things (functions, types, submodules, -etc.) to programs or libraries using it. If nothing special is done, +A module can provide various kinds of things to programs or libraries: functions, types, submodules. If nothing special is done, everything that's defined in a module will be accessible from the outside. That's often fine in small personal programs, but there are many situations where it is better that a module only provides what it is meant to provide, not any of @@ -292,15 +291,13 @@ let () = ### Submodule Interface -We can also restrict the interface of a given submodule. It is called a module +We can also restrict the interface of a submodule. It is called a module type. Let's do it in our `exeter.ml` file: ```ocaml module Hello : sig val hello : unit -> unit -end -= -struct +end = struct let message = "Hello" let hello () = print_endline message end @@ -333,29 +330,27 @@ end `Hello_type` is a named module type and can be reused to define other module interfaces. -## Practical Manipulation of Modules +## Module Manipulation -### Displaying the Interface of a Module +### Displaying a Module's Interface -You can use the OCaml toplevel to visualise the contents of an existing -module, such as `Fun`: +You can use the OCaml toplevel to see the contents of an existing +module, such as `Unit`: ```ocaml -# #show Fun;; -module Fun : +# #show Unit;; +module Unit : sig - external id : 'a -> 'a = "%identity" - val const : 'a -> 'b -> 'a - val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c - val negate : ('a -> bool) -> 'a -> bool - val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a - exception Finally_raised of exn + type t = unit = () + val equal : t -> t -> bool + val compare : t -> t -> int + val to_string : t -> string end ``` -There is online documentation for each library, for instance, [`Fun`](/api/Fun.html). +There is online documentation for each library, for instance, [`Unit`](/api/Unit.html). -The OCaml compiler tool chain can be used to dump a default interface from a `.ml` file. +The OCaml compiler tool chain can be used to dump a `.ml` file default interface. ```shell $ ocamlc -c -i cairo.ml val message : string @@ -370,7 +365,7 @@ can achieve this effect by using the `include` directive: ```ocaml module List = struct - include List + include Stdlib.List let uncons = function | [] -> None | hd :: tl -> Some (hd, tl) @@ -382,7 +377,7 @@ module has, plus a new `uncons` function. In order to override the default `List ## Stateful Modules -A module may have an internal state. This is the case of the `Random` module of the standard library. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is nameless and has an abstract type. +A module may have an internal state. This is the case standard library `Random` module. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is nameless and has an abstract type. ```ocaml # let s = Random.get_state ();; val s : Random.State.t = From eaeffa6bb0310271628c9ca58138272c1906af3c Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Wed, 24 Jan 2024 13:02:59 -0800 Subject: [PATCH 35/53] minor grammar --- data/tutorials/language/1ms_00_modules.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 0e91691e3e..b53ddb0ff4 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -109,7 +109,7 @@ let data = ["a"; "beautiful"; "day"] let () = List.iter (printf "%s\n") data ``` - The standard library is a module called `Stdlib` where modules `List`, `Option`, `Either` and others are [submodules](#submodules). Implicitly, all OCaml begins with `open Stdlib` which avoids writing `Stdlib.List.map`, `Stdlib.Array` or using `Stdlib.` anywhere. + The standard library is a module called `Stdlib` where modules `List`, `Option`, `Either`, and others are [submodules](#submodules). Implicitly, all OCaml begins with `open Stdlib`, which avoids writing `Stdlib.List.map`, `Stdlib.Array`, or using `Stdlib.` anywhere. There are also two means to open modules locally: From cbe969caa2c3c1d78e53115e3906143e351ce2df Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Wed, 24 Jan 2024 13:03:49 -0800 Subject: [PATCH 36/53] UK spelling --- data/tutorials/language/1ms_02_dune.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index fb257afc2c..35917709de 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -265,5 +265,5 @@ Here `foo` is the project name and `foo.dir` is its container folder, the names ## Conclusion -The OCaml module system allows organizing a project in many ways. Dune provides several means to arrange modules into libraries. +The OCaml module system allows organising a project in many ways. Dune provides several means to arrange modules into libraries. From 3efd4f6c4c5ca19b43b8cf155f59423c94e40cfd Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Thu, 25 Jan 2024 17:36:23 +0100 Subject: [PATCH 37/53] Refresh until line 200 --- data/tutorials/language/1ms_00_modules.md | 178 ++++++++++++---------- 1 file changed, 100 insertions(+), 78 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index b53ddb0ff4..78e0bc05a3 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -23,96 +23,92 @@ In OCaml, every piece of code is wrapped into a module. Optionally, a module itself can be a submodule of another module, pretty much like directories in a file system. -When you write a program, let's say using the two files `athens.ml` and -`berlin.ml`, each automatically defines a module named -`Athens` and `Berlin`, which provides whatever you put into the -files. +When you write a program using two files named `athens.ml` and `berlin.ml`, +each automatically defines a module named `Athens` and `Berlin`, which provides +whatever you put into the files. -Here is the code that we have in our file `athens.ml`: +Here is the code in the file `athens.ml`: ```ocaml let hello () = print_endline "Hello from Athens" ``` -This is what we have in `berlin.ml`: +This is what is in `berlin.ml`: ```ocaml let () = Athens.hello () ``` -In order to compile them using the [Dune](https://dune.build/) build system, at least two configuration files are required: - +To compile them using [Dune](https://dune.build/), at least two +configuration files are required: * The `dune-project` file contains project-wide configuration data. Here's a very minimal one: ```lisp (lang dune 3.7) ``` * The `dune` file contains actual build directives. A project may have several - of them, depending on the organisation of the sources. This is sufficient for - our example: + `dune` files, one per folder containing things to build. This single line is + sufficient in this example: ```lisp (executable (name berlin)) ``` -Here is how to create the configuration files, build the source, and run the +Here is a possible way to create those files, build the source, and run the executable: ```bash $ echo "(lang dune 3.7)" > dune-project + $ echo "(executable (name berlin))" > dune -$ opam exec -- une build + +$ opan exec -- dune build + $ opam exec -- dune exec ./berlin.exe Hello ``` -Actually, `dune build` is optional. Simply running `dune exec` would have -triggered the compilation. Beware that in the `dune exec` command, as the parameter -`./berlin.exe` is not a file path. This command means “execute the content of -the file `./berlin.ml`.” However, the actual executable file is stored and -named differently. +Actually, `dune build` is optional. Running `dune exec` would have triggered the +compilation. Note that in the `dune exec` command, the parameter `./berlin.exe` +is not a file path. This command means “execute the content of the file +`./berlin.ml`.” However, the executable file is stored and named differently. -In a real-world project, it is preferable to start by creating the `dune` -configuration files and directory structure using the `dune init project` -command. +In a project, it is preferable to create the `dune` configuration files and +directory structure using the `dune init project` command. ### Naming and Scoping -Now we have an executable that prints `Hello from Athens`. If you want to -access anything from a given module, use the name of the module (always -starting with a capital letter) followed by a dot and the thing you want to use. -It may be a value, a type constructor, or anything else that a given module can -provide. - -Libraries, starting with the standard library, provide collections of modules. -For example, `List.iter` designates the `iter` function from the `List` module. - -If you are using a given module heavily, you may want to make its contents -directly accessible. For this, we use the `open` directive. In our example, -`berlin.ml` could have been written: +In `berlin.ml`, we used `Athens.hello` to refer to `hello` from `athens.ml`. +Generally, to access something from a module, use the module's name (which +always starts with a capital letter: `Athens`) followed by a dot and the +thing you want to use (`hello`). It may be a value, a type constructor, or +anything the module provides. +If you are using a module heavily, you can directly access its contents. To do +this, use the `open` directive. In our example, `berlin.ml` could have been +written: ```ocaml open Athens let () = hello () ``` -Using `open` or not is a matter of personal taste. Some modules provide names -that are used in many other modules. This is the case of the `List` module, for -instance. Usually, we don't do `open List`. Other modules like `Printf` provide -names that normally aren't subject to conflicts, such as `printf`. In order to -avoid writing `Printf.printf` all over the place, it often makes sense to place -one `open Printf` at the beginning of the file: - +Using `open` is optional. Usually, we don't open the module `List` because it +provides names other modules also provide, such as `Array` or `Option`. Other +modules like `Printf` provide names that aren't subject to conflicts, such as +`printf`. Placing `open Printf` at the beginning of the file avoids writing +`Printf.printf` all over the place. ```ocaml open Printf let data = ["a"; "beautiful"; "day"] let () = List.iter (printf "%s\n") data ``` - The standard library is a module called `Stdlib` where modules `List`, `Option`, `Either`, and others are [submodules](#submodules). Implicitly, all OCaml begins with `open Stdlib`, which avoids writing `Stdlib.List.map`, `Stdlib.Array`, or using `Stdlib.` anywhere. + The standard library is a module called `Stdlib` where modules `List`, + `Option`, `Either` and others are [submodules](#submodules). Implicitly, all + OCaml begins with `open Stdlib`. That avoids writing `Stdlib.List.map`, + `Stdlib.Array` or using `Stdlib.` anywhere. There are also two means to open modules locally: - ```ocaml # let list_sum_sq m = let open List in @@ -122,23 +118,25 @@ val list_sum_sq : int -> int = # let array_sum_sq m = Array.(init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0);; val array_sum_sq : int -> int = - ``` -## Interfaces and Signatures +## Interfaces and Implementations + +By default, anything defined in a module is accessible from other modules. +Values, functions, types, or submodules, everything is public. This can be +restricted. That allows distinguishing content provided to other modules from +internal use content. What is internal is kept private and not available from +other modules. -A module can provide various kinds of things to programs or libraries: functions, types, submodules. If nothing special is done, -everything that's defined in a module will be accessible from the outside. That's -often fine in small personal programs, but there are many situations where it -is better that a module only provides what it is meant to provide, not any of -the auxiliary functions and types that are used internally. +For this, we must distinguish: +- Implementation, which is a module's actual content. +- Interface, which is a module's public content list -For this, we have to define a module interface, which will act as a mask over -the module's implementation. Just like a module derives from a `.ml` file, the -corresponding module interface or signature derives from a `.mli` file. It -contains a list of values with their type. Let's copy and change our `athens.ml` file -into something called `cairo.ml`: +A `.ml` file contains a module implementation. By default, without an explicitly +defined interface, an implementation has a default interface where everything is +public. +Copy the `athens.ml` file into `cairo.ml` and change it with this contents: ```ocaml let message = "Hello from Cairo" @@ -146,38 +144,38 @@ let hello () = print_endline message ``` As it is, `Cairo` has the following interface: - ```ocaml val message : string val hello : unit -> unit ``` -Let's assume that accessing the `message` value directly is none of the other -modules' business; we want it to be a private definition. We can hide it by -defining a restricted interface. This is our `cairo.mli` file: +Explicitly defining a module interface, allows restricting the default one. It +acts as a mask over the module's implementation. The `cairo.ml` file defines +`Cairo`'s implementation. Adding a `cairo.mli` file defines `Cairo`'s interface. +Filenames, without extensions, must be the same. +To turn `message` into a private definition, don't list it in the `cairo.mli` file: ```ocaml val hello : unit -> unit -(** Displays a greeting message. *) +(** [hello ()] displays a greeting message. *) ``` -Note the double asterisk at the beginning of the comment. It is a good habit -to document `.mli` files using the format supported by -[ocamldoc](/releases/4.14/htmlman/ocamldoc.html) - +**Note**: The double asterisk at the beginning of the comment indicates a +comment meant for API documentation tools, such as +[odoc](https://github.com/ocaml/odoc). It is a good habit to document `.mli` +files using the format supported by this tool. -The `Cairo` calling program is defined in file `delhi.ml`: +The file `delhi.ml` defines the program calling `Cairo`: ```ocaml let () = Cairo.hello () ``` -The `.mli` files must be compiled before the matching `.ml` files. This is done -automatically by Dune. We update the `dune` file to allow the compilation -of this example aside from the previous one. +Update the `dune` file to allow the compilation of this example aside from the +previous one. ```bash @@ -190,35 +188,57 @@ $ opam exec -- dune exec ./bmodule2.exe Hello 2 ======= $ echo "(executables (names berlin delhi))" > dune + $ dune build + $ dune exec ./berlin.exe Hello from Athens + $ dune exec ./delhi.exe Hello from Cairo >>>>>>> 5196e1c0 (Refresh modules.md text) ``` -## Abstract Types +You can check that `Cairo.message` is not public by attempting to compile a `delhi.ml` file containing: +```ocaml +let () = print_endline Cairo.message +``` + +This triggers a compilation error. -What about type definitions? We saw that values such as functions can be -exported by placing their name and their type in an `.mli` file, e.g.: +## Abstract and Read-Only Types - +Function and value definitions are either public or private. That also applies +to type definitions, but there are two more cases. + +Create files named `exeter.ml` and `exeter.ml` with the following contents: + +**`exeter.ml`** ```ocaml -val hello : unit -> unit +type measure_unit = Metric | Imperial +type length = unit * i +type meter = int +type date = { day : int; month : int; year : int } +``` + +**`exeter.mli`** +```ocaml +type unit = Metric | Imperial +type meter +type date = private { day : int; month : int; year : int } ``` But modules often define new types. Let's define a record type that would represent a date: ```ocaml -type date = {day : int; month : int; year : int} +type date = { day : int; month : int; year : int } ``` There are four options when it comes to writing the `.mli` file: -1. The type is completely omitted from the signature. -2. The type definition is copy-pasted into the signature. +1. The type is completely omitted from the signature. In that case, the type is private. It can't be used from outside the module. +2. The type definition is copy-pasted into the signature. In that case, the type is public. It can be used 3. The type is made abstract: only its name is given. 4. The record fields are made read-only: `type date = private { ... }`. @@ -253,18 +273,20 @@ a lot of sense in a library because subsequent versions of it can continue to expose the same interface while internally changing the implementation, including data structures. +Case 4 + ## Submodules ### Submodule Implementation -We saw that one `exeter.ml` file results automatically in the module +We saw that one `fairbanks.ml` file results automatically in the module implementation named `Exeter`. Its module signature is automatically derived -and is the broadest possible, or it can be restricted by writing an `exeter.mli` +and is the broadest possible, or it can be restricted by writing an `fairbanks.mli` file. That said, a given module can also be defined explicitly from within a file. That makes it a submodule of the current module. Let's consider this -`exeter.ml` file: +`fairbanks.ml` file: ```ocaml module Hello = struct @@ -292,7 +314,7 @@ let () = ### Submodule Interface We can also restrict the interface of a submodule. It is called a module -type. Let's do it in our `exeter.ml` file: +type. Let's do it in our `fairbanks.ml` file: ```ocaml module Hello : sig From 82149ff34c23d01ca09e86a4007fa64d2d15f7b7 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Fri, 26 Jan 2024 02:31:12 -0800 Subject: [PATCH 38/53] add two commas --- data/tutorials/language/1ms_00_modules.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 78e0bc05a3..e02a59c93d 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -104,9 +104,9 @@ let () = List.iter (printf "%s\n") data ``` The standard library is a module called `Stdlib` where modules `List`, - `Option`, `Either` and others are [submodules](#submodules). Implicitly, all + `Option`, `Either`, and others are [submodules](#submodules). Implicitly, all OCaml begins with `open Stdlib`. That avoids writing `Stdlib.List.map`, - `Stdlib.Array` or using `Stdlib.` anywhere. + `Stdlib.Array`, or using `Stdlib.` anywhere. There are also two means to open modules locally: ```ocaml From ec2017b104789734a85f5bf900a8acf950bd56d3 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Fri, 26 Jan 2024 02:40:09 -0800 Subject: [PATCH 39/53] minor punctuation/grammar --- data/tutorials/language/1ms_00_modules.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index e02a59c93d..1c2f82c0dd 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -130,9 +130,9 @@ other modules. For this, we must distinguish: - Implementation, which is a module's actual content. -- Interface, which is a module's public content list +- Interface, which is a module's public content list. -A `.ml` file contains a module implementation. By default, without an explicitly +An `.ml` file contains a module implementation. By default, without an explicitly defined interface, an implementation has a default interface where everything is public. @@ -153,7 +153,7 @@ val hello : unit -> unit Explicitly defining a module interface, allows restricting the default one. It acts as a mask over the module's implementation. The `cairo.ml` file defines `Cairo`'s implementation. Adding a `cairo.mli` file defines `Cairo`'s interface. -Filenames, without extensions, must be the same. +Filenames without extensions must be the same. To turn `message` into a private definition, don't list it in the `cairo.mli` file: From 2f7ca7327b2083d0a2cc8284392bbf724f4e285f Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Fri, 26 Jan 2024 02:42:58 -0800 Subject: [PATCH 40/53] minor punctuation --- data/tutorials/language/1ms_00_modules.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 1c2f82c0dd..8ac7f4304a 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -164,7 +164,7 @@ val hello : unit -> unit **Note**: The double asterisk at the beginning of the comment indicates a comment meant for API documentation tools, such as -[odoc](https://github.com/ocaml/odoc). It is a good habit to document `.mli` +[`odoc`](https://github.com/ocaml/odoc). It is a good habit to document `.mli` files using the format supported by this tool. The file `delhi.ml` defines the program calling `Cairo`: @@ -238,7 +238,7 @@ type date = { day : int; month : int; year : int } There are four options when it comes to writing the `.mli` file: 1. The type is completely omitted from the signature. In that case, the type is private. It can't be used from outside the module. -2. The type definition is copy-pasted into the signature. In that case, the type is public. It can be used +2. The type definition is copy-pasted into the signature. In that case, the type is public. It can be used. 3. The type is made abstract: only its name is given. 4. The record fields are made read-only: `type date = private { ... }`. From 1002a2bd38a04e0bfd49c290b0937324d30488e5 Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Fri, 26 Jan 2024 02:45:08 -0800 Subject: [PATCH 41/53] remove comma --- data/tutorials/language/1ms_00_modules.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 8ac7f4304a..958f432455 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -150,7 +150,7 @@ val message : string val hello : unit -> unit ``` -Explicitly defining a module interface, allows restricting the default one. It +Explicitly defining a module interface allows restricting the default one. It acts as a mask over the module's implementation. The `cairo.ml` file defines `Cairo`'s implementation. Adding a `cairo.mli` file defines `Cairo`'s interface. Filenames without extensions must be the same. From 0510a033e2fea46b5e072d83f0e598f1dd2055a3 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 26 Jan 2024 16:12:24 +0100 Subject: [PATCH 42/53] More refresh --- data/tutorials/language/1ms_00_modules.md | 184 ++++++++++++---------- 1 file changed, 101 insertions(+), 83 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 958f432455..32a49ab954 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -211,146 +211,164 @@ This triggers a compilation error. Function and value definitions are either public or private. That also applies to type definitions, but there are two more cases. -Create files named `exeter.ml` and `exeter.ml` with the following contents: +Create files named `exeter.mli` and `exeter.ml` with the following contents: + +**Interface: `exeter.mli`** -**`exeter.ml`** ```ocaml -type measure_unit = Metric | Imperial -type length = unit * i -type meter = int -type date = { day : int; month : int; year : int } + +type aleph = Ada | Alan | Alonzo + +type gimel +val gimel_of_bool : bool -> gimel +val gimel_flip : gimel -> gimel +val gimel_to_string : gimel -> string + +type dalet = private Dennis of int | Donald of string | Dorothy +val dalet_of : (int, string) Either.t option -> dalet ``` -**`exeter.mli`** +**Implementation: `exeter.ml`** + ```ocaml -type unit = Metric | Imperial -type meter -type date = private { day : int; month : int; year : int } +type aleph = Ada | Alan | Alonzo + +type bet = bool + +type gimel = Christos | Christine + +let gimel_of_bool b = if (b : bet) then Christos else Christine +let gimel_flip = function Christos -> Christine | Christine -> Christos +let gimel_to_string x = "Christ" ^ match x with Christos -> "os" | _ -> "ine" + +type dalet = Dennis of int | Donald of string | Dorothy +let dalet_of = function + | None -> Dorothy + | Some (Either.Left x) -> Dennis x + | Some (Either.Right x) -> Donald x ``` -But modules often define new types. Let's define a record type that -would represent a date: -```ocaml -type date = { day : int; month : int; year : int } +Update file `dune`: +```lisp +(executables (names berlin delhi) (modules berlin delhi)) +(library (name exeter) (modules exeter) (modes byte)) ``` -There are four options when it comes to writing the `.mli` file: +Run the `dune utop` command, it triggers `Exeter`'s compilation, launches `utop` and loads `Exeter`. +```ocaml +# open Exeter;; -1. The type is completely omitted from the signature. In that case, the type is private. It can't be used from outside the module. -2. The type definition is copy-pasted into the signature. In that case, the type is public. It can be used. -3. The type is made abstract: only its name is given. -4. The record fields are made read-only: `type date = private { ... }`. -Case 3 would look like this: +``` +Type `aleph` is public. Values can be created, such as `x` or read ```ocaml -type date +# #show bet;; +Unknown element. ``` -Now, users of the module can manipulate objects of type `date`, but they can't -access the record fields directly. They must use the functions that the module -provides. Let's assume the module provides three functions: one for creating a -date, one for computing the difference between two dates, and one that returns -the date in years: +Type `bet` is private, it is not available outside of the implementation where it is defined, here `Exeter`. +```ocaml +# #show gimel;; +type gimel + +# Christos;; +Error: Unbound constructor Christos - +# #show_val gimel_of_bool;; +val gimel_of_bool : bool -> gimel + +# true |> gimel_of_bool |> gimel_to_string;; +- : string = "Christos" + +# true |> gimel_of_bool |> gimel_flip |> gimel_to_string;; +- : string = "Christine" +``` + +Type `gimel` is _abstract_. Values are available, but only as function results or arguments. Only the provided functions `gimel_of_bool`, `gimel_flip`, and ` gimel_to_string` and polymorphic functions can receive or return `gimel` values. ```ocaml -type date +#show dalet;; +type dalet = private Dennis of int | Donald of string | Dorothy -val create : ?days:int -> ?months:int -> ?years:int -> unit -> date +# Dennis 42;; +Error: Cannot create values of the private type Exeter.dalet -val sub : date -> date -> date +# dalet_of (Some (Either.Left 10));; +- : dalet = Dennis 10 -val years : date -> float +# let dalet_to_string = function + | None -> "Dorothy" + | Some (Either.Left _) -> "Dennis" + | Some (Either.Right _) -> "Donald";; +val dalet_to_string : ('a, 'b) Either.t option -> string = ``` -The point is that only `create` and `sub` can be used to create `date` records. -Therefore, it is not possible for the user to create ill-formed -records. Actually, our implementation uses a record, but we could change it and -be sure that it will not break any code relying on this module! This makes -a lot of sense in a library because subsequent versions of it can -continue to expose the same interface while internally changing the -implementation, including data structures. + The type `dalet` is _read-only_. Pattern matching is possible, but values can only be constructed by the provided functions, here `dalet_to_string`. -Case 4 +Abstract and read-only types can be either variants, as shown in this section, records, or aliases. It is possible to access a read-only record field's value, but creating such a record requires using a provided function. ## Submodules ### Submodule Implementation -We saw that one `fairbanks.ml` file results automatically in the module -implementation named `Exeter`. Its module signature is automatically derived -and is the broadest possible, or it can be restricted by writing an `fairbanks.mli` -file. - -That said, a given module can also be defined explicitly from within a file. -That makes it a submodule of the current module. Let's consider this -`fairbanks.ml` file: +A module can be defined inside another module. That makes it a _submodule_. +Let's consider the files `florence.ml` and `glasgow.ml` +**`florence.ml`** ```ocaml module Hello = struct - let message = "Hello" - let hello () = print_endline message + let message = "Hello from Florence" + let print () = print_endline message end -let goodbye () = print_endline "Goodbye" - -let hello_goodbye () = - Hello.hello (); - goodbye () +let print_goodbye () = print_endline "Goodbye" ``` -From another file, we now have two levels of modules. We can -write: - - +**`glasgow.ml`** ```ocaml let () = - Exeter.Hello.hello (); - Exeter.goodbye () + Florence.Hello.print (); + Florence.print_goodbye () ``` -### Submodule Interface +The module `Hello` is a submodule of module `Florence`. -We can also restrict the interface of a submodule. It is called a module -type. Let's do it in our `fairbanks.ml` file: +### Submodule Interface +We can also restrict the interface of a submodule. Here is a second version of the `florence.ml` file: ```ocaml module Hello : sig - val hello : unit -> unit + val print : unit -> unit end = struct let message = "Hello" - let hello () = print_endline message + let print () = print_endline message end -(* At this point, Hello.message is not accessible anymore. *) - -let goodbye () = print_endline "Goodbye" - -let hello_goodbye () = - Hello.hello (); - goodbye () +let print_goodbye () = print_endline "Goodbye" ``` -The definition of the `Hello` module above is the equivalent of a -`hello.mli`, `hello.ml` pair of files. Writing all of that in one block of code -is not elegant, so in general, we prefer to define the module signature -separately: +The first version made `Florence.Hello.message` public. In this version it can't be accessed from `glasgow.ml`. - +### Interfaces are Types + +The role played by interfaces to implementations is akin to the role played by types to values. Here is third possible way to write file `florence.ml`: ```ocaml -module type Hello_type = sig - val hello : unit -> unit +module type HelloType = sig + val hello : unit -> unit end -module Hello : Hello_type = struct - ... +module Hello : HelloType = struct + let message = "Hello" + let print () = print_endline message end + +let print_goodbye () = print_endline "Goodbye" ``` -`Hello_type` is a named module type and can be reused to define other module -interfaces. +The interface used previously for `Florence.Hello` is turned into a `module type` called `HelloType`. Later, when defining `Florence.Hello`, it is annotated with `HelloType` as a value could be. The `HelloType` acts as a type alias. + +This allows writing once interfaces shared by several modules. An implementation satisfies any module type listing some of its contents. This implies a module may have several types and there are subtyping relationship between module types. ## Module Manipulation From 60b3cebb2da6ed9d7c2ad49b1cac5d05332e933b Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 26 Jan 2024 16:25:16 +0100 Subject: [PATCH 43/53] Fix typos --- data/tutorials/language/1ms_00_modules.md | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 32a49ab954..34d204b9ea 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -258,11 +258,9 @@ Update file `dune`: Run the `dune utop` command, it triggers `Exeter`'s compilation, launches `utop` and loads `Exeter`. ```ocaml # open Exeter;; - - ``` -Type `aleph` is public. Values can be created, such as `x` or read +Type `aleph` is public. Values can be created or accessed. ```ocaml # #show bet;; Unknown element. @@ -286,9 +284,9 @@ val gimel_of_bool : bool -> gimel - : string = "Christine" ``` -Type `gimel` is _abstract_. Values are available, but only as function results or arguments. Only the provided functions `gimel_of_bool`, `gimel_flip`, and ` gimel_to_string` and polymorphic functions can receive or return `gimel` values. +Type `gimel` is _abstract_. Values are available, but only as function result or argument. Only the provided functions `gimel_of_bool`, `gimel_flip`, and ` gimel_to_string` and polymorphic functions can receive or return `gimel` values. ```ocaml -#show dalet;; +# #show dalet;; type dalet = private Dennis of int | Donald of string | Dorothy # Dennis 42;; @@ -304,7 +302,7 @@ Error: Cannot create values of the private type Exeter.dalet val dalet_to_string : ('a, 'b) Either.t option -> string = ``` - The type `dalet` is _read-only_. Pattern matching is possible, but values can only be constructed by the provided functions, here `dalet_to_string`. + The type `dalet` is _read-only_. Pattern matching is possible, but values can only be constructed by the provided functions, here `dalet_of`. Abstract and read-only types can be either variants, as shown in this section, records, or aliases. It is possible to access a read-only record field's value, but creating such a record requires using a provided function. From 67ec8ed5a7553e2d3c3a21e89430232fa0dcaa82 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Fri, 26 Jan 2024 17:51:08 +0100 Subject: [PATCH 44/53] Review edits --- data/tutorials/language/1ms_00_modules.md | 142 +++++++++++----------- 1 file changed, 74 insertions(+), 68 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 34d204b9ea..1c770dfadf 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -20,20 +20,19 @@ Modules are collections of definitions grouped together. This is the basic means ### File-Based Modules In OCaml, every piece of code is wrapped into a module. Optionally, a module -itself can be a submodule of another module, pretty much like directories in a -file system. +itself can be a [submodule](#submodules) of another module, pretty much like +directories in a file system. -When you write a program using two files named `athens.ml` and `berlin.ml`, -each automatically defines a module named `Athens` and `Berlin`, which provides -whatever you put into the files. +Here is a program using two files: `athens.ml` and `berlin.ml`. Each file +defines a module named `Athens` and `Berlin`, respectively. -Here is the code in the file `athens.ml`: +Here is the file `athens.ml`: ```ocaml let hello () = print_endline "Hello from Athens" ``` -This is what is in `berlin.ml`: +Here is the file `berlin.ml`: ```ocaml let () = Athens.hello () @@ -41,8 +40,7 @@ let () = Athens.hello () To compile them using [Dune](https://dune.build/), at least two configuration files are required: -* The `dune-project` file contains project-wide configuration data. - Here's a very minimal one: +* The `dune-project` file contains project-wide configuration. ```lisp (lang dune 3.7) ``` @@ -53,27 +51,24 @@ configuration files are required: (executable (name berlin)) ``` -Here is a possible way to create those files, build the source, and run the -executable: +After you create those files, build and run them: ```bash -$ echo "(lang dune 3.7)" > dune-project - -$ echo "(executable (name berlin))" > dune - $ opan exec -- dune build -$ opam exec -- dune exec ./berlin.exe -Hello +$ opan exec -- dune exec ./berlin.exe +Hello from Athens ``` -Actually, `dune build` is optional. Running `dune exec` would have triggered the -compilation. Note that in the `dune exec` command, the parameter `./berlin.exe` -is not a file path. This command means “execute the content of the file -`./berlin.ml`.” However, the executable file is stored and named differently. +Actually, `dune build` is optional. Running `dune exec ./berlin.exe` would have +triggered the compilation. Note that in the `dune exec` command, the parameter +`./berlin.exe` is not a file path. This command means “execute the content of +the file `./berlin.ml`.” However, the executable file is stored and named +differently. In a project, it is preferable to create the `dune` configuration files and -directory structure using the `dune init project` command. +directory structure using the `dune init project` command. Refer to the Dune +documentation for more on this matter. ### Naming and Scoping @@ -83,8 +78,8 @@ always starts with a capital letter: `Athens`) followed by a dot and the thing you want to use (`hello`). It may be a value, a type constructor, or anything the module provides. -If you are using a module heavily, you can directly access its contents. To do -this, use the `open` directive. In our example, `berlin.ml` could have been +If you are using a module heavily, you might want to `open` it. This brings the +module's definitions into scope. In our example, `berlin.ml` could have been written: ```ocaml @@ -92,29 +87,31 @@ open Athens let () = hello () ``` -Using `open` is optional. Usually, we don't open the module `List` because it -provides names other modules also provide, such as `Array` or `Option`. Other -modules like `Printf` provide names that aren't subject to conflicts, such as -`printf`. Placing `open Printf` at the beginning of the file avoids writing -`Printf.printf` all over the place. +Using `open` is optional. Usually, we don't open a module like `List` because it +provides names other modules also provide, such as `Array` or `Option`. Modules +like `Printf` provide names that aren't subject to conflicts, such as `printf`. +Placing `open Printf` at the top of a file avoids writing `Printf.printf` repeatedly. ```ocaml open Printf let data = ["a"; "beautiful"; "day"] let () = List.iter (printf "%s\n") data ``` - The standard library is a module called `Stdlib` where modules `List`, - `Option`, `Either`, and others are [submodules](#submodules). Implicitly, all - OCaml begins with `open Stdlib`. That avoids writing `Stdlib.List.map`, - `Stdlib.Array`, or using `Stdlib.` anywhere. + The standard library is a module called `Stdlib`. It contains + [submodules](#submodules) `List`, `Option`, `Either`, and more. By default, the + OCaml compiler opens the standard library, as if you had written `open Stdlib` + at the top of every file. Refer to Dune documentation if you need to opt-out. -There are also two means to open modules locally: +You can open a module inside a definition, using the `let open ... in` construct: ```ocaml # let list_sum_sq m = let open List in init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0;; val list_sum_sq : int -> int = +``` +The module access notation can be applied to an entire expression: +```ocaml # let array_sum_sq m = Array.(init m Fun.id |> map (fun i -> i * i) |> fold_left ( + ) 0);; val array_sum_sq : int -> int = @@ -124,19 +121,17 @@ val array_sum_sq : int -> int = By default, anything defined in a module is accessible from other modules. Values, functions, types, or submodules, everything is public. This can be -restricted. That allows distinguishing content provided to other modules from -internal use content. What is internal is kept private and not available from -other modules. +restricted to avoid exposing definitions that are not relevant from the outside. For this, we must distinguish: -- Implementation, which is a module's actual content. -- Interface, which is a module's public content list. +- The definitions inside a module (the module implementation) +- The public declarations of a module (the module interface) -An `.ml` file contains a module implementation. By default, without an explicitly -defined interface, an implementation has a default interface where everything is -public. +An `.ml` file contains a module implementation; an `.mli` file contains a module +interface. By default, when no corresponding `.mli` file is provided, an +implementation has a default interface where everything is public. -Copy the `athens.ml` file into `cairo.ml` and change it with this contents: +Copy the `athens.ml` file into `cairo.ml` and change its contents: ```ocaml let message = "Hello from Cairo" @@ -176,8 +171,8 @@ let () = Cairo.hello () Update the `dune` file to allow the compilation of this example aside from the previous one. - +<<<<<<< HEAD ```bash <<<<<<< HEAD $ echo "(executables (names bmodule bmodule2))" > dune @@ -190,7 +185,14 @@ Hello 2 $ echo "(executables (names berlin delhi))" > dune $ dune build +======= +```lisp +(executables (names berlin delhi)) +``` +>>>>>>> 68015412 (Review edits) +Compile and execute both programs: +```shell $ dune exec ./berlin.exe Hello from Athens @@ -236,7 +238,6 @@ type aleph = Ada | Alan | Alonzo type bet = bool type gimel = Christos | Christine - let gimel_of_bool b = if (b : bet) then Christos else Christine let gimel_flip = function Christos -> Christine | Christine -> Christos let gimel_to_string x = "Christ" ^ match x with Christos -> "os" | _ -> "ine" @@ -248,7 +249,6 @@ let dalet_of = function | Some (Either.Right x) -> Donald x ``` - Update file `dune`: ```lisp (executables (names berlin delhi) (modules berlin delhi)) @@ -258,6 +258,9 @@ Update file `dune`: Run the `dune utop` command, it triggers `Exeter`'s compilation, launches `utop` and loads `Exeter`. ```ocaml # open Exeter;; + +# #show aleph;; +type aleph = Ada | Alan | Alonzo ``` Type `aleph` is public. Values can be created or accessed. @@ -284,25 +287,25 @@ val gimel_of_bool : bool -> gimel - : string = "Christine" ``` -Type `gimel` is _abstract_. Values are available, but only as function result or argument. Only the provided functions `gimel_of_bool`, `gimel_flip`, and ` gimel_to_string` and polymorphic functions can receive or return `gimel` values. +Type `gimel` is _abstract_. Values can be created or manipulated, but only as function results or arguments. Only the provided functions `gimel_of_bool`, `gimel_flip`, and `gimel_to_string` or polymorphic functions can receive or return `gimel` values. ```ocaml # #show dalet;; type dalet = private Dennis of int | Donald of string | Dorothy -# Dennis 42;; +# Donald 42;; Error: Cannot create values of the private type Exeter.dalet # dalet_of (Some (Either.Left 10));; - : dalet = Dennis 10 # let dalet_to_string = function - | None -> "Dorothy" - | Some (Either.Left _) -> "Dennis" - | Some (Either.Right _) -> "Donald";; -val dalet_to_string : ('a, 'b) Either.t option -> string = + | Dorothy -> "Dorothy" + | Dennis _ -> "Dennis" + | Donald _ -> "Donald";; +val dalet_to_string : dalet -> string = ``` - The type `dalet` is _read-only_. Pattern matching is possible, but values can only be constructed by the provided functions, here `dalet_of`. +The type `dalet` is _read-only_. Pattern matching is possible, but values can only be constructed by the provided functions, here `dalet_of`. Abstract and read-only types can be either variants, as shown in this section, records, or aliases. It is possible to access a read-only record field's value, but creating such a record requires using a provided function. @@ -330,11 +333,13 @@ let () = Florence.print_goodbye () ``` -The module `Hello` is a submodule of module `Florence`. +Definitions from a submodule are access by chaining module names, here +`Florence.Hello.print`. -### Submodule Interface +### Submodule with Signatures -We can also restrict the interface of a submodule. Here is a second version of the `florence.ml` file: +To define an interface to a submodule we can provide a _module signature_. This +is done in this second version of the `florence.ml` file: ```ocaml module Hello : sig val print : unit -> unit @@ -348,9 +353,9 @@ let print_goodbye () = print_endline "Goodbye" The first version made `Florence.Hello.message` public. In this version it can't be accessed from `glasgow.ml`. -### Interfaces are Types +### Module Signatures are Types -The role played by interfaces to implementations is akin to the role played by types to values. Here is third possible way to write file `florence.ml`: +The role played by module signatures to implementations is akin to the role played by types to values. Here is a third possible way to write file `florence.ml`: ```ocaml module type HelloType = sig val hello : unit -> unit @@ -364,9 +369,9 @@ end let print_goodbye () = print_endline "Goodbye" ``` -The interface used previously for `Florence.Hello` is turned into a `module type` called `HelloType`. Later, when defining `Florence.Hello`, it is annotated with `HelloType` as a value could be. The `HelloType` acts as a type alias. +First, we define a `module type` called `HelloType` which defines the same module interface as previously. Instead of providing the signature when defining the `Hello` module, we use the `HelloType` module type. -This allows writing once interfaces shared by several modules. An implementation satisfies any module type listing some of its contents. This implies a module may have several types and there are subtyping relationship between module types. +This allows writing interfaces shared by several modules. An implementation satisfies any module type listing some of its contents. This implies a module may have several types and there is a subtyping relationship between module types. ## Module Manipulation @@ -386,9 +391,7 @@ module Unit : end ``` -There is online documentation for each library, for instance, [`Unit`](/api/Unit.html). - -The OCaml compiler tool chain can be used to dump a `.ml` file default interface. +The OCaml compiler tool chain can be used to dump an `.ml` file's default interface. ```shell $ ocamlc -c -i cairo.ml val message : string @@ -397,7 +400,7 @@ val hello : unit -> unit ### Module Inclusion -Let's say we feel that a function is missing from the standard `List` module, +Let's say we feel that a function is missing from the `List` module, but we really want it as if it were part of it. In an `extlib.ml` file, we can achieve this effect by using the `include` directive: @@ -410,12 +413,13 @@ module List = struct end ``` -It creates a module `Extlib.List` that has everything the standard `List` -module has, plus a new `uncons` function. In order to override the default `List` module from another `.ml` file, we merely need to add `open Extlib` at the beginning. +It creates a module `Extlib.List` that has everything the standard `List` module +has, plus a new `uncons` function. In order to override the default `List` +module from another `.ml` file, we need to add `open Extlib` at the beginning. ## Stateful Modules -A module may have an internal state. This is the case standard library `Random` module. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is nameless and has an abstract type. +A module may have an internal state. This is the case for the `Random` module from the standard library. The functions `Random.get_state` and `Random.set_state` provide read and write access to the internal state, which is nameless and has an abstract type. ```ocaml # let s = Random.get_state ();; val s : Random.State.t = @@ -433,7 +437,9 @@ val s : Random.State.t = - : int = 89809344 ``` -Values returned by `Random.bits` will differ in your setup, but the first and third calls return the same results, showing that the internal state was reset. +Values returned by `Random.bits` will differ when you run this code. The first +and third calls return the same results, showing that the internal state was +reset. ## Conclusion From e0f8995e72c6d6ef723d13783a6f17c1fd745a4c Mon Sep 17 00:00:00 2001 From: Christine Rose Date: Mon, 29 Jan 2024 04:43:01 -0800 Subject: [PATCH 45/53] minor line editing --- data/tutorials/language/1ms_00_modules.md | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index 1c770dfadf..be38380649 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -157,7 +157,7 @@ val hello : unit -> unit (** [hello ()] displays a greeting message. *) ``` -**Note**: The double asterisk at the beginning of the comment indicates a +**Note**: The double asterisk at the beginning indicates a comment meant for API documentation tools, such as [`odoc`](https://github.com/ocaml/odoc). It is a good habit to document `.mli` files using the format supported by this tool. @@ -169,7 +169,7 @@ The file `delhi.ml` defines the program calling `Cairo`: let () = Cairo.hello () ``` -Update the `dune` file to allow the compilation of this example aside from the +Update the `dune` file to allow this example's compilation aside from the previous one. <<<<<<< HEAD @@ -255,7 +255,7 @@ Update file `dune`: (library (name exeter) (modules exeter) (modes byte)) ``` -Run the `dune utop` command, it triggers `Exeter`'s compilation, launches `utop` and loads `Exeter`. +Run the `dune utop` command. This triggers `Exeter`'s compilation, launches `utop`, and loads `Exeter`. ```ocaml # open Exeter;; @@ -269,7 +269,7 @@ Type `aleph` is public. Values can be created or accessed. Unknown element. ``` -Type `bet` is private, it is not available outside of the implementation where it is defined, here `Exeter`. +Type `bet` is private. It is not available outside of the implementation where it is defined, here `Exeter`. ```ocaml # #show gimel;; type gimel @@ -287,7 +287,7 @@ val gimel_of_bool : bool -> gimel - : string = "Christine" ``` -Type `gimel` is _abstract_. Values can be created or manipulated, but only as function results or arguments. Only the provided functions `gimel_of_bool`, `gimel_flip`, and `gimel_to_string` or polymorphic functions can receive or return `gimel` values. +Type `gimel` is _abstract_. Values can be created or manipulated, but only as function results or arguments. Just the provided functions `gimel_of_bool`, `gimel_flip`, and `gimel_to_string` or polymorphic functions can receive or return `gimel` values. ```ocaml # #show dalet;; type dalet = private Dennis of int | Donald of string | Dorothy @@ -333,12 +333,12 @@ let () = Florence.print_goodbye () ``` -Definitions from a submodule are access by chaining module names, here +Definitions from a submodule are accessed by chaining module names, here `Florence.Hello.print`. -### Submodule with Signatures +### Submodule With Signatures -To define an interface to a submodule we can provide a _module signature_. This +To define an interface to a submodule, we can provide a _module signature_. This is done in this second version of the `florence.ml` file: ```ocaml module Hello : sig @@ -369,9 +369,9 @@ end let print_goodbye () = print_endline "Goodbye" ``` -First, we define a `module type` called `HelloType` which defines the same module interface as previously. Instead of providing the signature when defining the `Hello` module, we use the `HelloType` module type. +First, we define a `module type` called `HelloType`, which defines the same module interface as before. Instead of providing the signature when defining the `Hello` module, we use the `HelloType` module type. -This allows writing interfaces shared by several modules. An implementation satisfies any module type listing some of its contents. This implies a module may have several types and there is a subtyping relationship between module types. +This allows writing interfaces shared by several modules. An implementation satisfies any module type listing some of its contents. This implies a module may have several types and that there is a subtyping relationship between module types. ## Module Manipulation From 54352d031f982f1fd2ba5fd27fb077a2975fa905 Mon Sep 17 00:00:00 2001 From: sabine Date: Mon, 29 Jan 2024 14:47:31 +0100 Subject: [PATCH 46/53] editing --- data/tutorials/language/1ms_01_functors.md | 38 ++++++++++------------ 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 006d2ccb9b..456c942324 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -3,34 +3,33 @@ id: functors title: Functors short_title: Functors description: > - Functors essentially work the same way as functions. The difference is that we are passing modules instead of values. + In OCaml, a functor is a function at the module-level. Functors take modules as arguments and return a new module. category: "Module System" --- ## Introduction -In this tutorial, we look at how to use a functor, how to write a functor, and show a couple of use cases involving functors. +In this tutorial, we look at how to apply functors and how to write functors. We also show some use cases involving functors. -As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor is a parametrised module. - -In mathematics, [functor](https://en.wikipedia.org/wiki/Functor) means something different. You don't need to know about those functors to understand OCaml's. +As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor in OCaml is a parametrised module, not to be confused with a [functor in mathematics](https://en.wikipedia.org/wiki/Functor). **Prerequisites**: [Modules](/docs/modules). ## Project Setup -This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, and `funkt.ml`. The latter two are created empty. +This tutorial uses the [Dune](https://dune.build) build tool. Make sure you have installed version 3.7 or later. We start by creating a fresh project. We need a folder named `funkt` with files `dune-project`, `dune`, and `funkt.ml`. + ```shell $ mkdir funkt; cd funkt ``` -**`dune-project`** +Place the following in the file **`dune-project`**: ```lisp (lang dune 3.7) (package (name funkt)) ``` -**`dune`** +The content of the file **`dune`** should be this: ```lisp (executable (name funkt) @@ -38,32 +37,31 @@ $ mkdir funkt; cd funkt (libraries str)) ``` -Check this works using the `dune exec funkt` command, it shouldn't do anything (the empty file is valid OCaml syntax) but it shouldn't fail either. The stanza `libraries str` will be used later. +Create an empty file `funkt.ml`. + +Check that this works using the `dune exec funkt` command. It shouldn't do anything (the empty file is valid OCaml syntax), but it shouldn't fail either. The stanza `libraries str` makes the `Str` module (which we will use later) available. ## Using an Existing Functor: `Set.Make` -The standard library contains a [`Set`](/api/Set.html) module providing a data structure that allows set operations like union and intersection. You may check the [Set](/docs/sets) tutorial to learn more about this module, but it is not required to follow the present tutorial. To use the provided type and its associated [functions](/api/Set.S.html), it's necessary to use the functor provided by `Set`. For reference only, here is a shortened version of the interface of `Set`: +The standard library contains a [`Set`](/api/Set.html) module which is designed to handle sets. This module enables you to perform operations such as union, intersection, and difference on sets. You may check the [Set](/docs/sets) tutorial to learn more about this module, but it is not required to follow the present tutorial. + +To create a set module for a given element type (which allows you to use the provided type and its associated [functions](/api/Set.S.html)), it's necessary to use the functor `Set.Make` provided by the `Set` module. For reference only, here is a shortened version of the interface of `Set`: ```ocaml module type OrderedType = sig type t val compare : t -> t -> int end -module type S = sig - (** This is the module's signature returned by applying `Make` *) -end - module Make : functor (Ord : OrderedType) -> S ``` -Here is how this reads (starting from the bottom-up, then going up): +Here is how this reads (starting from the bottom, then going up): * Like a function (indicated by the arrow `->`), the functor `Set.Make` - - takes a module having `Set.OrderedType` as signature and - - returns a module having `Set.S` as signature -* The module type `Set.S` is the signature of some sort of set -* The module type `Set.OrderedType` is the signature of elements of a + - takes a module with signature `Set.OrderedType` and + - returns a module with signature [`Set.S`](/api/Set.S.html) +* The module type `Set.OrderedType` requires a type `t` and a function `compare`, which are used to perform the comparisons between elements of the set. -**Note**: Most set operation implementations must use a comparison function. Using `Stdlib.compare` would make it impossible to use a user-defined comparison algorithm. Passing the comparison function as a higher-order parameter, as done in `Array.sort`, for example, would add a lot of boilerplate code. Providing set operations as a functor allows specifying the comparison function only once. +**Note**: Most set operations need to compare elements to check if they are the same. To allow using a user-defined comparison algorithm, the `Set.Make` functor takes a module the specifies both the element type `t` and the `compare` function. Passing the comparison function as a higher-order parameter, as done in `Array.sort`, for example, would add a lot of boilerplate code. Providing set operations as a functor allows specifying the comparison function only once. Here is what it can look like in our project: From 01681baf4f35181feafcc955acc985c33d6e7f95 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 29 Jan 2024 16:27:46 +0100 Subject: [PATCH 47/53] Fix conflict artefact --- data/tutorials/language/1ms_00_modules.md | 21 ++------------------- 1 file changed, 2 insertions(+), 19 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index be38380649..a8f9236186 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -171,34 +171,17 @@ let () = Cairo.hello () Update the `dune` file to allow this example's compilation aside from the previous one. - -<<<<<<< HEAD -```bash -<<<<<<< HEAD -$ echo "(executables (names bmodule bmodule2))" > dune -$ opam exec -- dune build -$ opam exec -- dune exec ./bmodule.exe -Hello -$ opam exec -- dune exec ./bmodule2.exe -Hello 2 -======= -$ echo "(executables (names berlin delhi))" > dune - -$ dune build -======= ```lisp (executables (names berlin delhi)) ``` ->>>>>>> 68015412 (Review edits) Compile and execute both programs: ```shell -$ dune exec ./berlin.exe +$ opam exec -- dune exec ./berlin.exe Hello from Athens -$ dune exec ./delhi.exe +$ opam exec -- dune exec ./delhi.exe Hello from Cairo ->>>>>>> 5196e1c0 (Refresh modules.md text) ``` You can check that `Cairo.message` is not public by attempting to compile a `delhi.ml` file containing: From d44c018178d142cde8507670ea25fa2e256fd479 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 29 Jan 2024 16:59:48 +0100 Subject: [PATCH 48/53] Add missing short title --- data/tutorials/language/1ms_02_dune.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index 35917709de..c2318f1942 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -1,13 +1,12 @@ --- id: libraries-dune title: Libraries With Dune +short_title: Libraries With Dune description: > Dune provides several means to arrange modules into libraries. We look at Dune's mechanisms for structuring projects with libraries that contain modules. category: "Module System" --- -# Libraries With Dune - ## Introduction Dune provides several means to arrange modules into libraries. We look at Dune's mechanisms for structuring projects with libraries that contain modules. From 61cc103bc165acb18a69ddc9d11b097102b1d468 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Mon, 29 Jan 2024 17:06:26 +0100 Subject: [PATCH 49/53] review edits --- data/tutorials/language/1ms_00_modules.md | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/data/tutorials/language/1ms_00_modules.md b/data/tutorials/language/1ms_00_modules.md index a8f9236186..69b239fbb3 100644 --- a/data/tutorials/language/1ms_00_modules.md +++ b/data/tutorials/language/1ms_00_modules.md @@ -321,7 +321,7 @@ Definitions from a submodule are accessed by chaining module names, here ### Submodule With Signatures -To define an interface to a submodule, we can provide a _module signature_. This +To define a submodule's interface, we can provide a _module signature_. This is done in this second version of the `florence.ml` file: ```ocaml module Hello : sig @@ -426,7 +426,13 @@ reset. ## Conclusion -In OCaml, modules are the basic means of organising software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module has an interface, which is the list of definitions a module exposes. By default, a module's interface exposes all its definitions, but this can be restricted using the interface syntax. +In OCaml, modules are the basic means of organising software. To sum up, a +module is a collection of definitions wrapped under a name. These definitions +can be submodules, which allows the creation of hierarchies of modules. +Top-level modules must be files and are the units of compilation. Every module +has an interface, which is the list of definitions a module exposes. By default, +a module's interface exposes all its definitions, but this can be restricted +using the interface syntax. Going further, here are the other means to handle OCaml software components: - Functors, which act like functions from modules to modules From bf144f6b74cd9c15b6c769edec417c6443e4486b Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 30 Jan 2024 13:38:33 +0100 Subject: [PATCH 50/53] Fix typos --- data/tutorials/language/1ms_01_functors.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index 456c942324..abbcc4f153 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -11,7 +11,7 @@ category: "Module System" In this tutorial, we look at how to apply functors and how to write functors. We also show some use cases involving functors. -As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor takes a module as a parameter and returns a module as a result. A functor in OCaml is a parametrised module, not to be confused with a [functor in mathematics](https://en.wikipedia.org/wiki/Functor). +As suggested by the name, a _functor_ is almost like a function. However, while functions are between values, functors are between modules. A functor has a module as a parameter and returns a module as a result. A functor in OCaml is a parametrised module, not to be confused with a [functor in mathematics](https://en.wikipedia.org/wiki/Functor). **Prerequisites**: [Modules](/docs/modules). @@ -94,12 +94,12 @@ end) The module expression `struct ... end` is inlined in the call to `Set.Make`. -The be simplified even further into this: +This can be simplified even further into this: ```ocaml module StringSet = Set.Make(String) ``` -In both versions, the result module from the functor application `Set.Make(String)` is bound to the name `StringSet`, and it has the signature `Set.S`. The module `StringSet` provides set operations and is parametrized by the module `String`. This means the function `String.compare` is used internally by `StringSet`, inside the implementation of the functions it provides. Making a group of functions (here those provided by `StringSet`) use another group of functions (here only `String.compare`) is the role of a functor. +In all versions, the result module from the functor application `Set.Make` is bound to the name `StringSet`, and it has the signature `Set.S`. The module `StringSet` provides set operations and is parametrized by the module `String`. This means the function `String.compare` is used internally by `StringSet`, inside the implementation of the functions it provides. Making a group of functions (here those provided by `StringSet`) use another group of functions (here only `String.compare`) is the role of a functor. With this, the command `dune exec funkt` shouldn't do anything, but it shouldn't fail either. @@ -312,7 +312,7 @@ Check the behaviour of the program using `dune exec funkt < dune`. [Dependency injection](https://en.wikipedia.org/wiki/Dependency_injection) is a way to parametrise over a dependency. -Here is a refactoring of the module `IterPrint` to make of this technique: +Here is a refactoring of the module `IterPrint` to use this technique: **`iterPrint.ml`** ```ocaml @@ -333,7 +333,7 @@ end The module `IterPrint` is refactored into a functor that takes a module providing the function `iter` as a parameter. The `with type 'a t := 'a Dep.t` constraint means the type `t` from the parameter `Dep` replaces the type `t` in the result module. This allows the type of `f` to use the type `t` from the parameter module `Dep`. With this refactoring, `IterPrint` only has one dependency. At the time it is compiled, no implementation of function `iter` is available yet. -**Note**: An OCaml interface file must be a module, not a functor. Functors must be embedded inside modules. Therefore, it is customary to call them `Make`. +**Note**: An OCaml interface file (`.mli`) must be a module, not a functor. Functors must be embedded inside modules. Therefore, it is customary to call them `Make`. **`funkt.ml`** From eb74fcc85460674d4d451f29a53bd7f9a3c6e927 Mon Sep 17 00:00:00 2001 From: Cuihtlauac ALVARADO Date: Tue, 30 Jan 2024 15:19:26 +0100 Subject: [PATCH 51/53] review edits --- data/tutorials/language/1ms_01_functors.md | 96 +++++++++++----------- 1 file changed, 47 insertions(+), 49 deletions(-) diff --git a/data/tutorials/language/1ms_01_functors.md b/data/tutorials/language/1ms_01_functors.md index abbcc4f153..93b33f883d 100644 --- a/data/tutorials/language/1ms_01_functors.md +++ b/data/tutorials/language/1ms_01_functors.md @@ -39,31 +39,31 @@ The content of the file **`dune`** should be this: Create an empty file `funkt.ml`. -Check that this works using the `dune exec funkt` command. It shouldn't do anything (the empty file is valid OCaml syntax), but it shouldn't fail either. The stanza `libraries str` makes the `Str` module (which we will use later) available. +Check that this works using the `opam exec -- dune exec funkt` command. It shouldn't do anything (the empty file is valid OCaml syntax), but it shouldn't fail either. The stanza `libraries str` makes the `Str` module (which we will use later) available. ## Using an Existing Functor: `Set.Make` The standard library contains a [`Set`](/api/Set.html) module which is designed to handle sets. This module enables you to perform operations such as union, intersection, and difference on sets. You may check the [Set](/docs/sets) tutorial to learn more about this module, but it is not required to follow the present tutorial. -To create a set module for a given element type (which allows you to use the provided type and its associated [functions](/api/Set.S.html)), it's necessary to use the functor `Set.Make` provided by the `Set` module. For reference only, here is a shortened version of the interface of `Set`: +To create a set module for a given element type (which allows you to use the provided type and its associated [functions](/api/Set.S.html)), it's necessary to use the functor `Set.Make` provided by the `Set` module. Here is a simplified version of `Set`'s interface: ```ocaml module type OrderedType = sig type t val compare : t -> t -> int end -module Make : functor (Ord : OrderedType) -> S +module Make : functor (Ord : OrderedType) -> Set.S ``` Here is how this reads (starting from the bottom, then going up): * Like a function (indicated by the arrow `->`), the functor `Set.Make` - - takes a module with signature `Set.OrderedType` and + - takes a module with signature `OrderedType` and - returns a module with signature [`Set.S`](/api/Set.S.html) -* The module type `Set.OrderedType` requires a type `t` and a function `compare`, which are used to perform the comparisons between elements of the set. +* The module type `OrderedType` requires a type `t` and a function `compare`, which are used to perform the comparisons between elements of the set. **Note**: Most set operations need to compare elements to check if they are the same. To allow using a user-defined comparison algorithm, the `Set.Make` functor takes a module the specifies both the element type `t` and the `compare` function. Passing the comparison function as a higher-order parameter, as done in `Array.sort`, for example, would add a lot of boilerplate code. Providing set operations as a functor allows specifying the comparison function only once. -Here is what it can look like in our project: +Here is an example how to use `Set.Make`: **`funkt.ml`** @@ -76,13 +76,13 @@ end module StringSet = Set.Make(StringCompare) ``` -This defines a module `Funkt.StringSet`. What `Set.Make` needs is: -- A type `t`, here `string` -- A function allowing to compare two values of type `t`, here `String.compare` +This defines a module `Funkt.StringSet`. What `Set.Make` needs are: +- Type `t`, here `string` +- Function allowing to compare two values of type `t`, here `String.compare` However, since the module `String` defines -- A type name `t`, which is an alias for `string` -- A function `compare` of type `t -> t -> bool` that allows to compare two strings +- Type name `t`, which is an alias for `string` +- Function `compare` of type `t -> t -> bool` compares two strings This can be simplified using an _anonymous module_ expression: ```ocaml @@ -92,18 +92,18 @@ module StringSet = Set.Make(struct end) ``` -The module expression `struct ... end` is inlined in the call to `Set.Make`. +The module expression `struct ... end` is inlined in the `Set.Make` call. This can be simplified even further into this: ```ocaml module StringSet = Set.Make(String) ``` -In all versions, the result module from the functor application `Set.Make` is bound to the name `StringSet`, and it has the signature `Set.S`. The module `StringSet` provides set operations and is parametrized by the module `String`. This means the function `String.compare` is used internally by `StringSet`, inside the implementation of the functions it provides. Making a group of functions (here those provided by `StringSet`) use another group of functions (here only `String.compare`) is the role of a functor. +In all versions, the module resulting from the functor application `Set.Make` is bound to the name `StringSet`, and it has the signature `Set.S`. The module `StringSet` provides the operations on sets of strings. The function `String.compare` is used internally by `StringSet`. -With this, the command `dune exec funkt` shouldn't do anything, but it shouldn't fail either. +When you run `opam exec -- dune exec funkt`, it doesn't do anything, but it shouldn't fail either. -Add some code to the `funkt.ml` file to produce an executable that does something and checks the result. +Let's add some code to `funkt.ml` so that it does something. **`funkt.ml`** ```ocaml @@ -116,23 +116,16 @@ let _ = |> StringSet.iter print_endline ``` -Here are the types of functions used throughout the pipe: -- `In_channel.input_lines : in_channel -> string list`, -- `Str.(split (regexp "[ \t.,;:()]+")) : string -> string list`, -- `List.concat_map : ('a -> 'b list) -> 'a list -> 'b list`, -- `StringSet.of_list : string list -> StringSet.t`, and -- `StringSet.iter : StringSet.t -> unit`. +Here is how this code works: +- `In_channel.input_lines` : reads lines of text from standard input +- `List.concat_map` : splits lines into words and produces a word list +- `StringSet.of_list : string list -> StringSet.t` : converts the word list into a set +- `StringSet.iter : StringSet.t -> unit` : displays the set's elements -This reads the following way: -- Read lines of text from standard input, that produces a list of strings. -- Split each string using a regular expression and flatten the resulting list of lists into a list. -- Convert the list of strings into a set. -- Display each element of the set. - -The functions `StringSet.of_list` and `StringSet.iter` are available as the result of the functor application. +The functions `StringSet.of_list` and `StringSet.iter` are available in the functor's application result. ```shell -$ dune exec funkt < dune +$ opam exec -- dune exec funkt < dune executable libraries name @@ -162,13 +155,15 @@ let _ = |> String.Set.iter print_endline ``` -This allows the user to seemingly extend the module `String` with a submodule `Set`. Check the behaviour using `dune exec funkt < dune`. +This allows the user to seemingly extend the module `String` with a submodule `Set`. Check the behaviour using `opam exec -- dune exec funkt < dune`. -## Functors are Parametrised Modules +## Functors allows Parametrising Modules ### Functors from the Standard Library -Some ”modules” provide operations over an abstract type and need to be supplied with a parameter module used in their implementation. These “modules” are parametrised, in other words, functors. That's the case for the sets, maps, and hash tables provided by the standard library. It works like a contract between the functor and the developer: +A functor is almost a module, except it needs to be applied to a module. This turns it into a module. In that sense, a functor allows module parametrisation. + +That's the case for the sets, maps, and hash tables provided by the standard library. It works like a contract between the functor and the developer: * If you provide a module that implements what is expected, as described the parameter interface * The functor returns a module that implements what is promised, as described by the result interface @@ -189,8 +184,6 @@ module type HashedType = sig end ``` -**Note**: `Ordered.t` is a type of set elements or map keys, `Set.S.t` is a type of set, and `Map.S.t` is a type of mapping. `HashedType.t` is a type of hash table keys, and `Hashtbl.S.t` is a type of hash table. - The functors `Set.Make`, `Map.Make`, and `Hashtbl.Make` return modules satisfying the interfaces `Set.S`, `Map.S`, and `Hashtbl.S` (respectively), which all contain an abstract type `t` and associated functions. Refer to the documentation for the details about what they provide: * [`Set.S`](/api/Set.S.html) * [`Map.S`](/api/Map.S.html) @@ -198,7 +191,9 @@ The functors `Set.Make`, `Map.Make`, and `Hashtbl.Make` return modules satisfyi ### Writing Your Own Functors -There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Example include binary heaps, leftist heaps, binomial heaps, or Fibonacci heaps. +One reason to write a functor is to provide a data structure that is parametrised. This is the same as `Set` and `Map` on other data structures. In this section, we take heaps as an example. + +There are many kinds of [heap](https://en.wikipedia.org/wiki/Heap_(data_structure)) data structures. Examples include binary heaps, leftist heaps, binomial heaps, or Fibonacci heaps. The kind of data structures and algorithms used to implement a heap is not discussed in this document. @@ -258,11 +253,14 @@ module Binary(Elt: OrderedType) : S = struct end ``` -Here, binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each (e.g., `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc.). - +Here, binary heaps is the only implementation suggested. This can be extended to other implementations by adding one functor per each, e.g., `Heap.Leftist`, `Heap.Binomial`, `Heap.Fibonacci`, etc. ```bash -$ opan exec -- dune build +$ opam exec -- dune build -$ opan exec -- dune exec ./berlin.exe +$ opam exec -- dune exec ./berlin.exe Hello from Athens ``` -Actually, `dune build` is optional. Running `dune exec ./berlin.exe` would have -triggered the compilation. Note that in the `dune exec` command, the parameter +Actually, `opam exec -- dune build` is optional. Running `opam exec -- dune exec ./berlin.exe` would have +triggered the compilation. Note that in the `opam exec -- dune exec` command, the parameter `./berlin.exe` is not a file path. This command means “execute the content of the file `./berlin.ml`.” However, the executable file is stored and named differently. @@ -238,7 +238,7 @@ Update file `dune`: (library (name exeter) (modules exeter) (modes byte)) ``` -Run the `dune utop` command. This triggers `Exeter`'s compilation, launches `utop`, and loads `Exeter`. +Run the `opam exec -- dune utop` command. This triggers `Exeter`'s compilation, launches `utop`, and loads `Exeter`. ```ocaml # open Exeter;; @@ -426,7 +426,7 @@ reset. ## Conclusion -In OCaml, modules are the basic means of organising software. To sum up, a +OCaml, modules are the basic means of organising software. To sum up, a module is a collection of definitions wrapped under a name. These definitions can be submodules, which allows the creation of hierarchies of modules. Top-level modules must be files and are the units of compilation. Every module diff --git a/data/tutorials/language/1ms_02_dune.md b/data/tutorials/language/1ms_02_dune.md index c2318f1942..24cfda949e 100644 --- a/data/tutorials/language/1ms_02_dune.md +++ b/data/tutorials/language/1ms_02_dune.md @@ -63,7 +63,7 @@ let () = Here is the resulting output: ```shell -$ dune exec nube +$ opam exec -- dune exec nube Nimbostratus (Ns) Cumulonimbus (Cb) ```