unikernel/duniverse/ppxlib/astlib/ast_500.ml

@@ -0,0 +1,14 @@
+(* The only difference between 4.14 and 5.0 from a Parsetree point of view are the magic numbers *)
+
+module Asttypes = struct
+  include Ast_414.Asttypes
+end
+
+module Parsetree = struct
+  include Ast_414.Parsetree
+end
+
+module Config = struct
+  let ast_impl_magic_number = "Caml1999M032"
+  let ast_intf_magic_number = "Caml1999N032"
+end

unikernel/duniverse/ppxlib/astlib/ast_metadata.ml

@@ -0,0 +1 @@
+include Ocaml_common.Ast_mapper

unikernel/duniverse/ppxlib/astlib/ast_metadata.mli

@@ -0,0 +1,40 @@
+(** Meta data related interface for a ppx rewriter *)
+
+val add_ppx_context_str :
+  tool_name:string ->
+  Parsetree.structure_item list ->
+  Parsetree.structure_item list
+(** Extract information from the current environment and encode it into an
+    attribute which is prepended to the list of structure items in order to pass
+    the information to an external processor. *)
+
+val drop_ppx_context_str :
+  restore:bool -> Parsetree.structure_item list -> Parsetree.structure_item list
+(** Drop the ocaml.ppx.context attribute from a structure. If [restore] is true,
+    also restore the associated data in the current process. *)
+
+val add_ppx_context_sig :
+  tool_name:string ->
+  Parsetree.signature_item list ->
+  Parsetree.signature_item list
+(** Same as [add_ppx_context_str], but for signatures. *)
+
+val drop_ppx_context_sig :
+  restore:bool -> Parsetree.signature_item list -> Parsetree.signature_item list
+(** Same as [drop_ppx_context_str], but for signatures. *)
+
+val tool_name : unit -> string
+(** Can be used within a ppx preprocessor to know which tool is calling it
+    ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], ["ocaml"], ... *)
+
+(** {1 Cookies} *)
+
+(** Cookies are used to pass information from a ppx processor to a further
+    invocation of itself, when called from the OCaml toplevel (or other tools
+    that support cookies). *)
+
+val set_cookie : string -> Parsetree.expression -> unit
+(* [set_cookie name expr] registers a cookie with name [name] and value [expr]. *)
+
+val get_cookie : string -> Parsetree.expression option
+(* Returns the registered cookie with name [name], if any. *)

unikernel/duniverse/ppxlib/astlib/astlib.ml

@@ -0,0 +1,97 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                         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 Astlib_cinaps_helpers
+    open Printf $*)
+
+(* Copy of OCaml parsetrees *)
+(*$
+  foreach_version (fun suffix _ ->
+      printf "module Ast_%s = Ast_%s\n" suffix suffix)
+*)
+module Ast_408 = Ast_408
+module Ast_409 = Ast_409
+module Ast_410 = Ast_410
+module Ast_411 = Ast_411
+module Ast_412 = Ast_412
+module Ast_413 = Ast_413
+module Ast_414 = Ast_414
+module Ast_500 = Ast_500
+module Ast_501 = Ast_501
+module Ast_502 = Ast_502
+module Ast_503 = Ast_503
+module Ast_504 = Ast_504
+(*$*)
+
+(* Manual migration between versions *)
+(*$
+  foreach_version_pair (fun x y ->
+      printf "module Migrate_%s_%s = Migrate_%s_%s\n" x y x y;
+      printf "module Migrate_%s_%s = Migrate_%s_%s\n" y x y x)
+*)
+module Migrate_408_409 = Migrate_408_409
+module Migrate_409_408 = Migrate_409_408
+module Migrate_409_410 = Migrate_409_410
+module Migrate_410_409 = Migrate_410_409
+module Migrate_410_411 = Migrate_410_411
+module Migrate_411_410 = Migrate_411_410
+module Migrate_411_412 = Migrate_411_412
+module Migrate_412_411 = Migrate_412_411
+module Migrate_412_413 = Migrate_412_413
+module Migrate_413_412 = Migrate_413_412
+module Migrate_413_414 = Migrate_413_414
+module Migrate_414_413 = Migrate_414_413
+module Migrate_414_500 = Migrate_414_500
+module Migrate_500_414 = Migrate_500_414
+module Migrate_500_501 = Migrate_500_501
+module Migrate_501_500 = Migrate_501_500
+module Migrate_501_502 = Migrate_501_502
+module Migrate_502_501 = Migrate_502_501
+module Migrate_502_503 = Migrate_502_503
+module Migrate_503_502 = Migrate_503_502
+module Migrate_503_504 = Migrate_503_504
+module Migrate_504_503 = Migrate_504_503
+(*$*)
+
+(* Compiler modules *)
+module Ast_metadata = Ast_metadata
+module Config = Config
+module Keyword = Keyword
+module Location = Location
+module Longident = Longident
+module Parse = Parse
+module Pprintast = Pprintast
+module Compiler_pprintast = struct
+  include Ocaml_common.Pprintast
+
+  let structure_item fmt t = structure fmt [t]
+  let signature_item fmt t = signature fmt [t]
+
+  exception Unavailable
+
+  (*IF_NOT_AT_LEAST 414 let class_field _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_type_field _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_expr _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let class_type _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let module_type _fmt _t = raise Unavailable *)
+  (*IF_NOT_AT_LEAST 414 let module_expr _fmt _t = raise Unavailable *)
+end
+
+module Clean = Clean
+
+let init_error_reporting_style_using_env_vars () =
+  Ocaml_common.Compmisc.read_clflags_from_env ()
+(** Adjust the reporting style of error messages to the environment variables OCAML_COLOR and OCAML_ERROR_STYLE. *)

unikernel/duniverse/ppxlib/astlib/cinaps/astlib_cinaps_helpers.ml

@@ -0,0 +1,70 @@
+(* -*- tuareg -*- *)
+
+open StdLabels
+open Printf
+
+let nl () = printf "\n"
+
+let supported_versions =
+  [
+    ("408", "4.08");
+    ("409", "4.09");
+    ("410", "4.10");
+    ("411", "4.11");
+    ("412", "4.12");
+    ("413", "4.13");
+    ("414", "4.14");
+    ("500", "5.00");
+    ("501", "5.01");
+    ("502", "5.02");
+    ("503", "5.03");
+    ("504", "5.04");
+  ]
+
+let foreach_version f =
+  nl ();
+  List.iter supported_versions ~f:(fun (suffix, version) -> f suffix version)
+
+let foreach_version_pair f =
+  nl ();
+  let rec aux = function
+    | (x, _) :: ((y, _) :: _ as tail) ->
+        f x y;
+        aux tail
+    | [ _ ] | [] -> ()
+  in
+  aux supported_versions
+
+(* Just for 4.14 <-> 5.00, mostly used by [ast_cinaps_helpers] *)
+
+let qualified_types =
+  [
+    ( "Parsetree",
+      [
+        "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";
+      ] );
+  ]
+
+let foreach_module f =
+  nl ();
+  List.iter qualified_types ~f:(fun (m, types) -> f m types)
+
+let foreach_type f = foreach_module (fun m -> List.iter ~f:(f m))

unikernel/duniverse/ppxlib/astlib/cinaps/dune

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

unikernel/duniverse/ppxlib/astlib/clean.ml

@@ -0,0 +1,19 @@
+let remove_ppxlib_migration_from_ast_mapper =
+  let should_keep_attribute (a : Parsetree.attribute) =
+    not (Stdlib0.String.is_prefix ~prefix:"ppxlib.migration" a.attr_name.txt)
+  in
+  let mapper =
+    {
+      Ast_mapper.default_mapper with
+      attributes = (fun _ -> List.filter should_keep_attribute);
+    }
+  in
+  mapper
+
+let remove_migration_attributes_from_str =
+  remove_ppxlib_migration_from_ast_mapper.structure
+    remove_ppxlib_migration_from_ast_mapper
+
+let remove_migration_attributes_from_sig =
+  remove_ppxlib_migration_from_ast_mapper.signature
+    remove_ppxlib_migration_from_ast_mapper

unikernel/duniverse/ppxlib/astlib/clean.mli

@@ -0,0 +1,10 @@
+val remove_migration_attributes_from_str :
+  Parsetree.structure -> Parsetree.structure
+(** [remove_migration_attributes_from_str str] removes any left-over metadata
+    that be in the parsetree after a migration. Most users will not have to
+    worry about applying this function.*)
+
+val remove_migration_attributes_from_sig :
+  Parsetree.signature -> Parsetree.signature
+(** The same as {! remove_migration_attributes_from_str} except for
+    {! Parsetree.signature}. *)

unikernel/duniverse/ppxlib/astlib/config.ml

@@ -0,0 +1 @@
+include Ocaml_common.Config

unikernel/duniverse/ppxlib/astlib/config.mli

@@ -0,0 +1,7 @@
+(** Magic numbers *)
+
+val ast_intf_magic_number : string
+(** Magic number for file holding an interface syntax tree *)
+
+val ast_impl_magic_number : string
+(** Magic number for file holding an implementation syntax tree *)

unikernel/duniverse/ppxlib/astlib/config/gen.ml

@@ -0,0 +1,29 @@
+let write fn s =
+  let oc = open_out fn in
+  output_string oc s;
+  close_out oc
+
+let () =
+  let ocaml_version_str = Sys.argv.(1) in
+  let ocaml_version =
+    Scanf.sscanf ocaml_version_str "%u.%u" (fun a b -> (a, b))
+  in
+  write "ast-version"
+    (match ocaml_version with
+    | 4, 08 -> "408"
+    | 4, 09 -> "409"
+    | 4, 10 -> "410"
+    | 4, 11 -> "411"
+    | 4, 12 -> "412"
+    | 4, 13 -> "413"
+    | 4, 14 -> "414"
+    | 5, 0 ->
+        "414"
+        (* Ast_500 aliases Ast_414, since the AST hasn't changed between those two *)
+    | 5, 1 -> "501"
+    | 5, 2 -> "502"
+    | 5, 3 -> "503"
+    | 5, 4 -> "504"
+    | _ ->
+        Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str;
+        exit 1)

unikernel/duniverse/ppxlib/astlib/dune

@@ -0,0 +1,17 @@
+(library
+ (name astlib)
+ (public_name ppxlib.astlib)
+ (libraries ocaml-compiler-libs.common compiler-libs.common)
+ (flags -w -9)
+ (preprocess
+  (action
+   (run %{exe:pp/pp.exe} %{read:ast-version} %{input-file}))))
+
+(rule
+ (targets ast-version)
+ (action
+  (run %{ocaml} %{dep:config/gen.ml} %{ocaml_version})))
+
+(cinaps
+ (files *.ml *.mli)
+ (libraries astlib_cinaps_helpers))

unikernel/duniverse/ppxlib/astlib/keyword.ml

@@ -0,0 +1,99 @@
+let is_keyword = function
+  | "and" -> true
+  | "as" -> true
+  | "assert" -> true
+  | "begin" -> true
+  | "class" -> true
+  | "constraint" -> true
+  | "do" -> true
+  | "done" -> true
+  | "downto" -> true
+  | "else" -> true
+  | "end" -> true
+  | "exception" -> true
+  | "external" -> true
+  | "false" -> true
+  | "for" -> true
+  | "fun" -> true
+  | "function" -> true
+  | "functor" -> true
+  | "if" -> true
+  | "in" -> true
+  | "include" -> true
+  | "inherit" -> true
+  | "initializer" -> true
+  | "lazy" -> true
+  | "let" -> true
+  | "match" -> true
+  | "method" -> true
+  | "module" -> true
+  | "mutable" -> true
+  | "new" -> true
+  | "nonrec" -> true
+  | "object" -> true
+  | "of" -> true
+  | "open" -> true
+  | "or" -> true
+  (* | "parser" -> true *)
+  | "private" -> true
+  | "rec" -> true
+  | "sig" -> true
+  | "struct" -> true
+  | "then" -> true
+  | "to" -> true
+  | "true" -> true
+  | "try" -> true
+  | "type" -> true
+  | "val" -> true
+  | "virtual" -> true
+  | "when" -> true
+  | "while" -> true
+  | "with" -> true
+  | "lor" -> true
+  | "lxor" -> true
+  | "mod" -> true
+  | "land" -> true
+  | "lsl" -> true
+  | "lsr" -> true
+  | "asr" -> true
+  | _ -> false
+
+let apply_keyword_edition ~cli () =
+  let from_ocaml_param =
+    match Sys.getenv "OCAMLPARAM" with
+    | s -> (
+        let items =
+          if String.equal s "" then []
+          else
+            (* cf. Compenv.parse_args *)
+            match s.[0] with
+            | (':' | '|' | ';' | ' ' | ',') as c ->
+                List.tl (String.split_on_char c s)
+            | _ -> String.split_on_char ',' s
+        in
+        let fold_settings (acc, after_cli) item =
+          match (item, acc) with
+          | "_", None -> (acc, true)
+          | _ ->
+              let len = String.length item in
+              if len >= 9 && String.sub item 0 9 = "keywords=" then
+                (Some (String.sub item 9 (len - 9)), after_cli)
+              else (acc, after_cli)
+        in
+        let from_ocaml_param, after_cli =
+          List.fold_left fold_settings (None, false) items
+        in
+        match from_ocaml_param with
+        | None -> None
+        | Some s -> Some (s, after_cli))
+    | exception Not_found -> None
+  in
+  let keyword_edition =
+    match (cli, from_ocaml_param) with
+    | None, None -> None
+    | None, Some (s, _) | Some _, Some (s, true) -> Some s
+    | _ -> cli
+  in
+  (*IF_AT_LEAST 503 let () = if Option.is_some keyword_edition then Clflags.keyword_edition := keyword_edition in*)
+  (*IF_NOT_AT_LEAST 503 let () = ignore keyword_edition in*)
+  ()

unikernel/duniverse/ppxlib/astlib/keyword.mli

@@ -0,0 +1,7 @@
+val is_keyword : string -> bool
+(** Check if a string is an OCaml keyword. *)
+
+val apply_keyword_edition : cli:string option -> unit -> unit
+(** Processes any keywords= sections from the OCAMLPARAM environment variable
+    and CLI option and initialises the compiler's lexer with the correct keyword
+    set. *)

unikernel/duniverse/ppxlib/astlib/location.ml

@@ -0,0 +1,84 @@
+include Ocaml_common.Location
+
+let set_input_name name = input_name := name
+let set_input_lexbuf lexbuf_opt = input_lexbuf := lexbuf_opt
+
+module Error = struct
+  [@@@warning "-37"]
+
+  type old_t (*IF_NOT_AT_LEAST 408 = Ocaml_common.Location.error *) = {
+    loc: t;
+    msg: string;
+    sub: old_t list;
+    if_highlight: string;
+  }
+
+  type location_report_kind = Ocaml_common.Location.report_kind =
+  | Report_error
+  | Report_warning of string
+  | Report_warning_as_error of string
+  | Report_alert of string
+  | Report_alert_as_error of string
+
+  type location_msg =
+    (*IF_AT_LEAST 503 Ocaml_common.Format_doc.t loc *)
+    (*IF_NOT_AT_LEAST 503 (Format.formatter -> unit) loc *)
+
+  type location_report = Ocaml_common.Location.report = {
+    kind : location_report_kind;
+    main : location_msg;
+    sub : location_msg list;
+    (*IF_AT_LEAST 503 footnote: Format_doc.t option; *)
+  }
+
+  type t = Ocaml_common.Location.error
+
+  let is_well_formed error =
+    match error with
+    | { kind = Report_error; _ } -> true
+    | _ -> false
+
+  let string_of_location_msg (msg : location_msg) =
+     (*IF_AT_LEAST 503 Format.asprintf "%a" Ocaml_common.Format_doc.Doc.format msg.txt *)
+     (*IF_NOT_AT_LEAST 503 Format.asprintf "%t" msg.txt *)
+
+  let main_msg { main; _ } =
+    { txt = string_of_location_msg main; loc = main.loc }
+
+  let sub_msgs { sub; _ } =
+    List.map
+      (fun err -> { txt = string_of_location_msg err; loc = err.loc })
+      sub
+
+  let of_exn exn =
+    match error_of_exn exn with
+    | Some (`Ok e) -> Some e
+    | None | Some `Already_displayed -> None
+
+  let set_main_msg error msg =
+    (*IF_AT_LEAST 503 let txt = Ocaml_common.Format_doc.Doc.msg "%s" msg in *)
+    (*IF_NOT_AT_LEAST 503 let txt ppf = Format.pp_print_string ppf msg in *)
+    let main = { error.main with txt } in
+    { error with main }
+
+  let make ~sub { loc; txt } =
+    (*IF_AT_LEAST 503 let mk_txt x = Ocaml_common.Format_doc.Doc.msg "%s" x in *)
+    (*IF_NOT_AT_LEAST 503 let mk_txt x ppf = Format.pp_print_string ppf x in *)
+    let mk loc x = { loc; txt = mk_txt x } in
+    {
+      kind = Report_error;
+      main = mk loc txt;
+      sub = List.map (fun { loc; txt } -> mk loc txt) sub;
+      (*IF_AT_LEAST 503 footnote = None; *)
+    }
+
+  let set_main_loc error loc =
+    let main = { error.main with loc } in
+    { error with main }
+end
+
+let raise_errorf ?loc msg =
+  (* Update from [kasprintf] to [kdprintf] + [Format_doc.deprecated_printer]
+     when ocaml lower bound is 4.08+ *)
+  (*IF_AT_LEAST 503 Format.kdprintf (fun pr -> raise_errorf ?loc "%t" (Format_doc.deprecated_printer pr)) msg *)
+  (*IF_NOT_AT_LEAST 503 raise_errorf ?loc msg *)

unikernel/duniverse/ppxlib/astlib/location.mli

@@ -0,0 +1,71 @@
+(** Source code locations (ranges of positions), used in parsetrees *)
+
+type t = Ocaml_common.Location.t = {
+  loc_start : Lexing.position;
+  loc_end : Lexing.position;
+  loc_ghost : bool;
+}
+(** The location type *)
+
+type 'a loc = 'a Ocaml_common.Location.loc = { txt : 'a; loc : t }
+(** A located type *)
+
+module Error : sig
+  type location
+
+  type t
+  (** The location error type. It contains a located main message and a
+      (possibly empty) list of located submessages. *)
+
+  val is_well_formed : t -> bool
+  (** A location error constructed via [make] is always well-formed. A malformed
+      location error is a value of type [location_report] on compilers >= 4.08,
+      whose [kind] is different from [Report_error]. Notice that
+      [location_report] does not explicitly form part of Astlib. *)
+
+  val main_msg : t -> string loc
+  (** Get the located error main message. *)
+
+  val sub_msgs : t -> string loc list
+  (** Get the located error sub-messages. *)
+
+  val set_main_msg : t -> string -> t
+  (** Set the text of the error's main message. The location stays as is. *)
+
+  val set_main_loc : t -> location -> t
+  (** Set the location of the error's main message. The text satys as is. *)
+
+  val make : sub:string loc list -> string loc -> t
+  (** Construct a location error. *)
+
+  val of_exn : exn -> t option
+  (** Turn an exception into a location error, if possible. *)
+end
+with type location := t
+
+val set_input_name : string -> unit
+(** Set the name of the input source, e.g. the file name. *)
+
+val set_input_lexbuf : Lexing.lexbuf option -> unit
+(** Set the name of the input source, e.g. the file name. *)
+
+val none : t
+(** An arbitrary value of type [t]; describes an empty ghost range. *)
+
+(** {1 Automatically reporting errors for raised exceptions} *)
+
+val register_error_of_exn : (exn -> Error.t option) -> unit
+(** Each compiler module which defines a custom type of exception which can
+    surface as a user-visible error should register a "printer" for this
+    exception using [register_error_of_exn]. The result of the printer is an
+    [error] value containing a location, a message, and optionally sub-messages
+    (each of them being located as well). *)
+
+exception Error of Error.t
+(** Located exception. *)
+
+val raise_errorf : ?loc:t -> ('a, Format.formatter, unit, 'b) format4 -> 'a
+(** Raise a located exception. *)
+
+val report_exception : Format.formatter -> exn -> unit
+(** Report an exception on the given formatter *)

unikernel/duniverse/ppxlib/astlib/longident.ml

@@ -0,0 +1,56 @@
+type t =
+  (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *)
+  | Lident of string
+  | Ldot of t * string
+  | Lapply of t * t
+
+let rec flat accu = function
+  | Lident s -> s :: accu
+  | Ldot (lid, s) -> flat (s :: accu) lid
+  | Lapply (_, _) -> Misc.fatal_error "Longident.flat"
+
+let flatten lid = flat [] lid
+
+let rec split_at_dots s pos =
+  try
+    let dot = String.index_from s pos '.' in
+    String.sub s pos (dot - pos) :: split_at_dots s (dot + 1)
+  with Not_found -> [ String.sub s pos (String.length s - pos) ]
+
+let unflatten l =
+  match l with
+  | [] -> None
+  | hd :: tl -> Some (List.fold_left (fun p s -> Ldot (p, s)) (Lident hd) tl)
+
+let parse s =
+  match unflatten (split_at_dots s 0) with
+  | None ->
+      Lident ""
+      (* should not happen, but don't put assert false
+                          so as not to crash the toplevel (see Genprintval) *)
+  | Some v -> v
+
+let rec to_504_plus lid =
+  let loc = Location.none in
+  match lid with
+  | Lident s -> Longident_504.Lident s
+  | Ldot (lid, s) ->
+    Longident_504.Ldot ({txt = to_504_plus lid; loc}, { txt = s; loc})
+  | Lapply (lid, lid2) ->
+    Longident_504.Lapply
+      ({txt = to_504_plus lid; loc}, {txt= to_504_plus lid2; loc})
+
+let rec from_504_plus lid =
+  match lid with
+  | Longident_504.Lident s -> Lident s
+  | Longident_504.Ldot (lid, s) -> Ldot (from_504_plus lid.txt, s.txt)
+  | Longident_504.Lapply (lid, lid2) ->
+    Lapply (from_504_plus lid.txt, from_504_plus lid2.txt)
+
+let to_compiler lid =
+  (*IF_NOT_AT_LEAST 504 lid *)
+  (*IF_AT_LEAST 504 to_504_plus lid *)
+
+let from_compiler lid =
+  (*IF_NOT_AT_LEAST 504 lid *)
+  (*IF_AT_LEAST 504 from_504_plus lid *)

unikernel/duniverse/ppxlib/astlib/longident.mli

@@ -0,0 +1,19 @@
+(** Long identifiers, used in parsetrees. *)
+
+(** The long identifier type *)
+type t =
+  (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *)
+  | Lident of string
+  | Ldot of t * string
+  | Lapply of t * t
+
+val flatten : t -> string list
+(** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting
+    [Lapply].*)
+
+val parse : string -> t
+(** Parse a string into a long identifier built upon [Lident] and [Ldot]. *)
+
+val to_compiler : t -> Ocaml_common.Longident.t
+
+val from_compiler : Ocaml_common.Longident.t -> t

unikernel/duniverse/ppxlib/astlib/longident_504.ml

@@ -0,0 +1,5 @@
+type t =
+  (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *)
+  | Lident of string
+  | Ldot of t Location.loc * string Location.loc
+  | Lapply of t Location.loc * t Location.loc

unikernel/duniverse/ppxlib/astlib/longident_504.mli

@@ -0,0 +1,5 @@
+type t =
+  (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *)
+  | Lident of string
+  | Ldot of t Location.loc * string Location.loc
+  | Lapply of t Location.loc * t Location.loc

unikernel/duniverse/ppxlib/astlib/migrate_414_500.ml

@@ -0,0 +1,90 @@
+module From = Ast_414
+module To = Ast_500
+
+(*$ open Astlib_cinaps_helpers $*)
+
+(*$ foreach_type (fun _ s ->
+      Printf.printf
+        "let copy_%s\n\
+        \  : Ast_414.Parsetree.%s -> Ast_500.Parsetree.%s\n\
+        \  = fun x -> x\n\n"
+        s s s
+  )
+*)
+let copy_structure
+  : Ast_414.Parsetree.structure -> Ast_500.Parsetree.structure
+  = fun x -> x
+
+let copy_signature
+  : Ast_414.Parsetree.signature -> Ast_500.Parsetree.signature
+  = fun x -> x
+
+let copy_toplevel_phrase
+  : Ast_414.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase
+  = fun x -> x
+
+let copy_core_type
+  : Ast_414.Parsetree.core_type -> Ast_500.Parsetree.core_type
+  = fun x -> x
+
+let copy_expression
+  : Ast_414.Parsetree.expression -> Ast_500.Parsetree.expression
+  = fun x -> x
+
+let copy_pattern
+  : Ast_414.Parsetree.pattern -> Ast_500.Parsetree.pattern
+  = fun x -> x
+
+let copy_case
+  : Ast_414.Parsetree.case -> Ast_500.Parsetree.case
+  = fun x -> x
+
+let copy_type_declaration
+  : Ast_414.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration
+  = fun x -> x
+
+let copy_type_extension
+  : Ast_414.Parsetree.type_extension -> Ast_500.Parsetree.type_extension
+  = fun x -> x
+
+let copy_extension_constructor
+  : Ast_414.Parsetree.extension_constructor -> Ast_500.Parsetree.extension_constructor
+  = fun x -> x
+
+let copy_class_expr
+  : Ast_414.Parsetree.class_expr -> Ast_500.Parsetree.class_expr
+  = fun x -> x
+
+let copy_class_field
+  : Ast_414.Parsetree.class_field -> Ast_500.Parsetree.class_field
+  = fun x -> x
+
+let copy_class_type
+  : Ast_414.Parsetree.class_type -> Ast_500.Parsetree.class_type
+  = fun x -> x
+
+let copy_class_signature
+  : Ast_414.Parsetree.class_signature -> Ast_500.Parsetree.class_signature
+  = fun x -> x
+
+let copy_class_type_field
+  : Ast_414.Parsetree.class_type_field -> Ast_500.Parsetree.class_type_field
+  = fun x -> x
+
+let copy_module_expr
+  : Ast_414.Parsetree.module_expr -> Ast_500.Parsetree.module_expr
+  = fun x -> x
+
+let copy_module_type
+  : Ast_414.Parsetree.module_type -> Ast_500.Parsetree.module_type
+  = fun x -> x
+
+let copy_signature_item
+  : Ast_414.Parsetree.signature_item -> Ast_500.Parsetree.signature_item
+  = fun x -> x
+
+let copy_structure_item
+  : Ast_414.Parsetree.structure_item -> Ast_500.Parsetree.structure_item
+  = fun x -> x
+
+(*$*)

unikernel/duniverse/ppxlib/astlib/migrate_500_414.ml

@@ -0,0 +1,90 @@
+module From = Ast_500
+module To = Ast_414
+
+(*$ open Astlib_cinaps_helpers $*)
+
+(*$ foreach_type (fun _ s ->
+      Printf.printf
+        "let copy_%s\n\
+        \  : Ast_500.Parsetree.%s -> Ast_414.Parsetree.%s\n\
+        \  = fun x -> x\n\n"
+        s s s
+  )
+*)
+let copy_structure
+  : Ast_500.Parsetree.structure -> Ast_414.Parsetree.structure
+  = fun x -> x
+
+let copy_signature
+  : Ast_500.Parsetree.signature -> Ast_414.Parsetree.signature
+  = fun x -> x
+
+let copy_toplevel_phrase
+  : Ast_500.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase
+  = fun x -> x
+
+let copy_core_type
+  : Ast_500.Parsetree.core_type -> Ast_414.Parsetree.core_type
+  = fun x -> x
+
+let copy_expression
+  : Ast_500.Parsetree.expression -> Ast_414.Parsetree.expression
+  = fun x -> x
+
+let copy_pattern
+  : Ast_500.Parsetree.pattern -> Ast_414.Parsetree.pattern
+  = fun x -> x
+
+let copy_case
+  : Ast_500.Parsetree.case -> Ast_414.Parsetree.case
+  = fun x -> x
+
+let copy_type_declaration
+  : Ast_500.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration
+  = fun x -> x
+
+let copy_type_extension
+  : Ast_500.Parsetree.type_extension -> Ast_414.Parsetree.type_extension
+  = fun x -> x
+
+let copy_extension_constructor
+  : Ast_500.Parsetree.extension_constructor -> Ast_414.Parsetree.extension_constructor
+  = fun x -> x
+
+let copy_class_expr
+  : Ast_500.Parsetree.class_expr -> Ast_414.Parsetree.class_expr
+  = fun x -> x
+
+let copy_class_field
+  : Ast_500.Parsetree.class_field -> Ast_414.Parsetree.class_field
+  = fun x -> x
+
+let copy_class_type
+  : Ast_500.Parsetree.class_type -> Ast_414.Parsetree.class_type
+  = fun x -> x
+
+let copy_class_signature
+  : Ast_500.Parsetree.class_signature -> Ast_414.Parsetree.class_signature
+  = fun x -> x
+
+let copy_class_type_field
+  : Ast_500.Parsetree.class_type_field -> Ast_414.Parsetree.class_type_field
+  = fun x -> x
+
+let copy_module_expr
+  : Ast_500.Parsetree.module_expr -> Ast_414.Parsetree.module_expr
+  = fun x -> x
+
+let copy_module_type
+  : Ast_500.Parsetree.module_type -> Ast_414.Parsetree.module_type
+  = fun x -> x
+
+let copy_signature_item
+  : Ast_500.Parsetree.signature_item -> Ast_414.Parsetree.signature_item
+  = fun x -> x
+
+let copy_structure_item
+  : Ast_500.Parsetree.structure_item -> Ast_414.Parsetree.structure_item
+  = fun x -> x
+
+(*$*)

unikernel/duniverse/ppxlib/astlib/parse.ml

@@ -0,0 +1 @@
+include Ocaml_common.Parse

unikernel/duniverse/ppxlib/astlib/parse.mli

@@ -0,0 +1,22 @@
+(** Entry points in the parser *)
+
+val implementation : Lexing.lexbuf -> Parsetree.structure_item list
+(** Parse a structure *)
+
+val interface : Lexing.lexbuf -> Parsetree.signature_item list
+(** Parse a signature *)
+
+val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase
+(** Parse a toplevel phrase *)
+
+val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
+(** Parse a series of toplevel phrases *)
+
+val core_type : Lexing.lexbuf -> Parsetree.core_type
+(** Parse a core type *)
+
+val expression : Lexing.lexbuf -> Parsetree.expression
+(** Parse an expression *)
+
+val pattern : Lexing.lexbuf -> Parsetree.pattern
+(** Parse a pattern *)

unikernel/duniverse/ppxlib/astlib/pp/dune

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

unikernel/duniverse/ppxlib/astlib/pp/pp.ml

@@ -0,0 +1,12 @@
+let () =
+  match Sys.argv with
+  | [| _; ocaml_version; fname |] ->
+      let is_current =
+        Filename.basename fname = Printf.sprintf "ast_%s.ml" ocaml_version
+      in
+      let ic = open_in_bin fname in
+      Printf.printf "# 1 %S\n" fname;
+      Pp_rewrite.rewrite is_current ocaml_version (Lexing.from_channel ic)
+  | _ ->
+      Printf.eprintf "%s: <ocaml-version> <file-name>\n" Sys.executable_name;
+      exit 2

unikernel/duniverse/ppxlib/astlib/pp/pp.mli

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

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

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

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

@@ -0,0 +1,31 @@
+rule rewrite is_current ocaml_version = parse
+  |          "(*IF_CURRENT " ([^'*']* as s) "*)"
+    { let chunk = if is_current
+        then "             " ^ s ^          "  "
+        else Lexing.lexeme lexbuf
+      in
+      print_string chunk;
+      rewrite is_current 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 is_current ocaml_version lexbuf
+    }
+  |          "(*IF_NOT_AT_LEAST " ([^'*' ' ']* as v) " " (([^'*'] | '*' [^')'])* as s) "*)"
+    { let chunk = if not (v <= ocaml_version)
+        then "                  " ^ String.make (String.length v + 1) ' ' ^ s ^          "  "
+        else Lexing.lexeme lexbuf
+      in
+      print_string chunk;
+      rewrite is_current ocaml_version lexbuf
+    }
+  | _ as c
+    { print_char c;
+      rewrite is_current ocaml_version lexbuf
+    }
+  | eof { () }
+

unikernel/duniverse/ppxlib/astlib/pprintast.mli

@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Hongbo Zhang (University of Pennsylvania)                  *)
+(*                                                                        *)
+(*   Copyright 1996 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Ast_502
+
+type space_formatter = (unit, Format.formatter, unit) format
+
+val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
+val expression : Format.formatter -> Parsetree.expression -> unit
+val string_of_expression : Parsetree.expression -> string
+val top_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
+val core_type : Format.formatter -> Parsetree.core_type -> unit
+val pattern : Format.formatter -> Parsetree.pattern -> unit
+val signature : Format.formatter -> Parsetree.signature -> unit
+val structure : Format.formatter -> Parsetree.structure -> unit
+val string_of_structure : Parsetree.structure -> string
+val binding : Format.formatter -> Parsetree.value_binding -> unit
+val longident : Format.formatter -> Longident.t -> unit
+val payload : Format.formatter -> Parsetree.payload -> unit
+
+(* Added in the ppxlib copy *)
+val class_expr : Format.formatter -> Parsetree.class_expr -> unit
+val class_field : Format.formatter -> Parsetree.class_field -> unit
+val class_type : Format.formatter -> Parsetree.class_type -> unit
+val class_signature : Format.formatter -> Parsetree.class_signature -> unit
+val class_type_field : Format.formatter -> Parsetree.class_type_field -> unit
+val module_expr : Format.formatter -> Parsetree.module_expr -> unit
+val module_type : Format.formatter -> Parsetree.module_type -> unit
+val signature_item : Format.formatter -> Parsetree.signature_item -> unit
+val structure_item : Format.formatter -> Parsetree.structure_item -> unit
+val type_declaration : Format.formatter -> Parsetree.type_declaration -> unit

unikernel/duniverse/ppxlib/astlib/stdlib0.ml

@@ -0,0 +1,18 @@
+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
+
+module String = struct
+  let is_prefix t ~prefix =
+    let rec is_prefix_from t ~prefix ~pos ~len =
+      pos >= len
+      || Char.equal (String.get t pos) (String.get prefix pos)
+         && is_prefix_from t ~prefix ~pos:(pos + 1) ~len
+    in
+    String.length t >= String.length prefix
+    && is_prefix_from t ~prefix ~pos:0 ~len:(String.length prefix)
+end