Rename Pcty_fun to Pcty_arrow (and idem in Types, Typedtree, Outcometree) to be coherent with Ptyp_arrow.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13536 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Author: alainfrisch

bytecomp/translclass.ml

@@ -422,7 +422,7 @@ let rec transl_class_rebind obj_init cl vf =
       let path, obj_init = transl_class_rebind obj_init cl' vf in
       let rec check_constraint = function
           Cty_constr(path', _, _) when Path.same path path' -> ()
-        | Cty_fun (_, _, cty) -> check_constraint cty
+        | Cty_arrow (_, _, cty) -> check_constraint cty
         | _ -> raise Exit
       in
       check_constraint cl.cl_type;

camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml

@@ -1095,11 +1095,11 @@ value varify_constructors var_names =
         mkcty loc
           (Pcty_constr (long_class_ident id) (List.map ctyp (list_of_opt_ctyp tl [])))
     | CtFun loc (TyLab _ lab t) ct ->
-        mkcty loc (Pcty_fun lab (ctyp t) (class_type ct))
+        mkcty loc (Pcty_arrow lab (ctyp t) (class_type ct))
     | CtFun loc (TyOlb loc1 lab t) ct ->
         let t = TyApp loc1 (predef_option loc1) t in
-        mkcty loc (Pcty_fun ("?" ^ lab) (ctyp t) (class_type ct))
-    | CtFun loc t ct -> mkcty loc (Pcty_fun "" (ctyp t) (class_type ct))
+        mkcty loc (Pcty_arrow ("?" ^ lab) (ctyp t) (class_type ct))
+    | CtFun loc t ct -> mkcty loc (Pcty_arrow "" (ctyp t) (class_type ct))
     | CtSig loc t_o ctfl ->
         let t =
           match t_o with

camlp4/Camlp4Top/Rprint.ml

@@ -329,7 +329,7 @@ value rec print_out_class_type ppf =
               (print_typlist Toploop.print_out_type.val ",") tyl ]
       in
       fprintf ppf "@[%a%a@]" pr_tyl tyl print_ident id
-  | Octy_fun lab ty cty ->
+  | Octy_arrow lab ty cty ->
       fprintf ppf "@[%a[ %a ] ->@ %a@]" print_ty_label lab
         Toploop.print_out_type.val ty print_out_class_type cty
   | Octy_signature self_ty csil ->

camlp4/boot/Camlp4.ml

@@ -15483,14 +15483,14 @@ module Struct =
                     (Pcty_constr ((long_class_ident id),
                        (List.map ctyp (list_of_opt_ctyp tl []))))
               | CtFun (loc, (TyLab (_, lab, t)), ct) ->
-                  mkcty loc (Pcty_fun (lab, (ctyp t), (class_type ct)))
+                  mkcty loc (Pcty_arrow (lab, (ctyp t), (class_type ct)))
               | CtFun (loc, (TyOlb (loc1, lab, t)), ct) ->
                   let t = TyApp (loc1, (predef_option loc1), t)
                   in
                     mkcty loc
-                      (Pcty_fun (("?" ^ lab), (ctyp t), (class_type ct)))
+                      (Pcty_arrow (("?" ^ lab), (ctyp t), (class_type ct)))
               | CtFun (loc, t, ct) ->
-                  mkcty loc (Pcty_fun ("", (ctyp t), (class_type ct)))
+                  mkcty loc (Pcty_arrow ("", (ctyp t), (class_type ct)))
               | CtSig (loc, t_o, ctfl) ->
                   let t =
                     (match t_o with | Ast.TyNil _ -> Ast.TyAny loc | t -> t) in

ocamldoc/odoc_ast.ml

@@ -200,7 +200,7 @@ module Typedtree_search =
       let rec iter = function
         Types.Cty_constr (_, _, cty) -> iter cty
       | Types.Cty_signature s -> s
-      | Types.Cty_fun (_,_, cty) -> iter cty
+      | Types.Cty_arrow (_,_, cty) -> iter cty
       in
       fun ct_decl -> iter ct_decl.Types.clty_type
 

ocamldoc/odoc_env.ml

@@ -238,9 +238,9 @@ let subst_class_type env t =
     | Types.Cty_signature cs ->
         (* on ne s'occupe pas des vals et methods *)
         t
-    | Types.Cty_fun (l, texp, ct) ->
+    | Types.Cty_arrow (l, texp, ct) ->
         let new_texp = subst_type env texp in
         let new_ct = iter ct in
-        Types.Cty_fun (l, new_texp, new_ct)
+        Types.Cty_arrow (l, new_texp, new_ct)
   in
   iter t

ocamldoc/odoc_print.ml

@@ -90,9 +90,9 @@ let simpl_class_type t =
                                Types.cty_concr = Types.Concr.empty ;
                                Types.cty_inher = []
                              }
-    | Types.Cty_fun (l, texp, ct) ->
+    | Types.Cty_arrow (l, texp, ct) ->
         let new_ct = iter ct in
-        Types.Cty_fun (l, texp, new_ct)
+        Types.Cty_arrow (l, texp, new_ct)
   in
   iter t
 

ocamldoc/odoc_sig.ml

@@ -450,7 +450,7 @@ module Analyser =
                   ic
 
               | Parsetree.Pcty_signature _
-              | Parsetree.Pcty_fun _ ->
+              | Parsetree.Pcty_arrow _ ->
                     (* we don't have a name for the class signature, so we call it "object ... end"  *)
                   {
                     ic_name = Odoc_messages.object_end ;
@@ -1235,7 +1235,7 @@ module Analyser =
           in
           ([], Class_structure (inher_l, ele))
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
+      | (Parsetree.Pcty_arrow (parse_label, _, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
           (* label = string. Dans les signatures, pas de nom de parametres a l'interieur des tuples *)
           (* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *)
           if parse_label = label then
@@ -1252,7 +1252,7 @@ module Analyser =
             )
           else
             (
-             raise (Failure "Parsetree.Pcty_fun (parse_label, _, pclass_type), labels differents")
+             raise (Failure "Parsetree.Pcty_arrow (parse_label, _, pclass_type), labels differents")
             )
 
       | _ ->
@@ -1286,8 +1286,8 @@ module Analyser =
           in
           Class_signature (inher_l, ele)
 
-      | (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
-          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_fun (...) with Types.Cty_fun (...)")
+      | (Parsetree.Pcty_arrow (parse_label, _, pclass_type), Types.Cty_arrow (label, type_expr, class_type)) ->
+          raise (Failure "analyse_class_type_kind : Parsetree.Pcty_arrow (...) with Types.Cty_arrow (...)")
 (*
       | (Parsetree.Pcty_constr (longident, _) (*of Longident.t * core_type list *),
          Types.Cty_signature class_signature) ->

ocamldoc/odoc_str.ml

@@ -125,7 +125,7 @@ let string_of_class_type_param_list l =
 let string_of_class_params c =
   let b = Buffer.create 256 in
   let rec iter = function
-      Types.Cty_fun (label, t, ctype) ->
+      Types.Cty_arrow (label, t, ctype) ->
         let parent = is_arrow_type t in
         Printf.bprintf b "%s%s%s%s -> "
           (

otherlibs/labltk/browser/searchpos.ml

@@ -151,7 +151,7 @@ let rec search_pos_class_type cl ~pos ~env =
                 end
             | Pctf_extension _ -> ()
           end)
-    | Pcty_fun (_, ty, cty) ->
+    | Pcty_arrow (_, ty, cty) ->
         search_pos_type ty ~pos ~env;
         search_pos_class_type cty ~pos ~env
     | Pcty_extension _ -> ()

parsing/ast_helper.ml

@@ -209,7 +209,7 @@ module Cty = struct
 
   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 fun_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_fun (a, b, c))
+  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)
 end
 

parsing/ast_helper.mli

@@ -190,7 +190,7 @@ module Cty:
 
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type
     val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type
-    val fun_: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type
+    val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type
   end
 module Ctf:

parsing/ast_mapper.ml

@@ -82,8 +82,8 @@ module CT = struct
     match desc with
     | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys)
     | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x)
-    | Pcty_fun (lab, t, ct) ->
-        fun_ ~loc ~attrs lab
+    | Pcty_arrow (lab, t, ct) ->
+        arrow ~loc ~attrs lab
           (sub # typ t)
           (sub # class_type ct)
     | Pcty_extension x -> extension ~loc ~attrs (sub # extension x)

parsing/parser.mly

@@ -884,13 +884,13 @@ class_type:
     class_signature
       { $1 }
   | QUESTION LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $2 , mkoption $4, $6)) }
+      { mkcty(Pcty_arrow("?" ^ $2 , mkoption $4, $6)) }
   | OPTLABEL simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_fun("?" ^ $1, mkoption $2, $4)) }
+      { mkcty(Pcty_arrow("?" ^ $1, mkoption $2, $4)) }
   | LIDENT COLON simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_fun($1, $3, $5)) }
+      { mkcty(Pcty_arrow($1, $3, $5)) }
   | simple_core_type_or_tuple_no_attr MINUSGREATER class_type
-      { mkcty(Pcty_fun("", $1, $3)) }
+      { mkcty(Pcty_arrow("", $1, $3)) }
   | class_type attribute
       { Cty.attr $1 $2 }
   | extension

parsing/parsetree.mli

@@ -321,24 +321,42 @@ and value_description =
      pval_name: string loc;
      pval_type: core_type;
      pval_prim: string list;
-     pval_attributes: attributes;
+     pval_attributes: attributes;  (* .... [@@id1 E1] [@@id2 E2] *)
      pval_loc: Location.t;
     }
 
+(*
+  val x: t                            (prim = [])
+  external x: t = "s1" ... "sn"       (prim = ["s1";..."sn"])
+
+  Note: when used under Pstr_primitive, prim cannot be empty
+*)
+
 (* Type declarations *)
 
 and type_declaration =
     {
      ptype_name: string loc;
      ptype_params: (string loc option * variance) list;
+           (* ('a1,...'an) t; None represents  _*)
      ptype_cstrs: (core_type * core_type * Location.t) list;
+           (* ... constraint T1=T1'  ... constraint Tn=Tn' *)
      ptype_kind: type_kind;
-     ptype_private: private_flag;
-     ptype_manifest: core_type option;
-     ptype_attributes: attributes;
+     ptype_private: private_flag;   (* = private ... *)
+     ptype_manifest: core_type option;  (* = T *)
+     ptype_attributes: attributes;   (* .... [@@id1 E1] [@@id2 E2] *)
      ptype_loc: Location.t;
     }
 
+(*
+  type t                     (abstract, no manifest)
+  type t = T0                (abstract, manifest=T0)
+  type t = C of T | ...      (variant,  no manifest)
+  type t = T0 = C of T | ... (variant,  manifest=T0)
+  type t = {l: T; ...}       (record,   no manifest)
+  type t = T0 = {l : T; ...} (record,   manifest=T0)
+*)
+
 and type_kind =
   | Ptype_abstract
   | Ptype_variant of constructor_declaration list
@@ -353,6 +371,12 @@ and label_declaration =
      pld_attributes: attributes;
     }
 
+(*  { ...; l: T; ... }            (mutable=Immutable)
+    { ...; mutable l: T; ... }    (mutable=Mutable)
+
+    Note: T can be a Pexp_poly.
+*)
+
 and constructor_declaration =
     {
      pcd_name: string loc;
@@ -361,6 +385,11 @@ and constructor_declaration =
      pcd_loc: Location.t;
      pcd_attributes: attributes;
     }
+(*
+  | C of T1 * ... * Tn     (res = None)
+  | C: T0                  (args = [], res = Some T0)
+  | C: T1 * ... * Tn -> T0 (res = Some T0)
+*)
 
 (** {2 Class language} *)
 
@@ -370,14 +399,22 @@ and class_type =
     {
      pcty_desc: class_type_desc;
      pcty_loc: Location.t;
-     pcty_attributes: attributes;
+     pcty_attributes: attributes; (* CT [@id1 E1] [@id2 E2] ... *)
     }
 
 and class_type_desc =
   | Pcty_constr of Longident.t loc * core_type list
+        (* tconstr
+           ['a1, ..., 'an] tconstr *)
   | Pcty_signature of class_signature
-  | Pcty_fun of label * core_type * class_type
+        (* object ... end *)
+  | Pcty_arrow of label * core_type * class_type
+        (* T -> CT       (label = "")
+           ~l:T -> CT    (label = "l")
+           ?l:T -> CT    (label = "?l")
+         *)
   | Pcty_extension of extension
+        (* [%id E] *)
 
 and class_signature =
     {

parsing/pprintast.ml

@@ -764,7 +764,7 @@ class printer  ()= object(self:'self)
           | [] -> ()
           | _  -> pp f "[%a]@ " (self#list self#core_type ~sep:"," ) l) l 
           self#longident_loc li 
-    | Pcty_fun (l, co, cl) ->
+    | Pcty_arrow (l, co, cl) ->
         pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
           self#type_with_label (l,co) self#class_type cl
     | Pcty_extension _ -> assert false

parsing/printast.ml

@@ -407,8 +407,8 @@ and class_type i ppf x =
   | Pcty_signature (cs) ->
       line i ppf "Pcty_signature\n";
       class_signature i ppf cs;
-  | Pcty_fun (l, co, cl) ->
-      line i ppf "Pcty_fun \"%s\"\n" l;
+  | Pcty_arrow (l, co, cl) ->
+      line i ppf "Pcty_arrow \"%s\"\n" l;
       core_type i ppf co;
       class_type i ppf cl;
   | Pcty_extension (s, arg) ->

tools/addlabels.ml

@@ -44,7 +44,7 @@ let rec labels_of_sty sty =
 
 let rec labels_of_cty cty =
   match cty.pcty_desc with
-    Pcty_fun (lab, _, rem) ->
+    Pcty_arrow (lab, _, rem) ->
       let (labs, meths) = labels_of_cty rem in
       (lab :: labs, meths)
   | Pcty_signature { pcsig_fields = fields } ->

tools/depend.ml

@@ -86,7 +86,7 @@ let rec add_class_type bv cty =
   | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
       add_type bv ty;
       List.iter (add_class_type_field bv) fieldl
-  | Pcty_fun(_, ty1, cty2) ->
+  | Pcty_arrow(_, ty1, cty2) ->
       add_type bv ty1; add_class_type bv cty2
   | Pcty_extension _ -> ()
 

tools/eqparsetree.ml

@@ -565,7 +565,7 @@ and eq_class_type_desc :
         (eq_list eq_core_type (a1, b1))
   | (Pcty_signature a0, Pcty_signature b0) ->
       eq_class_signature (a0, b0)
-  | (Pcty_fun (a0, a1, a2), Pcty_fun (b0, b1, b2)) ->
+  | (Pcty_arrow (a0, a1, a2), Pcty_arrow (b0, b1, b2)) ->
       ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
         (eq_class_type (a2, b2))
   | (_, _) -> false

tools/tast_iter.ml

@@ -257,7 +257,7 @@ let class_type sub ct =
   match ct.cltyp_desc with
   | Tcty_signature csg -> sub # class_signature csg
   | Tcty_constr (_path, _, list) -> List.iter (sub # core_type) list
-  | Tcty_fun (_label, ct, cl) ->
+  | Tcty_arrow (_label, ct, cl) ->
       sub # core_type ct;
       sub # class_type cl
 

tools/untypeast.ml

@@ -453,8 +453,8 @@ and untype_class_type ct =
       Tcty_signature csg -> Pcty_signature (untype_class_signature csg)
     | Tcty_constr (_path, lid, list) ->
         Pcty_constr (lid, List.map untype_core_type list)
-    | Tcty_fun (label, ct, cl) ->
-        Pcty_fun (label, untype_core_type ct, untype_class_type cl)
+    | Tcty_arrow (label, ct, cl) ->
+        Pcty_arrow (label, untype_core_type ct, untype_class_type cl)
   in
   { pcty_desc = desc;
     pcty_loc = ct.cltyp_loc;

typing/btype.ml

@@ -367,7 +367,7 @@ let rec unmark_class_type =
       List.iter unmark_type tyl; unmark_class_type cty
   | Cty_signature sign ->
       unmark_class_signature sign
-  | Cty_fun (_, ty, cty) ->
+  | Cty_arrow (_, ty, cty) ->
       unmark_type ty; unmark_class_type cty