Add support for global_ and nonlocal_ constructor arguments (ocam…

…l#50)

ocamldoc/odoc_sig.ml

@@ -384,7 +384,7 @@ module Analyser =
             in
             let vc_args =
               match cd_args with
-              | Cstr_tuple l -> Cstr_tuple (List.map (Odoc_env.subst_type env) l)
+              | Cstr_tuple l -> Cstr_tuple (List.map (fun (ty, _) -> Odoc_env.subst_type env ty) l)
               | Cstr_record l ->
                   Cstr_record (List.map (get_field env name_comment_list) l)
             in
@@ -421,7 +421,7 @@ module Analyser =
       let open Typedtree in
       function
       | Cstr_tuple l ->
-          Odoc_type.Cstr_tuple (List.map tuple l)
+          Odoc_type.Cstr_tuple (List.map (fun (ty, _) -> tuple ty) l)
       | Cstr_record l ->
           let comments = Record.(doc typedtree) pos_end l in
           Odoc_type.Cstr_record (List.map (record comments) l)
@@ -847,7 +847,7 @@ module Analyser =
               let xt_args =
                 match types_ext.ext_args with
                 | Cstr_tuple l ->
-                    Cstr_tuple (List.map (Odoc_env.subst_type new_env) l)
+                    Cstr_tuple (List.map (fun (ty, _) -> Odoc_env.subst_type new_env ty) l)
                 | Cstr_record l ->
                     let docs = Record.(doc types ext_loc_end) l in
                     Cstr_record (List.map (get_field new_env docs) l)
@@ -891,7 +891,7 @@ module Analyser =
             let ex_args =
               let pos_end = Loc.end_ types_ext.ext_loc in
               match types_ext.ext_args with
-              | Cstr_tuple l -> Cstr_tuple (List.map (Odoc_env.subst_type env) l)
+              | Cstr_tuple l -> Cstr_tuple (List.map (fun (ty, _) -> Odoc_env.subst_type env ty) l)
               | Cstr_record l ->
                   let docs = Record.(doc types) pos_end l in
                   Cstr_record (List.map (get_field env docs) l)

parsing/builtin_attributes.ml

@@ -496,12 +496,6 @@ let has_local_opt attrs =
 let has_curry attrs =
   has_attribute ["extension.curry"; "ocaml.curry"; "curry"] attrs
 
-let has_global attrs =
-  has_attribute ["extension.global"; "ocaml.global"; "global"] attrs
-
-let has_nonlocal attrs =
-  has_attribute ["extension.nonlocal"; "ocaml.nonlocal"; "nonlocal"] attrs
-
 (* extension.* is generated by the parser and not usually written directly,
    so does not have a short form. An error is reported if it is seen when
    the extension is disabled *)
@@ -518,6 +512,12 @@ let check_local ext_names other_names attr =
 let has_local attr =
   check_local ["extension.local"] ["ocaml.local"; "local"] attr
 
+let has_global attrs =
+  check_local ["extension.global"] ["ocaml.global"; "global"] attrs
+
+let has_nonlocal attrs =
+  check_local ["extension.nonlocal"] ["ocaml.nonlocal"; "nonlocal"] attrs
+
 let tailcall attr =
   let has_nontail = has_attribute ["ocaml.nontail"; "nontail"] attr in
   let tail_attrs = filter_attributes [["ocaml.tail";"tail"], true] attr in

parsing/builtin_attributes.mli

@@ -134,12 +134,12 @@ val parse_standard_implementation_attributes : Parsetree.attribute -> unit
 
 val has_local_opt: Parsetree.attributes -> bool
 val has_curry: Parsetree.attributes -> bool
-val has_global: Parsetree.attributes -> bool
-val has_nonlocal: Parsetree.attributes -> bool
 
 (* These functions report Error if the builtin extension.* attributes
    are present despite the extension being disabled *)
 val has_local: Parsetree.attributes -> (bool,unit) result
+val has_global: Parsetree.attributes -> (bool,unit) result
+val has_nonlocal: Parsetree.attributes -> (bool,unit) result
 val tailcall : Parsetree.attributes ->
     ([`Tail|`Nontail|`Tail_if_possible] option, [`Conflict]) result
 val has_include_functor : Parsetree.attributes -> (bool,unit) result

parsing/parser.mly

@@ -243,6 +243,18 @@ let mkld_global_maybe gbl ld loc =
   | Nonlocal -> mkld_nonlocal ld loc
   | Nothing -> ld
 
+let mkcty_global cty loc =
+  { cty with ptyp_attributes = global_attr loc :: cty.ptyp_attributes }
+
+let mkcty_nonlocal cty loc =
+  { cty with ptyp_attributes = nonlocal_attr loc :: cty.ptyp_attributes }
+
+let mkcty_global_maybe gbl cty loc =
+  match gbl with
+  | Global -> mkcty_global cty loc
+  | Nonlocal -> mkcty_nonlocal cty loc
+  | Nothing -> cty
+
 (* TODO define an abstraction boundary between locations-as-pairs
    and locations-as-Location.t; it should be clear when we move from
    one world to the other *)
@@ -3302,8 +3314,14 @@ generalized_constructor_arguments:
                                   { ($2,Pcstr_tuple [],Some $4) }
 ;
 
+%inline atomic_type_gbl:
+  gbl = global_flag cty = atomic_type {
+  mkcty_global_maybe gbl cty (make_loc $loc(gbl))
+}
+;
+
 constructor_arguments:
-  | tys = inline_separated_nonempty_llist(STAR, atomic_type)
+  | tys = inline_separated_nonempty_llist(STAR, atomic_type_gbl)
     %prec below_HASH
       { Pcstr_tuple tys }
   | LBRACE label_declarations RBRACE
@@ -3911,6 +3929,11 @@ mutable_or_global_flag:
   | GLOBAL                                      { Immutable, Global }
   | NONLOCAL                                    { Immutable, Nonlocal }
 ;
+%inline global_flag:
+          { Nothing }
+  | GLOBAL { Global }
+  | NONLOCAL { Nonlocal }
+;
 virtual_flag:
     /* empty */                                 { Concrete }
   | VIRTUAL                                     { Virtual }