OpenE2K
/
rust
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Parse effect-qualified type definitions.

This commit is contained in:
Graydon Hoare 2010-07-02 12:02:56 -07:00
parent 2683ae64bf
commit 285a4735b9
6 changed files with 42 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/boot/fe/ast.ml
View File

@ -410,7 +410,7 @@ and obj =
and ty_param = ident * (ty_param_idx * effect)
and mod_item' =
MOD_ITEM_type of ty
MOD_ITEM_type of (effect * ty)
| MOD_ITEM_tag of (header_tup * ty_tag * node_id)
| MOD_ITEM_mod of (mod_view * mod_items)
| MOD_ITEM_fn of fn
@ -1212,6 +1212,10 @@ and fmt_ident_and_params
fmt_ident ff id;
fmt_decl_params ff params
and fmt_effect_qual (ff:Format.formatter) (e:effect) : unit =
fmt_effect ff e;
if e <> PURE then fmt ff " ";
and fmt_fn
(ff:Format.formatter)
(id:ident)
@ -1219,8 +1223,7 @@ and fmt_fn
(f:fn)
: unit =
fmt_obox ff;
fmt_effect ff f.fn_aux.fn_effect;
if f.fn_aux.fn_effect <> PURE then fmt ff " ";
fmt_effect_qual ff f.fn_aux.fn_effect;
fmt ff "%s "(if f.fn_aux.fn_is_iter then "iter" else "fn");
fmt_ident_and_params ff id params;
fmt_header_slots ff f.fn_input_slots;
@ -1240,8 +1243,7 @@ and fmt_obj
(obj:obj)
: unit =
fmt_obox ff;
fmt_effect ff obj.obj_effect;
if obj.obj_effect <> PURE then fmt ff " ";
fmt_effect_qual ff obj.obj_effect;
fmt ff "obj ";
fmt_ident_and_params ff id params;
fmt_header_slots ff obj.obj_state;
@ -1277,7 +1279,8 @@ and fmt_mod_item (ff:Format.formatter) (id:ident) (item:mod_item) : unit =
let params = Array.map (fun i -> i.node) params in
begin
match item.node.decl_item with
MOD_ITEM_type ty ->
MOD_ITEM_type (e, ty) ->
fmt_effect_qual ff e;
fmt ff "type ";
fmt_ident_and_params ff id params;
fmt ff " = ";

33
src/boot/fe/item.ml
View File

@ -760,6 +760,20 @@ and parse_obj_item
span ps apos bpos
(decl params (Ast.MOD_ITEM_obj obj)))
and parse_type_item
(ps:pstate)
(apos:pos)
(effect:Ast.effect)
: (Ast.ident * Ast.mod_item) =
expect ps TYPE;
let (ident, params) = parse_ident_and_params ps "type" in
let _ = expect ps EQ in
let ty = ctxt "mod type item: ty" Pexp.parse_ty ps in
let _ = expect ps SEMI in
let bpos = lexpos ps in
let item = Ast.MOD_ITEM_type (effect, ty) in
(ident, span ps apos bpos (decl params item))
and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) =
let apos = lexpos ps in
@ -775,13 +789,15 @@ and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) =
| _ -> ps.pstate_infer_lib_name ident
in
match peek ps with
IO | STATE | UNSAFE | OBJ | FN | ITER ->
IO | STATE | UNSAFE | TYPE | OBJ | FN | ITER ->
let effect = Pexp.parse_effect ps in
begin
match peek ps with
OBJ -> parse_obj_item ps apos effect
| TYPE -> parse_type_item ps apos effect
| _ ->
let is_iter = (peek ps) = ITER in
bump ps;
@ -795,16 +811,6 @@ and parse_mod_item (ps:pstate) : (Ast.ident * Ast.mod_item) =
(decl params (Ast.MOD_ITEM_fn fn)))
end
| TYPE ->
bump ps;
let (ident, params) = parse_ident_and_params ps "type" in
let _ = expect ps EQ in
let ty = ctxt "mod type item: ty" Pexp.parse_ty ps in
let _ = expect ps SEMI in
let bpos = lexpos ps in
let item = Ast.MOD_ITEM_type ty in
(ident, span ps apos bpos (decl params item))
| MOD ->
bump ps;
let (ident, params) = parse_ident_and_params ps "mod" in
@ -964,7 +970,8 @@ and parse_mod_item_from_signature (ps:pstate)
in
expect ps SEMI;
let bpos = lexpos ps in
(ident, span ps apos bpos (decl params (Ast.MOD_ITEM_type t)))
(ident, span ps apos bpos
(decl params (Ast.MOD_ITEM_type (Ast.UNSAFE, t))))
| _ -> raise (unexpected ps)
@ -1008,7 +1015,7 @@ and expand_tags
| _ -> [| |]
in
match item.node.Ast.decl_item with
Ast.MOD_ITEM_type tyd -> handle_ty_decl item.id tyd
Ast.MOD_ITEM_type (_, tyd) -> handle_ty_decl item.id tyd
| _ -> [| |]

3
src/boot/fe/pexp.ml
View File

@ -360,9 +360,6 @@ and flag (ps:pstate) (tok:token) : bool =
then (bump ps; true)
else false
and parse_mutability (ps:pstate) : bool =
flag ps MUTABLE
and parse_slot (aliases_ok:bool) (ps:pstate) : Ast.slot =
let mode =
match (peek ps, aliases_ok) with

11
src/boot/me/dwarf.ml
View File

@ -1210,6 +1210,8 @@ let (abbrev_typedef:abbrev) =
(DW_TAG_typedef, DW_CHILDREN_yes,
[|
(DW_AT_name, DW_FORM_string);
(DW_AT_mutable, DW_FORM_flag);
(DW_AT_pure, DW_FORM_flag);
(DW_AT_type, DW_FORM_ref_addr)
|])
;;
@ -2319,6 +2321,7 @@ let dwarf_visitor
let emit_typedef_die
(id:Ast.ident)
(e:Ast.effect)
(ty:Ast.ty)
: unit =
let abbrev_code = get_abbrev_code abbrev_typedef in
@ -2327,6 +2330,7 @@ let dwarf_visitor
uleb abbrev_code;
(* DW_AT_name: DW_FORM_string *)
ZSTRING id;
encode_effect e;
(* DW_AT_type: DW_FORM_ref_addr *)
(ref_type_die ty);
|])
@ -2388,13 +2392,13 @@ let dwarf_visitor
(Hashtbl.find cx.ctxt_fn_fixups item.id);
emit_type_param_decl_dies item.node.Ast.decl_params;
end
| Ast.MOD_ITEM_type _ ->
| Ast.MOD_ITEM_type (e, _) ->
begin
log cx "walking typedef '%s' with %d type params"
(path_name())
(Array.length item.node.Ast.decl_params);
emit_typedef_die
id (Hashtbl.find cx.ctxt_all_type_items item.id);
id e (Hashtbl.find cx.ctxt_all_type_items item.id);
emit_type_param_decl_dies item.node.Ast.decl_params;
end
| _ -> ()
@ -3100,9 +3104,10 @@ let rec extract_mod_items
let die = Hashtbl.find dies i in
match die.die_tag with
DW_TAG_typedef ->
let effect = get_effect die in
let ident = get_name die in
let ty = get_referenced_ty die in
let tyi = Ast.MOD_ITEM_type ty in
let tyi = Ast.MOD_ITEM_type (effect, ty) in
let (params, islots) = get_formals die in
assert ((Array.length islots) = 0);
htab_put mis ident (decl params tyi)

8
src/boot/me/resolve.ml
View File

@ -270,7 +270,7 @@ let type_reference_and_tag_extracting_visitor
let visit_mod_item_pre id params item =
begin
match item.node.Ast.decl_item with
Ast.MOD_ITEM_type ty ->
Ast.MOD_ITEM_type (_, ty) ->
begin
log cx "extracting references for type node %d"
(int_of_node item.id);
@ -395,7 +395,7 @@ and lookup_type_by_name
| Some (scopes', id) ->
let ty, params =
match htab_search cx.ctxt_all_defns id with
Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type t;
Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type (_, t);
Ast.decl_params = params }) ->
(t, Array.map (fun p -> p.node) params)
| Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj ob;
@ -543,7 +543,7 @@ let type_resolving_visitor
begin
try
match item.node.Ast.decl_item with
Ast.MOD_ITEM_type ty ->
Ast.MOD_ITEM_type (_, ty) ->
let ty =
resolve_type cx (!scopes) recursive_tag_groups
all_tags empty_recur_info ty
@ -838,7 +838,7 @@ let resolve_recursion
then begin
match Hashtbl.find cx.ctxt_all_defns id with
DEFN_item
{ Ast.decl_item = Ast.MOD_ITEM_type (Ast.TY_tag _) } ->
{ Ast.decl_item = Ast.MOD_ITEM_type (_, (Ast.TY_tag _)) } ->
log cx "type %d is a recursive tag" (int_of_node id);
Hashtbl.replace recursive_tag_types id ()
| _ ->

2
src/boot/me/walk.ml
View File

@ -235,7 +235,7 @@ and walk_mod_item
: unit =
let children _ =
match item.node.Ast.decl_item with
Ast.MOD_ITEM_type ty -> walk_ty v ty
Ast.MOD_ITEM_type (_, ty) -> walk_ty v ty
| Ast.MOD_ITEM_fn f -> walk_fn v f item.id
| Ast.MOD_ITEM_tag (htup, ttag, _) ->
walk_header_tup v htup;