WIP: Upgrade latest_version to the actual 4.08 grammar

Author: NathanReb

ast/builder_v4_08.ml

@@ -1,5 +1,10 @@
 (*$ Ppx_ast_cinaps.print_builder_mli (Astlib.Version.of_string "v4_08") *)
 open Versions.V4_08
+val attribute :
+  loc:Astlib.Location.t
+  -> name:string Astlib.Loc.t
+  -> payload:Payload.t
+  -> Attribute.t
 val ptyp_any :
   loc:Astlib.Location.t
   -> Core_type.t
@@ -56,6 +61,25 @@ val ptyp_extension :
   loc:Astlib.Location.t
   -> Extension.t
   -> Core_type.t
+val rtag :
+  loc:Astlib.Location.t
+  -> string Astlib.Loc.t
+  -> bool
+  -> Core_type.t list
+  -> Row_field.t
+val rinherit :
+  loc:Astlib.Location.t
+  -> Core_type.t
+  -> Row_field.t
+val otag :
+  loc:Astlib.Location.t
+  -> string Astlib.Loc.t
+  -> Core_type.t
+  -> Object_field.t
+val oinherit :
+  loc:Astlib.Location.t
+  -> Core_type.t
+  -> Object_field.t
 val ppat_any :
   loc:Astlib.Location.t
   -> Pattern.t
@@ -301,10 +325,13 @@ val pexp_pack :
   -> Expression.t
 val pexp_open :
   loc:Astlib.Location.t
-  -> Override_flag.t
-  -> Longident_loc.t
+  -> Open_declaration.t
   -> Expression.t
   -> Expression.t
+val pexp_letop :
+  loc:Astlib.Location.t
+  -> Letop.t
+  -> Expression.t
 val pexp_extension :
   loc:Astlib.Location.t
   -> Extension.t
@@ -317,6 +344,17 @@ val case :
   -> lhs:Pattern.t
   -> rhs:Expression.t
   -> Case.t
+val letop :
+  ands:Binding_op.t list
+  -> body:Expression.t
+  -> let_:Binding_op.t
+  -> Letop.t
+val binding_op :
+  loc:Astlib.Location.t
+  -> exp:Expression.t
+  -> op:string Astlib.Loc.t
+  -> pat:Pattern.t
+  -> Binding_op.t
 val value_description :
   loc:Astlib.Location.t
   -> name:string Astlib.Loc.t
@@ -345,7 +383,8 @@ val constructor_declaration :
   -> res:Core_type.t option
   -> Constructor_declaration.t
 val type_extension :
-  constructors:Extension_constructor.t list
+  loc:Astlib.Location.t
+  -> constructors:Extension_constructor.t list
   -> params:(Core_type.t * Variance.t) list
   -> path:Longident_loc.t
   -> private_:Private_flag.t
@@ -355,6 +394,10 @@ val extension_constructor :
   -> kind:Extension_constructor_kind.t
   -> name:string Astlib.Loc.t
   -> Extension_constructor.t
+val type_exception :
+  loc:Astlib.Location.t
+  -> constructor:Extension_constructor.t
+  -> Type_exception.t
 val pcty_constr :
   loc:Astlib.Location.t
   -> Longident_loc.t
@@ -376,8 +419,7 @@ val pcty_extension :
   -> Class_type.t
 val pcty_open :
   loc:Astlib.Location.t
-  -> Override_flag.t
-  -> Longident_loc.t
+  -> Open_description.t
   -> Class_type.t
   -> Class_type.t
 val class_signature :
@@ -446,8 +488,7 @@ val pcl_extension :
   -> Class_expr.t
 val pcl_open :
   loc:Astlib.Location.t
-  -> Override_flag.t
-  -> Longident_loc.t
+  -> Open_description.t
   -> Class_expr.t
   -> Class_expr.t
 val class_structure :
@@ -524,18 +565,26 @@ val psig_type :
   -> Rec_flag.t
   -> Type_declaration.t list
   -> Signature_item.t
+val psig_typesubst :
+  loc:Astlib.Location.t
+  -> Type_declaration.t list
+  -> Signature_item.t
 val psig_typext :
   loc:Astlib.Location.t
   -> Type_extension.t
   -> Signature_item.t
 val psig_exception :
   loc:Astlib.Location.t
-  -> Extension_constructor.t
+  -> Type_exception.t
   -> Signature_item.t
 val psig_module :
   loc:Astlib.Location.t
   -> Module_declaration.t
   -> Signature_item.t
+val psig_modsubst :
+  loc:Astlib.Location.t
+  -> Module_substitution.t
+  -> Signature_item.t
 val psig_recmodule :
   loc:Astlib.Location.t
   -> Module_declaration.t list
@@ -574,16 +623,16 @@ val module_declaration :
   -> name:string Astlib.Loc.t
   -> type_:Module_type.t
   -> Module_declaration.t
+val module_substitution :
+  loc:Astlib.Location.t
+  -> manifest:Longident_loc.t
+  -> name:string Astlib.Loc.t
+  -> Module_substitution.t
 val module_type_declaration :
   loc:Astlib.Location.t
   -> name:string Astlib.Loc.t
   -> type_:Module_type.t option
   -> Module_type_declaration.t
-val open_description :
-  loc:Astlib.Location.t
-  -> lid:Longident_loc.t
-  -> override:Override_flag.t
-  -> Open_description.t
 val pmod_ident :
   loc:Astlib.Location.t
   -> Longident_loc.t
@@ -641,7 +690,7 @@ val pstr_typext :
   -> Structure_item.t
 val pstr_exception :
   loc:Astlib.Location.t
-  -> Extension_constructor.t
+  -> Type_exception.t
   -> Structure_item.t
 val pstr_module :
   loc:Astlib.Location.t
@@ -657,7 +706,7 @@ val pstr_modtype :
   -> Structure_item.t
 val pstr_open :
   loc:Astlib.Location.t
-  -> Open_description.t
+  -> Open_declaration.t
   -> Structure_item.t
 val pstr_class :
   loc:Astlib.Location.t
@@ -690,4 +739,26 @@ val module_binding :
   -> expr:Module_expr.t
   -> name:string Astlib.Loc.t
   -> Module_binding.t
+val toplevel_directive :
+  loc:Astlib.Location.t
+  -> arg:Directive_argument.t option
+  -> name:string Astlib.Loc.t
+  -> Toplevel_directive.t
+val pdir_string :
+  loc:Astlib.Location.t
+  -> string
+  -> Directive_argument.t
+val pdir_int :
+  loc:Astlib.Location.t
+  -> string
+  -> char option
+  -> Directive_argument.t
+val pdir_ident :
+  loc:Astlib.Location.t
+  -> Longident.t
+  -> Directive_argument.t
+val pdir_bool :
+  loc:Astlib.Location.t
+  -> bool
+  -> Directive_argument.t
 (*$*)

ast/builder_v4_08.mli

@@ -164,12 +164,17 @@ module Builder = struct
     match (shortcut type_name : Shortcut.t option) with
     | None -> []
     | Some {other_fields = _::_; _} ->
-      (* There currently is only attr, loc and descr in records for which we
-         have shortcuts and the code here relies on it, if new fields or added
-         we'll need do deal with them.
-         Note that a [xxx_loc_stack] has been added in recent OCaml versions. *)
+      (* There currently is only attr, loc, loc_stack and descr in records for
+         which we have shortcuts and the code here relies on it, if new fields
+         are added we'll need do deal with them. *)
       assert false
-    | Some {outer_record; desc_field; loc_field; attr_field; other_fields = []; _} ->
+    | Some
+        { outer_record
+        ; desc_field
+        ; loc_field
+        ; attr_field
+        ; loc_stack_field
+        ; other_fields = []; _} ->
       let type_ = Astlib.Grammar.Name outer_record in
       List.map v ~f:(fun (cname, (constr : Astlib.Grammar.clause)) ->
         let arr =
@@ -206,6 +211,7 @@ module Builder = struct
             [ Some (Some desc_field, desc)
             ; (loc_field >>| fun fname -> (Some fname, Expr.Ident "loc"))
             ; (attr_field >>| fun fname -> (Some fname, empty_attributes))
+            ; (loc_stack_field >>| fun fname -> (Some fname, Expr.Const Nil))
             ]
             |> List.filter_opt
           in

ast/cinaps/gen_builder.ml

@@ -15,7 +15,11 @@ let wrapper_types grammar =
       | _ -> acc)
 
 let shortcut_viewer_name ~shortcut cname =
-  let _, base_name = String.lsplit2_exn ~on:'_' cname in
+  let base_name =
+    match String.lsplit2 ~on:'_' cname with
+    | Some (_prefix, basename) -> basename
+    | None -> String.lowercase_ascii cname
+  in
   let prefix =
     match shortcut.Shortcut.outer_record with
     | "expression" -> "e"
@@ -29,6 +33,9 @@ let shortcut_viewer_name ~shortcut cname =
     | "class_expr" -> "ce"
     | "class_type" -> "ct"
     | "class_type_field" -> "ctf"
+    | "row_field" -> "rf"
+    | "object_field" -> "of"
+    | "directive_argument" -> "da"
     | s -> failwith "No prefix for shortcut: " ^ s
   in
   variant_viewer_name (prefix ^ base_name)

ast/cinaps/gen_viewer.ml

@@ -6,6 +6,7 @@ type t =
   ; desc_field : string
   ; attr_field : string option
   ; loc_field : string option
+  ; loc_stack_field : string option
   ; other_fields : (string * Astlib.Grammar.ty) list
   }
 
@@ -18,6 +19,7 @@ let find_field ~suffix record : (string * Astlib.Grammar.ty) option =
 let loc_suffix = "_loc"
 let desc_suffix = "_desc"
 let attr_suffix = "_attributes"
+let loc_stack_suffix = "_loc_stack"
 
 let desc_field record = find_field ~suffix:desc_suffix record
 
@@ -33,24 +35,32 @@ let loc_field record =
   | Some (loc_field, Location) -> Some loc_field
   | Some (_, _) -> assert false
 
+let loc_stack_field record =
+  match find_field ~suffix:loc_stack_suffix record with
+  | None -> None
+  | Some (loc_stack_field, List Location) -> Some loc_stack_field
+  | Some (_, _) -> assert false
+
 let other_fields record =
   List.filter record
     ~f:(fun (field_name, _) ->
       not
         ( String.is_suffix ~suffix:loc_suffix field_name
           || String.is_suffix ~suffix:desc_suffix field_name
-          || String.is_suffix ~suffix:attr_suffix field_name ))
+          || String.is_suffix ~suffix:attr_suffix field_name
+          || String.is_suffix ~suffix:loc_stack_suffix field_name))
 
 let from_record ~name record =
   match desc_field record with
   | None -> None
   | Some (desc_field, Name inner_variant) ->
     let loc_field = loc_field record in
     let attr_field = attr_field record in
+    let loc_stack_field = loc_stack_field record in
     let other_fields = other_fields record in
     Some
       { outer_record = name; inner_variant
-      ; desc_field; loc_field; attr_field; other_fields }
+      ; desc_field; loc_field; attr_field; loc_stack_field; other_fields }
   | Some (_, _) ->
     assert false
 

ast/cinaps/shortcut.ml

@@ -5,6 +5,8 @@
     description
     - [loc_field] is the name of the field in the parent pointing to the
     location, if any
+    - [loc_stack_field] is the name of the field in the parent pointing to the
+    location stack, if any
     - [attr_field] is the name of the field in the parent pointing to the
     attributes, if any
     - [other_fields] is the list of the remaining fields of the parent *)
@@ -14,6 +16,7 @@ type t =
   ; desc_field : string
   ; attr_field : string option
   ; loc_field : string option
+  ; loc_stack_field : string option
   ; other_fields : (string * Astlib.Grammar.ty) list
   }