More explicit internal representation of attribute payload. Now also support patterns as payload [%id ? pat].

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

camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml

@@ -1270,7 +1270,7 @@ value varify_constructors var_names =
   ;
 
   value attribute loc s str =
-    (with_loc s loc, str_item str);
+    (with_loc s loc, PStr (str_item str));
 
   value () =
     attribute_fwd.val := attribute;

experimental/frisch/copy_typedef.ml

@@ -23,9 +23,8 @@
 
 module Main : sig end = struct
   open Asttypes
-  open Location
+  open! Location
   open Parsetree
-  open Longident
 
   let fatal loc s =
     Location.print_error Format.err_formatter loc;
@@ -122,7 +121,7 @@ module Main : sig end = struct
     val mutable file = ""
 
     method source name = function
-      | [] ->
+      | PStr [] ->
           let file =
             if Filename.check_suffix file ".ml"
             then (Filename.chop_suffix file ".ml") ^ ".mli"
@@ -131,7 +130,7 @@ module Main : sig end = struct
             else failwith "Unknown source extension"
           in
           file, path, name
-      | [{pstr_desc=Pstr_eval
+      | PStr [{pstr_desc=Pstr_eval
             ({pexp_desc=Pexp_apply
                 ({pexp_desc=Pexp_constant(Const_string (file, _)); _},
                  ["", {pexp_desc=Pexp_ident{txt=lid;_}; _}]); _}, _); _}] ->

experimental/frisch/eval.ml

@@ -38,7 +38,7 @@ module Main : sig end = struct
     | Oval_string x -> str x
     | Oval_int x -> int x
     | Oval_char x -> char x
-    | Oval_float x -> float x
+    | Oval_float x -> Ast_helper.Convenience.float x
     | Oval_list l -> list (List.map exp_of_out_value l)
     | Oval_array l -> Exp.array (List.map exp_of_out_value l)
     | Oval_constr (c, args) -> constr (lid_of_out_ident c) (List.map exp_of_out_value args)
@@ -61,9 +61,9 @@ module Main : sig end = struct
       exit 2
 
   let get_exp loc = function
-    | [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
+    | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
     | _ ->
-        Format.eprintf "%aExpression expected"
+        Format.eprintf "%aExpression expected@."
           Location.print_error loc;
         exit 2
 
@@ -90,14 +90,14 @@ module Main : sig end = struct
           end;
           empty_str_item
       | Pstr_extension(({txt="eval.start";_},
-                        [{pstr_desc=Pstr_eval (e, _);_}]
+                        PStr [{pstr_desc=Pstr_eval (e, _);_}]
                        ), _) when get_lid e = Some "both" ->
           eval_str_items <- Some true;
           empty_str_item
-      | Pstr_extension(({txt="eval.start";_}, []), _) ->
+      | Pstr_extension(({txt="eval.start";_}, PStr []), _) ->
           eval_str_items <- Some false;
           empty_str_item
-      | Pstr_extension(({txt="eval.stop";_}, []), _) ->
+      | Pstr_extension(({txt="eval.stop";_}, PStr []), _) ->
           eval_str_items <- None;
           empty_str_item
       | _ ->

experimental/frisch/extension_points.txt

@@ -13,16 +13,14 @@ and a payload (written s below).
    In the Parsetree, the identifier is represented as a single string
    (without spaces).
 
- * The payload 's' is an OCaml structure (i.e. a list of structure items).
-   Note that a payload can be empty or reduced to a single expression
-   (both cases are valid structures).  To support attributes whose
-   payload needs to be a type expression, the special syntax:
+ * The payload 's' can be one of three things:
 
-      : T
+   - An OCaml structure (i.e. a list of structure items).  Note that a
+     structure can be empty or reduced to a single expression.
 
-   (where T is a type expression) is also accepted as a valid payload,
-   and is interpreted internally as the structure made of the single
-   expression (() : T).
+   - A type expression, prefixed with the ":" character.
+
+   - A pattern, prefixed with the "?" character.
 
 
 Attributes on expressions, type expressions, module expressions, module type expressions,

experimental/frisch/ifdef.ml

@@ -29,15 +29,15 @@
 
 *)
 
+open Location
 open Ast_helper
-open Asttypes
+open! Asttypes
 open Parsetree
 open Longident
-open Location
 
 let getenv loc arg =
   match arg with
-  | [{pstr_desc=Pstr_eval({pexp_desc = Pexp_construct ({txt = Lident sym; _}, None); _}, _); _}] ->
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc = Pexp_construct ({txt = Lident sym; _}, None); _}, _); _}] ->
       (try Sys.getenv sym with Not_found -> "")
   | _ ->
       Format.eprintf "%a** IFDEF: bad syntax."

experimental/frisch/js_syntax.ml

@@ -11,7 +11,7 @@
  *)
 
 open Asttypes
-open Location
+open! Location
 open Parsetree
 open Longident
 open Ast_helper
@@ -81,7 +81,7 @@ let mapper =
     method! expr e =
       let loc = e.pexp_loc in
       match e.pexp_desc with
-      | Pexp_extension({txt="js";_}, [{pstr_desc=Pstr_eval (e, _);_}]) ->
+      | Pexp_extension({txt="js";_}, PStr [{pstr_desc=Pstr_eval (e, _);_}]) ->
           {< js = true >} # expr e
 
       | Pexp_field (o, {txt = Lident meth; loc = _}) when js ->

experimental/frisch/metaquot.ml

@@ -67,9 +67,23 @@ module Main : sig end = struct
 
 
   let get_exp loc = function
-    | [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
+    | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e
     | _ ->
-        Format.eprintf "%aExpression expected"
+        Format.eprintf "%aExpression expected@."
+          Location.print_error loc;
+        exit 2
+
+  let get_typ loc = function
+    | PTyp t -> t
+    | _ ->
+        Format.eprintf "%aType expected@."
+          Location.print_error loc;
+        exit 2
+
+  let get_pat loc = function
+    | PPat t -> t
+    | _ ->
+        Format.eprintf "%aPattern expected@."
           Location.print_error loc;
         exit 2
 
@@ -144,13 +158,11 @@ module Main : sig end = struct
           | Pexp_extension({txt="expr";loc=l}, e) ->
               (lifter !loc) # lift_Parsetree_expression (get_exp l e)
           | Pexp_extension({txt="pat";loc=l}, e) ->
-              let p = extract_str Parse.pattern "pattern" (get_exp l e) in
-              (lifter !loc) # lift_Parsetree_pattern p
-          | Pexp_extension({txt="str";_}, e) ->
+              (lifter !loc) # lift_Parsetree_pattern (get_pat l e)
+          | Pexp_extension({txt="str";_}, PStr e) ->
               (lifter !loc) # lift_Parsetree_structure e
           | Pexp_extension({txt="type";loc=l}, e) ->
-              let p = extract_str Parse.core_type "type" (get_exp l e) in
-              (lifter !loc) # lift_Parsetree_core_type p
+              (lifter !loc) # lift_Parsetree_core_type (get_typ l e)
           | _ ->
               super # expr e
         )

experimental/frisch/metaquot_test.ml

@@ -2,7 +2,7 @@ let loc1 = Location.in_file "111"
 let loc2 = Location.in_file "222"
 
 let x = [%expr foobar]
-let pat = [%pat "_ as x"]
+let pat = [%pat? _ as x]
 
 let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
 let () = Format.printf "%a@." (Printast.expression 0) e
@@ -16,6 +16,6 @@ let e = [%expr fun (x, [%p pat]) -> x + [%e x] + 1]
 let () = Format.printf "%a@." (Printast.expression 0) e
 
 
-let mytype = [%type "int list"]
+let mytype = [%type: int list]
 let s = [%str type t = A of [%t mytype] | B of string]
 let () = Format.printf "%a@." Printast.implementation s

experimental/frisch/minidoc.ml

@@ -6,7 +6,7 @@ open Longident
 let pendings = ref []
 
 let doc ppf = function
-  | ({txt="doc";_}, [{pstr_desc=Pstr_eval(e, _); _}]) ->
+  | ({txt="doc";_}, PStr [{pstr_desc=Pstr_eval(e, _); _}]) ->
       begin match e.pexp_desc with
       | Pexp_constant(Const_string (s, _)) ->
           Format.fprintf ppf "    --> %s@." s

experimental/frisch/nomli.ml

@@ -6,7 +6,7 @@ open Longident
 open Misc
 open Parsetree
 open Types
-open Typedtree
+open! Typedtree
 open Ast_helper
 
 let mli_attr l = Convenience.find_attr "mli" l
@@ -15,7 +15,7 @@ let map_flatten f l =
   List.flatten (List.map f l)
 
 let is_abstract = function
-  | [{pstr_desc=Pstr_eval({pexp_desc=Pexp_ident{txt=Lident "abstract"}},_)}] -> true
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_ident{txt=Lident "abstract"}},_)}] -> true
   | _ -> false
 
 let explicit_type_of_expr = function
@@ -23,8 +23,8 @@ let explicit_type_of_expr = function
   | _ -> []
 
 let explicit_type = function
-  | [{pstr_desc=Pstr_eval({pexp_desc=Pexp_tuple el},_)}] -> map_flatten explicit_type_of_expr el
-  | [{pstr_desc=Pstr_eval(e,_)}] -> explicit_type_of_expr e
+  | PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_tuple el},_)}] -> map_flatten explicit_type_of_expr el
+  | PStr [{pstr_desc=Pstr_eval(e,_)}] -> explicit_type_of_expr e
   | _ -> []
 
 let rec structure l : Parsetree.signature =
@@ -98,12 +98,12 @@ and typ x : Parsetree.core_type =
 
 let mli_of_ml ppf sourcefile =
   Location.input_name := sourcefile;
-  Compile.init_path ();
+  Compmisc.init_path false;
   let file = chop_extension_if_any sourcefile in
   let modulename = String.capitalize(Filename.basename file) in
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
-  let env = Compile.initial_env() in
+  let env = Compmisc.initial_env() in
   let ast = Pparse.file ppf inputfile Parse.implementation Config.ast_impl_magic_number in
   let (str, _coerc) = Typemod.type_implementation sourcefile file modulename env ast in
   let sg = structure str in

experimental/frisch/ppx_builder.ml

@@ -20,7 +20,7 @@
 
 module Main : sig end = struct
   open Asttypes
-  open Location
+  open! Location
   open Parsetree
   open Ast_helper
   open Ast_helper.Convenience

experimental/frisch/test_copy_typedef.ml

@@ -16,4 +16,4 @@ let _x = M.A
 let _y : t = [1; 2]
 
 
-type loc = [%copy_typedef "../../parsing/location.mli" t]
+type _loc = [%copy_typedef "../../parsing/location.mli" t]

parsing/ast_helper.ml

@@ -412,13 +412,13 @@ module Convenience = struct
     try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs))
     with Not_found -> None
 
-  let expr_of_struct = function
-    | [{pstr_desc=Pstr_eval(e, _)}] -> Some e
+  let expr_of_payload = function
+    | PStr [{pstr_desc=Pstr_eval(e, _)}] -> Some e
     | _ -> None
 
   let find_attr_expr s attrs =
     match find_attr s attrs with
-    | Some e -> expr_of_struct e
+    | Some e -> expr_of_payload e
     | None -> None
 
   let has_attr s attrs =

parsing/ast_helper.mli

@@ -361,6 +361,6 @@ module Convenience :
     val get_lid: expression -> string option
 
     val has_attr: string -> attributes -> bool
-    val find_attr: string -> attributes -> structure option
+    val find_attr: string -> attributes -> payload option
     val find_attr_expr: string -> attributes -> expression option
   end

parsing/ast_mapper.ml

@@ -409,9 +409,13 @@ class mapper =
 
     method location l = l
 
-    method extension (s, e) = (map_loc this s, this # structure e)
-    method attribute (s, e) = (map_loc this s, this # structure e)
+    method extension (s, e) = (map_loc this s, this # payload e)
+    method attribute (s, e) = (map_loc this s, this # payload e)
     method attributes l = List.map (this # attribute) l
+    method payload = function
+      | PStr x -> PStr (this # structure x)
+      | PTyp x -> PTyp (this # typ x)
+      | PPat x -> PPat (this # pat x)
   end
 
 class type main_entry_points =

parsing/ast_mapper.mli

@@ -54,6 +54,7 @@ class mapper:
     method constructor_declaration: constructor_declaration -> constructor_declaration
     method label_declaration: label_declaration -> label_declaration
     method value_binding: value_binding -> value_binding
+    method payload: payload -> payload
   end
 
 class type main_entry_points =

parsing/parser.mly

@@ -276,7 +276,7 @@ let wrap_exp_attrs body (ext, attrs) =
   let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
   match ext with
   | None -> body
-  | Some id -> ghexp(Pexp_extension (id, [mkstrexp body []]))
+  | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))
 
 let mkexp_attrs d attrs =
   wrap_exp_attrs (mkexp d) attrs
@@ -1978,10 +1978,10 @@ attr_id:
   | single_attr_id DOT attr_id { mkloc ($1 ^ "." ^ $3.txt) (symbol_rloc())}
 ;
 attribute:
-  LBRACKETAT attr_id ext_arg RBRACKET { ($2, $3) }
+  LBRACKETAT attr_id payload RBRACKET { ($2, $3) }
 ;
 post_item_attribute:
-  LBRACKETATAT attr_id ext_arg RBRACKET { ($2, $3) }
+  LBRACKETATAT attr_id payload RBRACKET { ($2, $3) }
 ;
 post_item_attributes:
     /* empty */  { [] }
@@ -1997,15 +1997,18 @@ ext_attributes:
   | PERCENT attr_id attributes { Some $2, $3 }
 ;
 extension:
-  LBRACKETPERCENT attr_id ext_arg RBRACKET { ($2, $3) }
+  LBRACKETPERCENT attr_id payload RBRACKET { ($2, $3) }
 ;
 item_extension:
-  LBRACKETPERCENTPERCENT attr_id ext_arg RBRACKET { ($2, $3) }
+  LBRACKETPERCENTPERCENT attr_id payload RBRACKET { ($2, $3) }
 ;
-ext_arg:
-    structure { $1 }
-  | COLON core_type {
-      [ mkstrexp (ghexp (Pexp_constraint (ghunit (), $2))) [] ]
+payload:
+    structure { PStr $1 }
+  | COLON core_type { PTyp $2
+(*      [ mkstrexp (ghexp (Pexp_constraint (ghunit (), $2))) [] ] *)
+  }
+  | QUESTION pattern { PPat $2
+(*       [ mkstr(Pstr_value(Nonrecursive, [Vb.mk $2 (ghunit ())])) ] *)
   }
 ;
 %%

parsing/parsetree.mli

@@ -16,18 +16,23 @@ open Asttypes
 
 (** {2 Extension points} *)
 
-type attribute = string loc * structure
+type attribute = string loc * payload
       (* [@id STRUCTURE]
          [@@id STRUCTURE]
        *)
 
-and extension = string loc * structure
+and extension = string loc * payload
       (* [%id STRUCTURE]
          [%%id STRUCTURE]
        *)
 
 and attributes = attribute list
 
+and payload =
+  | PStr of structure
+  | PTyp of core_type
+  | PPat of pattern
+
 (** {2 Core language} *)
 
 (* Type expressions *)

parsing/pprintast.ml

@@ -322,7 +322,7 @@ class printer  ()= object(self:'self)
             pp f "@[<hov2>(module@ %a@ with@ %a)@]" self#longident_loc lid
               (self#list aux  ~sep:"@ and@ ")  cstrs)
     | Ptyp_extension (s, arg) ->
-      pp f "@[<2>(&%s@ %a)@]" s.txt self#structure arg
+      pp f "@[<2>(&%s@ %a)@]" s.txt self#payload arg
     | _ -> self#paren true self#core_type f x
           (********************pattern********************)
           (* be cautious when use [pattern], [pattern1] is preferred *)
@@ -618,7 +618,7 @@ class printer  ()= object(self:'self)
     | Pexp_variant (l,Some eo) ->
         pp f "@[<2>`%s@;%a@]" l  self#simple_expr eo
     | Pexp_extension (s, arg) ->
-      pp f "@[<2>(&%s@ %a)@]" s.txt self#structure arg
+      pp f "@[<2>(&%s@ %a)@]" s.txt self#payload arg
     | _ -> self#expression1 f x
   method expression1 f x =
     if x.pexp_attributes <> [] then self#expression f x
@@ -688,7 +688,7 @@ class printer  ()= object(self:'self)
     List.iter (self # attribute f) l
 
   method attribute f (s, e) =
-    pp f "[@@%s %a]" s.txt self#structure e
+    pp f "[@@%s %a]" s.txt self#payload e
 
   method value_description f x =
     pp f "@[<hov2>%a%a@]" self#core_type x.pval_type
@@ -951,6 +951,11 @@ class printer  ()= object(self:'self)
 
   method structure f x = self#list ~sep:"@\n" self#structure_item f x
 
+  method payload f = function
+    | PStr x -> self#structure f x
+    | PTyp x -> pp f ":"; self#core_type f x
+    | PPat x -> pp f "?"; self#pattern f x
+
   (* transform [f = fun g h -> ..] to [f g h = ... ] could be improved *)
   method binding f {pvb_pat=p; pvb_expr=x; pvb_attributes=_} = (* TODO: print attributes *)
     let rec pp_print_pexp_function f x =

parsing/pprintast.mli

@@ -75,6 +75,7 @@ class printer :
           (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
     method pattern : Format.formatter -> Parsetree.pattern -> unit
     method pattern1 : Format.formatter -> Parsetree.pattern -> unit
+    method payload : Format.formatter -> Parsetree.payload -> unit
     method private_flag : Format.formatter -> Asttypes.private_flag -> unit
     method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
 

parsing/printast.ml

@@ -177,7 +177,7 @@ let rec core_type i ppf x =
       list i package_with ppf l;
   | Ptyp_extension (s, arg) ->
       line i ppf "Ptyp_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and package_with i ppf (s, t) =
   line i ppf "with type %a\n" fmt_longident_loc s;
@@ -228,7 +228,7 @@ and pattern i ppf x =
       line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
   | Ppat_extension (s, arg) ->
       line i ppf "Ppat_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.pexp_loc;
@@ -352,7 +352,7 @@ and expression i ppf x =
       expression i ppf e
   | Pexp_extension (s, arg) ->
       line i ppf "Pexp_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and value_description i ppf x =
   line i ppf "value_description %a %a\n" fmt_string_loc x.pval_name fmt_location x.pval_loc;
@@ -386,10 +386,15 @@ and attributes i ppf l =
   List.iter
     (fun (s, arg) ->
       line i ppf "attribute \"%s\"\n" s.txt;
-      structure (i + 1) ppf arg;
+      payload (i + 1) ppf arg;
     )
     l
 
+and payload i ppf = function
+  | PStr x -> structure i ppf x
+  | PTyp x -> core_type i ppf x
+  | PPat x -> pattern i ppf x
+
 and type_kind i ppf x =
   match x with
   | Ptype_abstract ->
@@ -418,7 +423,7 @@ and class_type i ppf x =
       class_type i ppf cl;
   | Pcty_extension (s, arg) ->
       line i ppf "Pcty_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and class_signature i ppf cs =
   line i ppf "class_signature\n";
@@ -446,7 +451,7 @@ and class_type_field i ppf x =
       core_type (i+1) ppf ct2;
   | Pctf_extension (s, arg) ->
       line i ppf "Pctf_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+     payload i ppf arg
 
 and class_description i ppf x =
   line i ppf "class_description %a\n" fmt_location x.pci_loc;
@@ -501,7 +506,7 @@ and class_expr i ppf x =
       class_type i ppf ct;
   | Pcl_extension (s, arg) ->
       line i ppf "Pcl_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and class_structure i ppf { pcstr_self = p; pcstr_fields = l } =
   line i ppf "class_structure\n";
@@ -534,7 +539,7 @@ and class_field i ppf x =
       expression (i+1) ppf e;
   | Pcf_extension (s, arg) ->
       line i ppf "Pcf_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and class_field_kind i ppf = function
   | Cfk_concrete (o, e) ->
@@ -577,7 +582,7 @@ and module_type i ppf x =
       module_expr i ppf m;
   | Pmty_extension (s, arg) ->
       line i ppf "Pmod_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and signature i ppf x = list i signature_item ppf x
 
@@ -623,10 +628,10 @@ and signature_item i ppf x =
   | Psig_extension ((s, arg), attrs) ->
       line i ppf "Psig_extension \"%s\"\n" s.txt;
       attributes i ppf attrs;
-      structure i ppf arg
+      payload i ppf arg
   | Psig_attribute (s, arg) ->
       line i ppf "Psig_attribute \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and modtype_declaration i ppf = function
   | None -> line i ppf "#abstract"
@@ -675,7 +680,7 @@ and module_expr i ppf x =
       expression i ppf e;
   | Pmod_extension (s, arg) ->
       line i ppf "Pmod_extension \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and structure i ppf x = list i structure_item ppf x
 
@@ -732,10 +737,10 @@ and structure_item i ppf x =
   | Pstr_extension ((s, arg), attrs) ->
       line i ppf "Pstr_extension \"%s\"\n" s.txt;
       attributes i ppf attrs;
-      structure i ppf arg
+      payload i ppf arg
   | Pstr_attribute (s, arg) ->
       line i ppf "Pstr_attribute \"%s\"\n" s.txt;
-      structure i ppf arg
+      payload i ppf arg
 
 and module_declaration i ppf pmd =
   string_loc i ppf pmd.pmd_name;

parsing/printast.mli

@@ -19,3 +19,4 @@ val top_phrase : formatter -> toplevel_phrase -> unit;;
 
 val expression: int -> formatter -> expression -> unit
 val structure: int -> formatter -> structure -> unit
+val payload: int -> formatter -> payload -> unit

typing/printtyped.ml

@@ -141,7 +141,7 @@ let attributes i ppf l =
   List.iter
     (fun (s, arg) ->
       line i ppf "attribute \"%s\"\n" s.txt;
-      Printast.structure (i + 1) ppf arg;
+      Printast.payload (i + 1) ppf arg;
     )
     l
 
@@ -613,7 +613,7 @@ and signature_item i ppf x =
       list i class_type_declaration ppf l;
   | Tsig_attribute (s, arg) ->
       line i ppf "Psig_attribute \"%s\"\n" s.txt;
-      Printast.structure i ppf arg
+      Printast.payload i ppf arg
 
 and module_declaration i ppf md =
   line i ppf "%a" fmt_ident md.md_id;
@@ -719,7 +719,7 @@ and structure_item i ppf x =
       module_expr i ppf me;
   | Tstr_attribute (s, arg) ->
       line i ppf "Pstr_attribute \"%s\"\n" s.txt;
-      Printast.structure i ppf arg
+      Printast.payload i ppf arg
 
 and string_x_module_type i ppf (s, _, mty) =
   ident i ppf s;

typing/typecore.ml

@@ -1993,7 +1993,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         Exp.fun_ ~loc
           l None
           (Pat.var ~loc (mknoloc "*opt*"))
-          (Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",[]] [Vb.mk spat smatch] sexp)
+          (Exp.let_ ~loc Nonrecursive ~attrs:[mknoloc "#default",PStr []] [Vb.mk spat smatch] sexp)
       in
       type_expect ?in_function env sfun ty_expected
         (* TODO: keep attributes, call type_function directly *)

typing/typedtree.ml

@@ -21,7 +21,7 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
-type attribute = string loc * Parsetree.structure
+type attribute = Parsetree.attribute
 type attributes = attribute list
 
 type pattern =

typing/typedtree.mli

@@ -20,7 +20,7 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
-type attribute = string loc * Parsetree.structure
+type attribute = Parsetree.attribute
 type attributes = attribute list
 
 type pattern =