I rewrote some comments so [dune build @doc] can extract HTML from

module interfaces.

This is meant as an exercise and an example to all team members.

I fixed a minor shadowing issue in [x_list.ml].

vendors/ligo-utils/simple-utils/pos.mli

@@ -1,4 +1,4 @@
-(* Positions in a file
+(** Positions in a file
 
    A position in a file denotes a single unit belonging to it, for
    example, in an ASCII text file, it is a particular character within
@@ -7,22 +7,57 @@
 
      Units can be either bytes (as ASCII characters) or, more
    generally, unicode points.
+ *)
 
-     The type for positions is the object type [t].
+(** {1 Definition} *)
+
+(** The type for positions is the object type [t].
 
      We use here lexing positions to denote byte-oriented positions
    (field [byte]), and we manage code points by means of the fields
    [point_num] and [point_bol]. These two fields have a meaning
    similar to the fields [pos_cnum] and [pos_bol], respectively, from
-   the standard module [Lexing]. That is to say, [point_num] holds the
+   the standard module {! Lexing}. That is to say, [point_num] holds
-   number of code points since the beginning of the file, and
+   the number of code points since the beginning of the file, and
    [point_bol] the number of code points since the beginning of the
    current line.
 
-     The name of the file is given by the field [file], and the line
+   {ul
-   number by the field [line].
-*)
 
+     {li The name of the file is given by the field [file], and the
+         line number by the field [line].}
+
+     {li The call [pos#new_line s], where the string [s] is either
+         ["\n"] or ["\c\r"], updates the position [pos] with a new
+         line.}
+
+     {li The call [pos#add_nl] assumes that the newline character is
+         one byte.}
+
+     {li The call [pos#shift_bytes n] evaluates in a position that is
+         the translation of position [pos] of [n] bytes forward in the
+         file.}
+
+     {li The call [pos#shift_one_uchar n] is similar, except that it
+         assumes that [n] is the number of bytes making up one unicode
+         point.}
+
+     {li The call [pos#offset `Byte] provides the horizontal offset of
+         the position [pos] in bytes. (An offset is the number of
+         units, like bytes, since the beginning of the current line.)
+         The call [pos#offset `Point] is the offset counted in number
+         of unicode points.}
+
+     {li The calls to the method [column] are similar to those to
+         [offset], except that they give the curren column number.}
+
+     {li The call [pos#line_offset `Byte] is the offset of the line of
+         position [pos], counted in bytes. Dually, [pos#line_offset
+         `Point] counts the same offset in code points.}
+
+     {li The call [pos#byte_offset] is the offset of the position
+         [pos] since the begininng of the file, counted in bytes.}}
+ *)
 type t = <
   (* Payload *)
 
@@ -39,43 +74,16 @@ type t = <
   set_offset : int -> t;
   set        : file:string -> line:int -> offset:int -> t;
 
-  (* The call [pos#new_line s], where the string [s] is either "\n" or
-     "\c\r", updates the position [pos] with a new line. *)
-
   new_line : string -> t;
   add_nl   : t;
 
-  (* The call [pos#shift_bytes n] evaluates in a position that is the
-     translation of position [pos] of [n] bytes forward in the
-     file. The call [pos#shift_one_uchar n] is similar, except that it
-     assumes that [n] is the number of bytes making up one unicode
-     point. *)
-
   shift_bytes     : int -> t;
   shift_one_uchar : int -> t;
 
   (* Getters *)
 
-  (* The call [pos#offset `Byte] provides the horizontal offset of the
-     position [pos] in bytes. (An offset is the number of units, like
-     bytes, since the beginning of the current line.) The call
-     [pos#offset `Point] is the offset counted in number of unicode
-     points.
-
-     The calls to the method [column] are similar to those to
-     [offset], except that they give the curren column number.
-
-     The call [pos#line_offset `Byte] is the offset of the line of
-     position [pos], counted in bytes. Dually, [pos#line_offset
-     `Point] counts the same offset in code points.
-
-     The call [pos#byte_offset] is the offset of the position [pos]
-     since the begininng of the file, counted in bytes.
-  *)
-
   offset      : [`Byte | `Point] -> int;
   column      : [`Byte | `Point] -> int;
-
   line_offset : [`Byte | `Point] -> int;
   byte_offset : int;
 
@@ -90,19 +98,26 @@ type t = <
   anonymous : ?offsets:bool -> [`Byte | `Point] -> string
 >
 
+(** A shorthand after an [open Pos].
+ *)
 type pos = t
 
-(* Constructors *)
+(** {1 Constructors} *)
 
 val make      : byte:Lexing.position -> point_num:int -> point_bol:int -> t
 val from_byte : Lexing.position -> t
 
-(* Special positions *)
+(** {1 Special positions} *)
 
-val ghost : t  (* Same as [Lexing.dummy_pos] *)
+(** The value [ghost] is the same as {! Lexing.dummy_pos}.
-val min   : t  (* Lexing convention: line 1, offsets to 0 and file to "". *)
+ *)
+val ghost : t
 
-(* Comparisons *)
+(** Lexing convention: line [1], offsets to [0] and file to [""].
+ *)
+val min : t
+
+(** {1 Comparisons} *)
 
 val equal : t -> t -> bool
 val lt    : t -> t -> bool

vendors/ligo-utils/simple-utils/region.ml

@@ -1,7 +1,11 @@
 (* Regions of a file *)
 
+(* A shorthand *)
+
 let sprintf = Printf.sprintf
 
+(* The object type for regions *)
+
 type t = <
   start : Pos.t;
   stop  : Pos.t;
@@ -28,8 +32,12 @@ type t = <
   compact   : ?file:bool -> ?offsets:bool -> [`Byte | `Point] -> string
 >
 
+(* A synonym *)
+
 type region = t
 
+(* A convenience *)
+
 type 'a reg = {region: t; value: 'a}
 
 (* Injections *)

vendors/ligo-utils/simple-utils/region.mli

@@ -1,44 +1,73 @@
-(* Regions of a file
+(** Regions of a file
 
-   A _region_ is a contiguous series of bytes, for example, in a text
+   A {e region} is a contiguous series of bytes, for example, in a
-   file. It is here denoted by the object type [t].
+   text file. It is here denoted by the object type [t].
+ *)
 
-     The start (included) of the region is given by the field [start],
+(** {1 Definition} *)
-   which is a _position_, and the end (excluded) is the position given
+
-   by the field [stop]. The convention of including the start and
+(** The start (included) of the region is given by the field [start],
-   excluding the end enables to have empty regions if, and only if,
+    which is a {e position}, and the end (excluded) is the position
-   [start = stop]. See module [Pos] for the definition of positions.
+    given by the field [stop]. The convention of including the start
+    and excluding the end enables to have empty regions if, and only
+    if, [start = stop], which a fast and easy check. See module {!
+    Pos} for the definition of positions.
 
       The first byte of a file starts at the offset zero (that is,
     column one), and [start] is always lower than or equal to [stop],
     and they must refer to the same file.
-*)
+    {ul
 
+      {li The call [region#shift_bytes n] evaluates in a region that
+          is the translation of region [region] of [n] bytes forward
+          in the file.}
+
+      {li The call [region#shift_one_uchar n] is similar to
+          [region#shift_bytes n], except that it assumes that [n] is
+          the number of bytes making up one unicode point.}
+
+      {li The call [region#set_file f] sets the file name to be [f].}
+
+      {li The method [file] returns the file name.}
+
+      {li The method [pos] returns the values of the fields [start]
+          and [stop].}
+
+      {li The method [byte_pos] returns the start and end positions of
+          the region at hand {e interpreting them as lexing
+          positions}, that is, the unit is the byte.}
+
+      {li The call [region#to_string ~file ~offsets mode] evaluates in
+          a string denoting the region [region], in the manner of the
+          OCaml compilers.}
+
+      {li The name of the file is present if, and only if, [file =
+          true] or [file] is missing.}
+
+      {li The positions in the file are expressed as horizontal
+          offsets if [offsets = true] or [offsets] is missing (the
+          default), otherwise as columns.}
+
+      {li If [mode = `Byte], those positions will be assumed to have
+          bytes as their unit, otherwise, if [mode = `Point], they
+          will be assumed to refer to code points.}
+
+      {li The method [compact] has the same signature as and calling
+          convention as [to_string], except that the resulting string
+          is more compact.}}
+ *)
 type t = <
   start : Pos.t;
   stop  : Pos.t;
 
   (* Setters *)
 
-  (* The call [region#shift_bytes n] evaluates in a region that is the
-     translation of region [region] of [n] bytes forward in the
-     file. The call [region#shift_one_uchar n] is similar, except that
-     it assumes that [n] is the number of bytes making up one unicode
-     point. The call [region#set_file f] sets the file name to be
-     [f]. *)
-
   shift_bytes     : int -> t;
   shift_one_uchar : int -> t;
   set_file        : string -> t;
 
   (* Getters *)
 
-  (* The method [file] returns the file name.
-     The method [pos] returns the values of the fields [start] and [stop].
-     The method [byte_pos] returns the start and end positions of the
-     region at hand _interpreting them as lexing positions_, that is,
-     the unit is the byte. *)
-
   file     : string;
   pos      : Pos.t * Pos.t;
   byte_pos : Lexing.position * Lexing.position;
@@ -47,84 +76,70 @@ type t = <
 
   is_ghost : bool;
 
-  (* Conversions to [string] *)
+  (* Conversions to type [string] *)
-
-  (* The call [region#to_string ~file ~offsets mode] evaluates in a
-     string denoting the region [region].
-
-     The name of the file is present if, and only if, [file = true] or
-     [file] is missing.
-
-     The positions in the file are expressed horizontal offsets if
-     [offsets = true] or [offsets] is missing (the default), otherwise
-     as columns.
-
-     If [mode = `Byte], those positions will be assumed to have bytes
-     as their unit, otherwise, if [mode = `Point], they will be
-     assumed to refer to code points.
-
-     The method [compact] has the same signature and calling
-     convention as [to_string], except that the resulting string is
-     more compact.
-   *)
 
   to_string : ?file:bool -> ?offsets:bool -> [`Byte | `Point] -> string;
   compact   : ?file:bool -> ?offsets:bool -> [`Byte | `Point] -> string
 >
 
+(** The type [region] is a synonym of [t] to use after [open Region].
+ *)
 type region = t
 
+(** The type ['a reg] enables the concept of something of type ['a] to
+    be related to a region in a source file.
+ *)
 type 'a reg = {region: t; value: 'a}
 
-(* Constructors *)
+(* {1 Constructors} *)
-
-(* The function [make] creates a region from two positions. If the
-   positions are not properly ordered or refer to different files, the
-   exception [Invalid] is raised. *)
 
 exception Invalid
 
+(** The function [make] creates a region from two positions. If the
+    positions are not properly ordered or refer to different files,
+    the exception [Invalid] is raised.
+    @raise [Invalid]
+ *)
 val make : start:Pos.t -> stop:Pos.t -> t
 
-(* Special regions *)
+(** {1 Special regions} *)
 
-(* To deal with ghost expressions, that is, pieces of abstract syntax
+(** To deal with ghost expressions, that is, pieces of abstract syntax
     that have not been built from excerpts of concrete syntax, we need
-   _ghost regions_. The module [Pos] provides a [ghost] position, and
+    {e ghost regions}. The module {! Pos} provides a [ghost] position,
-   we also provide a [ghost] region and, in type [t], the method
+    and we also provide a [ghost] region and, in type [t], the method
-   [is_ghost] to check it. *)
+    [is_ghost] to check it. It is implemented as two [Pos.ghost]
-
+    positions.  *)
-val ghost : t (* Two [Pos.ghost] positions *)
+val ghost : t
-
-(* This wraps a value with a ghost region. *)
 
+(** The call to [wrap_ghost] wraps a value within a ghost region.
+ *)
 val wrap_ghost : 'a -> 'a reg
 
+(** Occasionnally, we may need a minimum region. It is here made of
+    two minimal positions.
+*)
+val min : t
 
-(* Occasionnally, we may need a minimum region. It is here made of two
+(** {1 Comparisons} *)
-   minimal positions. *)
 
-val min : t (* Two [Pos.min] positions *)
+(** Two regions are equal if, and only if, they refer to the same file
-
-(* Comparisons *)
-
-(* Two regions are equal if, and only if, they refer to the same file
     and their start positions are equal and their stop positions are
-   equal. See [Pos.equal]. Note that [r1] and [r2] can be ghosts. *)
+    equal. See {! Pos.equal}. Note that [r1] and [r2] can be
-
+    ghosts.  *)
 val equal : t -> t -> bool
 
-(* The call [lt r1 r2] ("lower than") has the value [true] if, and
+(** The call [lt r1 r2] ("lower than") has the value [true] if, and
     only if, regions [r1] and [r2] refer to the same file, none is a
     ghost and the start position of [r1] is lower than that of
-   [r2]. (See [Pos.lt].) *)
+    [r2]. (See {! Pos.lt}.) *)
-
 val lt : t -> t -> bool
 
-(* Given two regions [r1] and [r2], we may want the region [cover r1
+(** Given two regions [r1] and [r2], we may want the region [cover r1
-   r2] that covers [r1] and [r2]. We property [equal (cover r1 r2)
+    r2] that covers [r1] and [r2]. We have the property [equal (cover
-   (cover r2 r1)]. (In a sense, it is the maximum region, but we avoid
+    r1 r2) (cover r2 r1)]. (In a sense, it is the maximum region, but
-   that name because of the [min] function above.) If [r1] is a ghost,
+    we avoid that name because of the [min] function above.) If [r1]
-   the cover is [r2], and if [r2] is a ghost, the cover is [r1]. *)
+    is a ghost, the cover is [r2], and if [r2] is a ghost, the cover
-
+    is [r1].
+ *)
 val cover : t -> t -> t

vendors/ligo-utils/simple-utils/trace.ml

@@ -1,243 +1,253 @@
 (** Trace tutorial
 
-    The module below guides the reader through the writing of a
+    This module guides the reader through the writing of a simplified
-    simplified version of the trace monad (`result`), and the
+    version of the trace monad [result], and the definition of a few
-    definition of a few operations that make it easier to work with
+    operations that make it easier to work with [result].
-    `result`.
 *)
 
 module Trace_tutorial = struct
-(** The trace monad is fairly similar to the option type: *)
+  (** The trace monad is fairly similar to the predefined option
+      type. *)
 
-type 'a option =
+  type annotation = string
-    Some of 'a  (* Ok also stores a list of annotations *)
+  type      error = string
-  | None;;      (* Errors also stores a list of messages *)
 
-type annotation = string;;
+  (** The type ['a result] is used by the trace monad to both model an
-type      error = string;;
+      expected value of type ['a] or the failure to obtain it, instead
-type 'a result =
+      of working directly with ['a] values and handling separately
+      errors, for example by means of exceptions. (See the type [('a,'b)
+      result] in the module [Pervasives] of the OCaml system for a
+      comparable approach to error handling.)
+
+      The type ['a result] carries either a value of type ['a], with a
+      list of annotations (information about past successful
+      computations), or it is a list of errors accumulated so far.
+      The former case is denoted by the data constructor [Ok], and the
+      second by [Errors].
+   *)
+  type 'a result =
     Ok of 'a * annotation list
-  | Errors of error list;;
+  | Errors of error list
 
-(** When applying a partial function on a result, it can return a valid result
+  (** The function [divide_trace] shows the basic use of the trace
-    (Some v), or indicate failure (None). *)
+      monad.
-
+   *)
-let divide a b =
+  let divide_trace a b =
     if   b = 0
-  then None
+    then Errors [Printf.sprintf "division by zero: %d/%d" a b]
-  else Some (a/b);;
+    else Ok (a/b, [])
 
-(** With the trace monad, the Errors case also indicates some information about
+  (** The function [divide_three] shows that when composing two
-    the failure, to ease debugging. *)
+      functions, if the first call fails, the error is passed along
-
+      and the second call is not evaluated. (A pattern called
-let divide_trace a b =
+      "error-passing style").
-  if b = 0
+   *)
-  then (Errors [Printf.sprintf "division by zero: %d / %d" a b])
+  let divide_three a b c =
-  else Ok ((a/b) , []);;
+    match divide_trace a b with
-
-(** when composing two functions, the error case is propagated. *)
-
-let divide_three a b c =
-  let maybe_a_div_b = divide_trace a b in
-  match maybe_a_div_b with
       Ok (a_div_b , _) -> divide_trace a_div_b c
-   | (Errors _) as e -> e;;
+    |          errors  -> errors
 
-(** If both calls are successful, the lists of annotations are concatenated. *)
+  (** The function [divide_three_annot] shows that when composing two
+      functions, if both calls are successful, the lists of
+      annotations are joined.
+   *)
+  let divide_three_annot a b c =
+    match divide_trace a b with
+      Ok (a_div_b, annot1) -> (
+        match divide_trace a_div_b c with
+           Ok (a_div_b_div_c, annot2) ->
+             Ok (a_div_b_div_c, annot2 @ annot1)
+        | errors -> errors)
+    | errors -> errors
 
-let divide_three_annots a b c =
+  (** The systematic matching of the result of each call in a function
+      composition is bulky, so we define a [bind] function which takes
+      a function [f: 'a -> 'b result] and applies it to a current ['a
+      result] (not ['a]).
+      {ul
+        {li If the current result is an error, then [bind]
+        returns that same error without calling [f];}
+
+        {li otherwise [bind] unwraps the [Ok] of the current result
+        and calls [f] on it:
+          {ul
+            {li That call itself may return an error;}
+            {li if not, [bind] combines the annotations and returns the last
+       result.}}}}
+   *)
+  let bind (f: 'a -> 'b result) : 'a result -> 'b result =
+    function
+      Ok (x, annot) -> (
+        match f x with
+          Ok (x', annot') -> Ok (x', annot' @ annot)
+        |          errors -> ignore annot; errors)
+    | Errors _ as e -> e
+
+  (** The function [divide_three_bind] is equivalent to the verbose
+      [divide_three] above, but makes use of [bind].
+   *)
+  let divide_three_bind a b c =
     let maybe_a_div_b = divide_trace a b in
-  match maybe_a_div_b with
+    let continuation a_div_b = divide_trace a_div_b c
-     Ok (a_div_b , annots1) ->
+    in bind continuation maybe_a_div_b
-       let maybe_a_div_b_div_c = divide_trace a_div_b c in
-       begin
-         match maybe_a_div_b_div_c with
-           Ok (a_div_b_div_c , annots2)
-           -> Ok (a_div_b_div_c , annots2 @ annots1)
-         | (Errors _) as e2 -> e2
-       end
-   | (Errors _) as e1 -> e1;;
 
-(** This incurs quite a lot of noise, so we define a `bind` operator which
+  (** The operator [(>>?)] is a redefinition of [bind] that makes the
-    takes a function ('x -> ('y result)) and applies it to an existing
+      program shorter, at the cost of a slightly
-    ('x result).
+      awkward reading because the two parameters are swapped.
+   *)
+  let (>>?) x f = bind f x
 
-   * If the existing result is Errors, `bind` returns that error without
+  (** The function [divide_three_bind_symbol] is equivalent to
-     calling the function
+      [divide_three_bind], but makes use of the operator [(>>?)].
-   * Otherwise `bind` unwraps the Ok and calls the function
+   *)
-     * That function may itself return an error
+  let divide_three_bind_symbol a b c =
-     * Otherwise `bind` combines the annotations and returns the second
-       result. *)
-
-let bind f = function
-  | Ok (x, annotations) ->
-      (match f x with
-         Ok (x', annotations') -> Ok (x', annotations' @ annotations)
-       | Errors _ as e' -> ignore annotations; e')
-  | Errors _ as e -> e;;
-
-(** The following function divide_three_bind is equivalent to the verbose
-   divide_three. *)
-
-let divide_three_bind a b c =
     let maybe_a_div_b = divide_trace a b in
     let continuation a_div_b = divide_trace a_div_b c in
-  bind continuation maybe_a_div_b;;
+    maybe_a_div_b >>? continuation
 
-(** This made the code shorter, but the reading order is a bit awkward.
+  (** The function [divide_three_bind_symbol'] is equivalent to
-    We define an operator symbol for `bind`: *)
+      [divide_three_bind_symbol], where the two temporary [let]
+      definitions are inlined for a more compact reading.
+   *)
+  let divide_three_bind_symbol' a b c =
+    divide_trace a b >>? (fun a_div_b -> divide_trace a_div_b c)
 
-let (>>?) x f = bind f x;;
+  (** This is now fairly legible, but chaining many such functions is
-
+      not the usual way of writing code. We use the PPX extension to
-let divide_three_bind_symbol a b c =
+      the OCaml compiler [ppx_let] to add some syntactic sugar.
-  let maybe_a_div_b = divide_trace a b in
+      The extension framework PPX is enabled by adding the following
-  let continuation a_div_b = divide_trace a_div_b c in
+      lines inside the section [(library ...)] or [(executable ...)]
-  maybe_a_div_b >>? continuation;;
+      of the [dune] file for the project that uses [ppx_let], like so:
-
+      [(preprocess
-(** and we inline the two temporary let definitions: *)
+         (pps simple-utils.ppx_let_generalized))]
-
+      The extension [ppx_let] requires the module [Let_syntax] to be
-let divide_three_bind_symbol' a b c =
+      defined.
-  divide_trace a b >>? (fun a_div_b -> divide_trace a_div_b c);;
+   *)
-
+  module Let_syntax = struct
-(** This is now fairly legible, but chaining many such functions is
-    not the usual way of writing code. We use ppx_let to add some
-    syntactic sugar.
-
-    The ppx is enabled by adding the following lines inside the
-    section (library …) or (executable …) of the dune file for
-    the project that uses ppx_let.
-
-    (preprocess
-      (pps simple-utils.ppx_let_generalized))
-*)
-
-module Let_syntax = struct
     let bind m ~f = m >>? f
     module Open_on_rhs_bind = struct end
-end;;
+  end
 
-(** divide_three_bind_ppx_let is equivalent to divide_three_bind_symbol'.
+  (** The function [divide_three_bind_ppx_let] is equivalent to the
+      function [divide_three_bind_symbol']. The only difference is
+      that the module [Open_on_rhs_bind] is implicitly opened around
+      the expression on the righ-hand side of the [=] sign, namely
+      [divide_trace a b].
+   *)
+  let divide_three_bind_ppx_let a b c =
+    let%bind a_div_b = divide_trace a b
+    in divide_trace a_div_b c
 
-    Strictly speaking, the only difference is that the module
+  (** The function [divide_many_bind_ppx_let] shows how well this
-    Open_on_rhs_bind is opened around the expression on the righ-hand side
+      notation composes.
-    of the `=` sign, namely `divide_trace a b` *)
+   *)
-
+  let divide_many_bind_ppx_let a b c d e f  =
-let divide_three_bind_ppx_let a b c =
-  let%bind a_div_b = divide_trace a b in
-  divide_trace a_div_b c;;
-
-(** This notation scales fairly well: *)
-
-let divide_many_bind_ppx_let a b c d e f  =
     let      x = a                in
     let%bind x = divide_trace x b in
     let%bind x = divide_trace x c in
     let%bind x = divide_trace x d in
     let%bind x = divide_trace x e in
-  let%bind x = divide_trace x f in
+    let%bind x = divide_trace x f
-  Ok (x , []);;
+    in Ok (x, [])
 
-(** We define a couple of shorthands for common use cases.
+  (** The function [ok] is a shorthand for an [Ok] without
+      annotations.
+   *)
+  let ok x = Ok (x, [])
 
-    `ok` lifts a ('foo) value to a ('foo result): *)
+  (** The function [map] lifts a regular ['a -> 'b] function on values to
+      a function on results, of type ['a result -> 'b result].
+   *)
+  let map f = function
+    Ok (x, annotations) -> Ok (f x, annotations)
+  | e -> e
 
-let ok x = Ok (x, []);;
+  (** The function [bind_list] turns a list of results of type [('a
-
+      result) list] into a result of list, of type [('a list) result],
-(** `map` lifts a regular ('foo -> 'bar) function on values
+      as follows.
-    to a function on results, with type ('foo result -> 'bar result): *)
+      {ul
-
+        {li If the list only contains [Ok] values, it strips the [Ok]
-let map f = function
+         of each element and returns that list wrapped with [Ok].}
-  | Ok (x, annotations) -> Ok (f x, annotations)
+        {li Otherwise, one or more of the elements of the input list
-  | Errors _ as e -> e;;
+         is [Errors], then [bind_list] returns the first error in the
-
+         list.}}
-(** `bind_list` turns a (('foo result) list) into a (('foo list) result).
+   *)
-
+  let rec bind_list = function
-    If the list only contains Ok values, it strips the Ok returns that list
+    [] -> ok []
-    wrapped with Ok.
+  | hd::tl ->
-
-    Otherwise, when one or more of the elements of the original list is
-    Errors, `bind_list` returns the first error in the list. *)
-
-let rec bind_list = function
-  | [] -> ok []
-  | hd :: tl -> (
      hd >>? fun hd ->
      bind_list tl >>? fun tl ->
-      ok @@ hd :: tl
+     ok @@ hd::tl
-    );;
+  (** A major feature of [Trace] is that it enables having a stack of
-
+      errors (that should act as a simplified stack frame), rather
-(**
+      than a unique error. It is done by using the function
-   A major feature of Trace is that it enables having a stack of errors (that
+      [trace]. For instance, let's say that you have a function that
-   should act as a simplified stack frame), rather than a unique error.
+      can trigger two errors, and you want to pass their data along
-   It is done by using the function `trace`.
+      with an other error, what you would usually do is:
-   For instance, let's say that you have a function that can trigger two errors,
+      [let foobarer ... = ... in
-   and you want to pass their data along with an other error, what you would
-   usually do is:
-   ```
-   let foobarer ... =
-     ... in
         let value =
-       try ( get key map )
+          try get key map with
-       with
+            Bad_key _ -> raise (Error ("bad key", key, map))
-       | Bad_key _ -> raise (Foobar_error ("bad key" , key , map))
+          | Missing_value _ -> raise (Error ("missing index", key, map))
-       | Missing_value _ -> raise (Foobar_error ("missing index" , key , map))
+        in ...]
-     in ...
+      With [Trace], you would instead:
-   ```
+      [let foobarer ... = ... in
-   With Trace, you would instead:
-   ```
-   let foobarer ... =
-     ... in
         let%bind value =
           trace (simple_error "error getting key") @@
           get key map
-     in ...
+        in ...]
-   ```
+        And this will pass along the error triggered by [get key map].
-   And this will pass along the error triggered by "get key map".
+   *)
-*)
+  let trace err = function
+    Errors e -> Errors (err::e)
+  | ok -> ok
 
-let trace err = function
+  (** The real trace monad is very similar to the one that we have
-  | Ok _ as o -> o
-  | Errors errs -> Errors (err :: errs);;
-
-(** The real trace monad is very similar to the one that we have
       defined above. The main difference is that the errors and
-    annotations are structured data (instead of plain strings) and are
+      annotations are structured data (instead of plain strings) and
-    lazily-generated. *)
+      are generated lazily.
-
+   *)
-let the_end = "End of the tutorial.";;
+  let the_end = "End of the tutorial."
 
 end (* end Trace_tutorial. *)
 
 module J = Yojson.Basic
 
 module JSON_string_utils = struct
-  let member = fun n x ->
+  let member n x =
     match x with
-    | `Null -> `Null
+      `Null -> `Null
     | x -> J.Util.member n x
+
   let string = J.Util.to_string_option
+
   let to_list_option = fun x ->
-    try ( Some (J.Util.to_list x))
+    try Some (J.Util.to_list x) with _ -> None
-    with _ -> None
+
   let to_assoc_option = fun x ->
-    try ( Some (J.Util.to_assoc x))
+    try Some (J.Util.to_assoc x) with _ -> None
-    with _ -> None
+
   let list = to_list_option
+
   let assoc = to_assoc_option
+
   let int = J.Util.to_int_option
 
   let patch j k v =
     match assoc j with
-    | None -> j
+      None -> j
     | Some assoc -> `Assoc (
-        List.map (fun (k' , v') -> (k' , if k = k' then v else v')) assoc
+        List.map (fun (k', v') -> (k', if k = k' then v else v')) assoc
       )
 
   let swap f l r = f r l
 
   let unit x = Some x
+
   let bind f = function None -> None | Some x -> Some (f x)
-  let bind2 f = fun l r -> match l, r with
+
+  let bind2 f l r =
+    match l, r with
       None,   None   -> None
     | None,   Some _ -> None
     | Some _, None   -> None
@@ -250,73 +260,68 @@ module JSON_string_utils = struct
   let string_of_int = bind string_of_int
 
   let (||) l r = l |> default r
+
   let (|^) = bind2 (^)
+
 end
 
 type 'a thunk = unit -> 'a
 
-(**
+(** Errors are encoded in JSON. This is because different libraries
-   Errors are encoded in JSON. This is because different libraries will
+    will implement their own helpers, and we do not want to hardcode
-   implement their own helpers, and we don't want to hardcode in their type how
+    in their type how they are supposed to interact.
-   they are supposed to interact.
+ *)
-*)
 type error = J.t
 
-(**
+(** Thunks are used because computing some errors can be costly, and
-   Thunks are used because computing some errors can be costly, and we don't
+    we do not want to spend most of our time building errors. Instead,
-   to spend most of our time building errors. Instead, their computation is
+    their computation is deferred.
-   deferred.
+ *)
-*)
 type error_thunk = error thunk
 
-(**
+(** Annotations should be used in debug mode to aggregate information
-   Annotations should be used in debug mode to aggregate information about some
+    about some value history. Where it was produced, when it was
-   value history. Where it was produced, when it was modified, etc.
+    modified, etc.  It is currently not being used.  *)
-   It's currently not being used.
-*)
 type annotation = J.t
 
-(**
+(** Even in debug mode, building annotations can be quite
-   Even in debug mode, building annotations can be quite resource-intensive.
+   resource-intensive.  Instead, a thunk is passed, that is computed
-   Instead, a thunk is passed, that is computed only when debug information is
+   only when debug information is queried (typically before a print).
-   queried (typically before a print).
+ *)
-*)
 type annotation_thunk = annotation thunk
 
-(**
+(** Types of traced elements. It might be good to rename it [trace] at
-   Types of traced elements. It might be good to rename it `trace` at some
+    some point.
-   point.
+ *)
-*)
 type 'a result =
-  | Ok of 'a * annotation_thunk list
+  Ok    of 'a * annotation_thunk list
-  | Error of error_thunk
+| Error of error_thunk
 
 
-(**
+(** {1 Constructors} *)
-   Constructors
+
-*)
 let ok x = Ok (x, [])
+
 let fail err = Error err
 
-(**
+(** {1 Monadic operators} *)
-   Monadic operators
+
-*)
 let bind f = function
-  | Ok (x, annotations) ->
+  Ok (x, ann) -> (
-      (match f x with
+    match f x with
-         Ok (x', annotations') -> Ok (x', annotations' @ annotations)
+      Ok (x', ann') -> Ok (x', ann' @ ann)
-       | Error _ as e' -> ignore annotations; e')
+    | Error _ as e' -> ignore ann; e')
-  | Error _ as e -> e
+| Error _ as e -> e
 
 let map f = function
-  | Ok (x, annotations) -> Ok (f x, annotations)
+  Ok (x, annotations) -> Ok (f x, annotations)
-  | Error _ as e -> e
+| Error _ as e -> e
 
-(**
+(** The lexical convention usually adopted for the bind function is
-   Usual bind-syntax is `>>=`, but this is taken from the Tezos code base. Where
+   [>>=], but ours comes from the Tezos code base, where the [result]
-   the `result` bind is `>>?`, Lwt's (threading library) is `>>=`, and the
+   bind is [>>?], and [Lwt]'s (threading library) is [>>=], and the
-   combination of both is `>>=?`.
+   combination of both is [>>=?].
-*)
+ *)
 let (>>?)  x f = bind f x
 let (>>|?) x f = map f x
 
@@ -324,32 +329,32 @@ let (>>|?) x f = map f x
    Used by PPX_let, an OCaml preprocessor.
    What it does is that, when you only care about the case where a result isn't
    an error, instead of writing:
-   ```
+   [
    (* Stuff that might return an error *) >>? fun ok_value ->
    (* Stuff being done on the result *)
-   ```
+   ]
    You can write:
-   ```
+   [
    let%bind ok_value = (* Stuff that might return an error *) in
    (* Stuff being done on the result *)
-   ```
+   ]
-   This is much more typical of OCaml. makes the code more readable, easy to
+   This is much more typical of OCaml. This makes the code more
-   write and refactor. It is used pervasively in LIGO.
+   readable, easy to write and refactor. It is used pervasively in
-*)
+   LIGO.
+ *)
 module Let_syntax = struct
   let bind m ~f = m >>? f
   module Open_on_rhs_bind = struct end
 end
 
 
-(**
+(** Build a thunk from a constant.
-   Build a thunk from a constant.
+  *)
-*)
 let thunk x () = x
 
-(**
+(** Build a standard error, with a title, a message, an error code and
-   Build a standard error, with a title, a message, an error code and some data.
+    some data.
-*)
+ *)
 let mk_error
     ?(error_code : int thunk option) ?(message : string thunk option)
     ?(data : (string * string thunk) list option)
@@ -407,48 +412,42 @@ let prepend_info = fun info err ->
   patch err "infos" (`List infos)
 
 
-(**
+(** Helpers that ideally should not be used in production.
-   Helpers that ideally shouldn't be used in production.
 *)
 let simple_error str () = mk_error ~title:(thunk str) ()
 let simple_info str () = mk_info ~title:(thunk str) ()
 let simple_fail str = fail @@ simple_error str
 let internal_assertion_failure str = simple_error ("assertion failed: " ^ str)
 
-(**
+(** To be used when you only want to signal an error. It can be useful
-   To be used when you only want to signal an error. It can be useful when
+    when followed by [trace_strong].
-   followed by `trace_strong`.
+ *)
-*)
 let dummy_fail = simple_fail "dummy"
 
 let trace info = function
-  | Ok _ as o -> o
+  Ok _ as o -> o
-  | Error err -> Error (fun () -> prepend_info (info ()) (err ()))
+| Error err -> Error (fun () -> prepend_info (info ()) (err ()))
 
-(**
+(** Erase the current error stack, and replace it by the given
-   Erase the current error stack, and replace it by the given error. It's useful
+   error. It's useful when using [Assert] and you want to discard its
-   when using `Assert` and you want to discard its auto-generated message.
+   autogenerated message.
-*)
+ *)
 let trace_strong err = function
-  | Ok _ as o -> o
+  Ok _ as o -> o
-  | Error _ -> Error err
+| Error _ -> Error err
 
 (**
    Sometimes, when you have a list of potentially erroneous elements, you need
    to retrieve all the errors, instead of just the first one. In that case, do:
-   ```
+   [let type_list lst =
-   let type_list lst =
      let%bind lst' =
        trace_list (simple_error "Error while typing a list") @@
        List.map type_element lst in
-     ...
+     ...]
-   ```
    Where before you would have written:
-   ```
+   [let type_list lst =
-   let type_list lst =
      let%bind lst' = bind_map_list type_element lst in
-     ...
+     ...]
-   ```
 *)
 let trace_list err lst =
   let oks =
@@ -520,18 +519,16 @@ let trace_option error = function
   | None -> fail error
   | Some s -> ok s
 
-(**
+(** Utilities to interact with other data-structure.  [bind_t] takes
-   Utilities to interact with other data-structure.
+   an ['a result t] and makes a ['a t result] out of it. It "lifts" the
-   `bind_t` takes an `'a result t` and makes a `'a t result` out of it. It
+   error out of the type.  The most common context is when mapping a
-   "lifts" the error out of the type.
+   given type. For instance, if you use a function that can fail in
-   The most common context is when mapping a given type. For instance, if you
+   [List.map], you need to manage a whole list of results. Instead,
-   use a function that can fail in `List.map`, you need to manage a whole list
+   you do [let%bind lst' = bind_list @@ List.map f lst], which will
-   of results. Instead, you do `let%bind lst' = bind_list @@ List.map f lst`,
+   yield an ['a list].  [bind_map_t] is roughly syntactic sugar for
-   which will yield an `'a list`.
+   [bind_t @@ T.map]. So that you can rewrite the previous example as
-   `bind_map_t` is roughly syntactic sugar for `bind_t @@ T.map`. So that you
+   [let%bind lst' = bind_map_list f lst].  Same thing with folds.
-   can rewrite the previous example as `let%bind lst' = bind_map_list f lst`.
+ *)
-   Same thing with folds.
-*)
 
 let bind_map_option f = function
   | None -> ok None
@@ -560,10 +557,8 @@ let bind_smap (s:_ X_map.String.t) =
 
 let bind_fold_smap f init (smap : _ X_map.String.t) =
   let aux k v prev =
-    prev >>? fun prev' ->
+    prev >>? fun prev' -> f prev' k v
-    f prev' k v
+  in X_map.String.fold aux smap init
-  in
-  X_map.String.fold aux smap init
 
 let bind_map_smap f smap = bind_smap (X_map.String.map f smap)
 
@@ -573,6 +568,7 @@ let bind_concat (l1:'a list result) (l2: 'a list result) =
   ok @@ (l1' @ l2')
 
 let bind_map_list f lst = bind_list (List.map f lst)
+
 let rec bind_map_list_seq f lst = match lst with
   | [] -> ok []
   | hd :: tl -> (
@@ -580,9 +576,10 @@ let rec bind_map_list_seq f lst = match lst with
       let%bind tl' = bind_map_list_seq f tl in
       ok (hd' :: tl')
     )
-let bind_map_ne_list : _ -> 'a X_list.Ne.t -> 'b X_list.Ne.t result = fun f lst -> bind_ne_list (X_list.Ne.map f lst)
+let bind_map_ne_list : _ -> 'a X_list.Ne.t -> 'b X_list.Ne.t result =
-let bind_iter_list : (_ -> unit result) -> _ list -> unit result = fun f lst ->
+  fun f lst -> bind_ne_list (X_list.Ne.map f lst)
-  bind_map_list f lst >>? fun _ -> ok ()
+let bind_iter_list : (_ -> unit result) -> _ list -> unit result =
+  fun f lst -> bind_map_list f lst >>? fun _ -> ok ()
 
 let bind_location (x:_ Location.wrap) =
   x.wrap_content >>? fun wrap_content ->
@@ -847,4 +844,3 @@ let errors_pp_short =
   Format.pp_print_list
     ~pp_sep:Format.pp_print_newline
     error_pp_short
-

vendors/ligo-utils/simple-utils/x_list.ml

@@ -178,7 +178,7 @@ module Ne = struct
 
   type 'a t = 'a * 'a list
 
-  let of_list lst = List.(hd lst, tl lst)
+  let of_list lst = List.hd lst, List.tl lst
   let to_list (hd, tl : _ t) = hd :: tl
   let singleton hd : 'a t = hd , []
   let hd : 'a t -> 'a = fst