unikernel/duniverse/ppxlib/ast/ast_helper_lite.ml

@@ -0,0 +1,580 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   Copyright 2012 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TODO: remove this open *)
+open Stdlib0
+module Location = Astlib.Location
+module Longident = Astlib.Longident
+open Astlib.Ast_502
+
+[@@@warning "-9"]
+
+open Asttypes
+open Parsetree
+
+type 'a with_loc = 'a Location.loc
+type loc = Location.t
+type lid = Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+let default_loc = ref Location.none
+
+type ref_and_value = R : 'a ref * 'a -> ref_and_value
+
+let protect_ref =
+  let set_ref (R (r, v)) = r := v in
+  fun ref f ->
+    let (R (r, _)) = ref in
+    let backup = R (r, !r) in
+    set_ref ref;
+    match f () with
+    | x ->
+        set_ref backup;
+        x
+    | exception e ->
+        set_ref backup;
+        raise e
+
+let with_default_loc l f = protect_ref (R (default_loc, l)) f
+
+module Const = struct
+  let integer ?suffix i = Pconst_integer (i, suffix)
+  let int ?suffix i = integer ?suffix (Int.to_string i)
+  let int32 ?(suffix = 'l') i = integer ~suffix (Int32.to_string i)
+  let int64 ?(suffix = 'L') i = integer ~suffix (Int64.to_string i)
+  let nativeint ?(suffix = 'n') i = integer ~suffix (Nativeint.to_string i)
+  let float ?suffix f = Pconst_float (f, suffix)
+  let char c = Pconst_char c
+
+  let string ?quotation_delimiter ?(loc = !default_loc) s =
+    Pconst_string (s, loc, quotation_delimiter)
+end
+
+module Attr = struct
+  let mk ?(loc = !default_loc) name payload =
+    { attr_name = name; attr_payload = payload; attr_loc = loc }
+end
+
+module Typ = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+      ptyp_desc = d;
+      ptyp_loc = loc;
+      ptyp_loc_stack = [];
+      ptyp_attributes = attrs;
+    }
+
+  let attr d a = { d with ptyp_attributes = d.ptyp_attributes @ [ a ] }
+  let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
+  let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
+  let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
+  let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
+  let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
+
+  let force_poly t =
+    match t.ptyp_desc with Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t
+  (* -> ghost? *)
+
+  let varify_constructors var_names t =
+    let check_variable vl loc v =
+      if List.mem v vl then
+        Location.raise_errorf ~loc "variable in scope syntax error: %s" v
+    in
+    let var_names = List.map (fun v -> v.txt) var_names in
+    let rec loop t =
+      let desc =
+        match t.ptyp_desc with
+        | Ptyp_any -> Ptyp_any
+        | Ptyp_var x ->
+            check_variable var_names t.ptyp_loc x;
+            Ptyp_var x
+        | Ptyp_arrow (label, core_type, core_type') ->
+            Ptyp_arrow (label, loop core_type, loop core_type')
+        | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+        | Ptyp_constr ({ txt = Longident.Lident s }, [])
+          when List.mem s var_names ->
+            Ptyp_var s
+        | Ptyp_constr (longident, lst) ->
+            Ptyp_constr (longident, List.map loop lst)
+        | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o)
+        | Ptyp_class (longident, lst) ->
+            Ptyp_class (longident, List.map loop lst)
+        | Ptyp_alias (core_type, string) ->
+            check_variable var_names t.ptyp_loc string.txt;
+            Ptyp_alias (loop core_type, string)
+        | Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
+            Ptyp_variant
+              (List.map loop_row_field row_field_list, flag, lbl_lst_option)
+        | Ptyp_poly (string_lst, core_type) ->
+            List.iter
+              (fun v -> check_variable var_names t.ptyp_loc v.txt)
+              string_lst;
+            Ptyp_poly (string_lst, loop core_type)
+        | Ptyp_package (longident, lst) ->
+            Ptyp_package
+              (longident, List.map (fun (n, typ) -> (n, loop typ)) lst)
+        | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg)
+        | Ptyp_open (l, ct) -> Ptyp_open (l, loop ct)
+      in
+      { t with ptyp_desc = desc }
+    and loop_row_field field =
+      let prf_desc =
+        match field.prf_desc with
+        | Rtag (label, flag, lst) -> Rtag (label, flag, List.map loop lst)
+        | Rinherit t -> Rinherit (loop t)
+      in
+      { field with prf_desc }
+    and loop_object_field field =
+      let pof_desc =
+        match field.pof_desc with
+        | Otag (label, t) -> Otag (label, loop t)
+        | Oinherit t -> Oinherit (loop t)
+      in
+      { field with pof_desc }
+    in
+    loop t
+end
+
+module Pat = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+      ppat_desc = d;
+      ppat_loc = loc;
+      ppat_loc_stack = [];
+      ppat_attributes = attrs;
+    }
+
+  let attr d a = { d with ppat_attributes = d.ppat_attributes @ [ a ] }
+  let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any
+  let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a)
+  let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
+  let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+
+  let construct ?loc ?attrs a b =
+    mk ?loc ?attrs (Ppat_construct (a, Option.map (fun b -> ([], b)) b))
+
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a)
+  let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b))
+  let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a)
+  let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
+  let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
+end
+
+module Exp = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {
+      pexp_desc = d;
+      pexp_loc = loc;
+      pexp_loc_stack = [];
+      pexp_attributes = attrs;
+    }
+
+  let attr d a = { d with pexp_attributes = d.pexp_attributes @ [ a ] }
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
+  let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
+
+  let function_ ?loc ?attrs ?loc_location cases =
+    let loc_locations =
+      match loc_location with Some l -> l | None -> !default_loc
+    in
+    mk ?loc ?attrs
+      (Pexp_function ([], None, Pfunction_cases (cases, loc_locations, [])))
+
+  let fun_ ?loc ?attrs a b c d =
+    let pparam_desc = Pparam_val (a, b, c) in
+    let body = Pfunction_body d in
+    let pparam_loc = match loc with Some loc -> loc | None -> Location.none in
+    mk ?loc ?attrs (Pexp_function ([ { pparam_loc; pparam_desc } ], None, body))
+
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
+  let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
+  let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
+  let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a)
+  let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b))
+  let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b))
+  let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b))
+  let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b))
+  let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c))
+  let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)
+  let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c))
+  let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))
+  let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))
+  let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))
+  let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c))
+  let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b))
+  let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a)
+  let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b))
+  let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a)
+  let letmodule ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_letmodule (a, b, c))
+  let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b))
+  let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a)
+  let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a)
+  let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
+  let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
+  let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b))
+  let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))
+
+  let letop ?loc ?attrs let_ ands body =
+    mk ?loc ?attrs (Pexp_letop { let_; ands; body })
+
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+  let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable
+  let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs }
+
+  let binding_op op pat exp loc =
+    { pbop_op = op; pbop_pat = pat; pbop_exp = exp; pbop_loc = loc }
+end
+
+module Mty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs }
+
+  let attr d a = { d with pmty_attributes = d.pmty_attributes @ [ a ] }
+  let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
+  let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
+  let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b))
+  let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
+  let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a)
+end
+
+module Mod = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs }
+
+  let attr d a = { d with pmod_attributes = d.pmod_attributes @ [ a ] }
+  let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
+  let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x)
+  let functor_ ?loc ?attrs arg body = mk ?loc ?attrs (Pmod_functor (arg, body))
+  let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
+  let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
+  let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
+end
+
+module Sig = struct
+  let mk ?(loc = !default_loc) d = { psig_desc = d; psig_loc = loc }
+  let value ?loc a = mk ?loc (Psig_value a)
+  let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a))
+  let type_subst ?loc a = mk ?loc (Psig_typesubst a)
+  let type_extension ?loc a = mk ?loc (Psig_typext a)
+  let exception_ ?loc a = mk ?loc (Psig_exception a)
+  let module_ ?loc a = mk ?loc (Psig_module a)
+  let mod_subst ?loc a = mk ?loc (Psig_modsubst a)
+  let rec_module ?loc a = mk ?loc (Psig_recmodule a)
+  let modtype ?loc a = mk ?loc (Psig_modtype a)
+  let open_ ?loc a = mk ?loc (Psig_open a)
+  let include_ ?loc a = mk ?loc (Psig_include a)
+  let class_ ?loc a = mk ?loc (Psig_class a)
+  let class_type ?loc a = mk ?loc (Psig_class_type a)
+  let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Psig_attribute a)
+end
+
+module Str = struct
+  let mk ?(loc = !default_loc) d = { pstr_desc = d; pstr_loc = loc }
+  let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))
+  let value ?loc a b = mk ?loc (Pstr_value (a, b))
+  let primitive ?loc a = mk ?loc (Pstr_primitive a)
+  let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a))
+  let type_extension ?loc a = mk ?loc (Pstr_typext a)
+  let exception_ ?loc a = mk ?loc (Pstr_exception a)
+  let module_ ?loc a = mk ?loc (Pstr_module a)
+  let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
+  let modtype ?loc a = mk ?loc (Pstr_modtype a)
+  let open_ ?loc a = mk ?loc (Pstr_open a)
+  let class_ ?loc a = mk ?loc (Pstr_class a)
+  let class_type ?loc a = mk ?loc (Pstr_class_type a)
+  let include_ ?loc a = mk ?loc (Pstr_include a)
+  let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
+  let attribute ?loc a = mk ?loc (Pstr_attribute a)
+end
+
+module Cl = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs }
+
+  let attr d a = { d with pcl_attributes = d.pcl_attributes @ [ a ] }
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b))
+  let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a)
+  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d))
+  let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b))
+  let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b))
+end
+
+module Cty = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs }
+
+  let attr d a = { d with pcty_attributes = d.pcty_attributes @ [ a ] }
+  let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b))
+  let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a)
+  let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a)
+  let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b))
+end
+
+module Ctf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pctf_desc = d; pctf_loc = loc; pctf_attributes = attrs }
+
+  let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a)
+  let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d))
+  let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b))
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a)
+  let attribute ?loc a = mk ?loc (Pctf_attribute a)
+  let attr d a = { d with pctf_attributes = d.pctf_attributes @ [ a ] }
+end
+
+module Cf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    { pcf_desc = d; pcf_loc = loc; pcf_attributes = attrs }
+
+  let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c))
+  let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c))
+  let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c))
+  let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b))
+  let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a)
+  let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a)
+  let attribute ?loc a = mk ?loc (Pcf_attribute a)
+  let virtual_ ct = Cfk_virtual ct
+  let concrete o e = Cfk_concrete (o, e)
+  let attr d a = { d with pcf_attributes = d.pcf_attributes @ [ a ] }
+end
+
+module Val = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(prim = []) name typ =
+    {
+      pval_name = name;
+      pval_type = typ;
+      pval_attributes = attrs;
+      pval_loc = loc;
+      pval_prim = prim;
+    }
+end
+
+module Md = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) name typ =
+    { pmd_name = name; pmd_type = typ; pmd_attributes = attrs; pmd_loc = loc }
+end
+
+module Ms = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) name syn =
+    {
+      pms_name = name;
+      pms_manifest = syn;
+      pms_attributes = attrs;
+      pms_loc = loc;
+    }
+end
+
+module Mtd = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?typ name =
+    {
+      pmtd_name = name;
+      pmtd_type = typ;
+      pmtd_attributes = attrs;
+      pmtd_loc = loc;
+    }
+end
+
+module Mb = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) name expr =
+    { pmb_name = name; pmb_expr = expr; pmb_attributes = attrs; pmb_loc = loc }
+end
+
+module Opn = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(override = Fresh) expr =
+    {
+      popen_expr = expr;
+      popen_override = override;
+      popen_loc = loc;
+      popen_attributes = attrs;
+    }
+end
+
+module Incl = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
+    { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = attrs }
+end
+
+module Vb = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?value_constraint pat expr =
+    {
+      pvb_pat = pat;
+      pvb_expr = expr;
+      pvb_attributes = attrs;
+      pvb_loc = loc;
+      pvb_constraint = value_constraint;
+    }
+end
+
+module Ci = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(virt = Concrete) ?(params = [])
+      name expr =
+    {
+      pci_virt = virt;
+      pci_params = params;
+      pci_name = name;
+      pci_expr = expr;
+      pci_attributes = attrs;
+      pci_loc = loc;
+    }
+end
+
+let constructor ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
+    ?(args = Pcstr_tuple []) ?res name =
+  {
+    pcd_name = name;
+    pcd_vars = vars;
+    pcd_args = args;
+    pcd_res = res;
+    pcd_loc = loc;
+    pcd_attributes = attrs;
+  }
+
+module Type = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(params = []) ?(cstrs = [])
+      ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name =
+    {
+      ptype_name = name;
+      ptype_params = params;
+      ptype_cstrs = cstrs;
+      ptype_kind = kind;
+      ptype_private = priv;
+      ptype_manifest = manifest;
+      ptype_attributes = attrs;
+      ptype_loc = loc;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
+      ?(args = Pcstr_tuple []) ?res name =
+    {
+      pcd_name = name;
+      pcd_vars = vars;
+      pcd_args = args;
+      pcd_res = res;
+      pcd_loc = loc;
+      pcd_attributes = attrs;
+    }
+
+  let field ?(loc = !default_loc) ?(attrs = []) ?(mut = Immutable) name typ =
+    {
+      pld_name = name;
+      pld_mutable = mut;
+      pld_type = typ;
+      pld_loc = loc;
+      pld_attributes = attrs;
+    }
+end
+
+(** Type extensions *)
+module Te = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) ?(params = []) ?(priv = Public)
+      path constructors =
+    {
+      ptyext_path = path;
+      ptyext_params = params;
+      ptyext_constructors = constructors;
+      ptyext_private = priv;
+      ptyext_loc = loc;
+      ptyext_attributes = attrs;
+    }
+
+  let mk_exception ?(loc = !default_loc) ?(attrs = []) constructor =
+    {
+      ptyexn_constructor = constructor;
+      ptyexn_loc = loc;
+      ptyexn_attributes = attrs;
+    }
+
+  let constructor ?(loc = !default_loc) ?(attrs = []) name kind =
+    {
+      pext_name = name;
+      pext_kind = kind;
+      pext_loc = loc;
+      pext_attributes = attrs;
+    }
+
+  let decl ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
+      ?(args = Pcstr_tuple []) ?res name =
+    {
+      pext_name = name;
+      pext_kind = Pext_decl (vars, args, res);
+      pext_loc = loc;
+      pext_attributes = attrs;
+    }
+
+  let rebind ?(loc = !default_loc) ?(attrs = []) name lid =
+    {
+      pext_name = name;
+      pext_kind = Pext_rebind lid;
+      pext_loc = loc;
+      pext_attributes = attrs;
+    }
+end
+
+module Csig = struct
+  let mk self fields = { pcsig_self = self; pcsig_fields = fields }
+end
+
+module Cstr = struct
+  let mk self fields = { pcstr_self = self; pcstr_fields = fields }
+end
+
+(** Row fields *)
+module Rf = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) desc =
+    { prf_desc = desc; prf_loc = loc; prf_attributes = attrs }
+
+  let tag ?loc ?attrs label const tys =
+    mk ?loc ?attrs (Rtag (label, const, tys))
+
+  let inherit_ ?loc ty = mk ?loc (Rinherit ty)
+end
+
+(** Object fields *)
+module Of = struct
+  let mk ?(loc = !default_loc) ?(attrs = []) desc =
+    { pof_desc = desc; pof_loc = loc; pof_attributes = attrs }
+
+  let tag ?loc ?attrs label ty = mk ?loc ?attrs (Otag (label, ty))
+  let inherit_ ?loc ty = mk ?loc (Oinherit ty)
+end

unikernel/duniverse/ppxlib/ast/ast_helper_lite.mli

@@ -0,0 +1,657 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         Alain Frisch, LexiFi                           *)
+(*                                                                        *)
+(*   Copyright 2012 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Copy of Ast_helper from OCaml 4.14 with docstring related stuff removed *)
+
+open Astlib.Ast_502
+open Asttypes
+open Parsetree
+
+type 'a with_loc = 'a Astlib.Location.loc
+type loc = Astlib.Location.t
+type lid = Astlib.Longident.t with_loc
+type str = string with_loc
+type str_opt = string option with_loc
+type attrs = attribute list
+
+(** {1 Default locations} *)
+
+val default_loc : loc ref
+(** Default value for all optional location arguments. *)
+
+val with_default_loc : loc -> (unit -> 'a) -> 'a
+(** Set the [default_loc] within the scope of the execution of the provided
+    function. *)
+
+(** {1 Constants} *)
+
+module Const : sig
+  val char : char -> constant
+  val string : ?quotation_delimiter:string -> ?loc:loc -> string -> constant
+  val integer : ?suffix:char -> string -> constant
+  val int : ?suffix:char -> int -> constant
+  val int32 : ?suffix:char -> int32 -> constant
+  val int64 : ?suffix:char -> int64 -> constant
+  val nativeint : ?suffix:char -> nativeint -> constant
+  val float : ?suffix:char -> string -> constant
+end
+
+(** {1 Attributes} *)
+module Attr : sig
+  val mk : ?loc:loc -> str -> payload -> attribute
+end
+
+(** {1 Core language} *)
+
+(** Type expressions *)
+module Typ : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type
+  val attr : core_type -> attribute -> core_type
+  val any : ?loc:loc -> ?attrs:attrs -> unit -> core_type
+  val var : ?loc:loc -> ?attrs:attrs -> string -> core_type
+
+  val arrow :
+    ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type
+
+  val tuple : ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
+  val constr : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+
+  val object_ :
+    ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type
+
+  val class_ : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
+  val alias : ?loc:loc -> ?attrs:attrs -> core_type -> str -> core_type
+
+  val variant :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    row_field list ->
+    closed_flag ->
+    label list option ->
+    core_type
+
+  val poly : ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type
+
+  val package :
+    ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type
+
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> core_type
+  val force_poly : core_type -> core_type
+
+  val varify_constructors : str list -> core_type -> core_type
+  (** [varify_constructors newtypes te] is type expression [te], of which any of
+      nullary type constructor [tc] is replaced by type variable of the same
+      name, if [tc]'s name appears in [newtypes]. Raise
+      [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in
+      [newtypes].
+
+      @since 4.05 *)
+end
+
+(** Patterns *)
+module Pat : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern
+  val attr : pattern -> attribute -> pattern
+  val any : ?loc:loc -> ?attrs:attrs -> unit -> pattern
+  val var : ?loc:loc -> ?attrs:attrs -> str -> pattern
+  val alias : ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
+  val constant : ?loc:loc -> ?attrs:attrs -> constant -> pattern
+  val interval : ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
+  val tuple : ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+  val construct : ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
+  val variant : ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
+
+  val record :
+    ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern
+
+  val array : ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+  val or_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
+  val constraint_ : ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern
+  val type_ : ?loc:loc -> ?attrs:attrs -> lid -> pattern
+  val lazy_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+  val unpack : ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
+  val open_ : ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern
+  val exception_ : ?loc:loc -> ?attrs:attrs -> pattern -> pattern
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> pattern
+end
+
+(** Expressions *)
+module Exp : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> expression_desc -> expression
+  val attr : expression -> attribute -> expression
+  val ident : ?loc:loc -> ?attrs:attrs -> lid -> expression
+  val constant : ?loc:loc -> ?attrs:attrs -> constant -> expression
+
+  val let_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    rec_flag ->
+    value_binding list ->
+    expression ->
+    expression
+
+  val fun_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    arg_label ->
+    expression option ->
+    pattern ->
+    expression ->
+    expression
+
+  val function_ :
+    ?loc:loc -> ?attrs:attrs -> ?loc_location:loc -> case list -> expression
+
+  val apply :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    expression ->
+    (arg_label * expression) list ->
+    expression
+
+  val match_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+  val try_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
+  val tuple : ?loc:loc -> ?attrs:attrs -> expression list -> expression
+
+  val construct :
+    ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression
+
+  val variant :
+    ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression
+
+  val record :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    (lid * expression) list ->
+    expression option ->
+    expression
+
+  val field : ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression
+
+  val setfield :
+    ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression
+
+  val array : ?loc:loc -> ?attrs:attrs -> expression list -> expression
+
+  val ifthenelse :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    expression ->
+    expression ->
+    expression option ->
+    expression
+
+  val sequence :
+    ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
+
+  val while_ :
+    ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
+
+  val for_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    pattern ->
+    expression ->
+    expression ->
+    direction_flag ->
+    expression ->
+    expression
+
+  val coerce :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    expression ->
+    core_type option ->
+    core_type ->
+    expression
+
+  val constraint_ :
+    ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression
+
+  val send : ?loc:loc -> ?attrs:attrs -> expression -> str -> expression
+  val new_ : ?loc:loc -> ?attrs:attrs -> lid -> expression
+  val setinstvar : ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+
+  val override :
+    ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression
+
+  val letmodule :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str_opt ->
+    module_expr ->
+    expression ->
+    expression
+
+  val letexception :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    extension_constructor ->
+    expression ->
+    expression
+
+  val assert_ : ?loc:loc -> ?attrs:attrs -> expression -> expression
+  val lazy_ : ?loc:loc -> ?attrs:attrs -> expression -> expression
+
+  val poly :
+    ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression
+
+  val object_ : ?loc:loc -> ?attrs:attrs -> class_structure -> expression
+  val newtype : ?loc:loc -> ?attrs:attrs -> str -> expression -> expression
+  val pack : ?loc:loc -> ?attrs:attrs -> module_expr -> expression
+
+  val open_ :
+    ?loc:loc -> ?attrs:attrs -> open_declaration -> expression -> expression
+
+  val letop :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    binding_op ->
+    binding_op list ->
+    expression ->
+    expression
+
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression
+  val unreachable : ?loc:loc -> ?attrs:attrs -> unit -> expression
+  val case : pattern -> ?guard:expression -> expression -> case
+  val binding_op : str -> pattern -> expression -> loc -> binding_op
+end
+
+(** Value declarations *)
+module Val : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?prim:string list ->
+    str ->
+    core_type ->
+    value_description
+end
+
+(** Type declarations *)
+module Type : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?params:(core_type * (variance * injectivity)) list ->
+    ?cstrs:(core_type * core_type * loc) list ->
+    ?kind:type_kind ->
+    ?priv:private_flag ->
+    ?manifest:core_type ->
+    str ->
+    type_declaration
+
+  val constructor :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?vars:str list ->
+    ?args:constructor_arguments ->
+    ?res:core_type ->
+    str ->
+    constructor_declaration
+
+  val field :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?mut:mutable_flag ->
+    str ->
+    core_type ->
+    label_declaration
+end
+
+(** Type extensions *)
+module Te : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?params:(core_type * (variance * injectivity)) list ->
+    ?priv:private_flag ->
+    lid ->
+    extension_constructor list ->
+    type_extension
+
+  val mk_exception :
+    ?loc:loc -> ?attrs:attrs -> extension_constructor -> type_exception
+
+  val constructor :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str ->
+    extension_constructor_kind ->
+    extension_constructor
+
+  val decl :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?vars:str list ->
+    ?args:constructor_arguments ->
+    ?res:core_type ->
+    str ->
+    extension_constructor
+
+  val rebind : ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor
+end
+
+(** {1 Module language} *)
+
+(** Module type expressions *)
+module Mty : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type
+  val attr : module_type -> attribute -> module_type
+  val ident : ?loc:loc -> ?attrs:attrs -> lid -> module_type
+  val alias : ?loc:loc -> ?attrs:attrs -> lid -> module_type
+  val signature : ?loc:loc -> ?attrs:attrs -> signature -> module_type
+
+  val functor_ :
+    ?loc:loc -> ?attrs:attrs -> functor_parameter -> module_type -> module_type
+
+  val with_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    module_type ->
+    with_constraint list ->
+    module_type
+
+  val typeof_ : ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> module_type
+end
+
+(** Module expressions *)
+module Mod : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr
+  val attr : module_expr -> attribute -> module_expr
+  val ident : ?loc:loc -> ?attrs:attrs -> lid -> module_expr
+  val structure : ?loc:loc -> ?attrs:attrs -> structure -> module_expr
+
+  val functor_ :
+    ?loc:loc -> ?attrs:attrs -> functor_parameter -> module_expr -> module_expr
+
+  val apply :
+    ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr
+
+  val constraint_ :
+    ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr
+
+  val unpack : ?loc:loc -> ?attrs:attrs -> expression -> module_expr
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> module_expr
+end
+
+(** Signature items *)
+module Sig : sig
+  val mk : ?loc:loc -> signature_item_desc -> signature_item
+  val value : ?loc:loc -> value_description -> signature_item
+  val type_ : ?loc:loc -> rec_flag -> type_declaration list -> signature_item
+  val type_subst : ?loc:loc -> type_declaration list -> signature_item
+  val type_extension : ?loc:loc -> type_extension -> signature_item
+  val exception_ : ?loc:loc -> type_exception -> signature_item
+  val module_ : ?loc:loc -> module_declaration -> signature_item
+  val mod_subst : ?loc:loc -> module_substitution -> signature_item
+  val rec_module : ?loc:loc -> module_declaration list -> signature_item
+  val modtype : ?loc:loc -> module_type_declaration -> signature_item
+  val open_ : ?loc:loc -> open_description -> signature_item
+  val include_ : ?loc:loc -> include_description -> signature_item
+  val class_ : ?loc:loc -> class_description list -> signature_item
+  val class_type : ?loc:loc -> class_type_declaration list -> signature_item
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> signature_item
+  val attribute : ?loc:loc -> attribute -> signature_item
+end
+
+(** Structure items *)
+module Str : sig
+  val mk : ?loc:loc -> structure_item_desc -> structure_item
+  val eval : ?loc:loc -> ?attrs:attributes -> expression -> structure_item
+  val value : ?loc:loc -> rec_flag -> value_binding list -> structure_item
+  val primitive : ?loc:loc -> value_description -> structure_item
+  val type_ : ?loc:loc -> rec_flag -> type_declaration list -> structure_item
+  val type_extension : ?loc:loc -> type_extension -> structure_item
+  val exception_ : ?loc:loc -> type_exception -> structure_item
+  val module_ : ?loc:loc -> module_binding -> structure_item
+  val rec_module : ?loc:loc -> module_binding list -> structure_item
+  val modtype : ?loc:loc -> module_type_declaration -> structure_item
+  val open_ : ?loc:loc -> open_declaration -> structure_item
+  val class_ : ?loc:loc -> class_declaration list -> structure_item
+  val class_type : ?loc:loc -> class_type_declaration list -> structure_item
+  val include_ : ?loc:loc -> include_declaration -> structure_item
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> structure_item
+  val attribute : ?loc:loc -> attribute -> structure_item
+end
+
+(** Module declarations *)
+module Md : sig
+  val mk :
+    ?loc:loc -> ?attrs:attrs -> str_opt -> module_type -> module_declaration
+end
+
+(** Module substitutions *)
+module Ms : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> str -> lid -> module_substitution
+end
+
+(** Module type declarations *)
+module Mtd : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?typ:module_type ->
+    str ->
+    module_type_declaration
+end
+
+(** Module bindings *)
+module Mb : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr -> module_binding
+end
+
+(** Opens *)
+module Opn : sig
+  val mk :
+    ?loc:loc -> ?attrs:attrs -> ?override:override_flag -> 'a -> 'a open_infos
+end
+
+(** Includes *)
+module Incl : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> 'a -> 'a include_infos
+end
+
+(** Value bindings *)
+module Vb : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?value_constraint:value_constraint ->
+    pattern ->
+    expression ->
+    value_binding
+end
+
+(** {1 Class language} *)
+
+(** Class type expressions *)
+module Cty : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type
+  val attr : class_type -> attribute -> class_type
+  val constr : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
+  val signature : ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
+
+  val arrow :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    arg_label ->
+    core_type ->
+    class_type ->
+    class_type
+
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> class_type
+
+  val open_ :
+    ?loc:loc -> ?attrs:attrs -> open_description -> class_type -> class_type
+end
+
+(** Class type fields *)
+module Ctf : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> class_type_field_desc -> class_type_field
+  val attr : class_type_field -> attribute -> class_type_field
+  val inherit_ : ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field
+
+  val val_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str ->
+    mutable_flag ->
+    virtual_flag ->
+    core_type ->
+    class_type_field
+
+  val method_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str ->
+    private_flag ->
+    virtual_flag ->
+    core_type ->
+    class_type_field
+
+  val constraint_ :
+    ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field
+
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> class_type_field
+  val attribute : ?loc:loc -> attribute -> class_type_field
+end
+
+(** Class expressions *)
+module Cl : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr
+  val attr : class_expr -> attribute -> class_expr
+  val constr : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr
+  val structure : ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr
+
+  val fun_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    arg_label ->
+    expression option ->
+    pattern ->
+    class_expr ->
+    class_expr
+
+  val apply :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    class_expr ->
+    (arg_label * expression) list ->
+    class_expr
+
+  val let_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    rec_flag ->
+    value_binding list ->
+    class_expr ->
+    class_expr
+
+  val constraint_ :
+    ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr
+
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> class_expr
+
+  val open_ :
+    ?loc:loc -> ?attrs:attrs -> open_description -> class_expr -> class_expr
+end
+
+(** Class fields *)
+module Cf : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> class_field_desc -> class_field
+  val attr : class_field -> attribute -> class_field
+
+  val inherit_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    override_flag ->
+    class_expr ->
+    str option ->
+    class_field
+
+  val val_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str ->
+    mutable_flag ->
+    class_field_kind ->
+    class_field
+
+  val method_ :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    str ->
+    private_flag ->
+    class_field_kind ->
+    class_field
+
+  val constraint_ :
+    ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field
+
+  val initializer_ : ?loc:loc -> ?attrs:attrs -> expression -> class_field
+  val extension : ?loc:loc -> ?attrs:attrs -> extension -> class_field
+  val attribute : ?loc:loc -> attribute -> class_field
+  val virtual_ : core_type -> class_field_kind
+  val concrete : override_flag -> expression -> class_field_kind
+end
+
+(** Classes *)
+module Ci : sig
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?virt:virtual_flag ->
+    ?params:(core_type * (variance * injectivity)) list ->
+    str ->
+    'a ->
+    'a class_infos
+end
+
+(** Class signatures *)
+module Csig : sig
+  val mk : core_type -> class_type_field list -> class_signature
+end
+
+(** Class structures *)
+module Cstr : sig
+  val mk : pattern -> class_field list -> class_structure
+end
+
+(** Row fields *)
+module Rf : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field
+
+  val tag :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    label with_loc ->
+    bool ->
+    core_type list ->
+    row_field
+
+  val inherit_ : ?loc:loc -> core_type -> row_field
+end
+
+(** Object fields *)
+module Of : sig
+  val mk : ?loc:loc -> ?attrs:attrs -> object_field_desc -> object_field
+
+  val tag :
+    ?loc:loc -> ?attrs:attrs -> label with_loc -> core_type -> object_field
+
+  val inherit_ : ?loc:loc -> core_type -> object_field
+end

unikernel/duniverse/ppxlib/ast/cinaps/ast_cinaps_helpers.ml

@@ -0,0 +1,34 @@
+(* -*- tuareg -*- *)
+
+include StdLabels
+include Printf
+
+let capitalize_ascii = Stdppx.String.capitalize_ascii
+
+(* Reexports from [Astlib_cinaps_helpers] *)
+let nl = Astlib_cinaps_helpers.nl
+let qualified_types = Astlib_cinaps_helpers.qualified_types
+let foreach_module = Astlib_cinaps_helpers.foreach_module
+let foreach_type = Astlib_cinaps_helpers.foreach_type
+let all_types = List.concat (List.map ~f:snd qualified_types)
+
+let foreach_version f =
+  nl ();
+  List.iter Supported_version.all ~f:(fun v ->
+      f (Supported_version.to_int v) (Supported_version.to_string v))
+
+let foreach_version_pair f =
+  nl ();
+  let rec aux = function
+    | x :: (y :: _ as tail) ->
+        f (Supported_version.to_int x) (Supported_version.to_int y);
+        aux tail
+    | [ _ ] | [] -> ()
+  in
+  aux Supported_version.all
+
+let with_then_and () =
+  let first = ref true in
+  fun oc ->
+    output_string oc (if !first then "with" else " and");
+    first := false

unikernel/duniverse/ppxlib/ast/cinaps/dune

@@ -0,0 +1,3 @@
+(library
+ (name ast_cinaps_helpers)
+ (libraries stdppx supported_version astlib_cinaps_helpers))

unikernel/duniverse/ppxlib/ast/dune

@@ -0,0 +1,23 @@
+;; Note that to use the preprocessor for the (* IF_AT_LEAST ... *)
+;; syntax you have to make sure the module is in the module list in
+;; (per_module <action> <module_list>)
+
+(library
+ (name ppxlib_ast)
+ (public_name ppxlib.ast)
+ (libraries astlib stdlib-shims)
+ (flags
+  (:standard -safe-string)
+  -w
+  -9-27-32)
+ (preprocess
+  (per_module
+   ((action
+     (run %{exe:pp/pp.exe} %{ocaml_version} %{input-file}))
+    versions)))
+ (lint
+  (pps ppxlib_traverse -deriving-keep-w32=impl)))
+
+(cinaps
+ (files *.ml *.mli)
+ (libraries ast_cinaps_helpers))

unikernel/duniverse/ppxlib/ast/import.ml

@@ -0,0 +1,214 @@
+(* This file is used to control what we use from the current compiler and what is embed in
+   this library.
+
+   It must be opened in all modules, especially the ones coming from the compiler.
+*)
+
+(*$ open Ast_cinaps_helpers $*)
+
+module Js = Versions.OCaml_502
+module Ocaml = Versions.OCaml_current
+
+module Select_ast (Ocaml : Versions.OCaml_version) = struct
+  include Js
+
+  module Type = struct
+    type ('js, 'ocaml) t =
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s\n\
+              \          : ( Js.Ast.Parsetree.%s,\n\
+              \              Ocaml.Ast.Parsetree.%s )\n\
+              \            t\n"
+              (capitalize_ascii s) s s
+          )
+      *)
+      | Structure
+          : ( Js.Ast.Parsetree.structure,
+              Ocaml.Ast.Parsetree.structure )
+            t
+      | Signature
+          : ( Js.Ast.Parsetree.signature,
+              Ocaml.Ast.Parsetree.signature )
+            t
+      | Toplevel_phrase
+          : ( Js.Ast.Parsetree.toplevel_phrase,
+              Ocaml.Ast.Parsetree.toplevel_phrase )
+            t
+      | Core_type
+          : ( Js.Ast.Parsetree.core_type,
+              Ocaml.Ast.Parsetree.core_type )
+            t
+      | Expression
+          : ( Js.Ast.Parsetree.expression,
+              Ocaml.Ast.Parsetree.expression )
+            t
+      | Pattern
+          : ( Js.Ast.Parsetree.pattern,
+              Ocaml.Ast.Parsetree.pattern )
+            t
+      | Case
+          : ( Js.Ast.Parsetree.case,
+              Ocaml.Ast.Parsetree.case )
+            t
+      | Type_declaration
+          : ( Js.Ast.Parsetree.type_declaration,
+              Ocaml.Ast.Parsetree.type_declaration )
+            t
+      | Type_extension
+          : ( Js.Ast.Parsetree.type_extension,
+              Ocaml.Ast.Parsetree.type_extension )
+            t
+      | Extension_constructor
+          : ( Js.Ast.Parsetree.extension_constructor,
+              Ocaml.Ast.Parsetree.extension_constructor )
+            t
+      | Class_expr
+          : ( Js.Ast.Parsetree.class_expr,
+              Ocaml.Ast.Parsetree.class_expr )
+            t
+      | Class_field
+          : ( Js.Ast.Parsetree.class_field,
+              Ocaml.Ast.Parsetree.class_field )
+            t
+      | Class_type
+          : ( Js.Ast.Parsetree.class_type,
+              Ocaml.Ast.Parsetree.class_type )
+            t
+      | Class_signature
+          : ( Js.Ast.Parsetree.class_signature,
+              Ocaml.Ast.Parsetree.class_signature )
+            t
+      | Class_type_field
+          : ( Js.Ast.Parsetree.class_type_field,
+              Ocaml.Ast.Parsetree.class_type_field )
+            t
+      | Module_expr
+          : ( Js.Ast.Parsetree.module_expr,
+              Ocaml.Ast.Parsetree.module_expr )
+            t
+      | Module_type
+          : ( Js.Ast.Parsetree.module_type,
+              Ocaml.Ast.Parsetree.module_type )
+            t
+      | Signature_item
+          : ( Js.Ast.Parsetree.signature_item,
+              Ocaml.Ast.Parsetree.signature_item )
+            t
+      | Structure_item
+          : ( Js.Ast.Parsetree.structure_item,
+              Ocaml.Ast.Parsetree.structure_item )
+            t
+(*$*)
+      | List : ('a, 'b) t -> ('a list, 'b list) t
+      | Pair : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
+  end
+
+  open Type
+  module Of_ocaml = Versions.Convert (Ocaml) (Js)
+  module To_ocaml = Versions.Convert (Js) (Ocaml)
+
+  let rec of_ocaml : type ocaml js. (js, ocaml) Type.t -> ocaml -> js =
+    let open Of_ocaml in
+    fun node ->
+      match node with
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s -> copy_%s\n"
+              (capitalize_ascii s) s
+          )
+      *)
+      | Structure -> copy_structure
+      | Signature -> copy_signature
+      | Toplevel_phrase -> copy_toplevel_phrase
+      | Core_type -> copy_core_type
+      | Expression -> copy_expression
+      | Pattern -> copy_pattern
+      | Case -> copy_case
+      | Type_declaration -> copy_type_declaration
+      | Type_extension -> copy_type_extension
+      | Extension_constructor -> copy_extension_constructor
+      | Class_expr -> copy_class_expr
+      | Class_field -> copy_class_field
+      | Class_type -> copy_class_type
+      | Class_signature -> copy_class_signature
+      | Class_type_field -> copy_class_type_field
+      | Module_expr -> copy_module_expr
+      | Module_type -> copy_module_type
+      | Signature_item -> copy_signature_item
+      | Structure_item -> copy_structure_item
+(*$*)
+      | List t -> List.map (of_ocaml t)
+      | Pair (a, b) ->
+          let f = of_ocaml a in
+          let g = of_ocaml b in
+          fun (x, y) -> (f x, g y)
+
+  let rec to_ocaml : type ocaml js. (js, ocaml) Type.t -> js -> ocaml =
+    let open To_ocaml in
+    fun node ->
+      match node with
+      (*$ foreach_type (fun _ s ->
+            printf
+              "      | %s -> copy_%s\n"
+              (capitalize_ascii s) s
+          )
+      *)
+      | Structure -> copy_structure
+      | Signature -> copy_signature
+      | Toplevel_phrase -> copy_toplevel_phrase
+      | Core_type -> copy_core_type
+      | Expression -> copy_expression
+      | Pattern -> copy_pattern
+      | Case -> copy_case
+      | Type_declaration -> copy_type_declaration
+      | Type_extension -> copy_type_extension
+      | Extension_constructor -> copy_extension_constructor
+      | Class_expr -> copy_class_expr
+      | Class_field -> copy_class_field
+      | Class_type -> copy_class_type
+      | Class_signature -> copy_class_signature
+      | Class_type_field -> copy_class_type_field
+      | Module_expr -> copy_module_expr
+      | Module_type -> copy_module_type
+      | Signature_item -> copy_signature_item
+      | Structure_item -> copy_structure_item
+(*$*)
+      | List t -> List.map (to_ocaml t)
+      | Pair (a, b) ->
+          let f = to_ocaml a in
+          let g = to_ocaml b in
+          fun (x, y) -> (f x, g y)
+
+  let of_ocaml_mapper item f ctxt x = to_ocaml item x |> f ctxt |> of_ocaml item
+  let to_ocaml_mapper item f ctxt x = of_ocaml item x |> f ctxt |> to_ocaml item
+end
+
+module Selected_ast = Select_ast (Ocaml)
+module Ast_helper = Ast_helper_lite
+
+(* Modules from Ast_<n> of Astlib, where <n> is the compiler version the ppxlib driver is compiled with *)
+module Parsetree = Selected_ast.Ast.Parsetree
+module Asttypes = Selected_ast.Ast.Asttypes
+
+(* Other Astlib modules *)
+module Location = Astlib.Location
+module Longident = Astlib.Longident
+
+module Parse = struct
+  include Astlib.Parse
+  module Of_ocaml = Versions.Convert (Ocaml) (Js)
+
+  let implementation lexbuf = implementation lexbuf |> Of_ocaml.copy_structure
+  let interface lexbuf = interface lexbuf |> Of_ocaml.copy_signature
+
+  let toplevel_phrase lexbuf =
+    toplevel_phrase lexbuf |> Of_ocaml.copy_toplevel_phrase
+
+  let use_file lexbuf =
+    use_file lexbuf |> List.map Of_ocaml.copy_toplevel_phrase
+
+  let core_type lexbuf = core_type lexbuf |> Of_ocaml.copy_core_type
+  let expression lexbuf = expression lexbuf |> Of_ocaml.copy_expression
+  let pattern lexbuf = pattern lexbuf |> Of_ocaml.copy_pattern
+end

unikernel/duniverse/ppxlib/ast/location_error.ml

@@ -0,0 +1,72 @@
+open Import
+
+type t = Astlib.Location.Error.t
+
+let to_extension (error : Astlib.Location.Error.t) =
+  let open Astlib.Location.Error in
+  let open Ast_helper in
+  if not (is_well_formed error) then
+    raise (Invalid_argument "to_extension: expected kind Report_error");
+  let sub_msgs = sub_msgs error in
+  let main_msg = main_msg error in
+  let err_extension_name loc = { Location.loc; txt = "ocaml.error" } in
+  let mk_string_constant x = Str.eval (Exp.constant (Const.string x)) in
+  let extension_of_sub_msg (sub_msg : string Location.loc) =
+    Str.extension
+      (err_extension_name sub_msg.loc, PStr [ mk_string_constant sub_msg.txt ])
+  in
+  ( err_extension_name main_msg.loc,
+    Parsetree.PStr
+      (mk_string_constant main_msg.txt :: List.map extension_of_sub_msg sub_msgs)
+  )
+
+let register_error_of_exn = Astlib.Location.register_error_of_exn
+
+let message error =
+  let { Astlib.Location.txt; _ } = Astlib.Location.Error.main_msg error in
+  txt
+
+let set_message = Astlib.Location.Error.set_main_msg
+
+let make ~loc txt ~sub =
+  let sub = List.map (fun (loc, txt) -> { Astlib.Location.loc; txt }) sub in
+  Astlib.Location.Error.make ~sub { loc; txt }
+
+let update_loc = Astlib.Location.Error.set_main_loc
+
+let get_location error =
+  let { Astlib.Location.loc; _ } = Astlib.Location.Error.main_msg error in
+  loc
+
+let of_exn = Astlib.Location.Error.of_exn
+let raise error = raise (Astlib.Location.Error error)
+
+let of_extension (extension : Ast.extension) =
+  let open Parsetree in
+  let parse_msg = function
+    | {
+        pstr_desc =
+          Pstr_eval
+            ({ pexp_desc = Pexp_constant (Pconst_string (msg, _, _)); _ }, []);
+        _;
+      } ->
+        msg
+    | _ -> "ppxlib: failed to extract message in ocaml.error"
+  in
+  let parse_sub_msg = function
+    | {
+        pstr_desc =
+          Pstr_extension
+            (({ txt = "error" | "ocaml.error"; loc }, PStr [ msg ]), []);
+        _;
+      } ->
+        (loc, parse_msg msg)
+    | { pstr_loc = loc; _ } ->
+        (loc, "ppxlib: failed to parse ocaml.error sub messages")
+  in
+  match extension with
+  | { txt = "error" | "ocaml.error"; loc }, PStr (main :: sub) ->
+      let main = parse_msg main in
+      let sub = List.map parse_sub_msg sub in
+      Some (make ~loc main ~sub)
+  | _ -> None

unikernel/duniverse/ppxlib/ast/location_error.mli

@@ -0,0 +1,14 @@
+open Import
+
+type t = Astlib.Location.Error.t
+
+val of_exn : exn -> t option
+val register_error_of_exn : (exn -> t option) -> unit
+val message : t -> string
+val set_message : t -> string -> t
+val make : loc:Location.t -> string -> sub:(Location.t * string) list -> t
+val to_extension : t -> Import.Parsetree.extension
+val raise : t -> 'a
+val update_loc : t -> Location.t -> t
+val get_location : t -> Location.t
+val of_extension : Import.Parsetree.extension -> t option

unikernel/duniverse/ppxlib/ast/pp/dune

@@ -0,0 +1,6 @@
+(executables
+ (names pp)
+ (libraries supported_version)
+ (flags :standard -w -3))
+
+(ocamllex pp_rewrite)

unikernel/duniverse/ppxlib/ast/pp/pp.ml

@@ -0,0 +1,16 @@
+let () =
+  match Sys.argv with
+  | [| _; ocaml_version_str; fname |] ->
+      let ocaml_version =
+        match Supported_version.of_string ocaml_version_str with
+        | Some v -> string_of_int (Supported_version.to_int v)
+        | None ->
+            Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str;
+            exit 1
+      in
+      let ic = open_in_bin fname in
+      Printf.printf "# 1 %S\n" fname;
+      Pp_rewrite.rewrite ocaml_version (Lexing.from_channel ic)
+  | _ ->
+      Printf.eprintf "%s: <ocaml-version> <file-name>\n" Sys.executable_name;
+      exit 2

unikernel/duniverse/ppxlib/ast/pp/pp.mli

@@ -0,0 +1 @@
+(* empty *)

unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mli

@@ -0,0 +1 @@
+val rewrite : string -> Lexing.lexbuf -> unit

unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mll

@@ -0,0 +1,27 @@
+{
+open Printf
+
+let print_ocaml_version version =
+  let patt_len = String.length "OCAML_VERSION" in
+  (* Note: the spaces in the replacements are to preserve locations *)
+  printf "%-*s" patt_len version
+}
+
+rule rewrite ocaml_version = parse
+  | "OCAML_VERSION"
+    { print_ocaml_version ocaml_version;
+      rewrite ocaml_version lexbuf
+    }
+  |          "(*IF_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)"
+    { let chunk = if (v <= ocaml_version)
+        then "              " ^ String.make (String.length v + 1) ' ' ^ s ^          "  "
+        else Lexing.lexeme lexbuf
+      in
+      print_string chunk;
+      rewrite ocaml_version lexbuf
+    }
+  | _ as c
+    { print_char c;
+      rewrite ocaml_version lexbuf
+    }
+  | eof { () }

unikernel/duniverse/ppxlib/ast/ppxlib_ast.ml

@@ -0,0 +1,19 @@
+open Import
+
+module type OCaml_version = Versions.OCaml_version
+
+module Ast = Ast
+module Ast_helper = Ast_helper
+module Ast_magic = Selected_ast.Ast.Config
+module Asttypes = Asttypes
+module Compiler_version = Versions.OCaml_current
+module Js = Js
+module Find_version = Versions.Find_version
+module Convert = Versions.Convert
+module Extra_warnings = Warn
+module Location_error = Location_error
+module Parse = Parse
+module Parsetree = Parsetree
+module Pprintast = Astlib.Pprintast
+module Select_ast = Select_ast
+module Selected_ast = Selected_ast

unikernel/duniverse/ppxlib/ast/stdlib0.ml

@@ -0,0 +1,7 @@
+module Int = struct
+  let to_string = string_of_int
+end
+
+module Option = struct
+  let map f o = match o with None -> None | Some v -> Some (f v)
+end

unikernel/duniverse/ppxlib/ast/supported_version/dune

@@ -0,0 +1,2 @@
+(library
+ (name supported_version))

unikernel/duniverse/ppxlib/ast/supported_version/supported_version.ml

@@ -0,0 +1,26 @@
+type t = int * int
+
+let all =
+  [
+    (4, 08);
+    (4, 09);
+    (4, 10);
+    (4, 11);
+    (4, 12);
+    (4, 13);
+    (4, 14);
+    (5, 0);
+    (5, 1);
+    (5, 2);
+    (5, 3);
+    (5, 4);
+  ]
+
+let to_string (a, b) =
+  if a < 5 then Printf.sprintf "%d.%02d" a b else Printf.sprintf "%d.%d" a b
+
+let to_int (a, b) = (a * 100) + b
+
+let of_string s =
+  let t = Scanf.sscanf s "%u.%u" (fun a b -> (a, b)) in
+  if List.mem t all then Some t else None

unikernel/duniverse/ppxlib/ast/supported_version/supported_version.mli

@@ -0,0 +1,14 @@
+(** Supported versions of the OCaml AST *)
+
+type t
+
+val all : t list
+
+val to_string : t -> string
+(** Return a string such as "4.02" *)
+
+val to_int : t -> int
+(** Return an integer such as [402] *)
+
+val of_string : string -> t option
+(** Parse a string as reported by [ocamlc -version] *)

unikernel/duniverse/ppxlib/ast/versions.ml

@@ -0,0 +1,728 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                         OCaml Migrate Parsetree                        *)
+(*                                                                        *)
+(*                             Frédéric Bour                              *)
+(*                   Jérémie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 Institut National de Recherche en Informatique et     *)
+(*     en Automatique (INRIA).                                            *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* BEGIN of BLACK MAGIC *)
+(*$ open Ast_cinaps_helpers $*)
+
+type _ witnesses = ..
+
+type _ migration = ..
+type _ migration += Undefined : _ migration
+
+type 'a migration_info = {
+  mutable next_version : 'a migration;
+  mutable previous_version : 'a migration;
+}
+
+(** Abstract view of a version of an OCaml Ast *)
+module type Ast = sig
+  (*$ foreach_module (fun m types ->
+      printf "  module %s : sig\n" m;
+      List.iter types ~f:(printf "    type %s\n");
+      printf "  end\n"
+    )
+  *)
+  module Parsetree : sig
+    type structure
+    type signature
+    type toplevel_phrase
+    type core_type
+    type expression
+    type pattern
+    type case
+    type type_declaration
+    type type_extension
+    type extension_constructor
+    type class_expr
+    type class_field
+    type class_type
+    type class_signature
+    type class_type_field
+    type module_expr
+    type module_type
+    type signature_item
+    type structure_item
+  end
+(*$*)
+  module Config : sig
+    val ast_impl_magic_number : string
+    val ast_intf_magic_number : string
+  end
+end
+
+(* Shortcuts for talking about ast types outside of the module language *)
+
+type 'a _types = 'a constraint 'a
+  = <
+    (*$ foreach_type (fun _ s -> printf "    %-21s : _;\n" s) *)
+    structure             : _;
+    signature             : _;
+    toplevel_phrase       : _;
+    core_type             : _;
+    expression            : _;
+    pattern               : _;
+    case                  : _;
+    type_declaration      : _;
+    type_extension        : _;
+    extension_constructor : _;
+    class_expr            : _;
+    class_field           : _;
+    class_type            : _;
+    class_signature       : _;
+    class_type_field      : _;
+    module_expr           : _;
+    module_type           : _;
+    signature_item        : _;
+    structure_item        : _;
+(*$*)
+  >
+;;
+
+(*$ foreach_type (fun _ s ->
+    printf "type 'a get_%s =\n" s;
+    printf "  'x constraint 'a _types = < %s : 'x; .. >\n" s
+  ) *)
+type 'a get_structure =
+  'x constraint 'a _types = < structure : 'x; .. >
+type 'a get_signature =
+  'x constraint 'a _types = < signature : 'x; .. >
+type 'a get_toplevel_phrase =
+  'x constraint 'a _types = < toplevel_phrase : 'x; .. >
+type 'a get_core_type =
+  'x constraint 'a _types = < core_type : 'x; .. >
+type 'a get_expression =
+  'x constraint 'a _types = < expression : 'x; .. >
+type 'a get_pattern =
+  'x constraint 'a _types = < pattern : 'x; .. >
+type 'a get_case =
+  'x constraint 'a _types = < case : 'x; .. >
+type 'a get_type_declaration =
+  'x constraint 'a _types = < type_declaration : 'x; .. >
+type 'a get_type_extension =
+  'x constraint 'a _types = < type_extension : 'x; .. >
+type 'a get_extension_constructor =
+  'x constraint 'a _types = < extension_constructor : 'x; .. >
+type 'a get_class_expr =
+  'x constraint 'a _types = < class_expr : 'x; .. >
+type 'a get_class_field =
+  'x constraint 'a _types = < class_field : 'x; .. >
+type 'a get_class_type =
+  'x constraint 'a _types = < class_type : 'x; .. >
+type 'a get_class_signature =
+  'x constraint 'a _types = < class_signature : 'x; .. >
+type 'a get_class_type_field =
+  'x constraint 'a _types = < class_type_field : 'x; .. >
+type 'a get_module_expr =
+  'x constraint 'a _types = < module_expr : 'x; .. >
+type 'a get_module_type =
+  'x constraint 'a _types = < module_type : 'x; .. >
+type 'a get_signature_item =
+  'x constraint 'a _types = < signature_item : 'x; .. >
+type 'a get_structure_item =
+  'x constraint 'a _types = < structure_item : 'x; .. >
+(*$*)
+
+module type OCaml_version = sig
+  module Ast : Ast
+  val version : int
+  val string_version : string
+  type types = <
+    (*$ foreach_type (fun m s -> printf "    %-21s : Ast.%s.%s;\n" s m s)*)
+    structure             : Ast.Parsetree.structure;
+    signature             : Ast.Parsetree.signature;
+    toplevel_phrase       : Ast.Parsetree.toplevel_phrase;
+    core_type             : Ast.Parsetree.core_type;
+    expression            : Ast.Parsetree.expression;
+    pattern               : Ast.Parsetree.pattern;
+    case                  : Ast.Parsetree.case;
+    type_declaration      : Ast.Parsetree.type_declaration;
+    type_extension        : Ast.Parsetree.type_extension;
+    extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
+(*$*)
+  > _types
+  type _ witnesses += Version : types witnesses
+  val migration_info : types migration_info
+end
+
+module Make_witness(Ast : Ast) =
+struct
+  type types = <
+    (*$ foreach_type (fun m s -> printf "    %-21s : Ast.%s.%s;\n" s m s)*)
+    structure             : Ast.Parsetree.structure;
+    signature             : Ast.Parsetree.signature;
+    toplevel_phrase       : Ast.Parsetree.toplevel_phrase;
+    core_type             : Ast.Parsetree.core_type;
+    expression            : Ast.Parsetree.expression;
+    pattern               : Ast.Parsetree.pattern;
+    case                  : Ast.Parsetree.case;
+    type_declaration      : Ast.Parsetree.type_declaration;
+    type_extension        : Ast.Parsetree.type_extension;
+    extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
+(*$*)
+  > _types
+  type _ witnesses += Version : types witnesses
+  let migration_info : types migration_info =
+    { next_version = Undefined; previous_version = Undefined }
+end
+
+type 'types ocaml_version =
+  (module OCaml_version
+    (*$ let sep = with_then_and () in
+      foreach_type (fun m s ->
+          printf "    %t type Ast.%s.%s = 'types get_%s\n" sep m s s) *)
+    with type Ast.Parsetree.structure = 'types get_structure
+     and type Ast.Parsetree.signature = 'types get_signature
+     and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase
+     and type Ast.Parsetree.core_type = 'types get_core_type
+     and type Ast.Parsetree.expression = 'types get_expression
+     and type Ast.Parsetree.pattern = 'types get_pattern
+     and type Ast.Parsetree.case = 'types get_case
+     and type Ast.Parsetree.type_declaration = 'types get_type_declaration
+     and type Ast.Parsetree.type_extension = 'types get_type_extension
+     and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor
+     and type Ast.Parsetree.class_expr = 'types get_class_expr
+     and type Ast.Parsetree.class_field = 'types get_class_field
+     and type Ast.Parsetree.class_type = 'types get_class_type
+     and type Ast.Parsetree.class_signature = 'types get_class_signature
+     and type Ast.Parsetree.class_type_field = 'types get_class_type_field
+     and type Ast.Parsetree.module_expr = 'types get_module_expr
+     and type Ast.Parsetree.module_type = 'types get_module_type
+     and type Ast.Parsetree.signature_item = 'types get_signature_item
+     and type Ast.Parsetree.structure_item = 'types get_structure_item
+(*$*)
+  )
+
+type ('from, 'to_) migration_functions = {
+  (*$ foreach_type (fun _ s ->
+      printf "  copy_%s: 'from get_%s -> 'to_ get_%s;\n" s s s) *)
+  copy_structure: 'from get_structure -> 'to_ get_structure;
+  copy_signature: 'from get_signature -> 'to_ get_signature;
+  copy_toplevel_phrase: 'from get_toplevel_phrase -> 'to_ get_toplevel_phrase;
+  copy_core_type: 'from get_core_type -> 'to_ get_core_type;
+  copy_expression: 'from get_expression -> 'to_ get_expression;
+  copy_pattern: 'from get_pattern -> 'to_ get_pattern;
+  copy_case: 'from get_case -> 'to_ get_case;
+  copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration;
+  copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension;
+  copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor;
+  copy_class_expr: 'from get_class_expr -> 'to_ get_class_expr;
+  copy_class_field: 'from get_class_field -> 'to_ get_class_field;
+  copy_class_type: 'from get_class_type -> 'to_ get_class_type;
+  copy_class_signature: 'from get_class_signature -> 'to_ get_class_signature;
+  copy_class_type_field: 'from get_class_type_field -> 'to_ get_class_type_field;
+  copy_module_expr: 'from get_module_expr -> 'to_ get_module_expr;
+  copy_module_type: 'from get_module_type -> 'to_ get_module_type;
+  copy_signature_item: 'from get_signature_item -> 'to_ get_signature_item;
+  copy_structure_item: 'from get_structure_item -> 'to_ get_structure_item;
+(*$*)
+}
+
+let id x = x
+let migration_identity : ('a, 'a) migration_functions = {
+  (*$ foreach_type (fun _ s -> printf "  copy_%s = id;\n" s) *)
+  copy_structure = id;
+  copy_signature = id;
+  copy_toplevel_phrase = id;
+  copy_core_type = id;
+  copy_expression = id;
+  copy_pattern = id;
+  copy_case = id;
+  copy_type_declaration = id;
+  copy_type_extension = id;
+  copy_extension_constructor = id;
+  copy_class_expr = id;
+  copy_class_field = id;
+  copy_class_type = id;
+  copy_class_signature = id;
+  copy_class_type_field = id;
+  copy_module_expr = id;
+  copy_module_type = id;
+  copy_signature_item = id;
+  copy_structure_item = id;
+(*$*)
+}
+
+let compose f g x = f (g x)
+let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migration_functions) : ('a, 'c) migration_functions = {
+  (*$ foreach_type (fun _ s ->
+      printf "  copy_%-21s = compose bc.copy_%-21s ab.copy_%s;\n" s s s) *)
+  copy_structure             = compose bc.copy_structure             ab.copy_structure;
+  copy_signature             = compose bc.copy_signature             ab.copy_signature;
+  copy_toplevel_phrase       = compose bc.copy_toplevel_phrase       ab.copy_toplevel_phrase;
+  copy_core_type             = compose bc.copy_core_type             ab.copy_core_type;
+  copy_expression            = compose bc.copy_expression            ab.copy_expression;
+  copy_pattern               = compose bc.copy_pattern               ab.copy_pattern;
+  copy_case                  = compose bc.copy_case                  ab.copy_case;
+  copy_type_declaration      = compose bc.copy_type_declaration      ab.copy_type_declaration;
+  copy_type_extension        = compose bc.copy_type_extension        ab.copy_type_extension;
+  copy_extension_constructor = compose bc.copy_extension_constructor ab.copy_extension_constructor;
+  copy_class_expr            = compose bc.copy_class_expr            ab.copy_class_expr;
+  copy_class_field           = compose bc.copy_class_field           ab.copy_class_field;
+  copy_class_type            = compose bc.copy_class_type            ab.copy_class_type;
+  copy_class_signature       = compose bc.copy_class_signature       ab.copy_class_signature;
+  copy_class_type_field      = compose bc.copy_class_type_field      ab.copy_class_type_field;
+  copy_module_expr           = compose bc.copy_module_expr           ab.copy_module_expr;
+  copy_module_type           = compose bc.copy_module_type           ab.copy_module_type;
+  copy_signature_item        = compose bc.copy_signature_item        ab.copy_signature_item;
+  copy_structure_item        = compose bc.copy_structure_item        ab.copy_structure_item;
+(*$*)
+}
+
+type _ migration += Migration : 'from ocaml_version * ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from migration
+
+module type Migrate_module = sig
+  module From : Ast
+  module To : Ast
+  (*$ foreach_type (fun m s ->
+      printf "  val copy_%-21s: From.%s.%s -> To.%s.%s\n" s m s m s) *)
+  val copy_structure            : From.Parsetree.structure -> To.Parsetree.structure
+  val copy_signature            : From.Parsetree.signature -> To.Parsetree.signature
+  val copy_toplevel_phrase      : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase
+  val copy_core_type            : From.Parsetree.core_type -> To.Parsetree.core_type
+  val copy_expression           : From.Parsetree.expression -> To.Parsetree.expression
+  val copy_pattern              : From.Parsetree.pattern -> To.Parsetree.pattern
+  val copy_case                 : From.Parsetree.case -> To.Parsetree.case
+  val copy_type_declaration     : From.Parsetree.type_declaration -> To.Parsetree.type_declaration
+  val copy_type_extension       : From.Parsetree.type_extension -> To.Parsetree.type_extension
+  val copy_extension_constructor: From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor
+  val copy_class_expr           : From.Parsetree.class_expr -> To.Parsetree.class_expr
+  val copy_class_field          : From.Parsetree.class_field -> To.Parsetree.class_field
+  val copy_class_type           : From.Parsetree.class_type -> To.Parsetree.class_type
+  val copy_class_signature      : From.Parsetree.class_signature -> To.Parsetree.class_signature
+  val copy_class_type_field     : From.Parsetree.class_type_field -> To.Parsetree.class_type_field
+  val copy_module_expr          : From.Parsetree.module_expr -> To.Parsetree.module_expr
+  val copy_module_type          : From.Parsetree.module_type -> To.Parsetree.module_type
+  val copy_signature_item       : From.Parsetree.signature_item -> To.Parsetree.signature_item
+  val copy_structure_item       : From.Parsetree.structure_item -> To.Parsetree.structure_item
+(*$*)
+end
+
+module Migration_functions
+    (A : OCaml_version) (B : OCaml_version)
+    (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast)
+=
+struct
+  let migration_functions : (A.types, B.types) migration_functions =
+    let open A_to_B in
+    {
+      (*$ foreach_type (fun _ s -> printf "      copy_%s;\n" s) *)
+      copy_structure;
+      copy_signature;
+      copy_toplevel_phrase;
+      copy_core_type;
+      copy_expression;
+      copy_pattern;
+      copy_case;
+      copy_type_declaration;
+      copy_type_extension;
+      copy_extension_constructor;
+      copy_class_expr;
+      copy_class_field;
+      copy_class_type;
+      copy_class_signature;
+      copy_class_type_field;
+      copy_module_expr;
+      copy_module_type;
+      copy_signature_item;
+      copy_structure_item;
+(*$*)
+    }
+end
+
+module Register_migration (A : OCaml_version) (B : OCaml_version)
+    (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast)
+    (B_to_A : Migrate_module with module From = B.Ast and module To = A.Ast)
+=
+struct
+  let () = (
+    let is_undefined : type a. a migration -> bool = function
+      | Undefined -> true
+      | _ -> false
+    in
+    assert (A.version < B.version);
+    assert (is_undefined A.migration_info.next_version);
+    assert (is_undefined B.migration_info.previous_version);
+    let module A_to_B_fun = Migration_functions(A)(B)(A_to_B) in
+    let module B_to_A_fun = Migration_functions(B)(A)(B_to_A) in
+    A.migration_info.next_version <-
+      Migration ((module A), A_to_B_fun.migration_functions, (module B));
+    B.migration_info.previous_version <-
+      Migration ((module B), B_to_A_fun.migration_functions, (module A));
+  )
+end
+
+type 'from immediate_migration =
+  | No_migration : 'from immediate_migration
+  | Immediate_migration
+    :  ('from, 'to_) migration_functions * 'to_ ocaml_version
+      -> 'from immediate_migration
+
+let immediate_migration
+    (*$ foreach_type (fun _ s -> printf "    (type %s)\n" s) *)
+    (type structure)
+    (type signature)
+    (type toplevel_phrase)
+    (type core_type)
+    (type expression)
+    (type pattern)
+    (type case)
+    (type type_declaration)
+    (type type_extension)
+    (type extension_constructor)
+    (type class_expr)
+    (type class_field)
+    (type class_type)
+    (type class_signature)
+    (type class_type_field)
+    (type module_expr)
+    (type module_type)
+    (type signature_item)
+    (type structure_item)
+(*$*)
+    ((module A) : <
+     (*$ foreach_type (fun _ s -> printf  "     %-21s : %s;\n" s s) *)
+     structure             : structure;
+     signature             : signature;
+     toplevel_phrase       : toplevel_phrase;
+     core_type             : core_type;
+     expression            : expression;
+     pattern               : pattern;
+     case                  : case;
+     type_declaration      : type_declaration;
+     type_extension        : type_extension;
+     extension_constructor : extension_constructor;
+     class_expr            : class_expr;
+     class_field           : class_field;
+     class_type            : class_type;
+     class_signature       : class_signature;
+     class_type_field      : class_type_field;
+     module_expr           : module_expr;
+     module_type           : module_type;
+     signature_item        : signature_item;
+     structure_item        : structure_item;
+(*$*)
+     > ocaml_version)
+    direction
+  =
+  let version = match direction with
+    | `Next -> A.migration_info.next_version
+    | `Previous -> A.migration_info.previous_version
+  in
+  match version with
+  | Undefined -> No_migration
+  | Migration (_, funs, to_) -> Immediate_migration (funs, to_)
+  | _ -> assert false
+
+let migrate
+    (*$ foreach_type (fun _ s -> printf "    (type %s1) (type %s2)\n" s s) *)
+    (type structure1) (type structure2)
+    (type signature1) (type signature2)
+    (type toplevel_phrase1) (type toplevel_phrase2)
+    (type core_type1) (type core_type2)
+    (type expression1) (type expression2)
+    (type pattern1) (type pattern2)
+    (type case1) (type case2)
+    (type type_declaration1) (type type_declaration2)
+    (type type_extension1) (type type_extension2)
+    (type extension_constructor1) (type extension_constructor2)
+    (type class_expr1) (type class_expr2)
+    (type class_field1) (type class_field2)
+    (type class_type1) (type class_type2)
+    (type class_signature1) (type class_signature2)
+    (type class_type_field1) (type class_type_field2)
+    (type module_expr1) (type module_expr2)
+    (type module_type1) (type module_type2)
+    (type signature_item1) (type signature_item2)
+    (type structure_item1) (type structure_item2)
+(*$*)
+    ((module A) : <
+     (*$ foreach_type (fun _ s -> printf "     %-21s : %s1;\n" s s) *)
+     structure             : structure1;
+     signature             : signature1;
+     toplevel_phrase       : toplevel_phrase1;
+     core_type             : core_type1;
+     expression            : expression1;
+     pattern               : pattern1;
+     case                  : case1;
+     type_declaration      : type_declaration1;
+     type_extension        : type_extension1;
+     extension_constructor : extension_constructor1;
+     class_expr            : class_expr1;
+     class_field           : class_field1;
+     class_type            : class_type1;
+     class_signature       : class_signature1;
+     class_type_field      : class_type_field1;
+     module_expr           : module_expr1;
+     module_type           : module_type1;
+     signature_item        : signature_item1;
+     structure_item        : structure_item1;
+(*$*)
+     > ocaml_version)
+    ((module B) : <
+     (*$ foreach_type (fun _ s -> printf "     %-21s : %s2;\n" s s) *)
+     structure             : structure2;
+     signature             : signature2;
+     toplevel_phrase       : toplevel_phrase2;
+     core_type             : core_type2;
+     expression            : expression2;
+     pattern               : pattern2;
+     case                  : case2;
+     type_declaration      : type_declaration2;
+     type_extension        : type_extension2;
+     extension_constructor : extension_constructor2;
+     class_expr            : class_expr2;
+     class_field           : class_field2;
+     class_type            : class_type2;
+     class_signature       : class_signature2;
+     class_type_field      : class_type_field2;
+     module_expr           : module_expr2;
+     module_type           : module_type2;
+     signature_item        : signature_item2;
+     structure_item        : structure_item2;
+(*$*)
+     > ocaml_version)
+  : (A.types, B.types) migration_functions
+  =
+  match A.Version with
+  | B.Version -> migration_identity
+  | _ ->
+    let direction = if A.version < B.version then `Next else `Previous in
+    let rec migrate (m : A.types immediate_migration) : (A.types, B.types) migration_functions =
+      match m with
+      | No_migration -> assert false
+      | Immediate_migration (f, (module To)) ->
+        match To.Version with
+        | B.Version -> f
+        | _ ->
+          match immediate_migration (module To) direction with
+          | No_migration -> assert false
+          | Immediate_migration (g, to2) ->
+            migrate (Immediate_migration (migration_compose f g, to2))
+    in
+    migrate (immediate_migration (module A) direction)
+
+module Convert (A : OCaml_version) (B : OCaml_version) = struct
+  let {
+    (*$ foreach_type (fun _ s -> printf "    copy_%s;\n" s) *)
+    copy_structure;
+    copy_signature;
+    copy_toplevel_phrase;
+    copy_core_type;
+    copy_expression;
+    copy_pattern;
+    copy_case;
+    copy_type_declaration;
+    copy_type_extension;
+    copy_extension_constructor;
+    copy_class_expr;
+    copy_class_field;
+    copy_class_type;
+    copy_class_signature;
+    copy_class_type_field;
+    copy_module_expr;
+    copy_module_type;
+    copy_signature_item;
+    copy_structure_item;
+(*$*)
+  } : (A.types, B.types) migration_functions =
+    migrate (module A) (module B)
+end
+
+(*$ foreach_version (fun n version ->
+    printf "module OCaml_%d = struct\n" n;
+    printf "  module Ast = Astlib.Ast_%d\n" n;
+    printf "  include Make_witness(Astlib.Ast_%d)\n" n;
+    printf "  let version = %d\n" n;
+    printf "  let string_version = %S\n" version;
+    printf "end\n";
+    printf "let ocaml_%d : OCaml_%d.types ocaml_version = (module OCaml_%d)\n"
+      n n n;
+  )
+*)
+module OCaml_408 = struct
+  module Ast = Astlib.Ast_408
+  include Make_witness(Astlib.Ast_408)
+  let version = 408
+  let string_version = "4.08"
+end
+let ocaml_408 : OCaml_408.types ocaml_version = (module OCaml_408)
+module OCaml_409 = struct
+  module Ast = Astlib.Ast_409
+  include Make_witness(Astlib.Ast_409)
+  let version = 409
+  let string_version = "4.09"
+end
+let ocaml_409 : OCaml_409.types ocaml_version = (module OCaml_409)
+module OCaml_410 = struct
+  module Ast = Astlib.Ast_410
+  include Make_witness(Astlib.Ast_410)
+  let version = 410
+  let string_version = "4.10"
+end
+let ocaml_410 : OCaml_410.types ocaml_version = (module OCaml_410)
+module OCaml_411 = struct
+  module Ast = Astlib.Ast_411
+  include Make_witness(Astlib.Ast_411)
+  let version = 411
+  let string_version = "4.11"
+end
+let ocaml_411 : OCaml_411.types ocaml_version = (module OCaml_411)
+module OCaml_412 = struct
+  module Ast = Astlib.Ast_412
+  include Make_witness(Astlib.Ast_412)
+  let version = 412
+  let string_version = "4.12"
+end
+let ocaml_412 : OCaml_412.types ocaml_version = (module OCaml_412)
+module OCaml_413 = struct
+  module Ast = Astlib.Ast_413
+  include Make_witness(Astlib.Ast_413)
+  let version = 413
+  let string_version = "4.13"
+end
+let ocaml_413 : OCaml_413.types ocaml_version = (module OCaml_413)
+module OCaml_414 = struct
+  module Ast = Astlib.Ast_414
+  include Make_witness(Astlib.Ast_414)
+  let version = 414
+  let string_version = "4.14"
+end
+let ocaml_414 : OCaml_414.types ocaml_version = (module OCaml_414)
+module OCaml_500 = struct
+  module Ast = Astlib.Ast_500
+  include Make_witness(Astlib.Ast_500)
+  let version = 500
+  let string_version = "5.0"
+end
+let ocaml_500 : OCaml_500.types ocaml_version = (module OCaml_500)
+module OCaml_501 = struct
+  module Ast = Astlib.Ast_501
+  include Make_witness(Astlib.Ast_501)
+  let version = 501
+  let string_version = "5.1"
+end
+let ocaml_501 : OCaml_501.types ocaml_version = (module OCaml_501)
+module OCaml_502 = struct
+  module Ast = Astlib.Ast_502
+  include Make_witness(Astlib.Ast_502)
+  let version = 502
+  let string_version = "5.2"
+end
+let ocaml_502 : OCaml_502.types ocaml_version = (module OCaml_502)
+module OCaml_503 = struct
+  module Ast = Astlib.Ast_503
+  include Make_witness(Astlib.Ast_503)
+  let version = 503
+  let string_version = "5.3"
+end
+let ocaml_503 : OCaml_503.types ocaml_version = (module OCaml_503)
+module OCaml_504 = struct
+  module Ast = Astlib.Ast_504
+  include Make_witness(Astlib.Ast_504)
+  let version = 504
+  let string_version = "5.4"
+end
+let ocaml_504 : OCaml_504.types ocaml_version = (module OCaml_504)
+(*$*)
+
+let all_versions : (module OCaml_version) list = [
+  (*$foreach_version (fun n _ ->
+      printf "(module OCaml_%d : OCaml_version);\n" n)*)
+(module OCaml_408 : OCaml_version);
+(module OCaml_409 : OCaml_version);
+(module OCaml_410 : OCaml_version);
+(module OCaml_411 : OCaml_version);
+(module OCaml_412 : OCaml_version);
+(module OCaml_413 : OCaml_version);
+(module OCaml_414 : OCaml_version);
+(module OCaml_500 : OCaml_version);
+(module OCaml_501 : OCaml_version);
+(module OCaml_502 : OCaml_version);
+(module OCaml_503 : OCaml_version);
+(module OCaml_504 : OCaml_version);
+(*$*)
+]
+
+(*$foreach_version_pair (fun a b ->
+    printf "include Register_migration(OCaml_%d)(OCaml_%d)\n" a b;
+    printf "    (Astlib.Migrate_%d_%d)(Astlib.Migrate_%d_%d)\n" a b b a
+  )
+*)
+include Register_migration(OCaml_408)(OCaml_409)
+    (Astlib.Migrate_408_409)(Astlib.Migrate_409_408)
+include Register_migration(OCaml_409)(OCaml_410)
+    (Astlib.Migrate_409_410)(Astlib.Migrate_410_409)
+include Register_migration(OCaml_410)(OCaml_411)
+    (Astlib.Migrate_410_411)(Astlib.Migrate_411_410)
+include Register_migration(OCaml_411)(OCaml_412)
+    (Astlib.Migrate_411_412)(Astlib.Migrate_412_411)
+include Register_migration(OCaml_412)(OCaml_413)
+    (Astlib.Migrate_412_413)(Astlib.Migrate_413_412)
+include Register_migration(OCaml_413)(OCaml_414)
+    (Astlib.Migrate_413_414)(Astlib.Migrate_414_413)
+include Register_migration(OCaml_414)(OCaml_500)
+    (Astlib.Migrate_414_500)(Astlib.Migrate_500_414)
+include Register_migration(OCaml_500)(OCaml_501)
+    (Astlib.Migrate_500_501)(Astlib.Migrate_501_500)
+include Register_migration(OCaml_501)(OCaml_502)
+    (Astlib.Migrate_501_502)(Astlib.Migrate_502_501)
+include Register_migration(OCaml_502)(OCaml_503)
+    (Astlib.Migrate_502_503)(Astlib.Migrate_503_502)
+include Register_migration(OCaml_503)(OCaml_504)
+    (Astlib.Migrate_503_504)(Astlib.Migrate_504_503)
+(*$*)
+
+module OCaml_current = OCaml_OCAML_VERSION
+
+module Find_version = struct
+  type t = Impl of (module OCaml_version) | Intf of (module OCaml_version) | Unknown
+
+  let from_magic magic =
+    let rec loop = function
+      | [] -> Unknown
+      | (module Version : OCaml_version) :: tail ->
+          if Version.Ast.Config.ast_impl_magic_number = magic then
+            Impl (module Version)
+          else if Version.Ast.Config.ast_intf_magic_number = magic then
+            Intf (module Version)
+          else
+            loop tail
+    in
+    (* Traverse the versions from last to first:
+       if the magic numbers aren't unique among versions,
+       we want the latest version with a magic number match.
+       The situation in mind is trunk support. *)
+      let all_versions_top_down = List.rev all_versions in
+      loop all_versions_top_down
+end

unikernel/duniverse/ppxlib/ast/versions.mli

@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                         OCaml Migrate Parsetree                        *)
+(*                                                                        *)
+(*                             Frédéric Bour                              *)
+(*                   Jérémie Dimino, Jane Street Europe                   *)
+(*                                                                        *)
+(*   Copyright 2017 Institut National de Recherche en Informatique et     *)
+(*     en Automatique (INRIA).                                            *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(*$ open Ast_cinaps_helpers $*)
+
+(** {1 Abstracting an OCaml frontend} *)
+
+(** Abstract view of a version of an OCaml Ast *)
+module type Ast = sig
+  (*$ foreach_module (fun m types ->
+      printf "  module %s : sig\n" m;
+      List.iter types ~f:(printf "    type %s\n");
+      printf "  end\n"
+    )
+  *)
+  module Parsetree : sig
+    type structure
+    type signature
+    type toplevel_phrase
+    type core_type
+    type expression
+    type pattern
+    type case
+    type type_declaration
+    type type_extension
+    type extension_constructor
+    type class_expr
+    type class_field
+    type class_type
+    type class_signature
+    type class_type_field
+    type module_expr
+    type module_type
+    type signature_item
+    type structure_item
+  end
+(*$*)
+  module Config : sig
+    val ast_impl_magic_number : string
+    val ast_intf_magic_number : string
+  end
+end
+
+(* Shortcuts for talking about ast types outside of the module language *)
+
+type 'a _types = 'a constraint 'a
+  = <
+    (*$ foreach_type (fun _ s -> printf "    %-21s : _;\n" s) *)
+    structure             : _;
+    signature             : _;
+    toplevel_phrase       : _;
+    core_type             : _;
+    expression            : _;
+    pattern               : _;
+    case                  : _;
+    type_declaration      : _;
+    type_extension        : _;
+    extension_constructor : _;
+    class_expr            : _;
+    class_field           : _;
+    class_type            : _;
+    class_signature       : _;
+    class_type_field      : _;
+    module_expr           : _;
+    module_type           : _;
+    signature_item        : _;
+    structure_item        : _;
+(*$*)
+  >
+;;
+
+(** A version of the OCaml frontend packs the ast with type witnesses
+    so that equalities can be recovered dynamically. *)
+type _ witnesses (*IF_AT_LEAST 406 = private ..*)
+
+(** [migration_info] is an opaque type that is used to generate migration
+    functions. *)
+type _ migration_info
+
+(** An OCaml frontend versions an Ast, version number and some witnesses for
+    conversion. *)
+module type OCaml_version = sig
+
+  (** Ast definition for this version *)
+  module Ast : Ast
+
+  (* Version number as an integer, 402, 403, 404, ... *)
+  val version : int
+
+  (* Version number as a user-friendly string *)
+  val string_version : string (* 4.02, 4.03, 4.04, ... *)
+
+  (** Shortcut for talking about Ast types *)
+  type types = <
+    (*$ foreach_type (fun m s -> printf "    %-21s : Ast.%s.%s;\n" s m s) *)
+    structure             : Ast.Parsetree.structure;
+    signature             : Ast.Parsetree.signature;
+    toplevel_phrase       : Ast.Parsetree.toplevel_phrase;
+    core_type             : Ast.Parsetree.core_type;
+    expression            : Ast.Parsetree.expression;
+    pattern               : Ast.Parsetree.pattern;
+    case                  : Ast.Parsetree.case;
+    type_declaration      : Ast.Parsetree.type_declaration;
+    type_extension        : Ast.Parsetree.type_extension;
+    extension_constructor : Ast.Parsetree.extension_constructor;
+    class_expr            : Ast.Parsetree.class_expr;
+    class_field           : Ast.Parsetree.class_field;
+    class_type            : Ast.Parsetree.class_type;
+    class_signature       : Ast.Parsetree.class_signature;
+    class_type_field      : Ast.Parsetree.class_type_field;
+    module_expr           : Ast.Parsetree.module_expr;
+    module_type           : Ast.Parsetree.module_type;
+    signature_item        : Ast.Parsetree.signature_item;
+    structure_item        : Ast.Parsetree.structure_item;
+(*$*)
+  > _types
+
+  (** A construtor for recovering type equalities between two arbitrary
+      versions. *)
+  type _ witnesses += Version : types witnesses
+
+  (** Information used to derive migration functions, see below *)
+  val migration_info : types migration_info
+end
+
+(** {1 Concrete frontend instances} *)
+
+(*$foreach_version (fun n _ ->
+    printf "module OCaml_%d : OCaml_version with module Ast = Astlib.Ast_%d\n"
+      n n
+  )*)
+module OCaml_408 : OCaml_version with module Ast = Astlib.Ast_408
+module OCaml_409 : OCaml_version with module Ast = Astlib.Ast_409
+module OCaml_410 : OCaml_version with module Ast = Astlib.Ast_410
+module OCaml_411 : OCaml_version with module Ast = Astlib.Ast_411
+module OCaml_412 : OCaml_version with module Ast = Astlib.Ast_412
+module OCaml_413 : OCaml_version with module Ast = Astlib.Ast_413
+module OCaml_414 : OCaml_version with module Ast = Astlib.Ast_414
+module OCaml_500 : OCaml_version with module Ast = Astlib.Ast_500
+module OCaml_501 : OCaml_version with module Ast = Astlib.Ast_501
+module OCaml_502 : OCaml_version with module Ast = Astlib.Ast_502
+module OCaml_503 : OCaml_version with module Ast = Astlib.Ast_503
+module OCaml_504 : OCaml_version with module Ast = Astlib.Ast_504
+(*$*)
+
+(* An alias to the current compiler version *)
+module OCaml_current = OCaml_OCAML_VERSION
+
+(* The list of all supported versions *)
+val all_versions : (module OCaml_version) list
+
+(** {1 Convenience definitions} *)
+
+(** Module level migration *)
+module Convert (A : OCaml_version) (B : OCaml_version) : sig
+  (*$ foreach_type (fun m s ->
+      let fq = sprintf "%s.%s" m s in
+      printf "  val copy_%-21s : A.Ast.%-31s -> B.Ast.%s\n" s fq fq) *)
+  val copy_structure             : A.Ast.Parsetree.structure             -> B.Ast.Parsetree.structure
+  val copy_signature             : A.Ast.Parsetree.signature             -> B.Ast.Parsetree.signature
+  val copy_toplevel_phrase       : A.Ast.Parsetree.toplevel_phrase       -> B.Ast.Parsetree.toplevel_phrase
+  val copy_core_type             : A.Ast.Parsetree.core_type             -> B.Ast.Parsetree.core_type
+  val copy_expression            : A.Ast.Parsetree.expression            -> B.Ast.Parsetree.expression
+  val copy_pattern               : A.Ast.Parsetree.pattern               -> B.Ast.Parsetree.pattern
+  val copy_case                  : A.Ast.Parsetree.case                  -> B.Ast.Parsetree.case
+  val copy_type_declaration      : A.Ast.Parsetree.type_declaration      -> B.Ast.Parsetree.type_declaration
+  val copy_type_extension        : A.Ast.Parsetree.type_extension        -> B.Ast.Parsetree.type_extension
+  val copy_extension_constructor : A.Ast.Parsetree.extension_constructor -> B.Ast.Parsetree.extension_constructor
+  val copy_class_expr            : A.Ast.Parsetree.class_expr            -> B.Ast.Parsetree.class_expr
+  val copy_class_field           : A.Ast.Parsetree.class_field           -> B.Ast.Parsetree.class_field
+  val copy_class_type            : A.Ast.Parsetree.class_type            -> B.Ast.Parsetree.class_type
+  val copy_class_signature       : A.Ast.Parsetree.class_signature       -> B.Ast.Parsetree.class_signature
+  val copy_class_type_field      : A.Ast.Parsetree.class_type_field      -> B.Ast.Parsetree.class_type_field
+  val copy_module_expr           : A.Ast.Parsetree.module_expr           -> B.Ast.Parsetree.module_expr
+  val copy_module_type           : A.Ast.Parsetree.module_type           -> B.Ast.Parsetree.module_type
+  val copy_signature_item        : A.Ast.Parsetree.signature_item        -> B.Ast.Parsetree.signature_item
+  val copy_structure_item        : A.Ast.Parsetree.structure_item        -> B.Ast.Parsetree.structure_item
+(*$*)
+end
+
+(** Helper to find the frontend corresponding to a given magic number *)
+module Find_version : sig
+  type t = Impl of (module OCaml_version) | Intf of (module OCaml_version) | Unknown
+
+  val from_magic : string -> t
+end

unikernel/duniverse/ppxlib/ast/warn.ml

@@ -0,0 +1,6 @@
+open! Import
+
+let default_print_warning _loc = ()
+let about_ite_branch_ref = ref default_print_warning
+let care_about_ite_branch = ref false
+let about_ite_branch loc = !about_ite_branch_ref loc

unikernel/duniverse/ppxlib/ast/warn.mli

@@ -0,0 +1,10 @@
+open Import
+
+val care_about_ite_branch : bool ref
+(** Ignored -- kept for compatibility. *)
+
+val about_ite_branch_ref : (Location.t -> unit) ref
+(** Ignored -- kept for compatibility. *)
+
+val about_ite_branch : Location.t -> unit
+(** Ignored -- kept for compatibility. *)