Keep item attributes on let-binding structure items.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13511 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
8a9188eb3f
commit
92ad47d47b
|
@ -286,7 +286,7 @@ and transl_structure fields cc rootpath = function
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
| Tstr_eval expr ->
|
| Tstr_eval expr ->
|
||||||
Lsequence(transl_exp expr, transl_structure fields cc rootpath rem)
|
Lsequence(transl_exp expr, transl_structure fields cc rootpath rem)
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) ->
|
||||||
let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
|
let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
|
||||||
transl_let rec_flag pat_expr_list
|
transl_let rec_flag pat_expr_list
|
||||||
(transl_structure ext_fields cc rootpath rem)
|
(transl_structure ext_fields cc rootpath rem)
|
||||||
|
@ -365,7 +365,7 @@ let rec defined_idents = function
|
||||||
| item :: rem ->
|
| item :: rem ->
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
| Tstr_eval expr -> defined_idents rem
|
| Tstr_eval expr -> defined_idents rem
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) ->
|
||||||
let_bound_idents pat_expr_list @ defined_idents rem
|
let_bound_idents pat_expr_list @ defined_idents rem
|
||||||
| Tstr_primitive desc -> defined_idents rem
|
| Tstr_primitive desc -> defined_idents rem
|
||||||
| Tstr_type decls -> defined_idents rem
|
| Tstr_type decls -> defined_idents rem
|
||||||
|
@ -388,7 +388,7 @@ let rec more_idents = function
|
||||||
| item :: rem ->
|
| item :: rem ->
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
| Tstr_eval expr -> more_idents rem
|
| Tstr_eval expr -> more_idents rem
|
||||||
| Tstr_value(rec_flag, pat_expr_list) -> more_idents rem
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) -> more_idents rem
|
||||||
| Tstr_primitive _ -> more_idents rem
|
| Tstr_primitive _ -> more_idents rem
|
||||||
| Tstr_type decls -> more_idents rem
|
| Tstr_type decls -> more_idents rem
|
||||||
| Tstr_exception _ -> more_idents rem
|
| Tstr_exception _ -> more_idents rem
|
||||||
|
@ -409,7 +409,7 @@ and all_idents = function
|
||||||
| item :: rem ->
|
| item :: rem ->
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
| Tstr_eval expr -> all_idents rem
|
| Tstr_eval expr -> all_idents rem
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) ->
|
||||||
let_bound_idents pat_expr_list @ all_idents rem
|
let_bound_idents pat_expr_list @ all_idents rem
|
||||||
| Tstr_primitive _ -> all_idents rem
|
| Tstr_primitive _ -> all_idents rem
|
||||||
| Tstr_type decls -> all_idents rem
|
| Tstr_type decls -> all_idents rem
|
||||||
|
@ -459,7 +459,7 @@ let transl_store_structure glob map prims str =
|
||||||
| Tstr_eval expr ->
|
| Tstr_eval expr ->
|
||||||
Lsequence(subst_lambda subst (transl_exp expr),
|
Lsequence(subst_lambda subst (transl_exp expr),
|
||||||
transl_store rootpath subst rem)
|
transl_store rootpath subst rem)
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) ->
|
||||||
let ids = let_bound_idents pat_expr_list in
|
let ids = let_bound_idents pat_expr_list in
|
||||||
let lam = transl_let rec_flag pat_expr_list (store_idents ids) in
|
let lam = transl_let rec_flag pat_expr_list (store_idents ids) in
|
||||||
Lsequence(subst_lambda subst lam,
|
Lsequence(subst_lambda subst lam,
|
||||||
|
@ -672,7 +672,7 @@ let transl_toplevel_item item =
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
Tstr_eval expr ->
|
Tstr_eval expr ->
|
||||||
transl_exp expr
|
transl_exp expr
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list, _attrs) ->
|
||||||
let idents = let_bound_idents pat_expr_list in
|
let idents = let_bound_idents pat_expr_list in
|
||||||
transl_let rec_flag pat_expr_list
|
transl_let rec_flag pat_expr_list
|
||||||
(make_sequence toploop_setvalue_id idents)
|
(make_sequence toploop_setvalue_id idents)
|
||||||
|
|
|
@ -1085,7 +1085,7 @@ value varify_constructors var_names =
|
||||||
[mkstr loc (Pstr_open (long_uident id, [])) :: l]
|
[mkstr loc (Pstr_open (long_uident id, [])) :: l]
|
||||||
| StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l]
|
| StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l]
|
||||||
| StVal loc rf bi ->
|
| StVal loc rf bi ->
|
||||||
[mkstr loc (Pstr_value (mkrf rf) (binding bi [])) :: l]
|
[mkstr loc (Pstr_value (mkrf rf) (binding bi []) []) :: l]
|
||||||
| <:str_item@loc< $anti:_$ >> -> error loc "antiquotation in str_item" ]
|
| <:str_item@loc< $anti:_$ >> -> error loc "antiquotation in str_item" ]
|
||||||
and class_type =
|
and class_type =
|
||||||
fun
|
fun
|
||||||
|
|
|
@ -15471,7 +15471,7 @@ module Struct =
|
||||||
| StTyp (loc, tdl) ->
|
| StTyp (loc, tdl) ->
|
||||||
(mkstr loc (Pstr_type (mktype_decl tdl []))) :: l
|
(mkstr loc (Pstr_type (mktype_decl tdl []))) :: l
|
||||||
| StVal (loc, rf, bi) ->
|
| StVal (loc, rf, bi) ->
|
||||||
(mkstr loc (Pstr_value ((mkrf rf), (binding bi [])))) :: l
|
(mkstr loc (Pstr_value ((mkrf rf), (binding bi []), []))) :: l
|
||||||
| Ast.StAnt (loc, _) -> error loc "antiquotation in str_item"
|
| Ast.StAnt (loc, _) -> error loc "antiquotation in str_item"
|
||||||
and class_type =
|
and class_type =
|
||||||
function
|
function
|
||||||
|
|
|
@ -98,7 +98,7 @@ module Typedtree_search =
|
||||||
(CT (Name.from_ident id))
|
(CT (Name.from_ident id))
|
||||||
(Typedtree.Tstr_class_type [ci]))
|
(Typedtree.Tstr_class_type [ci]))
|
||||||
info_list
|
info_list
|
||||||
| Typedtree.Tstr_value (_, pat_exp_list) ->
|
| Typedtree.Tstr_value (_, pat_exp_list, _) ->
|
||||||
List.iter
|
List.iter
|
||||||
(fun (pat,exp) ->
|
(fun (pat,exp) ->
|
||||||
match iter_val_pattern pat.Typedtree.pat_desc with
|
match iter_val_pattern pat.Typedtree.pat_desc with
|
||||||
|
@ -1059,7 +1059,7 @@ module Analyser =
|
||||||
| Parsetree.Pstr_attribute _
|
| Parsetree.Pstr_attribute _
|
||||||
| Parsetree.Pstr_extension _ ->
|
| Parsetree.Pstr_extension _ ->
|
||||||
(0, env, [])
|
(0, env, [])
|
||||||
| Parsetree.Pstr_value (rec_flag, pat_exp_list) ->
|
| Parsetree.Pstr_value (rec_flag, pat_exp_list, _) ->
|
||||||
(* of rec_flag * (pattern * expression) list *)
|
(* of rec_flag * (pattern * expression) list *)
|
||||||
(* For each value, look for the value name, then look in the
|
(* For each value, look for the value name, then look in the
|
||||||
typedtree for the corresponding information,
|
typedtree for the corresponding information,
|
||||||
|
|
|
@ -452,7 +452,7 @@ let search_structure str ~name ~kind ~prefix =
|
||||||
List.iter (search_module str ~prefix) ~f:
|
List.iter (search_module str ~prefix) ~f:
|
||||||
begin fun item ->
|
begin fun item ->
|
||||||
if match item.pstr_desc with
|
if match item.pstr_desc with
|
||||||
Pstr_value (_, l) when kind = Pvalue ->
|
Pstr_value (_, l, _) when kind = Pvalue ->
|
||||||
List.iter l ~f:
|
List.iter l ~f:
|
||||||
begin fun (pat,_) ->
|
begin fun (pat,_) ->
|
||||||
if List.mem name (bound_variables pat)
|
if List.mem name (bound_variables pat)
|
||||||
|
|
|
@ -660,7 +660,7 @@ let rec search_pos_structure ~pos str =
|
||||||
List.iter str ~f:
|
List.iter str ~f:
|
||||||
begin function str -> match str.str_desc with
|
begin function str -> match str.str_desc with
|
||||||
Tstr_eval exp -> search_pos_expr exp ~pos
|
Tstr_eval exp -> search_pos_expr exp ~pos
|
||||||
| Tstr_value (rec_flag, l) ->
|
| Tstr_value (rec_flag, l, _) ->
|
||||||
List.iter l ~f:
|
List.iter l ~f:
|
||||||
begin fun (pat, exp) ->
|
begin fun (pat, exp) ->
|
||||||
let env =
|
let env =
|
||||||
|
|
|
@ -158,7 +158,7 @@ module Str = struct
|
||||||
let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}
|
let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc}
|
||||||
|
|
||||||
let eval ?loc a = mk ?loc (Pstr_eval a)
|
let eval ?loc a = mk ?loc (Pstr_eval a)
|
||||||
let value ?loc a b = mk ?loc (Pstr_value (a, b))
|
let value ?loc ?(attrs = []) a b = mk ?loc (Pstr_value (a, b, attrs))
|
||||||
let primitive ?loc a = mk ?loc (Pstr_primitive a)
|
let primitive ?loc a = mk ?loc (Pstr_primitive a)
|
||||||
let type_ ?loc a = mk ?loc (Pstr_type a)
|
let type_ ?loc a = mk ?loc (Pstr_type a)
|
||||||
let exception_ ?loc a = mk ?loc (Pstr_exception a)
|
let exception_ ?loc a = mk ?loc (Pstr_exception a)
|
||||||
|
|
|
@ -154,7 +154,7 @@ module Str:
|
||||||
val mk: ?loc:loc -> structure_item_desc -> structure_item
|
val mk: ?loc:loc -> structure_item_desc -> structure_item
|
||||||
|
|
||||||
val eval: ?loc:loc -> expression -> structure_item
|
val eval: ?loc:loc -> expression -> structure_item
|
||||||
val value: ?loc:loc -> rec_flag -> (pattern * expression) list -> structure_item
|
val value: ?loc:loc -> ?attrs:attributes -> rec_flag -> (pattern * expression) list -> structure_item
|
||||||
val primitive: ?loc:loc -> value_description -> structure_item
|
val primitive: ?loc:loc -> value_description -> structure_item
|
||||||
val type_: ?loc:loc -> type_declaration list -> structure_item
|
val type_: ?loc:loc -> type_declaration list -> structure_item
|
||||||
val exception_: ?loc:loc -> constructor_declaration -> structure_item
|
val exception_: ?loc:loc -> constructor_declaration -> structure_item
|
||||||
|
|
|
@ -166,7 +166,7 @@ module M = struct
|
||||||
let loc = sub # location loc in
|
let loc = sub # location loc in
|
||||||
match desc with
|
match desc with
|
||||||
| Pstr_eval x -> eval ~loc (sub # expr x)
|
| Pstr_eval x -> eval ~loc (sub # expr x)
|
||||||
| Pstr_value (r, pel) -> value ~loc r (List.map (map_tuple (sub # pat) (sub # expr)) pel)
|
| Pstr_value (r, pel, attrs) -> value ~loc ~attrs:(sub # attributes attrs) r (List.map (map_tuple (sub # pat) (sub # expr)) pel)
|
||||||
| Pstr_primitive vd -> primitive ~loc (sub # value_description vd)
|
| Pstr_primitive vd -> primitive ~loc (sub # value_description vd)
|
||||||
| Pstr_type l -> type_ ~loc (List.map (sub # type_declaration) l)
|
| Pstr_type l -> type_ ~loc (List.map (sub # type_declaration) l)
|
||||||
| Pstr_exception ed -> exception_ ~loc (sub # constructor_declaration ed)
|
| Pstr_exception ed -> exception_ ~loc (sub # constructor_declaration ed)
|
||||||
|
|
|
@ -173,6 +173,9 @@ let unclosed opening_name opening_num closing_name closing_num =
|
||||||
let expecting pos nonterm =
|
let expecting pos nonterm =
|
||||||
raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))
|
raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))
|
||||||
|
|
||||||
|
let not_expecting pos nonterm =
|
||||||
|
raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm)))
|
||||||
|
|
||||||
let bigarray_function str name =
|
let bigarray_function str name =
|
||||||
ghloc (Ldot(Ldot(Lident "Bigarray", str), name))
|
ghloc (Ldot(Ldot(Lident "Bigarray", str), name))
|
||||||
|
|
||||||
|
@ -597,11 +600,18 @@ str_attribute:
|
||||||
post_item_attribute { mkstr(Pstr_attribute $1) }
|
post_item_attribute { mkstr(Pstr_attribute $1) }
|
||||||
;
|
;
|
||||||
structure_item:
|
structure_item:
|
||||||
LET ext_attributes rec_flag let_bindings
|
LET ext_attributes rec_flag let_bindings post_item_attributes
|
||||||
{ (* todo: keep attributes *)
|
{
|
||||||
match $4 with
|
match $4 with
|
||||||
[{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
|
[{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
|
||||||
| l -> mkstr(Pstr_value($3, List.rev l)) }
|
(* todo: keep attributes, support extension *)
|
||||||
|
| l ->
|
||||||
|
begin match $2 with
|
||||||
|
| None, [] -> mkstr(Pstr_value($3, List.rev l, $5))
|
||||||
|
| Some _, _ -> not_expecting 2 "extension"
|
||||||
|
| None, _ :: _ -> not_expecting 2 "attribute"
|
||||||
|
end
|
||||||
|
}
|
||||||
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
|
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
|
||||||
{ mkstr
|
{ mkstr
|
||||||
(Pstr_primitive (Val.mk (mkrhs $2 2) $4
|
(Pstr_primitive (Val.mk (mkrhs $2 2) $4
|
||||||
|
|
|
@ -337,7 +337,7 @@ and structure_item =
|
||||||
|
|
||||||
and structure_item_desc =
|
and structure_item_desc =
|
||||||
Pstr_eval of expression
|
Pstr_eval of expression
|
||||||
| Pstr_value of rec_flag * (pattern * expression) list
|
| Pstr_value of rec_flag * (pattern * expression) list * attributes
|
||||||
| Pstr_primitive of value_description
|
| Pstr_primitive of value_description
|
||||||
| Pstr_type of type_declaration list
|
| Pstr_type of type_declaration list
|
||||||
| Pstr_exception of constructor_declaration
|
| Pstr_exception of constructor_declaration
|
||||||
|
|
|
@ -1038,7 +1038,7 @@ class printer ()= object(self:'self)
|
||||||
pp f "@[<hov2>let@ _ =@ %a@]" self#expression e
|
pp f "@[<hov2>let@ _ =@ %a@]" self#expression e
|
||||||
| Pstr_type [] -> assert false
|
| Pstr_type [] -> assert false
|
||||||
| Pstr_type l -> self#type_def_list f l
|
| Pstr_type l -> self#type_def_list f l
|
||||||
| Pstr_value (rf, l) -> (* pp f "@[<hov2>let %a%a@]" self#rec_flag rf self#bindings l *)
|
| Pstr_value (rf, l, _attrs) -> (* pp f "@[<hov2>let %a%a@]" self#rec_flag rf self#bindings l *)
|
||||||
pp f "@[<2>%a@]" self#bindings (rf,l)
|
pp f "@[<2>%a@]" self#bindings (rf,l)
|
||||||
| Pstr_exception ed -> self#exception_declaration f ed
|
| Pstr_exception ed -> self#exception_declaration f ed
|
||||||
| Pstr_module x ->
|
| Pstr_module x ->
|
||||||
|
|
|
@ -677,8 +677,9 @@ and structure_item i ppf x =
|
||||||
| Pstr_eval (e) ->
|
| Pstr_eval (e) ->
|
||||||
line i ppf "Pstr_eval\n";
|
line i ppf "Pstr_eval\n";
|
||||||
expression i ppf e;
|
expression i ppf e;
|
||||||
| Pstr_value (rf, l) ->
|
| Pstr_value (rf, l, attrs) ->
|
||||||
line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
|
line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
|
||||||
|
attributes i ppf attrs;
|
||||||
list i pattern_x_expression_def ppf l;
|
list i pattern_x_expression_def ppf l;
|
||||||
| Pstr_primitive vd ->
|
| Pstr_primitive vd ->
|
||||||
line i ppf "Pstr_primitive\n";
|
line i ppf "Pstr_primitive\n";
|
||||||
|
|
|
@ -17,6 +17,7 @@ open Format
|
||||||
type error =
|
type error =
|
||||||
Unclosed of Location.t * string * Location.t * string
|
Unclosed of Location.t * string * Location.t * string
|
||||||
| Expecting of Location.t * string
|
| Expecting of Location.t * string
|
||||||
|
| Not_expecting of Location.t * string
|
||||||
| Applicative_path of Location.t
|
| Applicative_path of Location.t
|
||||||
| Variable_in_scope of Location.t * string
|
| Variable_in_scope of Location.t * string
|
||||||
| Other of Location.t
|
| Other of Location.t
|
||||||
|
@ -42,6 +43,10 @@ let report_error ppf = function
|
||||||
fprintf ppf
|
fprintf ppf
|
||||||
"%a@[Syntax error: %s expected.@]"
|
"%a@[Syntax error: %s expected.@]"
|
||||||
Location.print_error loc nonterm
|
Location.print_error loc nonterm
|
||||||
|
| Not_expecting (loc, nonterm) ->
|
||||||
|
fprintf ppf
|
||||||
|
"%a@[Syntax error: %s not expected.@]"
|
||||||
|
Location.print_error loc nonterm
|
||||||
| Applicative_path loc ->
|
| Applicative_path loc ->
|
||||||
fprintf ppf
|
fprintf ppf
|
||||||
"%aSyntax error: applicative paths of the form F(X).t \
|
"%aSyntax error: applicative paths of the form F(X).t \
|
||||||
|
@ -61,4 +66,5 @@ let location_of_error = function
|
||||||
| Applicative_path l
|
| Applicative_path l
|
||||||
| Variable_in_scope(l,_)
|
| Variable_in_scope(l,_)
|
||||||
| Other l
|
| Other l
|
||||||
|
| Not_expecting (l, _)
|
||||||
| Expecting (l, _) -> l
|
| Expecting (l, _) -> l
|
||||||
|
|
|
@ -17,6 +17,7 @@ open Format
|
||||||
type error =
|
type error =
|
||||||
Unclosed of Location.t * string * Location.t * string
|
Unclosed of Location.t * string * Location.t * string
|
||||||
| Expecting of Location.t * string
|
| Expecting of Location.t * string
|
||||||
|
| Not_expecting of Location.t * string
|
||||||
| Applicative_path of Location.t
|
| Applicative_path of Location.t
|
||||||
| Variable_in_scope of Location.t * string
|
| Variable_in_scope of Location.t * string
|
||||||
| Other of Location.t
|
| Other of Location.t
|
||||||
|
|
|
@ -92,7 +92,7 @@ let iterator rebuild_env =
|
||||||
|
|
||||||
method private structure_item_rem s rem =
|
method private structure_item_rem s rem =
|
||||||
begin match s with
|
begin match s with
|
||||||
| {str_desc = Tstr_value (rec_flag, bindings); str_loc = loc} ->
|
| {str_desc = Tstr_value (rec_flag, bindings, _); str_loc = loc} ->
|
||||||
let open Location in
|
let open Location in
|
||||||
let doit loc_start = bind_bindings {scope with loc_start} bindings in
|
let doit loc_start = bind_bindings {scope with loc_start} bindings in
|
||||||
begin match rec_flag, rem with
|
begin match rec_flag, rem with
|
||||||
|
|
|
@ -262,7 +262,7 @@ and add_struct_item bv item =
|
||||||
match item.pstr_desc with
|
match item.pstr_desc with
|
||||||
Pstr_eval e ->
|
Pstr_eval e ->
|
||||||
add_expr bv e; bv
|
add_expr bv e; bv
|
||||||
| Pstr_value(rf, pel) ->
|
| Pstr_value(rf, pel, _attrs) ->
|
||||||
let bv = add_bindings rf bv pel in bv
|
let bv = add_bindings rf bv pel in bv
|
||||||
| Pstr_primitive vd ->
|
| Pstr_primitive vd ->
|
||||||
add_type bv vd.pval_type; bv
|
add_type bv vd.pval_type; bv
|
||||||
|
|
|
@ -368,7 +368,7 @@ and rewrite_mod iflag smod =
|
||||||
and rewrite_str_item iflag item =
|
and rewrite_str_item iflag item =
|
||||||
match item.pstr_desc with
|
match item.pstr_desc with
|
||||||
Pstr_eval exp -> rewrite_exp iflag exp
|
Pstr_eval exp -> rewrite_exp iflag exp
|
||||||
| Pstr_value(_, exps)
|
| Pstr_value(_, exps, _attrs)
|
||||||
-> List.iter (function (_,exp) -> rewrite_exp iflag exp) exps
|
-> List.iter (function (_,exp) -> rewrite_exp iflag exp) exps
|
||||||
| Pstr_module x -> rewrite_mod iflag x.pmb_expr
|
| Pstr_module x -> rewrite_mod iflag x.pmb_expr
|
||||||
(* todo: Pstr_recmodule?? *)
|
(* todo: Pstr_recmodule?? *)
|
||||||
|
|
|
@ -25,7 +25,7 @@ let constructor_decl sub cd =
|
||||||
let structure_item sub x =
|
let structure_item sub x =
|
||||||
match x.str_desc with
|
match x.str_desc with
|
||||||
| Tstr_eval exp -> sub # expression exp
|
| Tstr_eval exp -> sub # expression exp
|
||||||
| Tstr_value (rec_flag, list) -> sub # bindings (rec_flag, list)
|
| Tstr_value (rec_flag, list, _) -> sub # bindings (rec_flag, list)
|
||||||
| Tstr_primitive v -> sub # value_description v
|
| Tstr_primitive v -> sub # value_description v
|
||||||
| Tstr_type list -> List.iter (sub # type_declaration) list
|
| Tstr_type list -> List.iter (sub # type_declaration) list
|
||||||
| Tstr_exception decl -> constructor_decl sub decl
|
| Tstr_exception decl -> constructor_decl sub decl
|
||||||
|
|
|
@ -47,9 +47,9 @@ and untype_structure_item item =
|
||||||
let desc =
|
let desc =
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
Tstr_eval exp -> Pstr_eval (untype_expression exp)
|
Tstr_eval exp -> Pstr_eval (untype_expression exp)
|
||||||
| Tstr_value (rec_flag, list) ->
|
| Tstr_value (rec_flag, list, attrs) ->
|
||||||
Pstr_value (rec_flag, List.map (fun (pat, exp) ->
|
Pstr_value (rec_flag, List.map (fun (pat, exp) ->
|
||||||
untype_pattern pat, untype_expression exp) list)
|
untype_pattern pat, untype_expression exp) list, attrs)
|
||||||
| Tstr_primitive vd ->
|
| Tstr_primitive vd ->
|
||||||
Pstr_primitive (untype_value_description vd)
|
Pstr_primitive (untype_value_description vd)
|
||||||
| Tstr_type list ->
|
| Tstr_type list ->
|
||||||
|
|
|
@ -683,8 +683,9 @@ and structure_item i ppf x =
|
||||||
| Tstr_eval (e) ->
|
| Tstr_eval (e) ->
|
||||||
line i ppf "Pstr_eval\n";
|
line i ppf "Pstr_eval\n";
|
||||||
expression i ppf e;
|
expression i ppf e;
|
||||||
| Tstr_value (rf, l) ->
|
| Tstr_value (rf, l, attrs) ->
|
||||||
line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
|
line i ppf "Pstr_value %a\n" fmt_rec_flag rf;
|
||||||
|
attributes i ppf attrs;
|
||||||
list i pattern_x_expression_def ppf l;
|
list i pattern_x_expression_def ppf l;
|
||||||
| Tstr_primitive vd ->
|
| Tstr_primitive vd ->
|
||||||
line i ppf "Pstr_primitive\n";
|
line i ppf "Pstr_primitive\n";
|
||||||
|
|
|
@ -167,7 +167,7 @@ let iter_expression f e =
|
||||||
and structure_item str =
|
and structure_item str =
|
||||||
match str.pstr_desc with
|
match str.pstr_desc with
|
||||||
| Pstr_eval e -> expr e
|
| Pstr_eval e -> expr e
|
||||||
| Pstr_value (_, pel) -> List.iter (fun (_, e) -> expr e) pel
|
| Pstr_value (_, pel, _) -> List.iter (fun (_, e) -> expr e) pel
|
||||||
| Pstr_primitive _
|
| Pstr_primitive _
|
||||||
| Pstr_type _
|
| Pstr_type _
|
||||||
| Pstr_exception _
|
| Pstr_exception _
|
||||||
|
@ -1340,7 +1340,7 @@ and is_nonexpansive_mod mexp =
|
||||||
(fun item -> match item.str_desc with
|
(fun item -> match item.str_desc with
|
||||||
| Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
|
| Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
|
||||||
| Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true
|
| Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true
|
||||||
| Tstr_value (_, pat_exp_list) ->
|
| Tstr_value (_, pat_exp_list, _) ->
|
||||||
List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
|
List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
|
||||||
| Tstr_module {mb_expr=m;_} | Tstr_include (m, _, _) -> is_nonexpansive_mod m
|
| Tstr_module {mb_expr=m;_} | Tstr_include (m, _, _) -> is_nonexpansive_mod m
|
||||||
| Tstr_recmodule id_mod_list ->
|
| Tstr_recmodule id_mod_list ->
|
||||||
|
|
|
@ -202,7 +202,7 @@ and structure_item =
|
||||||
|
|
||||||
and structure_item_desc =
|
and structure_item_desc =
|
||||||
Tstr_eval of expression
|
Tstr_eval of expression
|
||||||
| Tstr_value of rec_flag * (pattern * expression) list
|
| Tstr_value of rec_flag * (pattern * expression) list * attributes
|
||||||
| Tstr_primitive of value_description
|
| Tstr_primitive of value_description
|
||||||
| Tstr_type of type_declaration list
|
| Tstr_type of type_declaration list
|
||||||
| Tstr_exception of constructor_declaration
|
| Tstr_exception of constructor_declaration
|
||||||
|
|
|
@ -201,7 +201,7 @@ and structure_item =
|
||||||
|
|
||||||
and structure_item_desc =
|
and structure_item_desc =
|
||||||
Tstr_eval of expression
|
Tstr_eval of expression
|
||||||
| Tstr_value of rec_flag * (pattern * expression) list
|
| Tstr_value of rec_flag * (pattern * expression) list * attributes
|
||||||
| Tstr_primitive of value_description
|
| Tstr_primitive of value_description
|
||||||
| Tstr_type of type_declaration list
|
| Tstr_type of type_declaration list
|
||||||
| Tstr_exception of constructor_declaration
|
| Tstr_exception of constructor_declaration
|
||||||
|
|
|
@ -120,7 +120,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
|
||||||
begin
|
begin
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
Tstr_eval exp -> iter_expression exp
|
Tstr_eval exp -> iter_expression exp
|
||||||
| Tstr_value (rec_flag, list) ->
|
| Tstr_value (rec_flag, list, _attrs) ->
|
||||||
iter_bindings rec_flag list
|
iter_bindings rec_flag list
|
||||||
| Tstr_primitive vd -> iter_value_description vd
|
| Tstr_primitive vd -> iter_value_description vd
|
||||||
| Tstr_type list -> List.iter iter_type_declaration list
|
| Tstr_type list -> List.iter iter_type_declaration list
|
||||||
|
|
|
@ -92,8 +92,8 @@ module MakeMap(Map : MapArgument) = struct
|
||||||
let str_desc =
|
let str_desc =
|
||||||
match item.str_desc with
|
match item.str_desc with
|
||||||
Tstr_eval exp -> Tstr_eval (map_expression exp)
|
Tstr_eval exp -> Tstr_eval (map_expression exp)
|
||||||
| Tstr_value (rec_flag, list) ->
|
| Tstr_value (rec_flag, list, attrs) ->
|
||||||
Tstr_value (rec_flag, map_bindings rec_flag list)
|
Tstr_value (rec_flag, map_bindings rec_flag list, attrs)
|
||||||
| Tstr_primitive vd ->
|
| Tstr_primitive vd ->
|
||||||
Tstr_primitive (map_value_description vd)
|
Tstr_primitive (map_value_description vd)
|
||||||
| Tstr_type list ->
|
| Tstr_type list ->
|
||||||
|
|
|
@ -662,7 +662,7 @@ and closed_signature_item = function
|
||||||
|
|
||||||
let check_nongen_scheme env str =
|
let check_nongen_scheme env str =
|
||||||
match str.str_desc with
|
match str.str_desc with
|
||||||
Tstr_value(rec_flag, pat_exp_list) ->
|
Tstr_value(rec_flag, pat_exp_list, _attrs) ->
|
||||||
List.iter
|
List.iter
|
||||||
(fun (pat, exp) ->
|
(fun (pat, exp) ->
|
||||||
if not (Ctype.closed_schema exp.exp_type) then
|
if not (Ctype.closed_schema exp.exp_type) then
|
||||||
|
@ -975,7 +975,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
|
||||||
let item = mk (Tstr_eval expr) in
|
let item = mk (Tstr_eval expr) in
|
||||||
let (str_rem, sig_rem, final_env) = type_struct env srem in
|
let (str_rem, sig_rem, final_env) = type_struct env srem in
|
||||||
(item :: str_rem, sig_rem, final_env)
|
(item :: str_rem, sig_rem, final_env)
|
||||||
| Pstr_value(rec_flag, sdefs) ->
|
| Pstr_value(rec_flag, sdefs, attrs) ->
|
||||||
let scope =
|
let scope =
|
||||||
match rec_flag with
|
match rec_flag with
|
||||||
| Recursive -> Some (Annot.Idef {scope with
|
| Recursive -> Some (Annot.Idef {scope with
|
||||||
|
@ -988,7 +988,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
|
||||||
in
|
in
|
||||||
let (defs, newenv) =
|
let (defs, newenv) =
|
||||||
Typecore.type_binding env rec_flag sdefs scope in
|
Typecore.type_binding env rec_flag sdefs scope in
|
||||||
let item = mk (Tstr_value(rec_flag, defs)) in
|
let item = mk (Tstr_value(rec_flag, defs, attrs)) in
|
||||||
let (str_rem, sig_rem, final_env) = type_struct newenv srem in
|
let (str_rem, sig_rem, final_env) = type_struct newenv srem in
|
||||||
let bound_idents = let_bound_idents defs in
|
let bound_idents = let_bound_idents defs in
|
||||||
(* Note: Env.find_value does not trigger the value_used event. Values
|
(* Note: Env.find_value does not trigger the value_used event. Values
|
||||||
|
|
Loading…
Reference in New Issue