From fbf6c5682e32bffe7512988cf87af62bbe099af0 Mon Sep 17 00:00:00 2001
From: Lucas Franceschino <lucas@cryspen.com>
Date: Tue, 9 Jul 2024 14:43:13 +0200
Subject: [PATCH] doc(engine/utils): generate-visitors

---
 .../generate_visitors/codegen_visitor.ml      | 38 +++++++++++++------
 engine/utils/generate_visitors/errors.ml      | 34 ++++++++++-------
 .../generate_visitors/primitive_types.ml      |  4 ++
 engine/utils/generate_visitors/types.ml       |  6 +++
 engine/utils/generate_visitors/visitors.ml    |  3 ++
 5 files changed, 60 insertions(+), 25 deletions(-)

diff --git a/engine/utils/generate_visitors/codegen_visitor.ml b/engine/utils/generate_visitors/codegen_visitor.ml
index 4b82ffb02..55825ee7d 100644
--- a/engine/utils/generate_visitors/codegen_visitor.ml
+++ b/engine/utils/generate_visitors/codegen_visitor.ml
@@ -5,23 +5,32 @@ open Base
 open Utils
 open Types
 
+(** What kind of visitor are we generating? *)
 type kind = Map | MapReduce | Reduce
 
-let is_reduce = function MapReduce | Reduce -> true | _ -> false
-let is_map = function Map | MapReduce -> true | _ -> false
-let method_prefix = "visit_"
+(** Helpers around kinds *)
+include struct
+  let is_reduce = function MapReduce | Reduce -> true | _ -> false
+  let is_map = function Map | MapReduce -> true | _ -> false
+end
 
+(** Various helpers and constants *)
+include struct
+  let method_prefix = "visit_"
+  let acc_var_prefix = "acc___"
+  let acc_var_param = acc_var_prefix ^ "param___var"
+  let payload_var = "v___payload"
+  let env_var = "env___var"
+  let app = List.filter ~f:(String.is_empty >> not) >> String.concat ~sep:" "
+  let parens s = if String.contains s ' ' then "(" ^ s ^ ")" else s
+end
+
+(** Produces a method name given a dot-separated path *)
 let method_name path =
   let path = String.split ~on:'.' path in
   method_prefix ^ String.concat ~sep:"__" path
 
-let acc_var_prefix = "acc___"
-let acc_var_param = acc_var_prefix ^ "param___var"
-let payload_var = "v___payload"
-let env_var = "env___var"
-let app = List.filter ~f:(String.is_empty >> not) >> String.concat ~sep:" "
-let parens s = if String.contains s ' ' then "(" ^ s ^ ")" else s
-
+(** Produces a visitor call for a type expression, without applying it. *)
 let rec of_type' need_parens (t : Type.t) =
   let f =
     if String.is_prefix ~prefix:"'" t.typ then "visit_" ^ t.typ
@@ -29,12 +38,15 @@ let rec of_type' need_parens (t : Type.t) =
   in
   if List.is_empty t.args then f
   else
-    app (f :: List.map ~f:(of_type' true) t.args)
+    app (f :: List.map ~f:(of_type' tru e) t.args)
     |> if need_parens then parens else Fn.id
 
+(** Produces a complete visitor call for a type expression. *)
 let of_type typ payload = app [ of_type' false typ; env_var; payload ]
+
 let acc_var_for_field ((field, _) : Record.field) = acc_var_prefix ^ field
 
+(** Given a list [x1; ...; xN], produces `self#plus x1 (self#plus ... (self#plus xN))` *)
 let self_plus =
   List.fold_left
     ~f:(fun acc var ->
@@ -44,6 +56,7 @@ let self_plus =
     ~init:None
   >> Option.value ~default:"self#zero"
 
+(** Creates a let expression *)
 let mk_let ~lhs ~rhs = "let " ^ lhs ^ " = " ^ rhs ^ " in "
 
 let of_typed_binding ~kind (value, typ, value_binding, acc_binding) =
@@ -143,6 +156,7 @@ let of_datatype ~kind (dt : Datatype.t) =
   "method " ^ meth ^ " : " ^ meth_typ ^ " = fun " ^ visitors ^ " " ^ env_var
   ^ " " ^ payload_var ^ " -> " ^ body
 
+(** Hard coded visitors *)
 let extra_visitors_for = function
   | Map ->
       "        method visit_list : 'a. ('env -> 'a -> 'a) -> 'env -> 'a list \
@@ -168,6 +182,7 @@ let extra_visitors_for = function
       \                ~f:(fun acc -> v env >> self#plus acc)\n\
       \                this"
 
+(** Make one kind of visitor *)
 let mk_one ~kind (l : Datatype.t list) : string =
   let contents =
     List.map ~f:(of_datatype ~kind) l |> String.concat ~sep:"\n\n"
@@ -223,6 +238,7 @@ let is_allowed_opaque name =
   List.mem ~equal:String.equal allowlist name
   || String.is_prefix ~prefix:"F." name
 
+(** Make all three kinds of visitors for a list of datatypes *)
 let mk (l : Datatype.t list) : string =
   let l = Primitive_types.(tuples @ [ option ]) @ l in
   let opaques =
diff --git a/engine/utils/generate_visitors/errors.ml b/engine/utils/generate_visitors/errors.ml
index f63bc37b6..587b7a635 100644
--- a/engine/utils/generate_visitors/errors.ml
+++ b/engine/utils/generate_visitors/errors.ml
@@ -1,21 +1,26 @@
 open Ppxlib
 open! Ppx_yojson_conv_lib.Yojson_conv.Primitives
 
-let pp_core_type = Pprintast.core_type
-
-let pp_label_declaration fmt label_decl =
-  Stdlib.Format.pp_print_string fmt label_decl.pld_name.txt
-
-let pp_constructor_declaration fmt cons_decl =
-  Stdlib.Format.pp_print_string fmt cons_decl.pcd_name.txt
-
-let pp_type_declaration fmt type_decl =
-  Pprintast.structure_item fmt
-    {
-      pstr_loc = Astlib.Location.none;
-      pstr_desc = Pstr_type (Nonrecursive, [ type_decl ]);
-    }
+(** Define `pp_*` functions for some type of the OCaml ASTs so that we
+can show them *)
+include struct
+  let pp_core_type = Pprintast.core_type
+
+  let pp_label_declaration fmt label_decl =
+    Stdlib.Format.pp_print_string fmt label_decl.pld_name.txt
+
+  let pp_constructor_declaration fmt cons_decl =
+    Stdlib.Format.pp_print_string fmt cons_decl.pcd_name.txt
+
+  let pp_type_declaration fmt type_decl =
+    Pprintast.structure_item fmt
+      {
+        pstr_loc = Astlib.Location.none;
+        pstr_desc = Pstr_type (Nonrecursive, [ type_decl ]);
+      }
+end
 
+(** The type of various error that can occur errors *)
 type t =
   | UnsupportedCoreType of core_type
   | UnsupportedLabelDeclaration of label_declaration
@@ -23,6 +28,7 @@ type t =
   | UnsupportedTypeDeclaration of type_declaration
 [@@deriving show]
 
+(** We can't derive yojson for OCaml types. Thus this indirection, that prints payload of `t` as string, and *then* produces JSON. *)
 open struct
   type t_string =
     | UnsupportedCoreType of string
diff --git a/engine/utils/generate_visitors/primitive_types.ml b/engine/utils/generate_visitors/primitive_types.ml
index b5104c2cd..f57c4cf6b 100644
--- a/engine/utils/generate_visitors/primitive_types.ml
+++ b/engine/utils/generate_visitors/primitive_types.ml
@@ -5,8 +5,10 @@ open Base
 open! Utils
 open Types
 
+(** Helper to produce type variable. *)
 let ty_var typ = Type.{ typ; args = [] }
 
+(** Produces a datatype description for tuples of a given length. *)
 let mk_tuple len =
   let type_vars = List.init len ~f:(fun i -> "'t" ^ Int.to_string i) in
   let name = Type.tuple_name len in
@@ -15,8 +17,10 @@ let mk_tuple len =
   let kind = Datatype.Variant [ Variant.{ name = ""; payload } ] in
   Datatype.{ name; type_vars; kind }
 
+(** Common sizes of tuples. *)
 let tuples = List.map ~f:mk_tuple [ 2; 3; 4 ]
 
+(** Datatype description for the option type. *)
 let option =
   let kind =
     Datatype.Variant
diff --git a/engine/utils/generate_visitors/types.ml b/engine/utils/generate_visitors/types.ml
index 3e5b9b889..391b6bb0c 100644
--- a/engine/utils/generate_visitors/types.ml
+++ b/engine/utils/generate_visitors/types.ml
@@ -5,6 +5,7 @@ open Base
 open! Utils
 open Errors
 
+(** Describe what is a type expression, reflects OCaml's `core_type`. *)
 module Type = struct
   let tuple_prefix = "prim___tuple_"
   let is_tuple_name = String.is_prefix ~prefix:tuple_prefix
@@ -35,6 +36,7 @@ module Type = struct
     | _ -> unsupported t
 end
 
+(** Describe what is a record, reflects OCaml's `label_declaration`. *)
 module Record = struct
   type field = string * Type.t [@@deriving show, yojson]
   type t = field list [@@deriving show, yojson]
@@ -52,6 +54,7 @@ module Record = struct
   let of_ocaml : label_declaration list -> t = List.map ~f:field_of_ocaml
 end
 
+(** Describe what is a variant payload, reflects OCaml's `construtor_arguments`. *)
 module VariantPayload = struct
   type t = Record of Record.t | Tuple of Type.t list | None
   [@@deriving show, yojson]
@@ -69,6 +72,7 @@ module VariantPayload = struct
     | Pcstr_record label_decls -> Record (Record.of_ocaml label_decls)
 end
 
+(** Describe what is a variant, reflects OCaml's `constructor_declaration`. *)
 module Variant = struct
   type t = { name : string; payload : VariantPayload.t }
   [@@deriving show, yojson]
@@ -83,10 +87,12 @@ module Variant = struct
     { name = cons_decl.pcd_name.txt; payload }
 end
 
+(** A result type. *)
 module Result = struct
   type ('r, 'e) t = Ok of 'r | Error of 'e [@@deriving show, yojson]
 end
 
+(** Describe what is a datatype, reflects ppx' `type_declaration`. *)
 module Datatype = struct
   type kind =
     | Record of Record.t
diff --git a/engine/utils/generate_visitors/visitors.ml b/engine/utils/generate_visitors/visitors.ml
index 372bee3ae..eb67edc91 100644
--- a/engine/utils/generate_visitors/visitors.ml
+++ b/engine/utils/generate_visitors/visitors.ml
@@ -1,3 +1,6 @@
+(** This module is mostly generated, but hand-edited, it defines
+visitors for the types defined in module `Types`. *)
+
 open Base
 open Types
 open Utils