diff options
26 files changed, 116 insertions, 82 deletions
diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index 2cca622635..8dab7d8d61 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/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; diff --git a/experimental/frisch/copy_typedef.ml b/experimental/frisch/copy_typedef.ml index 1c05fa07bb..baf52de4d8 100644 --- a/experimental/frisch/copy_typedef.ml +++ b/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;_}; _}]); _}, _); _}] -> diff --git a/experimental/frisch/eval.ml b/experimental/frisch/eval.ml index a6c2b8547e..dcdb5b553f 100644 --- a/experimental/frisch/eval.ml +++ b/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 | _ -> diff --git a/experimental/frisch/extension_points.txt b/experimental/frisch/extension_points.txt index 1fa7e9c66c..e6276080fd 100644 --- a/experimental/frisch/extension_points.txt +++ b/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, diff --git a/experimental/frisch/ifdef.ml b/experimental/frisch/ifdef.ml index 1a356f38fb..e4396202a4 100644 --- a/experimental/frisch/ifdef.ml +++ b/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." diff --git a/experimental/frisch/js_syntax.ml b/experimental/frisch/js_syntax.ml index 0d65fde82a..518196eb19 100644 --- a/experimental/frisch/js_syntax.ml +++ b/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 -> diff --git a/experimental/frisch/metaquot.ml b/experimental/frisch/metaquot.ml index 1241f8d6ea..63aad0106d 100644 --- a/experimental/frisch/metaquot.ml +++ b/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 ) diff --git a/experimental/frisch/metaquot_test.ml b/experimental/frisch/metaquot_test.ml index 5f6e81581d..b389f18eee 100644 --- a/experimental/frisch/metaquot_test.ml +++ b/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 diff --git a/experimental/frisch/minidoc.ml b/experimental/frisch/minidoc.ml index 5f4d5b78b3..bf37a0123c 100644 --- a/experimental/frisch/minidoc.ml +++ b/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 diff --git a/experimental/frisch/nomli.ml b/experimental/frisch/nomli.ml index 83455b19c8..6cf34557bc 100644 --- a/experimental/frisch/nomli.ml +++ b/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 diff --git a/experimental/frisch/ppx_builder.ml b/experimental/frisch/ppx_builder.ml index 61240c1579..262274cb40 100644 --- a/experimental/frisch/ppx_builder.ml +++ b/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 diff --git a/experimental/frisch/test_copy_typedef.ml b/experimental/frisch/test_copy_typedef.ml index 62182a523c..cd774c6915 100644 --- a/experimental/frisch/test_copy_typedef.ml +++ b/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] diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index 40d5a62da6..6bb01d9534 100644 --- a/parsing/ast_helper.ml +++ b/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 = diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli index 57ac800f14..329db3616e 100644 --- a/parsing/ast_helper.mli +++ b/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 diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 7305d89b96..5ea1766e2a 100644 --- a/parsing/ast_mapper.ml +++ b/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 = diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli index 6f88d88d2e..b5ad431a69 100644 --- a/parsing/ast_mapper.mli +++ b/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 = diff --git a/parsing/parser.mly b/parsing/parser.mly index f01ac43ec3..7fb44b73fd 100644 --- a/parsing/parser.mly +++ b/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 ())])) ] *) } ; %% diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 14ed11ef3e..361fce5879 100644 --- a/parsing/parsetree.mli +++ b/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 *) diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index 3212aca365..9dfe7b6225 100644 --- a/parsing/pprintast.ml +++ b/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 = diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli index 6fc21255bc..86297cea82 100644 --- a/parsing/pprintast.mli +++ b/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 diff --git a/parsing/printast.ml b/parsing/printast.ml index d4f3f17058..cfefe441da 100644 --- a/parsing/printast.ml +++ b/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; diff --git a/parsing/printast.mli b/parsing/printast.mli index bca2820ba4..8523e71c92 100644 --- a/parsing/printast.mli +++ b/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 diff --git a/typing/printtyped.ml b/typing/printtyped.ml index c45a7dae63..7861361b8e 100644 --- a/typing/printtyped.ml +++ b/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; diff --git a/typing/typecore.ml b/typing/typecore.ml index c35cb162a6..6d2343ed56 100644 --- a/typing/typecore.ml +++ b/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 *) diff --git a/typing/typedtree.ml b/typing/typedtree.ml index 90cd6198bb..f7e6408986 100644 --- a/typing/typedtree.ml +++ b/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 = diff --git a/typing/typedtree.mli b/typing/typedtree.mli index e55561d08c..e0686f836a 100644 --- a/typing/typedtree.mli +++ b/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 = |