Copy string_of_label in Asttypes

src/ocaml/parsing/asttypes.ml

@@ -0,0 +1,72 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Auxiliary AST types used by parsetree and typedtree.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type constant =
+    Const_int of int
+  | Const_char of char
+  | Const_string of string * Location.t * string option
+  | Const_float of string
+  | Const_int32 of int32
+  | Const_int64 of int64
+  | Const_nativeint of nativeint
+
+type rec_flag = Nonrecursive | Recursive
+
+type direction_flag = Upto | Downto
+
+(* Order matters, used in polymorphic comparison *)
+type private_flag = Private | Public
+
+type mutable_flag = Immutable | Mutable
+
+type virtual_flag = Virtual | Concrete
+
+type override_flag = Override | Fresh
+
+type closed_flag = Closed | Open
+
+type label = string
+
+type arg_label =
+    Nolabel
+  | Labelled of string (** [label:T -> ...] *)
+  | Optional of string (** [?label:T -> ...] *)
+
+type 'a loc = 'a Location.loc = {
+  txt : 'a;
+  loc : Location.t;
+}
+
+
+type variance =
+  | Covariant
+  | Contravariant
+  | NoVariance
+
+type injectivity =
+  | Injective
+  | NoInjectivity
+
+let string_of_label = function
+    Nolabel -> ""
+  | Labelled s -> s
+  | Optional s -> "?"^s

src/ocaml/parsing/asttypes.mli

@@ -65,3 +65,5 @@ type variance =
 type injectivity =
   | Injective
   | NoInjectivity
+
+val string_of_label: arg_label -> string

src/ocaml/parsing/dune

@@ -5,5 +5,5 @@
   (name ocaml_parsing)
   (public_name merlin-lib.ocaml_parsing)
   (flags -open Ocaml_utils -open Merlin_utils (:standard -w -9))
-  (modules_without_implementation asttypes parsetree)
+  (modules_without_implementation parsetree)
   (libraries merlin_utils ocaml_utils))

src/ocaml/typing/errortrace_report.ml

@@ -272,7 +272,7 @@ let explain_incompatible_fields name (diff: Types.type_expr Errortrace.diff) =
 
 
 let explain_label_mismatch ~got ~expected =
-  let quoted_label ppf l = Style.inline_code ppf (Printtyp.string_of_label l) in
+  let quoted_label ppf l = Style.inline_code ppf (Asttypes.string_of_label l) in
   match got, expected with
   | Asttypes.Nolabel, Asttypes.(Labelled _ | Optional _ )  ->
       doc_printf "@,@[A label@ %a@ was expected@]"

src/ocaml/typing/printtyp_doc.ml

@@ -184,7 +184,7 @@ module Conflicts = struct
           (List.map snd names)
           pp_namespace_plural namespace in
     Array.iter (pp_submsg ppf) submsgs
-      
+
 
   let print_toplevel_hint ppf l =
     let conj ppf () = Format.fprintf ppf " and@ " in
@@ -219,7 +219,7 @@ module Conflicts = struct
           (List.map snd names)
           pp_namespace_plural namespace in
     Array.iter (pp_submsg ppf) submsgs
-      
+
 
   let print_explanations ppf =
     let ltop, l =

src/ocaml/typing/rawprinttyp.ml

@@ -71,7 +71,7 @@ and raw_type_desc ppf = function
     Tvar name -> fprintf ppf "Tvar %a" print_name name
   | Tarrow(l,t1,t2,c) ->
       fprintf ppf "@[<hov1>Tarrow(\"%s\",@,%a,@,%a,@,%s)@]"
-        (Printtyp.string_of_label l) raw_type t1 raw_type t2
+        (Asttypes.string_of_label l) raw_type t1 raw_type t2
         (if is_commu_ok c then "Cok" else "Cunknown")
   | Ttuple tl ->
       fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl

src/ocaml/typing/typeclass.ml

@@ -1214,7 +1214,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
           Location.prerr_warning
             cl.cl_loc
             (Warnings.Labels_omitted
-               (List.map Printtyp.string_of_label
+               (List.map Asttypes.string_of_label
                          (List.filter ((<>) Nolabel) labels)));
           true
         end
@@ -1262,7 +1262,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
                     if not optional && Btype.is_optional l' then
                       Location.prerr_warning sarg.pexp_loc
                         (Warnings.Nonoptional_label
-                           (Printtyp.string_of_label l));
+                           (Asttypes.string_of_label l));
                     remaining_sargs, use_arg sarg l'
                 | None ->
                     sargs,

src/ocaml/typing/typecore.ml

@@ -5505,7 +5505,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
       in
       Location.prerr_warning texp.exp_loc
         (Warnings.Eliminated_optional_arguments
-           (List.map (fun (l, _) -> Printtyp.string_of_label l) args));
+           (List.map (fun (l, _) -> Asttypes.string_of_label l) args));
       if warn then Location.prerr_warning texp.exp_loc
           (Warnings.Non_principal_labels "eliminated optional argument");
       (* let-expand to have side effects *)
@@ -5609,7 +5609,7 @@ and type_application env funct sargs =
       (Location.prerr_warning
          funct.exp_loc
          (Warnings.Labels_omitted
-            (List.map Printtyp.string_of_label
+            (List.map Asttypes.string_of_label
                       (List.filter ((<>) Nolabel) labels)));
        true)
     end
@@ -5699,7 +5699,7 @@ and type_application env funct sargs =
                 end;
                 if not optional && is_optional l' then
                   Location.prerr_warning sarg.pexp_loc
-                    (Warnings.Nonoptional_label (Printtyp.string_of_label l));
+                    (Warnings.Nonoptional_label (Asttypes.string_of_label l));
                 remaining_sargs, Some (use_arg sarg l', Some sarg.pexp_loc)
             | None ->
                 sargs,