aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGraydon Hoare <[email protected]>2010-06-29 12:00:15 -0700
committerGraydon Hoare <[email protected]>2010-06-29 12:00:15 -0700
commit1f9fd2710ec9122ddddcedaab51650a92ad7c8cf (patch)
tree5e8505579d43bb5ad4c95187f6207820a950b37c
parentFix underlying failure to signal errors when dep'ing. (diff)
downloadrust-1f9fd2710ec9122ddddcedaab51650a92ad7c8cf.tar.xz
rust-1f9fd2710ec9122ddddcedaab51650a92ad7c8cf.zip
Initial stab at lowering mutable and exterior into the type system.
-rw-r--r--src/boot/driver/llvm/glue.ml2
-rw-r--r--src/boot/driver/main.ml2
-rw-r--r--src/boot/fe/ast.ml101
-rw-r--r--src/boot/fe/item.ml16
-rw-r--r--src/boot/fe/parser.ml2
-rw-r--r--src/boot/fe/pexp.ml115
-rw-r--r--src/boot/me/alias.ml2
-rw-r--r--src/boot/me/dwarf.ml174
-rw-r--r--src/boot/me/effect.ml27
-rw-r--r--src/boot/me/semant.ml171
-rw-r--r--src/boot/me/trans.ml1050
-rw-r--r--src/boot/me/transutil.ml64
-rw-r--r--src/boot/me/type.ml85
-rw-r--r--src/boot/me/typestate.ml12
-rw-r--r--src/boot/me/walk.ml18
15 files changed, 937 insertions, 904 deletions
diff --git a/src/boot/driver/llvm/glue.ml b/src/boot/driver/llvm/glue.ml
index ef5c1c86..30fce0cd 100644
--- a/src/boot/driver/llvm/glue.ml
+++ b/src/boot/driver/llvm/glue.ml
@@ -16,8 +16,8 @@ let alt_pipeline sess sem_cx crate =
[|
Resolve.process_crate;
Type.process_crate;
- Effect.process_crate;
Typestate.process_crate;
+ Effect.process_crate;
Loop.process_crate;
Alias.process_crate;
Dead.process_crate;
diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml
index 8cfe4048..5655604d 100644
--- a/src/boot/driver/main.ml
+++ b/src/boot/driver/main.ml
@@ -316,8 +316,8 @@ let main_pipeline _ =
exit_if_failed ())
[| Resolve.process_crate;
Type.process_crate;
- Effect.process_crate;
Typestate.process_crate;
+ Effect.process_crate;
Loop.process_crate;
Alias.process_crate;
Dead.process_crate;
diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 770b57bf..8b1ce71f 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -9,11 +9,6 @@
open Common;;
open Fmt;;
-(*
- * Slot names are given by a dot-separated path within the current
- * module namespace.
- *)
-
type ident = string
;;
@@ -70,11 +65,11 @@ and ty =
| TY_str
| TY_tup of ty_tup
- | TY_vec of slot
+ | TY_vec of ty
| TY_rec of ty_rec
(*
- * Note that ty_idx is only valid inside a slot of a ty_iso group, not
+ * Note that ty_idx is only valid inside a ty of a ty_iso group, not
* in a general type term.
*)
| TY_tag of ty_tag
@@ -93,18 +88,25 @@ and ty =
| TY_named of name
| TY_type
+ | TY_exterior of ty
+ | TY_mutable of ty
+
| TY_constrained of (ty * constrs)
+(*
+ * FIXME: this should be cleaned up to be a different
+ * type definition. Only args can be by-ref, only locals
+ * can be auto. The structure here is historical.
+ *)
+
and mode =
- MODE_exterior
| MODE_interior
| MODE_alias
and slot = { slot_mode: mode;
- slot_mutable: bool;
slot_ty: ty option; }
-and ty_tup = slot array
+and ty_tup = ty array
(* In closed type terms a constraint may refer to components of the term by
* anchoring off the "formal symbol" '*', which represents "the term this
@@ -147,7 +149,7 @@ and constr =
and constrs = constr array
-and ty_rec = (ident * slot) array
+and ty_rec = (ident * ty) array
(* ty_tag is a sum type.
*
@@ -185,9 +187,9 @@ and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t))
and check_calls = (lval * (atom array)) array
-and rec_input = (ident * mode * bool * atom)
+and rec_input = (ident * atom)
-and tup_input = (mode * bool * atom)
+and tup_input = atom
and stmt' =
@@ -195,10 +197,11 @@ and stmt' =
STMT_spawn of (lval * domain * lval * (atom array))
| STMT_init_rec of (lval * (rec_input array) * lval option)
| STMT_init_tup of (lval * (tup_input array))
- | STMT_init_vec of (lval * slot * (atom array))
+ | STMT_init_vec of (lval * atom array)
| STMT_init_str of (lval * string)
| STMT_init_port of lval
| STMT_init_chan of (lval * (lval option))
+ | STMT_init_exterior of (lval * atom)
| STMT_copy of (lval * expr)
| STMT_copy_binop of (lval * binop * atom)
| STMT_call of (lval * lval * (atom array))
@@ -516,13 +519,8 @@ and fmt_name (ff:Format.formatter) (n:name) : unit =
fmt ff ".";
fmt_name_component ff nc
-and fmt_mutable (ff:Format.formatter) (m:bool) : unit =
- if m
- then fmt ff "mutable ";
-
and fmt_mode (ff:Format.formatter) (m:mode) : unit =
match m with
- MODE_exterior -> fmt ff "@@"
| MODE_alias -> fmt ff "&"
| MODE_interior -> ()
@@ -530,10 +528,27 @@ and fmt_slot (ff:Format.formatter) (s:slot) : unit =
match s.slot_ty with
None -> fmt ff "auto"
| Some t ->
- fmt_mutable ff s.slot_mutable;
fmt_mode ff s.slot_mode;
fmt_ty ff t
+and fmt_tys
+ (ff:Format.formatter)
+ (tys:ty array)
+ : unit =
+ fmt_bracketed_arr_sep "(" ")" "," fmt_ty ff tys
+
+and fmt_ident_tys
+ (ff:Format.formatter)
+ (entries:(ident * ty) array)
+ : unit =
+ fmt_bracketed_arr_sep "(" ")" ","
+ (fun ff (ident, ty) ->
+ fmt_ty ff ty;
+ fmt ff " ";
+ fmt_ident ff ident)
+ ff
+ entries
+
and fmt_slots
(ff:Format.formatter)
(slots:slot array)
@@ -594,7 +609,7 @@ and fmt_tag (ff:Format.formatter) (ttag:ty_tag) : unit =
then first := false
else fmt ff ",@ ");
fmt_name ff name;
- fmt_slots ff ttup None
+ fmt_tys ff ttup
end
ttag;
fmt ff "@])@]"
@@ -623,19 +638,15 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
| TY_char -> fmt ff "char"
| TY_str -> fmt ff "str"
- | TY_tup slots -> (fmt ff "tup"; fmt_slots ff slots None)
- | TY_vec s -> (fmt ff "vec["; fmt_slot ff s; fmt ff "]")
+ | TY_tup tys -> (fmt ff "tup"; fmt_tys ff tys)
+ | TY_vec t -> (fmt ff "vec["; fmt_ty ff t; fmt ff "]")
| TY_chan t -> (fmt ff "chan["; fmt_ty ff t; fmt ff "]")
| TY_port t -> (fmt ff "port["; fmt_ty ff t; fmt ff "]")
- | TY_rec slots ->
- let (idents, slots) =
- let (idents, slots) = List.split (Array.to_list slots) in
- (Array.of_list idents, Array.of_list slots)
- in
- fmt ff "@[rec";
- fmt_slots ff slots (Some idents);
- fmt ff "@]"
+ | TY_rec entries ->
+ fmt ff "@[rec";
+ fmt_ident_tys ff entries;
+ fmt ff "@]"
| TY_param (i, e) -> (fmt_effect ff e;
if e <> PURE then fmt ff " ";
@@ -644,6 +655,14 @@ and fmt_ty (ff:Format.formatter) (t:ty) : unit =
| TY_named n -> fmt_name ff n
| TY_type -> fmt ff "type"
+ | TY_exterior t ->
+ fmt ff "@@";
+ fmt_ty ff t
+
+ | TY_mutable t ->
+ fmt ff "mutable ";
+ fmt_ty ff t
+
| TY_fn tfn -> fmt_ty_fn ff None tfn
| TY_task -> fmt ff "task"
| TY_tag ttag -> fmt_tag ff ttag
@@ -964,7 +983,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
fmt_lval ff lv;
fmt ff " ";
fmt_binop ff binop;
- fmt ff "=";
+ fmt ff "= ";
fmt_atom ff at;
fmt ff ";"
@@ -999,11 +1018,9 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
do
if i != 0
then fmt ff ", ";
- let (ident, mode, mut, atom) = entries.(i) in
+ let (ident, atom) = entries.(i) in
fmt_ident ff ident;
fmt ff " = ";
- fmt_mutable ff mut;
- fmt_mode ff mode;
fmt_atom ff atom;
done;
begin
@@ -1015,7 +1032,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
end;
fmt ff ");"
- | STMT_init_vec (dst, _, atoms) ->
+ | STMT_init_vec (dst, atoms) ->
fmt_lval ff dst;
fmt ff " = vec(";
for i = 0 to (Array.length atoms) - 1
@@ -1033,10 +1050,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
do
if i != 0
then fmt ff ", ";
- let (mode, mut, atom) = entries.(i) in
- fmt_mutable ff mut;
- fmt_mode ff mode;
- fmt_atom ff atom;
+ fmt_atom ff entries.(i);
done;
fmt ff ");";
@@ -1153,6 +1167,12 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
fmt_lval ff t;
fmt ff ";"
+ | STMT_init_exterior (lv, at) ->
+ fmt_lval ff lv;
+ fmt ff " = @";
+ fmt_atom ff at;
+ fmt ff ";"
+
| STMT_alt_tag _ -> fmt ff "?stmt_alt_tag?"
| STMT_alt_type _ -> fmt ff "?stmt_alt_type?"
| STMT_alt_port _ -> fmt ff "?stmt_alt_port?"
@@ -1321,7 +1341,6 @@ let sprintf_lval_component = sprintf_fmt fmt_lval_component;;
let sprintf_atom = sprintf_fmt fmt_atom;;
let sprintf_slot = sprintf_fmt fmt_slot;;
let sprintf_slot_key = sprintf_fmt fmt_slot_key;;
-let sprintf_mutable = sprintf_fmt fmt_mutable;;
let sprintf_ty = sprintf_fmt fmt_ty;;
let sprintf_effect = sprintf_fmt fmt_effect;;
let sprintf_tag = sprintf_fmt fmt_tag;;
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 3efd4e2a..5c0a7c65 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -128,6 +128,13 @@ and parse_auto_slot_and_init
and parse_stmts (ps:pstate) : Ast.stmt array =
let apos = lexpos ps in
+ let ensure_mutable slot =
+ match slot.Ast.slot_ty with
+ None -> slot
+ | Some (Ast.TY_mutable _) -> slot
+ | Some t -> { slot with Ast.slot_ty = Some (Ast.TY_mutable t) }
+ in
+
let rec name_to_lval (apos:pos) (bpos:pos) (name:Ast.name)
: Ast.lval =
match name with
@@ -236,7 +243,6 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
Ast.NAME_base (Ast.BASE_ident ident) ->
let slot =
{ Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = false;
Ast.slot_ty = None }
in
Ast.PAT_slot
@@ -456,7 +462,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
bump ps;
let (stmts, slot, ident) =
ctxt "stmt slot" parse_slot_and_ident_and_init ps in
- let slot = Pexp.apply_mutability slot true in
+ let slot = ensure_mutable slot in
let bpos = lexpos ps in
let decl = Ast.DECL_slot (Ast.KEY_ident ident,
(span ps apos bpos slot))
@@ -467,7 +473,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
bump ps;
let (stmts, slot, ident) =
ctxt "stmt slot" parse_auto_slot_and_init ps in
- let slot = Pexp.apply_mutability slot true in
+ let slot = ensure_mutable slot in
let bpos = lexpos ps in
let decl = Ast.DECL_slot (Ast.KEY_ident ident,
(span ps apos bpos slot))
@@ -979,7 +985,9 @@ and expand_tags
(ps, "unexpected name type while expanding tag"))
in
let header =
- Array.map (fun slot -> (clone_span ps item slot)) tup
+ Array.map (fun ty -> (clone_span ps item
+ { Ast.slot_mode = Ast.MODE_alias;
+ Ast.slot_ty = Some ty})) tup
in
let tag_item' = Ast.MOD_ITEM_tag (header, ttag, id) in
let cloned_params =
diff --git a/src/boot/fe/parser.ml b/src/boot/fe/parser.ml
index 5df44303..97cf8985 100644
--- a/src/boot/fe/parser.ml
+++ b/src/boot/fe/parser.ml
@@ -181,13 +181,11 @@ let err (str:string) (ps:pstate) =
let (slot_nil:Ast.slot) =
{ Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = false;
Ast.slot_ty = Some Ast.TY_nil }
;;
let (slot_auto:Ast.slot) =
{ Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = true;
Ast.slot_ty = None }
;;
diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml
index e859d135..25352e5c 100644
--- a/src/boot/fe/pexp.ml
+++ b/src/boot/fe/pexp.ml
@@ -22,7 +22,7 @@ type pexp' =
| PEXP_bind of (pexp * pexp option array)
| PEXP_rec of ((Ast.ident * pexp) array * pexp option)
| PEXP_tup of (pexp array)
- | PEXP_vec of (Ast.slot * (pexp array))
+ | PEXP_vec of (pexp array)
| PEXP_port
| PEXP_chan of (pexp option)
| PEXP_binop of (Ast.binop * pexp * pexp)
@@ -261,11 +261,10 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
| VEC ->
bump ps;
- Ast.TY_vec (bracketed LBRACKET RBRACKET (parse_slot false) ps)
+ Ast.TY_vec (bracketed LBRACKET RBRACKET parse_ty ps)
| IDENT _ -> Ast.TY_named (parse_name ps)
-
| TAG ->
bump ps;
let htab = Hashtbl.create 4 in
@@ -273,7 +272,7 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
let ident = parse_ident ps in
let tup =
match peek ps with
- LPAREN -> paren_comma_list (parse_slot false) ps
+ LPAREN -> paren_comma_list parse_ty ps
| _ -> raise (err "tag variant missing argument list" ps)
in
htab_put htab (Ast.NAME_base (Ast.BASE_ident ident)) tup
@@ -287,9 +286,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
| REC ->
bump ps;
let parse_rec_entry ps =
- let mut = parse_mutability ps in
- let (slot, ident) = parse_slot_and_ident false ps in
- (ident, apply_mutability slot mut)
+ let (ty, ident) = parse_ty_and_ident ps in
+ (ident, ty)
in
let entries = paren_comma_list parse_rec_entry ps in
let labels = Array.map (fun (l, _) -> l) entries in
@@ -300,8 +298,8 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
| TUP ->
bump ps;
- let slots = paren_comma_list (parse_slot false) ps in
- Ast.TY_tup slots
+ let tys = paren_comma_list parse_ty ps in
+ Ast.TY_tup tys
| MACH m ->
bump ps;
@@ -333,6 +331,14 @@ and parse_atomic_ty (ps:pstate) : Ast.ty =
| _ -> raise (unexpected ps)
end
+ | AT ->
+ bump ps;
+ Ast.TY_exterior (parse_ty ps)
+
+ | MUTABLE ->
+ bump ps;
+ Ast.TY_mutable (parse_ty ps)
+
| LPAREN ->
begin
bump ps;
@@ -356,21 +362,15 @@ and flag (ps:pstate) (tok:token) : bool =
and parse_mutability (ps:pstate) : bool =
flag ps MUTABLE
-and apply_mutability (slot:Ast.slot) (mut:bool) : Ast.slot =
- { slot with Ast.slot_mutable = mut }
-
and parse_slot (aliases_ok:bool) (ps:pstate) : Ast.slot =
- let mut = parse_mutability ps in
let mode =
match (peek ps, aliases_ok) with
- (AT, _) -> bump ps; Ast.MODE_exterior
- | (AND, true) -> bump ps; Ast.MODE_alias
+ (AND, true) -> bump ps; Ast.MODE_alias
| (AND, false) -> raise (err "alias slot in prohibited context" ps)
| _ -> Ast.MODE_interior
in
let ty = parse_ty ps in
{ Ast.slot_mode = mode;
- Ast.slot_mutable = mut;
Ast.slot_ty = Some ty }
and parse_slot_and_ident
@@ -381,6 +381,13 @@ and parse_slot_and_ident
let ident = ctxt "slot and ident: ident" parse_ident ps in
(slot, ident)
+and parse_ty_and_ident
+ (ps:pstate)
+ : (Ast.ty * Ast.ident) =
+ let ty = ctxt "ty and ident: ty" parse_ty ps in
+ let ident = ctxt "ty and ident: ident" parse_ident ps in
+ (ty, ident)
+
and parse_slot_and_optional_ignored_ident
(aliases_ok:bool)
(ps:pstate)
@@ -494,16 +501,9 @@ and parse_bottom_pexp (ps:pstate) : pexp =
| VEC ->
bump ps;
begin
- let slot =
- match peek ps with
- LBRACKET -> bracketed LBRACKET RBRACKET (parse_slot false) ps
- | _ -> { Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = false;
- Ast.slot_ty = None }
- in
let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in
let bpos = lexpos ps in
- span ps apos bpos (PEXP_vec (slot, pexps))
+ span ps apos bpos (PEXP_vec pexps)
end
@@ -1088,7 +1088,9 @@ and desugar_expr_atom
| PEXP_call _
| PEXP_bind _
| PEXP_spawn _
- | PEXP_custom _ ->
+ | PEXP_custom _
+ | PEXP_exterior _
+ | PEXP_mutable _ ->
let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in
let stmts = desugar_expr_init ps tmp pexp in
(Array.append [| decl_stmt |] stmts,
@@ -1101,31 +1103,6 @@ and desugar_expr_atom
let (stmts, lval) = desugar_lval ps pexp in
(stmts, Ast.ATOM_lval lval)
- | PEXP_exterior _ ->
- raise (err "exterior symbol in atom context" ps)
-
- | PEXP_mutable _ ->
- raise (err "mutable keyword in atom context" ps)
-
-
-and desugar_expr_mode_mut_atom
- (ps:pstate)
- (pexp:pexp)
- : (Ast.stmt array * (Ast.mode * bool * Ast.atom)) =
- let desugar_inner mode mut e =
- let (stmts, atom) = desugar_expr_atom ps e in
- (stmts, (mode, mut, atom))
- in
- match pexp.node with
- PEXP_mutable {node=(PEXP_exterior e); id=_} ->
- desugar_inner Ast.MODE_exterior true e
- | PEXP_exterior e ->
- desugar_inner Ast.MODE_exterior false e
- | PEXP_mutable e ->
- desugar_inner Ast.MODE_interior true e
- | _ ->
- desugar_inner Ast.MODE_interior false pexp
-
and desugar_expr_atoms
(ps:pstate)
(pexps:pexp array)
@@ -1138,12 +1115,6 @@ and desugar_opt_expr_atoms
: (Ast.stmt array * Ast.atom option array) =
arj1st (Array.map (desugar_opt_expr_atom ps) pexps)
-and desugar_expr_mode_mut_atoms
- (ps:pstate)
- (pexps:pexp array)
- : (Ast.stmt array * (Ast.mode * bool * Ast.atom) array) =
- arj1st (Array.map (desugar_expr_mode_mut_atom ps) pexps)
-
and desugar_expr_init
(ps:pstate)
(dst_lval:Ast.lval)
@@ -1253,10 +1224,10 @@ and desugar_expr_init
Array.map
begin
fun (ident, pexp) ->
- let (stmts, (mode, mut, atom)) =
- desugar_expr_mode_mut_atom ps pexp
+ let (stmts, atom) =
+ desugar_expr_atom ps pexp
in
- (stmts, (ident, mode, mut, atom))
+ (stmts, (ident, atom))
end
args
end
@@ -1278,19 +1249,19 @@ and desugar_expr_init
end
| PEXP_tup args ->
- let (arg_stmts, arg_mode_atoms) =
- desugar_expr_mode_mut_atoms ps args
+ let (arg_stmts, arg_atoms) =
+ desugar_expr_atoms ps args
in
- let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_mode_atoms)) in
+ let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_atoms)) in
aa arg_stmts [| stmt |]
| PEXP_str s ->
let stmt = ss (Ast.STMT_init_str (dst_lval, s)) in
[| stmt |]
- | PEXP_vec (slot, args) ->
+ | PEXP_vec args ->
let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in
- let stmt = ss (Ast.STMT_init_vec (dst_lval, slot, arg_atoms)) in
+ let stmt = ss (Ast.STMT_init_vec (dst_lval, arg_atoms)) in
aa arg_stmts [| stmt |]
| PEXP_port ->
@@ -1315,11 +1286,19 @@ and desugar_expr_init
in
aa port_stmts [| chan_stmt |]
- | PEXP_exterior _ ->
- raise (err "exterior symbol in initialiser context" ps)
+ | PEXP_exterior arg ->
+ let (arg_stmts, arg_mode_atom) =
+ desugar_expr_atom ps arg
+ in
+ let stmt = ss (Ast.STMT_init_exterior (dst_lval, arg_mode_atom)) in
+ aa arg_stmts [| stmt |]
- | PEXP_mutable _ ->
- raise (err "mutable keyword in initialiser context" ps)
+ | PEXP_mutable arg ->
+ (* Initializing a local from a "mutable" atom is the same as
+ * initializing it from an immutable one; all locals are mutable
+ * anyways. So this is just a fall-through.
+ *)
+ desugar_expr_init ps dst_lval arg
| PEXP_custom (n, a, b) ->
let (arg_stmts, args) = desugar_expr_atoms ps a in
diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml
index 25d4ed04..b603e779 100644
--- a/src/boot/me/alias.ml
+++ b/src/boot/me/alias.ml
@@ -67,7 +67,7 @@ let alias_analysis_visitor
| Ast.STMT_recv (dst, _) -> alias dst
| Ast.STMT_init_port (dst) -> alias dst
| Ast.STMT_init_chan (dst, _) -> alias dst
- | Ast.STMT_init_vec (dst, _, _) -> alias dst
+ | Ast.STMT_init_vec (dst, _) -> alias dst
| Ast.STMT_init_str (dst, _) -> alias dst
| Ast.STMT_for_each sfe ->
let (slot, _) = sfe.Ast.for_each_slot in
diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml
index b7fdf309..410ff402 100644
--- a/src/boot/me/dwarf.ml
+++ b/src/boot/me/dwarf.ml
@@ -1307,56 +1307,65 @@ let (abbrev_alias_slot:abbrev) =
(DW_TAG_reference_type, DW_CHILDREN_no,
[|
(DW_AT_type, DW_FORM_ref_addr);
- (DW_AT_mutable, DW_FORM_flag);
|])
;;
-let (abbrev_exterior_slot:abbrev) =
- (DW_TAG_reference_type, DW_CHILDREN_no,
+(* FIXME: Perverse, but given dwarf's vocabulary it seems at least plausible
+ * that a "mutable const type" is a correct way of saying "mutable". Or else we
+ * make up our own. Revisit perhaps.
+ *)
+let (abbrev_mutable_type:abbrev) =
+ (DW_TAG_const_type, DW_CHILDREN_no,
[|
(DW_AT_type, DW_FORM_ref_addr);
(DW_AT_mutable, DW_FORM_flag);
+ |])
+;;
+
+let (abbrev_exterior_type:abbrev) =
+ (DW_TAG_pointer_type, DW_CHILDREN_no,
+ [|
+ (DW_AT_type, DW_FORM_ref_addr);
(DW_AT_data_location, DW_FORM_block1);
|])
;;
let (abbrev_struct_type:abbrev) =
- (DW_TAG_structure_type, DW_CHILDREN_yes,
- [|
- (DW_AT_byte_size, DW_FORM_block4)
- |])
+ (DW_TAG_structure_type, DW_CHILDREN_yes,
+ [|
+ (DW_AT_byte_size, DW_FORM_block4)
+ |])
;;
let (abbrev_struct_type_member:abbrev) =
- (DW_TAG_member, DW_CHILDREN_no,
- [|
- (DW_AT_name, DW_FORM_string);
- (DW_AT_type, DW_FORM_ref_addr);
- (DW_AT_mutable, DW_FORM_flag);
- (DW_AT_data_member_location, DW_FORM_block4);
- (DW_AT_byte_size, DW_FORM_block4)
- |])
+ (DW_TAG_member, DW_CHILDREN_no,
+ [|
+ (DW_AT_name, DW_FORM_string);
+ (DW_AT_type, DW_FORM_ref_addr);
+ (DW_AT_data_member_location, DW_FORM_block4);
+ (DW_AT_byte_size, DW_FORM_block4)
+ |])
;;
let (abbrev_variant_part:abbrev) =
- (DW_TAG_variant_part, DW_CHILDREN_yes,
- [|
- (DW_AT_discr, DW_FORM_ref_addr)
- |])
+ (DW_TAG_variant_part, DW_CHILDREN_yes,
+ [|
+ (DW_AT_discr, DW_FORM_ref_addr)
+ |])
;;
let (abbrev_variant:abbrev) =
- (DW_TAG_variant, DW_CHILDREN_yes,
- [|
- (DW_AT_discr_value, DW_FORM_udata)
- |])
+ (DW_TAG_variant, DW_CHILDREN_yes,
+ [|
+ (DW_AT_discr_value, DW_FORM_udata)
+ |])
;;
let (abbrev_subroutine_type:abbrev) =
- (DW_TAG_subroutine_type, DW_CHILDREN_yes,
- [|
- (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *)
+ (DW_TAG_subroutine_type, DW_CHILDREN_yes,
+ [|
+ (DW_AT_type, DW_FORM_ref_addr); (* NB: output type. *)
(DW_AT_mutable, DW_FORM_flag);
(DW_AT_pure, DW_FORM_flag);
(DW_AT_rust_iterator, DW_FORM_flag);
@@ -1541,33 +1550,8 @@ let dwarf_visitor
in
match slot.Ast.slot_mode with
- Ast.MODE_exterior ->
- let fix = new_fixup "exterior DIE" in
- let body_off =
- word_sz_int * Abi.exterior_rc_slot_field_body
- in
- emit_die (DEF (fix, SEQ [|
- uleb (get_abbrev_code abbrev_exterior_slot);
- (* DW_AT_type: DW_FORM_ref_addr *)
- (ref_type_die (slot_ty slot));
- (* DW_AT_mutable: DW_FORM_flag *)
- BYTE (if slot.Ast.slot_mutable
- then 1 else 0);
- (* DW_AT_data_location: DW_FORM_block1 *)
- (* This is a DWARF expression for moving
- from the address of an exterior
- allocation to the address of its
- body. *)
- dw_form_block1
- [| DW_OP_push_object_address;
- DW_OP_lit body_off;
- DW_OP_plus;
- DW_OP_deref |]
- |]));
- ref_addr_for_fix fix
-
- (* FIXME (issue #72): encode mutable-ness of interiors. *)
- | Ast.MODE_interior -> ref_type_die (slot_ty slot)
+ | Ast.MODE_interior ->
+ ref_type_die (slot_ty slot)
| Ast.MODE_alias ->
let fix = new_fixup "alias DIE" in
@@ -1575,8 +1559,6 @@ let dwarf_visitor
uleb (get_abbrev_code abbrev_alias_slot);
(* DW_AT_type: DW_FORM_ref_addr *)
(ref_type_die (slot_ty slot));
- (* DW_AT_mutable: DW_FORM_flag *)
- BYTE (if slot.Ast.slot_mutable then 1 else 0)
|]));
ref_addr_for_fix fix
@@ -1708,15 +1690,13 @@ let dwarf_visitor
emit_die die;
Array.iteri
begin
- fun i (ident, slot) ->
+ fun i (ident, ty) ->
emit_die (SEQ [|
uleb (get_abbrev_code abbrev_struct_type_member);
(* DW_AT_name: DW_FORM_string *)
ZSTRING ident;
(* DW_AT_type: DW_FORM_ref_addr *)
- (ref_slot_die slot);
- (* DW_AT_mutable: DW_FORM_flag *)
- BYTE (if slot.Ast.slot_mutable then 1 else 0);
+ (ref_type_die ty);
(* DW_AT_data_member_location: DW_FORM_block4 *)
size_block4
(Il.get_element_offset word_bits rtys i)
@@ -1904,10 +1884,6 @@ let dwarf_visitor
unspecified_ptr_with_ref rust_ty (ref_type_die ty)
in
- let unspecified_ptr_with_ref_slot rust_ty slot =
- unspecified_ptr_with_ref rust_ty (ref_slot_die slot)
- in
-
let unspecified_ptr rust_ty =
unspecified_ptr_with_ref rust_ty (unspecified_anon_struct ())
in
@@ -1974,9 +1950,7 @@ let dwarf_visitor
(* DW_AT_name: DW_FORM_string *)
ZSTRING "tag";
(* DW_AT_type: DW_FORM_ref_addr *)
- (ref_slot_die (interior_slot Ast.TY_uint));
- (* DW_AT_mutable: DW_FORM_flag *)
- BYTE 0;
+ (ref_type_die Ast.TY_uint);
(* DW_AT_data_member_location: DW_FORM_block4 *)
size_block4
(Il.get_element_offset word_bits rtys 0)
@@ -2038,6 +2012,41 @@ let dwarf_visitor
ref_addr_for_fix (Stack.top iso_stack).(i)
in
+ let exterior_type t =
+ let fix = new_fixup "exterior DIE" in
+ let body_off =
+ word_sz_int * Abi.exterior_rc_slot_field_body
+ in
+ emit_die (DEF (fix, SEQ [|
+ uleb (get_abbrev_code abbrev_exterior_type);
+ (* DW_AT_type: DW_FORM_ref_addr *)
+ (ref_type_die t);
+ (* DW_AT_data_location: DW_FORM_block1 *)
+ (* This is a DWARF expression for moving
+ from the address of an exterior
+ allocation to the address of its
+ body. *)
+ dw_form_block1
+ [| DW_OP_push_object_address;
+ DW_OP_lit body_off;
+ DW_OP_plus;
+ DW_OP_deref |]
+ |]));
+ ref_addr_for_fix fix
+ in
+
+ let mutable_type t =
+ let fix = new_fixup "mutable DIE" in
+ emit_die (DEF (fix, SEQ [|
+ uleb (get_abbrev_code abbrev_mutable_type);
+ (* DW_AT_type: DW_FORM_ref_addr *)
+ (ref_type_die t);
+ (* DW_AT_mutable: DW_FORM_flag *)
+ BYTE 1;
+ |]));
+ ref_addr_for_fix fix
+ in
+
match ty with
Ast.TY_nil -> unspecified_struct DW_RUST_nil
| Ast.TY_bool -> base ("bool", DW_ATE_boolean, 1)
@@ -2058,7 +2067,7 @@ let dwarf_visitor
| Ast.TY_tag ttag -> tag_type None ttag
| Ast.TY_iso tiso -> iso_type tiso
| Ast.TY_idx i -> idx_type i
- | Ast.TY_vec s -> unspecified_ptr_with_ref_slot DW_RUST_vec s
+ | Ast.TY_vec t -> unspecified_ptr_with_ref_ty DW_RUST_vec t
| Ast.TY_chan t -> unspecified_ptr_with_ref_ty DW_RUST_chan t
| Ast.TY_port t -> unspecified_ptr_with_ref_ty DW_RUST_port t
| Ast.TY_task -> unspecified_ptr DW_RUST_task
@@ -2067,6 +2076,8 @@ let dwarf_visitor
| Ast.TY_native i -> native_ptr_type i
| Ast.TY_param p -> rust_type_param p
| Ast.TY_obj ob -> obj_type ob
+ | Ast.TY_mutable t -> mutable_type t
+ | Ast.TY_exterior t -> exterior_type t
| _ ->
bug () "unimplemented dwarf encoding for type %a"
Ast.sprintf_ty ty
@@ -2893,7 +2904,7 @@ let rec extract_mod_items
| DW_TAG_pointer_type
when is_rust_type die DW_RUST_vec ->
- Ast.TY_vec (get_referenced_slot die)
+ Ast.TY_vec (get_referenced_ty die)
| DW_TAG_pointer_type
when is_rust_type die DW_RUST_type_param ->
@@ -2903,6 +2914,13 @@ let rec extract_mod_items
when is_rust_type die DW_RUST_native ->
Ast.TY_native (get_opaque_of (get_native_id die))
+ | DW_TAG_pointer_type ->
+ Ast.TY_exterior (get_referenced_ty die)
+
+ | DW_TAG_const_type
+ when ((get_num die DW_AT_mutable) = 1) ->
+ Ast.TY_mutable (get_referenced_ty die)
+
| DW_TAG_string_type -> Ast.TY_str
| DW_TAG_base_type ->
@@ -2953,13 +2971,13 @@ let rec extract_mod_items
assert ((Array.length members) > 0);
if is_num_idx (get_name members.(0))
then
- let slots = Array.map get_referenced_slot members in
- Ast.TY_tup slots
+ let tys = Array.map get_referenced_ty members in
+ Ast.TY_tup tys
else
let entries =
Array.map
(fun member_die -> ((get_name member_die),
- (get_referenced_slot member_die)))
+ (get_referenced_ty member_die)))
members
in
Ast.TY_rec entries
@@ -2989,23 +3007,11 @@ let rec extract_mod_items
match die.die_tag with
DW_TAG_reference_type ->
let ty = get_referenced_ty die in
- let mut = get_flag die DW_AT_mutable in
- let mode =
- (* Exterior slots have a 'data_location' attr. *)
- match atab_search die.die_attrs DW_AT_data_location with
- Some _ -> Ast.MODE_exterior
- | None -> Ast.MODE_alias
- in
- { Ast.slot_mode = mode;
- Ast.slot_mutable = mut;
+ { Ast.slot_mode = Ast.MODE_alias;
Ast.slot_ty = Some ty }
| _ ->
let ty = get_ty die in
- (* FIXME (issue #28): encode mutability of interior slots
- * properly.
- *)
{ Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = false;
Ast.slot_ty = Some ty }
and get_referenced_ty die =
diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml
index ad9a4cb3..22edce7c 100644
--- a/src/boot/me/effect.ml
+++ b/src/boot/me/effect.ml
@@ -33,12 +33,18 @@ let mutability_checking_visitor
| _ -> ()
in
- let check_write id dst =
- let dst_slot = lval_slot cx dst in
- if (dst_slot.Ast.slot_mutable or
- (Hashtbl.mem cx.ctxt_copy_stmt_is_init id))
+ let check_write s dst =
+ let dst_ty = lval_ty cx dst in
+ let is_mutable =
+ match dst_ty with
+ Ast.TY_mutable _ -> true
+ | _ -> false
+ in
+ if (is_mutable or (Hashtbl.mem cx.ctxt_copy_stmt_is_init s.id))
then ()
- else err (Some id) "writing to non-mutable slot"
+ else err (Some s.id)
+ "writing to non-mutable slot of type %a in statement %a"
+ Ast.sprintf_ty dst_ty Ast.sprintf_stmt s
in
(* FIXME (issue #75): enforce the no-write-alias-to-immutable-slot
* rule.
@@ -46,10 +52,10 @@ let mutability_checking_visitor
let visit_stmt_pre s =
begin
match s.node with
- Ast.STMT_copy (dst, _) -> check_write s.id dst
- | Ast.STMT_copy_binop (dst, _, _) -> check_write s.id dst
- | Ast.STMT_call (dst, _, _) -> check_write s.id dst
- | Ast.STMT_recv (dst, _) -> check_write s.id dst
+ Ast.STMT_copy (dst, _) -> check_write s dst
+ | Ast.STMT_copy_binop (dst, _, _) -> check_write s dst
+ | Ast.STMT_call (dst, _, _) -> check_write s dst
+ | Ast.STMT_recv (dst, _) -> check_write s dst
| _ -> ()
end;
inner.Walk.visit_stmt_pre s
@@ -151,8 +157,7 @@ let function_effect_propagation_visitor
in
if lval_is_slot cx fn
then
- let t = lval_slot cx fn in
- lower_to_callee_ty (slot_ty t)
+ lower_to_callee_ty (lval_ty cx fn)
else
begin
let item = lval_item cx fn in
diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 5160429e..746f83bf 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -582,15 +582,13 @@ let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array =
;;
let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array =
- Array.concat (List.map
- (fun (_,_,a) -> atom_slots cx a)
- (Array.to_list az))
+ Array.concat (List.map (atom_slots cx) (Array.to_list az))
;;
let rec_inputs_slots (cx:ctxt)
(inputs:Ast.rec_input array) : node_id array =
Array.concat (List.map
- (fun (_, _, _, atom) -> atom_slots cx atom)
+ (fun (_, atom) -> atom_slots cx atom)
(Array.to_list inputs))
;;
@@ -606,14 +604,27 @@ let expr_slots (cx:ctxt) (e:Ast.expr) : node_id array =
(* Type extraction. *)
let interior_slot_full mut ty : Ast.slot =
- { Ast.slot_mode = Ast.MODE_interior;
- Ast.slot_mutable = mut;
- Ast.slot_ty = Some ty }
+ let ty =
+ if mut
+ then Ast.TY_mutable ty
+ else ty
+ in
+ { Ast.slot_mode = Ast.MODE_interior;
+ Ast.slot_ty = Some ty }
;;
let exterior_slot_full mut ty : Ast.slot =
- { Ast.slot_mode = Ast.MODE_exterior;
- Ast.slot_mutable = mut;
+ let ty =
+ match ty with
+ Ast.TY_exterior _ -> ty
+ | _ -> Ast.TY_exterior ty
+ in
+ let ty =
+ if mut
+ then Ast.TY_mutable ty
+ else ty
+ in
+ { Ast.slot_mode = Ast.MODE_interior;
Ast.slot_ty = Some ty }
;;
@@ -626,12 +637,13 @@ let exterior_slot ty : Ast.slot = exterior_slot_full false ty
(* General folds of Ast.ty. *)
-type ('ty, 'slot, 'slots, 'tag) ty_fold =
+type ('ty, 'tys, 'slot, 'slots, 'tag) ty_fold =
{
(* Functions that correspond to interior nodes in Ast.ty. *)
- ty_fold_slot : (Ast.mode * bool * 'ty) -> 'slot;
+ ty_fold_slot : (Ast.mode * 'ty) -> 'slot;
ty_fold_slots : ('slot array) -> 'slots;
- ty_fold_tags : (Ast.name, 'slots) Hashtbl.t -> 'tag;
+ ty_fold_tys : ('ty array) -> 'tys;
+ ty_fold_tags : (Ast.name, 'tys) Hashtbl.t -> 'tag;
(* Functions that correspond to the Ast.ty constructors. *)
ty_fold_any: unit -> 'ty;
@@ -642,9 +654,9 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold =
ty_fold_uint : unit -> 'ty;
ty_fold_char : unit -> 'ty;
ty_fold_str : unit -> 'ty;
- ty_fold_tup : 'slots -> 'ty;
- ty_fold_vec : 'slot -> 'ty;
- ty_fold_rec : (Ast.ident * 'slot) array -> 'ty;
+ ty_fold_tup : 'tys -> 'ty;
+ ty_fold_vec : 'ty -> 'ty;
+ ty_fold_rec : (Ast.ident * 'ty) array -> 'ty;
ty_fold_tag : 'tag -> 'ty;
ty_fold_iso : (int * 'tag array) -> 'ty;
ty_fold_idx : int -> 'ty;
@@ -659,21 +671,29 @@ type ('ty, 'slot, 'slots, 'tag) ty_fold =
ty_fold_param : (int * Ast.effect) -> 'ty;
ty_fold_named : Ast.name -> 'ty;
ty_fold_type : unit -> 'ty;
+ ty_fold_exterior : 'ty -> 'ty;
+ ty_fold_mutable : 'ty -> 'ty;
ty_fold_constrained : ('ty * Ast.constrs) -> 'ty }
;;
-let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
+let rec fold_ty (f:('ty, 'tys, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
let fold_slot (s:Ast.slot) : 'slot =
f.ty_fold_slot (s.Ast.slot_mode,
- s.Ast.slot_mutable,
fold_ty f (slot_ty s))
in
+
let fold_slots (slots:Ast.slot array) : 'slots =
f.ty_fold_slots (Array.map fold_slot slots)
in
+
+ let fold_tys (tys:Ast.ty array) : 'tys =
+ f.ty_fold_tys (Array.map (fold_ty f) tys)
+ in
+
let fold_tags (ttag:Ast.ty_tag) : 'tag =
- f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_slots v)))
+ f.ty_fold_tags (htab_map ttag (fun k v -> (k, fold_tys v)))
in
+
let fold_sig tsig =
(fold_slots tsig.Ast.sig_input_slots,
tsig.Ast.sig_input_constrs,
@@ -692,13 +712,15 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
| Ast.TY_char -> f.ty_fold_char ()
| Ast.TY_str -> f.ty_fold_str ()
- | Ast.TY_tup t -> f.ty_fold_tup (fold_slots t)
- | Ast.TY_vec s -> f.ty_fold_vec (fold_slot s)
- | Ast.TY_rec r -> f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_slot v)) r)
+ | Ast.TY_tup t -> f.ty_fold_tup (fold_tys t)
+ | Ast.TY_vec t -> f.ty_fold_vec (fold_ty f t)
+ | Ast.TY_rec r ->
+ f.ty_fold_rec (Array.map (fun (k,v) -> (k,fold_ty f v)) r)
| Ast.TY_tag tt -> f.ty_fold_tag (fold_tags tt)
- | Ast.TY_iso ti -> f.ty_fold_iso (ti.Ast.iso_index,
- (Array.map fold_tags ti.Ast.iso_group))
+ | Ast.TY_iso ti ->
+ f.ty_fold_iso (ti.Ast.iso_index,
+ (Array.map fold_tags ti.Ast.iso_group))
| Ast.TY_idx i -> f.ty_fold_idx i
| Ast.TY_fn (tsig,taux) -> f.ty_fold_fn (fold_sig tsig, taux)
@@ -713,16 +735,20 @@ let rec fold_ty (f:('ty, 'slot, 'slots, 'tag) ty_fold) (ty:Ast.ty) : 'ty =
| Ast.TY_named n -> f.ty_fold_named n
| Ast.TY_type -> f.ty_fold_type ()
+ | Ast.TY_exterior t -> f.ty_fold_exterior (fold_ty f t)
+ | Ast.TY_mutable t -> f.ty_fold_mutable (fold_ty f t)
+
| Ast.TY_constrained (t, constrs) ->
f.ty_fold_constrained (fold_ty f t, constrs)
;;
-type 'a simple_ty_fold = ('a, 'a, 'a, 'a) ty_fold
+type 'a simple_ty_fold = ('a, 'a, 'a, 'a, 'a) ty_fold
;;
let ty_fold_default (default:'a) : 'a simple_ty_fold =
- { ty_fold_slot = (fun _ -> default);
+ { ty_fold_tys = (fun _ -> default);
+ ty_fold_slot = (fun _ -> default);
ty_fold_slots = (fun _ -> default);
ty_fold_tags = (fun _ -> default);
ty_fold_any = (fun _ -> default);
@@ -748,19 +774,22 @@ let ty_fold_default (default:'a) : 'a simple_ty_fold =
ty_fold_param = (fun _ -> default);
ty_fold_named = (fun _ -> default);
ty_fold_type = (fun _ -> default);
+ ty_fold_exterior = (fun _ -> default);
+ ty_fold_mutable = (fun _ -> default);
ty_fold_constrained = (fun _ -> default) }
;;
let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
- : (Ast.ty, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold =
+ : (Ast.ty, Ast.ty array, Ast.slot, Ast.slot array, Ast.ty_tag) ty_fold =
let rebuild_fn ((islots, constrs, oslot), aux) =
({ Ast.sig_input_slots = islots;
Ast.sig_input_constrs = constrs;
Ast.sig_output_slot = oslot }, aux)
in
- { ty_fold_slot = (fun (mode, mut, t) ->
+ {
+ ty_fold_tys = (fun ts -> ts);
+ ty_fold_slot = (fun (mode, t) ->
{ Ast.slot_mode = mode;
- Ast.slot_mutable = mut;
Ast.slot_ty = Some t });
ty_fold_slots = (fun slots -> slots);
ty_fold_tags = (fun htab -> htab);
@@ -773,7 +802,7 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
ty_fold_char = (fun _ -> id Ast.TY_char);
ty_fold_str = (fun _ -> id Ast.TY_str);
ty_fold_tup = (fun slots -> id (Ast.TY_tup slots));
- ty_fold_vec = (fun slot -> id (Ast.TY_vec slot));
+ ty_fold_vec = (fun t -> id (Ast.TY_vec t));
ty_fold_rec = (fun entries -> id (Ast.TY_rec entries));
ty_fold_tag = (fun tag -> id (Ast.TY_tag tag));
ty_fold_iso = (fun (i, tags) -> id (Ast.TY_iso { Ast.iso_index = i;
@@ -791,6 +820,8 @@ let ty_fold_rebuild (id:Ast.ty -> Ast.ty)
ty_fold_param = (fun (i, mut) -> id (Ast.TY_param (i, mut)));
ty_fold_named = (fun n -> id (Ast.TY_named n));
ty_fold_type = (fun _ -> id (Ast.TY_type));
+ ty_fold_exterior = (fun t -> id (Ast.TY_exterior t));
+ ty_fold_mutable = (fun t -> id (Ast.TY_mutable t));
ty_fold_constrained = (fun (t, constrs) ->
id (Ast.TY_constrained (t, constrs))) }
;;
@@ -892,7 +923,7 @@ let associative_binary_op_ty_fold
in
{ base with
ty_fold_slots = (fun slots -> reduce (Array.to_list slots));
- ty_fold_slot = (fun (_, _, a) -> a);
+ ty_fold_slot = (fun (_, a) -> a);
ty_fold_tags = (fun tab -> reduce (htab_vals tab));
ty_fold_tup = (fun a -> a);
ty_fold_vec = (fun a -> a);
@@ -957,13 +988,9 @@ let lower_effect_of x y =
;;
let type_effect (t:Ast.ty) : Ast.effect =
- let fold_slot ((*mode*)_, mut, eff) =
- if mut
- then lower_effect_of Ast.STATE eff
- else eff
- in
+ let fold_mutable _ = Ast.STATE in
let fold = associative_binary_op_ty_fold Ast.PURE lower_effect_of in
- let fold = { fold with ty_fold_slot = fold_slot } in
+ let fold = { fold with ty_fold_mutable = fold_mutable } in
fold_ty fold t
;;
@@ -1037,15 +1064,15 @@ let check_concrete params thing =
;;
-let project_type_to_slot
+let project_type
(base_ty:Ast.ty)
(comp:Ast.lval_component)
- : Ast.slot =
+ : Ast.ty =
match (base_ty, comp) with
(Ast.TY_rec elts, Ast.COMP_named (Ast.COMP_ident id)) ->
begin
match atab_search elts id with
- Some slot -> slot
+ Some ty -> ty
| None -> err None "unknown record-member '%s'" id
end
@@ -1054,14 +1081,10 @@ let project_type_to_slot
then elts.(i)
else err None "out-of-range tuple index %d" i
- | (Ast.TY_vec slot, Ast.COMP_atom _) ->
- slot
-
- | (Ast.TY_str, Ast.COMP_atom _) ->
- interior_slot (Ast.TY_mach TY_u8)
-
+ | (Ast.TY_vec ty, Ast.COMP_atom _) -> ty
+ | (Ast.TY_str, Ast.COMP_atom _) -> (Ast.TY_mach TY_u8)
| (Ast.TY_obj (_, fns), Ast.COMP_named (Ast.COMP_ident id)) ->
- interior_slot (Ast.TY_fn (Hashtbl.find fns id))
+ (Ast.TY_fn (Hashtbl.find fns id))
| (_,_) ->
bug ()
@@ -1070,16 +1093,6 @@ let project_type_to_slot
Ast.sprintf_ty base_ty Ast.sprintf_lval_component comp
;;
-
-(* NB: this will fail if lval is not a slot. *)
-let rec lval_slot (cx:ctxt) (lval:Ast.lval) : Ast.slot =
- match lval with
- Ast.LVAL_base nb -> lval_to_slot cx nb.id
- | Ast.LVAL_ext (base, comp) ->
- let base_ty = slot_ty (lval_slot cx base) in
- project_type_to_slot base_ty comp
-;;
-
let exports_permit (view:Ast.mod_view) (ident:Ast.ident) : bool =
(Hashtbl.mem view.Ast.view_exports Ast.EXPORT_all_decls) ||
(Hashtbl.mem view.Ast.view_exports (Ast.EXPORT_ident ident))
@@ -1150,6 +1163,10 @@ let lval_is_direct_mod (cx:ctxt) (lval:Ast.lval) : bool =
| _ -> false
;;
+let lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty =
+ Hashtbl.find cx.ctxt_all_lval_types (lval_base_id lval)
+;;
+
let lval_is_static (cx:ctxt) (lval:Ast.lval) : bool =
defn_is_static (resolve_lval cx lval)
;;
@@ -1164,7 +1181,7 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool =
match lval with
Ast.LVAL_ext (base, _) ->
begin
- match slot_ty (lval_slot cx base) with
+ match lval_ty cx base with
Ast.TY_obj _ -> true
| _ -> false
end
@@ -1172,11 +1189,6 @@ let lval_is_obj_vtbl (cx:ctxt) (lval:Ast.lval) : bool =
else false
;;
-let rec lval_ty (cx:ctxt) (lval:Ast.lval) : Ast.ty =
- let base_id = lval_base_id lval in
- Hashtbl.find cx.ctxt_all_lval_types base_id
-;;
-
let rec atom_type (cx:ctxt) (at:Ast.atom) : Ast.ty =
match at with
Ast.ATOM_literal {node=(Ast.LIT_int _); id=_} -> Ast.TY_int
@@ -1741,7 +1753,7 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
let ptr = sp Il.OpaqueTy in
let rc_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in
let codeptr = sp Il.CodeTy in
- let tup ttup = Il.StructTy (Array.map (slot_referent_type abi) ttup) in
+ let tup ttup = Il.StructTy (Array.map (referent_type abi) ttup) in
let tag ttag =
let union =
Il.UnionTy
@@ -1802,6 +1814,11 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
| Ast.TY_native _ -> ptr
+ | Ast.TY_exterior t ->
+ sp (Il.StructTy [| word; referent_type abi t |])
+
+ | Ast.TY_mutable t -> referent_type abi t
+
| Ast.TY_param (i, _) -> Il.ParamTy i
| Ast.TY_named _ -> bug () "named type in referent_type"
@@ -1809,16 +1826,11 @@ let rec referent_type (abi:Abi.abi) (t:Ast.ty) : Il.referent_ty =
and slot_referent_type (abi:Abi.abi) (sl:Ast.slot) : Il.referent_ty =
let s t = Il.ScalarTy t in
- let v b = Il.ValTy b in
let p t = Il.AddrTy t in
- let sv b = s (v b) in
let sp t = s (p t) in
- let word = sv abi.Abi.abi_word_bits in
-
let rty = referent_type abi (slot_ty sl) in
match sl.Ast.slot_mode with
- Ast.MODE_exterior _ -> sp (Il.StructTy [| word; rty |])
| Ast.MODE_interior _ -> rty
| Ast.MODE_alias _ -> sp rty
;;
@@ -1940,14 +1952,17 @@ let word_slot (abi:Abi.abi) : Ast.slot =
let alias_slot (ty:Ast.ty) : Ast.slot =
{ Ast.slot_mode = Ast.MODE_alias;
- Ast.slot_mutable = false;
Ast.slot_ty = Some ty }
;;
let mutable_alias_slot (ty:Ast.ty) : Ast.slot =
- { Ast.slot_mode = Ast.MODE_alias;
- Ast.slot_mutable = true;
- Ast.slot_ty = Some ty }
+ let ty =
+ match ty with
+ Ast.TY_mutable _ -> ty
+ | _ -> Ast.TY_mutable ty
+ in
+ { Ast.slot_mode = Ast.MODE_alias;
+ Ast.slot_ty = Some ty }
;;
let mk_ty_fn_or_iter
@@ -2002,12 +2017,10 @@ let item_str (cx:ctxt) (id:node_id) : string =
let ty_str (ty:Ast.ty) : string =
let base = associative_binary_op_ty_fold "" (fun a b -> a ^ b) in
- let fold_slot (mode,mut,ty) =
- (if mut then "m" else "")
- ^ (match mode with
- Ast.MODE_exterior -> "e"
- | Ast.MODE_alias -> "a"
- | Ast.MODE_interior -> "")
+ let fold_slot (mode,ty) =
+ (match mode with
+ Ast.MODE_alias -> "a"
+ | Ast.MODE_interior -> "")
^ ty
in
let num n = (string_of_int n) ^ "$" in
@@ -2080,6 +2093,8 @@ let ty_str (ty:Ast.ty) : string =
ty_fold_native = (fun _ -> "N");
ty_fold_param = (fun _ -> "P");
ty_fold_type = (fun _ -> "Y");
+ ty_fold_mutable = (fun t -> "m" ^ t);
+ ty_fold_exterior = (fun t -> "e" ^ t);
(* FIXME (issue #78): encode obj types. *)
(* FIXME (issue #78): encode opaque and param numbers. *)
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 8ecc743e..5a15eada 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -55,13 +55,14 @@ let trans_visitor
let (abi:Abi.abi) = cx.ctxt_abi in
let (word_sz:int64) = word_sz abi in
let (word_slot:Ast.slot) = word_slot abi in
+ let (word_ty:Ast.ty) = Ast.TY_mach abi.Abi.abi_word_ty in
let oper_str = Il.string_of_operand abi.Abi.abi_str_of_hardreg in
let cell_str = Il.string_of_cell abi.Abi.abi_str_of_hardreg in
let (word_bits:Il.bits) = abi.Abi.abi_word_bits in
- let (word_ty:Il.scalar_ty) = Il.ValTy word_bits in
- let (word_rty:Il.referent_ty) = Il.ScalarTy word_ty in
+ let (word_sty:Il.scalar_ty) = Il.ValTy word_bits in
+ let (word_rty:Il.referent_ty) = Il.ScalarTy word_sty in
let (word_ty_mach:ty_mach) =
match word_bits with
Il.Bits8 -> TY_u8
@@ -88,7 +89,7 @@ let trans_visitor
let imm_true = imm_of_ty 1L TY_u8 in
let imm_false = imm_of_ty 0L TY_u8 in
let nil_ptr = Il.Mem ((Il.Abs (Asm.IMM 0L)), Il.NilTy) in
- let wordptr_ty = Il.AddrTy (Il.ScalarTy word_ty) in
+ let wordptr_ty = Il.AddrTy (Il.ScalarTy word_sty) in
let crate_rel fix =
Asm.SUB (Asm.M_POS fix, Asm.M_POS cx.ctxt_crate_fixup)
@@ -431,8 +432,8 @@ let trans_visitor
in
- let make_tydesc_slots n =
- Array.init n (fun _ -> interior_slot Ast.TY_type)
+ let make_tydesc_tys n =
+ Array.init n (fun _ -> Ast.TY_type)
in
let cell_vreg_num (vr:(int option) ref) : int =
@@ -521,7 +522,7 @@ let trans_visitor
begin
let obj = get_obj_for_current_frame() in
let tydesc = get_element_ptr obj 1 in
- let ty_params_ty = Ast.TY_tup (make_tydesc_slots n_ty_params) in
+ let ty_params_ty = Ast.TY_tup (make_tydesc_tys n_ty_params) in
let ty_params_rty = referent_type abi ty_params_ty in
let ty_params =
get_element_ptr (deref tydesc) Abi.tydesc_field_first_param
@@ -595,28 +596,28 @@ let trans_visitor
| SIZE_rt_neg a ->
let op_a = sub_sz a in
- let tmp = next_vreg_cell word_ty in
+ let tmp = next_vreg_cell word_sty in
emit (Il.unary Il.NEG tmp op_a);
Il.Cell tmp
| SIZE_rt_add (a, b) ->
let op_a = sub_sz a in
let op_b = sub_sz b in
- let tmp = next_vreg_cell word_ty in
+ let tmp = next_vreg_cell word_sty in
add tmp op_a op_b;
Il.Cell tmp
| SIZE_rt_mul (a, b) ->
let op_a = sub_sz a in
let op_b = sub_sz b in
- let tmp = next_vreg_cell word_ty in
+ let tmp = next_vreg_cell word_sty in
emit (Il.binary Il.UMUL tmp op_a op_b);
Il.Cell tmp
| SIZE_rt_max (a, b) ->
let op_a = sub_sz a in
let op_b = sub_sz b in
- let tmp = next_vreg_cell word_ty in
+ let tmp = next_vreg_cell word_sty in
mov tmp op_a;
emit (Il.cmp op_a op_b);
let jmp = mark () in
@@ -643,8 +644,8 @@ let trans_visitor
let op_align = sub_sz align in
annotate "fetch offset";
let op_off = sub_sz off in
- let mask = next_vreg_cell word_ty in
- let off = next_vreg_cell word_ty in
+ let mask = next_vreg_cell word_sty in
+ let off = next_vreg_cell word_sty in
mov mask op_align;
sub_from mask one;
mov off op_off;
@@ -678,8 +679,8 @@ let trans_visitor
| None ->
let runtime_size = calculate_sz ty_params size in
let v = next_vreg () in
- let c = (Il.Reg (v, word_ty)) in
- mov c (Il.Cell (Il.Reg (reg, word_ty)));
+ let c = (Il.Reg (v, word_sty)) in
+ mov c (Il.Cell (Il.Reg (reg, word_sty)));
add_to c runtime_size;
based v
@@ -690,17 +691,17 @@ let trans_visitor
based_sz (get_ty_params_of_current_frame()) abi.Abi.abi_sp_reg size
in
- let slot_sz_in_current_frame (slot:Ast.slot) : Il.operand =
- let rty = slot_referent_type abi slot in
+ let ty_sz_in_current_frame (ty:Ast.ty) : Il.operand =
+ let rty = referent_type abi ty in
let sz = Il.referent_ty_size word_bits rty in
calculate_sz_in_current_frame sz
in
- let slot_sz_with_ty_params
+ let ty_sz_with_ty_params
(ty_params:Il.cell)
- (slot:Ast.slot)
+ (ty:Ast.ty)
: Il.operand =
- let rty = slot_referent_type abi slot in
+ let rty = referent_type abi ty in
let sz = Il.referent_ty_size word_bits rty in
calculate_sz ty_params sz
in
@@ -722,8 +723,8 @@ let trans_visitor
Il.Mem (Il.mem_off_imm mem fixed_off, elt_rty)
| sz ->
let sz = calculate_sz ty_params sz in
- let v = next_vreg word_ty in
- let vc = Il.Reg (v, word_ty) in
+ let v = next_vreg word_sty in
+ let vc = Il.Reg (v, word_sty) in
lea vc mem;
add_to vc sz;
Il.Mem (based v, elt_rty)
@@ -739,12 +740,6 @@ let trans_visitor
get_element_ptr_dyn (get_ty_params_of_current_frame()) mem_cell i
in
- let get_explicit_args_for_current_frame _ =
- get_element_ptr_dyn_in_current_frame (get_args_for_current_frame ())
- Abi.calltup_elt_args
- in
-
-
let deref_off_sz
(ty_params:Il.cell)
(ptr:Il.cell)
@@ -890,15 +885,15 @@ let trans_visitor
(base_ty:Ast.ty)
(cell:Il.cell)
(comp:Ast.lval_component)
- : (Il.cell * Ast.slot) =
+ : (Il.cell * Ast.ty) =
- let bounds_checked_access at slot =
+ let bounds_checked_access at ty =
let atop = trans_atom at in
- let unit_sz = slot_sz_in_current_frame slot in
- let idx = next_vreg_cell word_ty in
+ let unit_sz = ty_sz_in_current_frame ty in
+ let idx = next_vreg_cell word_sty in
emit (Il.binary Il.UMUL idx atop unit_sz);
let elt_mem = trans_bounds_check (deref cell) (Il.Cell idx) in
- (Il.Mem (elt_mem, slot_referent_type abi slot), slot)
+ (Il.Mem (elt_mem, referent_type abi ty), ty)
in
match (base_ty, comp) with
@@ -911,18 +906,18 @@ let trans_visitor
Ast.COMP_named (Ast.COMP_idx i)) ->
(get_element_ptr_dyn_in_current_frame cell i, entries.(i))
- | (Ast.TY_vec slot,
+ | (Ast.TY_vec ty,
Ast.COMP_atom at) ->
- bounds_checked_access at slot
+ bounds_checked_access at ty
| (Ast.TY_str,
Ast.COMP_atom at) ->
- bounds_checked_access at (interior_slot (Ast.TY_mach TY_u8))
+ bounds_checked_access at (Ast.TY_mach TY_u8)
| (Ast.TY_obj obj_ty,
Ast.COMP_named (Ast.COMP_ident id)) ->
let (cell, fn_ty) = get_vtbl_entry cell obj_ty id in
- (cell, (interior_slot (Ast.TY_fn fn_ty)))
+ (cell, (Ast.TY_fn fn_ty))
| _ -> bug () "unhandled form of lval_ext in trans_slot_lval_ext"
@@ -938,7 +933,7 @@ let trans_visitor
let (base:Il.cell) = next_vreg_cell Il.voidptr_t in
let (elt_reg:Il.reg) = next_vreg () in
let (elt:Il.cell) = Il.Reg (elt_reg, Il.voidptr_t) in
- let (diff:Il.cell) = next_vreg_cell word_ty in
+ let (diff:Il.cell) = next_vreg_cell word_sty in
annotate "bounds check";
lea base (fst (need_mem_cell data));
add elt (Il.Cell base) mul_idx;
@@ -950,23 +945,27 @@ let trans_visitor
and trans_lval_full
(initializing:bool)
(lv:Ast.lval)
- : (Il.cell * Ast.slot) =
+ : (Il.cell * Ast.ty) =
let rec trans_slot_lval_full (initializing:bool) lv =
- let (cell, slot) =
+ let (cell, ty) =
match lv with
Ast.LVAL_ext (base, comp) ->
- let (base_cell, base_slot) =
+ let (base_cell, base_ty) =
trans_slot_lval_full initializing base
in
- let base_cell' = deref_slot initializing base_cell base_slot in
- trans_slot_lval_ext (slot_ty base_slot) base_cell' comp
+ let (base_cell, base_ty) =
+ deref_ty initializing base_cell base_ty
+ in
+ trans_slot_lval_ext base_ty base_cell comp
| Ast.LVAL_base nb ->
let slot = lval_to_slot cx nb.id in
let referent = lval_to_referent cx nb.id in
let cell = cell_of_block_slot referent in
- (cell, slot)
+ let ty = slot_ty slot in
+ let cell = deref_slot initializing cell slot in
+ deref_ty initializing cell ty
in
iflog
begin
@@ -976,7 +975,7 @@ let trans_visitor
Ast.sprintf_lval lv
(cell_str cell))
end;
- (cell, slot)
+ (cell, ty)
in
if lval_is_slot cx lv
@@ -994,13 +993,13 @@ let trans_visitor
and trans_lval_maybe_init
(initializing:bool)
(lv:Ast.lval)
- : (Il.cell * Ast.slot) =
+ : (Il.cell * Ast.ty) =
trans_lval_full initializing lv
- and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.slot) =
+ and trans_lval_init (lv:Ast.lval) : (Il.cell * Ast.ty) =
trans_lval_maybe_init true lv
- and trans_lval (lv:Ast.lval) : (Il.cell * Ast.slot) =
+ and trans_lval (lv:Ast.lval) : (Il.cell * Ast.ty) =
trans_lval_maybe_init false lv
and trans_callee
@@ -1231,8 +1230,8 @@ let trans_visitor
match atom with
Ast.ATOM_lval lv ->
- let (cell, slot) = trans_lval lv in
- Il.Cell (deref_slot false cell slot)
+ let (cell, ty) = trans_lval lv in
+ Il.Cell (fst (deref_ty false cell ty))
| Ast.ATOM_literal lit -> trans_lit lit.node
@@ -1302,7 +1301,7 @@ let trans_visitor
and check_interrupt_flag _ =
let dom = next_vreg_cell wordptr_ty in
- let flag = next_vreg_cell word_ty in
+ let flag = next_vreg_cell word_sty in
mov dom (Il.Cell (tp_imm (word_n Abi.task_field_dom)));
mov flag (Il.Cell (deref_imm dom
(word_n Abi.dom_field_interrupt_flag)));
@@ -1393,7 +1392,7 @@ let trans_visitor
(bs:Ast.slot array)
(* FIXME (issue #5): mutability flag *)
: Il.referent_ty =
- let rc = Il.ScalarTy word_ty in
+ let rc = Il.ScalarTy word_sty in
let targ = referent_type abi (mk_simple_ty_fn [||]) in
let bindings = Array.map (slot_referent_type abi) bs in
Il.StructTy [| rc; targ; Il.StructTy bindings |]
@@ -1557,7 +1556,7 @@ let trans_visitor
and ty_params_covering (t:Ast.ty) : Ast.slot =
let n_ty_params = n_used_type_params t in
- let params = make_tydesc_slots n_ty_params in
+ let params = make_tydesc_tys n_ty_params in
alias_slot (Ast.TY_tup params)
and get_drop_glue
@@ -1570,7 +1569,7 @@ let trans_visitor
let cell = get_element_ptr args 1 in
note_drop_step ty "in drop-glue, dropping";
trace_word cx.ctxt_sess.Session.sess_trace_drop cell;
- drop_ty ty_params ty (deref cell) curr_iso;
+ drop_ty ty_params (deref cell) ty curr_iso;
note_drop_step ty "drop-glue complete";
in
let ty_params_ptr = ty_params_covering ty in
@@ -1621,7 +1620,7 @@ let trans_visitor
let inner _ (args:Il.cell) =
let ty_params = deref (get_element_ptr args 0) in
let cell = get_element_ptr args 1 in
- sever_ty ty_params ty (deref cell) curr_iso
+ sever_ty ty_params (deref cell) ty curr_iso
in
let ty_params_ptr = ty_params_covering ty in
let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
@@ -1636,7 +1635,7 @@ let trans_visitor
let inner _ (args:Il.cell) =
let ty_params = deref (get_element_ptr args 0) in
let cell = get_element_ptr args 1 in
- mark_ty ty_params ty (deref cell) curr_iso
+ mark_ty ty_params (deref cell) ty curr_iso
in
let ty_params_ptr = ty_params_covering ty in
let fty = mk_simple_ty_fn [| ty_params_ptr; alias_slot ty |] in
@@ -1653,7 +1652,7 @@ let trans_visitor
let ty_params = deref (get_element_ptr args 0) in
let src = deref (get_element_ptr args 1) in
let clone_task = get_element_ptr args 2 in
- clone_ty ty_params clone_task ty dst src curr_iso
+ clone_ty ty_params clone_task dst src ty curr_iso
in
let ty_params_ptr = ty_params_covering ty in
let fty =
@@ -1677,7 +1676,7 @@ let trans_visitor
let dst = deref out_ptr in
let ty_params = deref (get_element_ptr args 0) in
let src = deref (get_element_ptr args 1) in
- copy_ty ty_params ty dst src curr_iso
+ copy_ty ty_params dst src ty curr_iso
in
let ty_params_ptr = ty_params_covering ty in
let fty =
@@ -2096,8 +2095,8 @@ let trans_visitor
end
and trans_init_port (dst:Ast.lval) : unit =
- let (dstcell, dst_slot) = trans_lval_init dst in
- let unit_ty = match slot_ty dst_slot with
+ let (dstcell, dst_ty) = trans_lval_init dst in
+ let unit_ty = match dst_ty with
Ast.TY_port t -> t
| _ -> bug () "init dst of port-init has non-port type"
in
@@ -2134,19 +2133,18 @@ let trans_visitor
*)
and trans_init_vec (dst:Ast.lval) (atoms:Ast.atom array) : unit =
- let (dst_cell, dst_slot) = trans_lval_init dst in
- let dst_ty = slot_ty dst_slot in
+ let (dst_cell, dst_ty) = trans_lval_init dst in
let gc_ctrl =
- if (slot_mem_ctrl dst_slot) = MEM_gc
- then Il.Cell (get_tydesc None (slot_ty dst_slot))
+ if (ty_mem_ctrl dst_ty) = MEM_gc
+ then Il.Cell (get_tydesc None dst_ty)
else zero
in
- let unit_slot = match dst_ty with
- Ast.TY_vec s -> s
+ let unit_ty = match dst_ty with
+ Ast.TY_vec t -> t
| _ -> bug () "init dst of vec-init has non-vec type"
in
- let fill = next_vreg_cell word_ty in
- let unit_sz = slot_sz_in_current_frame unit_slot in
+ let fill = next_vreg_cell word_sty in
+ let unit_sz = ty_sz_in_current_frame unit_ty in
umul fill unit_sz (imm (Int64.of_int (Array.length atoms)));
trans_upcall "upcall_new_vec" dst_cell [| Il.Cell fill; gc_ctrl |];
let vec = deref dst_cell in
@@ -2155,14 +2153,14 @@ let trans_visitor
(get_element_ptr_dyn_in_current_frame
vec Abi.vec_elt_data))
in
- let unit_rty = slot_referent_type abi unit_slot in
+ let unit_rty = referent_type abi unit_ty in
let body_rty = Il.StructTy (Array.map (fun _ -> unit_rty) atoms) in
let body = Il.Mem (body_mem, body_rty) in
Array.iteri
begin
fun i atom ->
let cell = get_element_ptr_dyn_in_current_frame body i in
- trans_init_slot_from_atom CLONE_none cell unit_slot atom
+ trans_init_ty_from_atom cell unit_ty atom
end
atoms;
mov (get_element_ptr vec Abi.vec_elt_fill) (Il.Cell fill);
@@ -2221,36 +2219,35 @@ let trans_visitor
exterior_ctrl_cell cell Abi.exterior_rc_slot_field_refcnt
and exterior_allocation_size
- (slot:Ast.slot)
+ (ty:Ast.ty)
: Il.operand =
let header_sz =
- match slot_mem_ctrl slot with
+ match ty_mem_ctrl ty with
MEM_gc
| MEM_rc_opaque
| MEM_rc_struct -> word_n Abi.exterior_rc_header_size
| MEM_interior -> bug () "exterior_allocation_size of MEM_interior"
in
- let t = slot_ty slot in
let refty_sz =
- Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi t)
+ Il.referent_ty_size abi.Abi.abi_word_bits (referent_type abi ty)
in
match refty_sz with
- SIZE_fixed _ -> imm (Int64.add (ty_sz abi t) header_sz)
+ SIZE_fixed _ -> imm (Int64.add (ty_sz abi ty) header_sz)
| _ ->
let ty_params = get_ty_params_of_current_frame() in
let refty_sz = calculate_sz ty_params refty_sz in
- let v = next_vreg word_ty in
- let vc = Il.Reg (v, word_ty) in
+ let v = next_vreg word_sty in
+ let vc = Il.Reg (v, word_sty) in
mov vc refty_sz;
add_to vc (imm header_sz);
Il.Cell vc;
- and iter_tag_slots
+ and iter_tag_parts
(ty_params:Il.cell)
(dst_cell:Il.cell)
(src_cell:Il.cell)
(ttag:Ast.ty_tag)
- (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
let tag_keys = sorted_htab_keys ttag in
@@ -2258,8 +2255,8 @@ let trans_visitor
let dst_tag = get_element_ptr dst_cell 0 in
let src_union = get_element_ptr_dyn ty_params src_cell 1 in
let dst_union = get_element_ptr_dyn ty_params dst_cell 1 in
- let tmp = next_vreg_cell word_ty in
- f dst_tag src_tag word_slot curr_iso;
+ let tmp = next_vreg_cell word_sty in
+ f dst_tag src_tag word_ty curr_iso;
mov tmp (Il.Cell src_tag);
Array.iteri
begin
@@ -2271,7 +2268,7 @@ let trans_visitor
trans_compare Il.JNE (Il.Cell tmp) (imm (Int64.of_int i))
in
let ttup = Hashtbl.find ttag key in
- iter_tup_slots
+ iter_tup_parts
(get_element_ptr_dyn ty_params)
(get_variant_ptr dst_union i)
(get_variant_ptr src_union i)
@@ -2284,24 +2281,24 @@ let trans_visitor
tiso.Ast.iso_group.(tiso.Ast.iso_index)
- and seq_unit_slot (seq:Ast.ty) : Ast.slot =
+ and seq_unit_ty (seq:Ast.ty) : Ast.ty =
match seq with
- Ast.TY_vec s -> s
- | Ast.TY_str -> (interior_slot (Ast.TY_mach TY_u8))
- | _ -> bug () "seq_unit_slot of non-vec, non-str type"
+ Ast.TY_vec t -> t
+ | Ast.TY_str -> Ast.TY_mach TY_u8
+ | _ -> bug () "seq_unit_ty of non-vec, non-str type"
- and iter_seq_slots
+ and iter_seq_parts
(ty_params:Il.cell)
(dst_cell:Il.cell)
(src_cell:Il.cell)
- (unit_slot:Ast.slot)
- (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (unit_ty:Ast.ty)
+ (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
- let unit_sz = slot_sz_with_ty_params ty_params unit_slot in
+ let unit_sz = ty_sz_with_ty_params ty_params unit_ty in
(*
- * Unlike most of the iter_ty_slots helpers; this one allocates a
+ * Unlike most of the iter_ty_parts helpers; this one allocates a
* vreg and so has to be aware of when it's iterating over 2
* sequences of cells or just 1.
*)
@@ -2323,9 +2320,9 @@ let trans_visitor
let back_jmp_target = mark () in
let fwd_jmps = trans_compare Il.JAE (Il.Cell ptr) (Il.Cell lim) in
let unit_cell =
- deref (ptr_cast ptr (slot_referent_type abi unit_slot))
+ deref (ptr_cast ptr (referent_type abi unit_ty))
in
- f unit_cell unit_cell unit_slot curr_iso;
+ f unit_cell unit_cell unit_ty curr_iso;
add_to ptr unit_sz;
check_interrupt_flag ();
emit (Il.jmp Il.JMP (Il.CodeLabel back_jmp_target));
@@ -2337,12 +2334,12 @@ let trans_visitor
end
- and iter_ty_slots_full
+ and iter_ty_parts_full
(ty_params:Il.cell)
- (ty:Ast.ty)
(dst_cell:Il.cell)
(src_cell:Il.cell)
- (f:Il.cell -> Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (ty:Ast.ty)
+ (f:Il.cell -> Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
(*
@@ -2352,84 +2349,74 @@ let trans_visitor
*)
match ty with
Ast.TY_rec entries ->
- iter_rec_slots
+ iter_rec_parts
(get_element_ptr_dyn ty_params) dst_cell src_cell
entries f curr_iso
- | Ast.TY_tup slots ->
- iter_tup_slots
+ | Ast.TY_tup tys ->
+ iter_tup_parts
(get_element_ptr_dyn ty_params) dst_cell src_cell
- slots f curr_iso
+ tys f curr_iso
| Ast.TY_tag tag ->
- iter_tag_slots ty_params dst_cell src_cell tag f curr_iso
+ iter_tag_parts ty_params dst_cell src_cell tag f curr_iso
| Ast.TY_iso tiso ->
let ttag = get_iso_tag tiso in
- iter_tag_slots ty_params dst_cell src_cell ttag f (Some tiso)
+ iter_tag_parts ty_params dst_cell src_cell ttag f (Some tiso)
| Ast.TY_fn _
| Ast.TY_obj _ -> bug () "Attempting to iterate over fn/pred/obj slots"
| Ast.TY_vec _
| Ast.TY_str ->
- let unit_slot = seq_unit_slot ty in
- iter_seq_slots ty_params dst_cell src_cell unit_slot f curr_iso
+ let unit_ty = seq_unit_ty ty in
+ iter_seq_parts ty_params dst_cell src_cell unit_ty f curr_iso
| _ -> ()
(*
- * This just calls iter_ty_slots_full with your cell as both src and
- * dst, with an adaptor function that discards the dst slots of the
+ * This just calls iter_ty_parts_full with your cell as both src and
+ * dst, with an adaptor function that discards the dst parts of the
* parallel traversal and and calls your provided function on the
- * passed-in src slots.
+ * passed-in src parts.
*)
- and iter_ty_slots
+ and iter_ty_parts
(ty_params:Il.cell)
- (ty:Ast.ty)
(cell:Il.cell)
- (f:Il.cell -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (ty:Ast.ty)
+ (f:Il.cell -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
- iter_ty_slots_full ty_params ty cell cell
- (fun _ src_cell slot curr_iso -> f src_cell slot curr_iso)
+ iter_ty_parts_full ty_params cell cell ty
+ (fun _ src_cell ty curr_iso -> f src_cell ty curr_iso)
curr_iso
and drop_ty
(ty_params:Il.cell)
- (ty:Ast.ty)
(cell:Il.cell)
+ (ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
- match ty with
- Ast.TY_param (i, _) ->
- iflog (fun _ -> annotate
- (Printf.sprintf "drop_ty: parametric drop %#d" i));
- aliasing false cell
- begin
- fun cell ->
- trans_call_simple_dynamic_glue
- i Abi.tydesc_field_drop_glue ty_params cell
- end
- | Ast.TY_fn _ ->
- begin
+ let ty = maybe_iso curr_iso ty in
+ let curr_iso = maybe_enter_iso ty curr_iso in
+ let mctrl = ty_mem_ctrl ty in
+
+ match ty with
+
+ Ast.TY_fn _ ->
let binding = get_element_ptr cell Abi.binding_field_binding in
let null_jmp = null_check binding in
(* Drop non-null bindings. *)
- (* FIXME (issue #58): this is completely wrong,
- * need a second thunk that generates code to make
- * use of a runtime type descriptor extracted from
- * a binding tuple. For now this only works by
- * accident.
+ (* FIXME (issue #58): this is completely wrong, Closures need to
+ * carry tydescs like objs. For now this only works by accident,
+ * and will leak closures with exterior substructure.
*)
- drop_slot ty_params binding
- (exterior_slot Ast.TY_int) curr_iso;
+ drop_ty ty_params binding (Ast.TY_exterior Ast.TY_int) curr_iso;
patch null_jmp
- end
- | Ast.TY_obj _ ->
- begin
+ | Ast.TY_obj _ ->
let binding = get_element_ptr cell Abi.binding_field_binding in
let null_jmp = null_check binding in
let obj = deref binding in
@@ -2445,55 +2432,109 @@ let trans_visitor
in
let null_dtor_jmp = null_check dtor in
(* Call any dtor, if present. *)
- trans_call_dynamic_glue tydesc
- Abi.tydesc_field_obj_drop_glue None [| binding |];
- patch null_dtor_jmp;
- (* Drop the body. *)
- trans_call_dynamic_glue tydesc
- Abi.tydesc_field_drop_glue None [| ty_params; alias body |];
- (* FIXME: this will fail if the user has lied about the
- * state-ness of their obj. We need to store state-ness in the
- * captured tydesc, and use that. *)
- trans_free binding (type_has_state ty);
- mov binding zero;
- patch rc_jmp;
- patch null_jmp
- end
+ trans_call_dynamic_glue tydesc
+ Abi.tydesc_field_obj_drop_glue None [| binding |];
+ patch null_dtor_jmp;
+ (* Drop the body. *)
+ trans_call_dynamic_glue tydesc
+ Abi.tydesc_field_drop_glue None [| ty_params; alias body |];
+ (* FIXME: this will fail if the user has lied about the
+ * state-ness of their obj. We need to store state-ness in the
+ * captured tydesc, and use that. *)
+ trans_free binding (type_has_state ty);
+ mov binding zero;
+ patch rc_jmp;
+ patch null_jmp
+
+ | Ast.TY_param (i, _) ->
+ iflog (fun _ -> annotate
+ (Printf.sprintf "drop_ty: parametric drop %#d" i));
+ aliasing false cell
+ begin
+ fun cell ->
+ trans_call_simple_dynamic_glue
+ i Abi.tydesc_field_drop_glue ty_params cell
+ end
| _ ->
- iter_ty_slots ty_params ty cell (drop_slot ty_params) curr_iso
+ match mctrl with
+ MEM_gc
+ | MEM_rc_opaque
+ | MEM_rc_struct ->
+
+ let _ = check_exterior_rty cell in
+ let null_jmp = null_check cell in
+ let rc = exterior_rc_cell cell in
+ let j = drop_refcount_and_cmp rc in
+
+ (* FIXME (issue #25): check to see that the exterior has
+ * further exterior members; if it doesn't we can elide the
+ * call to the glue function. *)
+
+ if mctrl = MEM_rc_opaque
+ then
+ free_ty false ty_params ty cell curr_iso
+ else
+ trans_call_simple_static_glue
+ (get_free_glue ty (mctrl = MEM_gc) curr_iso)
+ ty_params cell;
+
+ (* Null the slot out to prevent double-free if the frame
+ * unwinds.
+ *)
+ mov cell zero;
+ patch j;
+ patch null_jmp
+
+ | MEM_interior when type_is_structured ty ->
+ (iflog (fun _ ->
+ annotate ("drop interior slot " ^
+ (Fmt.fmt_to_str Ast.fmt_ty ty))));
+ let (mem, _) = need_mem_cell cell in
+ let vr = next_vreg_cell Il.voidptr_t in
+ lea vr mem;
+ trans_call_simple_static_glue
+ (get_drop_glue ty curr_iso)
+ ty_params vr
+
+ | MEM_interior ->
+ (* Interior allocation of all-interior value not caught above:
+ * nothing to do.
+ *)
+ ()
and sever_ty
(ty_params:Il.cell)
- (ty:Ast.ty)
(cell:Il.cell)
- (curr_iso:Ast.ty_iso option)
- : unit =
- match ty with
- | Ast.TY_fn _
- | Ast.TY_obj _ -> ()
- | _ ->
- iter_ty_slots ty_params ty cell (sever_slot ty_params) curr_iso
-
- and mark_ty
- (ty_params:Il.cell)
(ty:Ast.ty)
- (cell:Il.cell)
(curr_iso:Ast.ty_iso option)
: unit =
- match ty with
- | Ast.TY_fn _
- | Ast.TY_obj _ -> ()
- | _ ->
- iter_ty_slots ty_params ty cell (mark_slot ty_params) curr_iso
+ let _ = note_gc_step ty "severing" in
+ match ty_mem_ctrl ty with
+ MEM_gc ->
+
+ let _ = check_exterior_rty cell in
+ let null_jmp = null_check cell in
+ let rc = exterior_rc_cell cell in
+ let _ = note_gc_step ty "severing GC slot" in
+ emit (Il.binary Il.SUB rc (Il.Cell rc) one);
+ mov cell zero;
+ patch null_jmp
+
+ | MEM_interior when type_is_structured ty ->
+ iter_ty_parts ty_params cell ty
+ (sever_ty ty_params) curr_iso
+
+ | _ -> ()
+ (* No need to follow links / call glue; severing is shallow. *)
and clone_ty
(ty_params:Il.cell)
(clone_task:Il.cell)
- (ty:Ast.ty)
(dst:Il.cell)
(src:Il.cell)
+ (ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
match ty with
@@ -2508,15 +2549,21 @@ let trans_visitor
-> mov dst (Il.Cell src)
| Ast.TY_fn _
| Ast.TY_obj _ -> ()
+ | Ast.TY_exterior ty ->
+ let glue_fix = get_clone_glue ty curr_iso in
+ trans_call_static_glue
+ (code_fixup_to_ptr_operand glue_fix)
+ (Some dst)
+ [| alias ty_params; src; clone_task |]
| _ ->
- iter_ty_slots_full ty_params ty dst src
- (clone_slot ty_params clone_task) curr_iso
+ iter_ty_parts_full ty_params dst src ty
+ (clone_ty ty_params clone_task) curr_iso
and copy_ty
(ty_params:Il.cell)
- (ty:Ast.ty)
(dst:Il.cell)
(src:Il.cell)
+ (ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
iflog (fun _ ->
@@ -2565,18 +2612,18 @@ let trans_visitor
* through to the binding's self-copy fptr. For now
* this only works by accident.
*)
- trans_copy_slot ty_params true
- dst_binding (exterior_slot Ast.TY_int)
- src_binding (exterior_slot Ast.TY_int)
+ trans_copy_ty ty_params true
+ dst_binding (Ast.TY_exterior Ast.TY_int)
+ src_binding (Ast.TY_exterior Ast.TY_int)
curr_iso;
patch null_jmp
end
| _ ->
- iter_ty_slots_full ty_params ty dst src
- (fun dst src slot curr_iso ->
- trans_copy_slot ty_params true
- dst slot src slot curr_iso)
+ iter_ty_parts_full ty_params dst src ty
+ (fun dst src ty curr_iso ->
+ trans_copy_ty ty_params true
+ dst ty src ty curr_iso)
curr_iso
and free_ty
@@ -2591,8 +2638,8 @@ let trans_visitor
| Ast.TY_chan _ -> trans_del_chan cell
| Ast.TY_task -> trans_kill_task cell
| Ast.TY_vec s ->
- iter_seq_slots ty_params cell cell s
- (fun _ src slot iso -> drop_slot ty_params src slot iso) curr_iso;
+ iter_seq_parts ty_params cell cell s
+ (fun _ src ty iso -> drop_ty ty_params src ty iso) curr_iso;
trans_free cell is_gc
| _ -> trans_free cell is_gc
@@ -2603,7 +2650,7 @@ let trans_visitor
: Ast.ty =
match (curr_iso, t) with
(Some iso, Ast.TY_idx n) ->
- Ast.TY_iso { iso with Ast.iso_index = n }
+ Ast.TY_exterior (Ast.TY_iso { iso with Ast.iso_index = n })
| (None, Ast.TY_idx _) ->
bug () "TY_idx outside TY_iso"
| _ -> t
@@ -2616,74 +2663,46 @@ let trans_visitor
Ast.TY_iso tiso -> Some tiso
| _ -> curr_iso
- and sever_slot
+ and mark_slot
(ty_params:Il.cell)
(cell:Il.cell)
(slot:Ast.slot)
(curr_iso:Ast.ty_iso option)
: unit =
- let _ = note_gc_step slot "severing" in
- let ty = slot_ty slot in
- match slot_mem_ctrl slot with
- MEM_gc ->
-
- let _ = check_exterior_rty cell in
- let null_jmp = null_check cell in
- let rc = exterior_rc_cell cell in
- let _ = note_gc_step slot "severing GC slot" in
- emit (Il.binary Il.SUB rc (Il.Cell rc) one);
- mov cell zero;
- patch null_jmp
-
- | MEM_interior when type_is_structured ty ->
- let (mem, _) = need_mem_cell cell in
- let tmp = next_vreg_cell Il.voidptr_t in
- let ty = maybe_iso curr_iso ty in
- let curr_iso = maybe_enter_iso ty curr_iso in
- lea tmp mem;
- trans_call_simple_static_glue
- (get_sever_glue ty curr_iso)
- ty_params tmp
+ (* Marking goes straight through aliases. Reachable means reachable. *)
+ mark_ty ty_params (deref_slot false cell slot) (slot_ty slot) curr_iso
- | MEM_interior ->
- (* Interior allocation of all-interior value: sever directly. *)
- let ty = maybe_iso curr_iso ty in
- sever_ty ty_params ty cell curr_iso
-
- | _ -> ()
-
- and mark_slot
+ and mark_ty
(ty_params:Il.cell)
(cell:Il.cell)
- (slot:Ast.slot)
+ (ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
- let ty = slot_ty slot in
- match slot_mem_ctrl slot with
- MEM_gc ->
- let tmp = next_vreg_cell Il.voidptr_t in
+ match ty_mem_ctrl ty with
+ MEM_gc ->
+ let tmp = next_vreg_cell Il.voidptr_t in
trans_upcall "upcall_mark" tmp [| Il.Cell cell |];
- let marked_jump =
- trans_compare Il.JE (Il.Cell tmp) zero;
- in
- (* Iterate over exterior slots marking outgoing links. *)
- let (body_mem, _) =
- need_mem_cell
- (get_element_ptr (deref cell)
- Abi.exterior_gc_slot_field_body)
- in
- let ty = maybe_iso curr_iso ty in
- let curr_iso = maybe_enter_iso ty curr_iso in
- lea tmp body_mem;
- trans_call_simple_static_glue
- (get_mark_glue ty curr_iso)
- ty_params tmp;
- List.iter patch marked_jump;
+ let marked_jump =
+ trans_compare Il.JE (Il.Cell tmp) zero;
+ in
+ (* Iterate over exterior parts marking outgoing links. *)
+ let (body_mem, _) =
+ need_mem_cell
+ (get_element_ptr (deref cell)
+ Abi.exterior_gc_slot_field_body)
+ in
+ let ty = maybe_iso curr_iso ty in
+ let curr_iso = maybe_enter_iso ty curr_iso in
+ lea tmp body_mem;
+ trans_call_simple_static_glue
+ (get_mark_glue ty curr_iso)
+ ty_params tmp;
+ List.iter patch marked_jump;
| MEM_interior when type_is_structured ty ->
(iflog (fun _ ->
annotate ("mark interior slot " ^
- (Fmt.fmt_to_str Ast.fmt_slot slot))));
+ (Fmt.fmt_to_str Ast.fmt_ty ty))));
let (mem, _) = need_mem_cell cell in
let tmp = next_vreg_cell Il.voidptr_t in
let ty = maybe_iso curr_iso ty in
@@ -2704,30 +2723,6 @@ let trans_visitor
"expected plausibly-exterior cell, got %s"
(Il.string_of_referent_ty (Il.cell_referent_ty cell))
- and clone_slot
- (ty_params:Il.cell)
- (clone_task:Il.cell)
- (dst:Il.cell)
- (src:Il.cell)
- (dst_slot:Ast.slot)
- (curr_iso:Ast.ty_iso option)
- : unit =
- let ty = slot_ty dst_slot in
- match dst_slot.Ast.slot_mode with
- Ast.MODE_exterior _ ->
- let ty = maybe_iso curr_iso ty in
- let curr_iso = maybe_enter_iso ty curr_iso in
- let dst = deref_slot true dst dst_slot in
- let glue_fix = get_clone_glue (slot_ty dst_slot) curr_iso in
- trans_call_static_glue
- (code_fixup_to_ptr_operand glue_fix)
- (Some dst)
- [| alias ty_params; src; clone_task |]
-
- | Ast.MODE_alias _ -> bug () "cloning into alias slot"
- | Ast.MODE_interior _ ->
- clone_ty ty_params clone_task ty dst src curr_iso
-
and drop_slot_in_current_frame
(cell:Il.cell)
(slot:Ast.slot)
@@ -2755,54 +2750,11 @@ let trans_visitor
(slot:Ast.slot)
(curr_iso:Ast.ty_iso option)
: unit =
- let ty = slot_ty slot in
- let ty = maybe_iso curr_iso ty in
- let curr_iso = maybe_enter_iso ty curr_iso in
- let slot = {slot with Ast.slot_ty = Some ty} in
- let mctrl = slot_mem_ctrl slot in
- match mctrl with
- MEM_rc_opaque
- | MEM_gc
- | MEM_rc_struct ->
- let _ = check_exterior_rty cell in
- let null_jmp = null_check cell in
- let rc = exterior_rc_cell cell in
- let j = drop_refcount_and_cmp rc in
-
- (* FIXME (issue #25): check to see that the exterior has
- * further exterior members; if it doesn't we can elide the
- * call to the glue function. *)
-
- if mctrl = MEM_rc_opaque
- then
- free_ty false ty_params ty cell curr_iso
- else
- trans_call_simple_static_glue
- (get_free_glue ty (mctrl = MEM_gc) curr_iso)
- ty_params cell;
-
- (* Null the slot out to prevent double-free if the frame
- * unwinds.
- *)
- mov cell zero;
- patch j;
- patch null_jmp
-
- | MEM_interior when type_is_structured ty ->
- (iflog (fun _ ->
- annotate ("drop interior slot " ^
- (Fmt.fmt_to_str Ast.fmt_slot slot))));
- let (mem, _) = need_mem_cell cell in
- let vr = next_vreg_cell Il.voidptr_t in
- lea vr mem;
- trans_call_simple_static_glue
- (get_drop_glue ty curr_iso)
- ty_params vr
-
- | MEM_interior ->
- (* Interior allocation of all-interior value: free directly. *)
- let ty = maybe_iso curr_iso ty in
- drop_ty ty_params ty cell curr_iso
+ match slot.Ast.slot_mode with
+ Ast.MODE_alias
+ (* Aliases are always free to drop. *)
+ | Ast.MODE_interior ->
+ drop_ty ty_params cell (slot_ty slot) curr_iso
and note_drop_step ty step =
if cx.ctxt_sess.Session.sess_trace_drop ||
@@ -2815,44 +2767,70 @@ let trans_visitor
trace_str cx.ctxt_sess.Session.sess_trace_drop str
end
- and note_gc_step slot step =
+ and note_gc_step ty step =
if cx.ctxt_sess.Session.sess_trace_gc ||
cx.ctxt_sess.Session.sess_log_trans
then
let mctrl_str =
- match slot_mem_ctrl slot with
+ match ty_mem_ctrl ty with
MEM_gc -> "MEM_gc"
| MEM_rc_struct -> "MEM_rc_struct"
| MEM_rc_opaque -> "MEM_rc_opaque"
| MEM_interior -> "MEM_interior"
in
- let slotstr = Fmt.fmt_to_str Ast.fmt_slot slot in
- let str = step ^ " " ^ mctrl_str ^ " " ^ slotstr in
+ let tystr = Fmt.fmt_to_str Ast.fmt_ty ty in
+ let str = step ^ " " ^ mctrl_str ^ " " ^ tystr in
begin
annotate str;
trace_str cx.ctxt_sess.Session.sess_trace_gc str
end
(* Returns the offset of the slot-body in the initialized allocation. *)
- and init_exterior_slot (cell:Il.cell) (slot:Ast.slot) : unit =
- let mctrl = slot_mem_ctrl slot in
+ and init_exterior (cell:Il.cell) (ty:Ast.ty) : unit =
+ let mctrl = ty_mem_ctrl ty in
match mctrl with
MEM_gc
| MEM_rc_opaque
| MEM_rc_struct ->
let ctrl =
if mctrl = MEM_gc
- then Il.Cell (get_tydesc None (slot_ty slot))
+ then Il.Cell (get_tydesc None ty)
else zero
in
iflog (fun _ -> annotate "init exterior: malloc");
- let sz = exterior_allocation_size slot in
+ let sz = exterior_allocation_size ty in
trans_malloc cell sz ctrl;
iflog (fun _ -> annotate "init exterior: load refcount");
let rc = exterior_rc_cell cell in
mov rc one
- | MEM_interior -> bug () "init_exterior_slot of MEM_interior"
+ | MEM_interior -> bug () "init_exterior of MEM_interior"
+
+ and deref_ty
+ (initializing:bool)
+ (cell:Il.cell)
+ (ty:Ast.ty)
+ : (Il.cell * Ast.ty) =
+ match ty with
+
+ | Ast.TY_mutable ty
+ | Ast.TY_constrained (ty, _) ->
+ deref_ty initializing cell ty
+
+ | Ast.TY_exterior ty ->
+ check_exterior_rty cell;
+ if initializing
+ then init_exterior cell ty;
+ let cell =
+ get_element_ptr_dyn_in_current_frame
+ (deref cell)
+ (Abi.exterior_rc_slot_field_body)
+ in
+ (* Init recursively so @@@@T chain works. *)
+ deref_ty initializing cell ty
+
+ | _ -> (cell, ty)
+
and deref_slot
(initializing:bool)
@@ -2860,17 +2838,9 @@ let trans_visitor
(slot:Ast.slot)
: Il.cell =
match slot.Ast.slot_mode with
- Ast.MODE_interior _ ->
+ Ast.MODE_interior ->
cell
- | Ast.MODE_exterior _ ->
- check_exterior_rty cell;
- if initializing
- then init_exterior_slot cell slot;
- get_element_ptr_dyn_in_current_frame
- (deref cell)
- Abi.exterior_rc_slot_field_body
-
| Ast.MODE_alias _ ->
if initializing
then cell
@@ -2881,24 +2851,32 @@ let trans_visitor
(initializing:bool)
(dst:Il.cell)
(src:Il.cell)
- (slots:Ast.ty_tup)
+ (tys:Ast.ty_tup)
: unit =
Array.iteri
begin
- fun i slot ->
+ fun i ty ->
let sub_dst_cell = get_element_ptr_dyn ty_params dst i in
let sub_src_cell = get_element_ptr_dyn ty_params src i in
- trans_copy_slot
+ trans_copy_ty
ty_params initializing
- sub_dst_cell slot sub_src_cell slot None
+ sub_dst_cell ty sub_src_cell ty None
end
- slots
+ tys
- and trans_copy_slot
+ and without_exterior t =
+ match t with
+ | Ast.TY_mutable t
+ | Ast.TY_exterior t
+ | Ast.TY_constrained (t, _) ->
+ without_exterior t
+ | _ -> t
+
+ and trans_copy_ty
(ty_params:Il.cell)
(initializing:bool)
- (dst:Il.cell) (dst_slot:Ast.slot)
- (src:Il.cell) (src_slot:Ast.slot)
+ (dst:Il.cell) (dst_ty:Ast.ty)
+ (src:Il.cell) (src_ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
let anno (weight:string) : unit =
@@ -2908,13 +2886,12 @@ let trans_visitor
annotate
(Printf.sprintf "%sweight copy: %a <- %a"
weight
- Ast.sprintf_slot dst_slot
- Ast.sprintf_slot src_slot)
+ Ast.sprintf_ty dst_ty
+ Ast.sprintf_ty src_ty)
end;
in
- assert (slot_ty src_slot = slot_ty dst_slot);
- match (slot_mem_ctrl src_slot,
- slot_mem_ctrl dst_slot) with
+ assert (without_exterior src_ty = without_exterior dst_ty);
+ match (ty_mem_ctrl src_ty, ty_mem_ctrl dst_ty) with
| (MEM_rc_opaque, MEM_rc_opaque)
| (MEM_gc, MEM_gc)
@@ -2924,14 +2901,14 @@ let trans_visitor
add_to (exterior_rc_cell src) one;
if not initializing
then
- drop_slot ty_params dst dst_slot None;
+ drop_ty ty_params dst dst_ty None;
mov dst (Il.Cell src)
| _ ->
(* Heavyweight copy: duplicate 1 level of the referent. *)
anno "heavy";
- trans_copy_slot_heavy ty_params initializing
- dst dst_slot src src_slot curr_iso
+ trans_copy_ty_heavy ty_params initializing
+ dst dst_ty src src_ty curr_iso
(* NB: heavyweight copying here does not mean "producing a deep
* clone of the entire data tree rooted at the src operand". It means
@@ -2960,39 +2937,44 @@ let trans_visitor
*
*)
- and trans_copy_slot_heavy
+ and trans_copy_ty_heavy
(ty_params:Il.cell)
(initializing:bool)
- (dst:Il.cell) (dst_slot:Ast.slot)
- (src:Il.cell) (src_slot:Ast.slot)
+ (dst:Il.cell) (dst_ty:Ast.ty)
+ (src:Il.cell) (src_ty:Ast.ty)
(curr_iso:Ast.ty_iso option)
: unit =
- assert (slot_ty src_slot = slot_ty dst_slot);
+ assert (without_exterior src_ty = without_exterior dst_ty);
iflog (fun _ ->
annotate ("heavy copy: slot preparation"));
- let ty = slot_ty src_slot in
+ let ty = without_exterior src_ty in
let ty = maybe_iso curr_iso ty in
let curr_iso = maybe_enter_iso ty curr_iso in
- let dst_slot = { dst_slot with Ast.slot_ty = Some ty } in
- let src_slot = { src_slot with Ast.slot_ty = Some ty } in
- let dst = deref_slot initializing dst dst_slot in
- let src = deref_slot false src src_slot in
- copy_ty ty_params ty dst src curr_iso
+ let (dst, dst_ty) = deref_ty initializing dst dst_ty in
+ let (src, src_ty) = deref_ty false src src_ty in
+ assert (dst_ty = ty);
+ assert (src_ty = ty);
+ copy_ty ty_params dst src ty curr_iso
and trans_copy
(initializing:bool)
(dst:Ast.lval)
(src:Ast.expr)
: unit =
- let (dst_cell, dst_slot) = trans_lval_maybe_init initializing dst in
- match (slot_ty dst_slot, src) with
- (Ast.TY_vec _,
+ let (dst_cell, dst_ty) = trans_lval_maybe_init initializing dst in
+ let rec can_append t =
+ match t with
+ Ast.TY_vec _
+ | Ast.TY_str -> true
+ | Ast.TY_exterior t when can_append t -> true
+ | _ -> false
+ in
+ match (dst_ty, src) with
+ (t,
Ast.EXPR_binary (Ast.BINOP_add,
Ast.ATOM_lval a, Ast.ATOM_lval b))
- | (Ast.TY_str,
- Ast.EXPR_binary (Ast.BINOP_add,
- Ast.ATOM_lval a, Ast.ATOM_lval b)) ->
+ when can_append t ->
(*
* Translate str or vec
*
@@ -3003,14 +2985,14 @@ let trans_visitor
* s = a;
* s += b;
*)
- let (a_cell, a_slot) = trans_lval a in
- let (b_cell, b_slot) = trans_lval b in
- trans_copy_slot
+ let (a_cell, a_ty) = trans_lval a in
+ let (b_cell, b_ty) = trans_lval b in
+ trans_copy_ty
(get_ty_params_of_current_frame())
- initializing dst_cell dst_slot
- a_cell a_slot None;
- trans_vec_append dst_cell dst_slot
- (Il.Cell b_cell) (slot_ty b_slot)
+ initializing dst_cell dst_ty
+ a_cell a_ty None;
+ trans_vec_append dst_cell dst_ty
+ (Il.Cell b_cell) b_ty
| (Ast.TY_obj caller_obj_ty,
@@ -3026,7 +3008,6 @@ let trans_visitor
| _ -> bug () "obj cast from non-obj type"
in
let src_cell = need_cell (trans_atom a) in
- let src_slot = interior_slot src_ty in
(* FIXME (issue #84): this is wrong. It treats the underlying
* obj-state as the same as the callee and simply substitutes
@@ -3036,16 +3017,16 @@ let trans_visitor
* refcounted obj to hold the callee's vtbl+state pair, copy
* that in as the state here. *)
let _ =
- trans_copy_slot (get_ty_params_of_current_frame())
+ trans_copy_ty (get_ty_params_of_current_frame())
initializing
- dst_cell dst_slot
- src_cell src_slot
+ dst_cell dst_ty
+ src_cell src_ty
in
let caller_vtbl_oper =
get_forwarding_vtbl caller_obj_ty callee_obj_ty
in
- let caller_obj =
- deref_slot initializing dst_cell dst_slot
+ let (caller_obj, _) =
+ deref_ty initializing dst_cell dst_ty
in
let caller_vtbl =
get_element_ptr caller_obj Abi.binding_field_item
@@ -3061,19 +3042,19 @@ let trans_visitor
* so copy is just MOV into the lval.
*)
let src_operand = trans_expr src in
- mov (deref_slot false dst_cell dst_slot) src_operand
+ mov (fst (deref_ty false dst_cell dst_ty)) src_operand
| (_, Ast.EXPR_atom (Ast.ATOM_lval src_lval)) ->
if lval_is_direct_fn cx src_lval then
trans_copy_direct_fn dst_cell src_lval
else
(* Possibly-large structure copying *)
- let (src_cell, src_slot) = trans_lval src_lval in
- trans_copy_slot
+ let (src_cell, src_ty) = trans_lval src_lval in
+ trans_copy_ty
(get_ty_params_of_current_frame())
initializing
- dst_cell dst_slot
- src_cell src_slot
+ dst_cell dst_ty
+ src_cell src_ty
None
and trans_copy_direct_fn
@@ -3089,120 +3070,117 @@ let trans_visitor
let dst_pair_binding_cell =
get_element_ptr dst_cell Abi.binding_field_binding
in
-
mov dst_pair_item_cell (crate_rel_imm fix);
mov dst_pair_binding_cell zero
and trans_init_structural_from_atoms
(dst:Il.cell)
- (dst_slots:Ast.slot array)
+ (dst_tys:Ast.ty array)
(atoms:Ast.atom array)
: unit =
Array.iteri
begin
fun i atom ->
- trans_init_slot_from_atom
- CLONE_none
+ trans_init_ty_from_atom
(get_element_ptr_dyn_in_current_frame dst i)
- dst_slots.(i)
- atom
+ dst_tys.(i) atom
end
atoms
and trans_init_rec_update
(dst:Il.cell)
- (dst_slots:Ast.slot array)
+ (dst_tys:Ast.ty array)
(trec:Ast.ty_rec)
- (atab:(Ast.ident * Ast.mode * bool * Ast.atom) array)
+ (atab:(Ast.ident * Ast.atom) array)
(base:Ast.lval)
: unit =
Array.iteri
begin
fun i (fml_ident, _) ->
- let fml_entry _ (act_ident, _, _, atom) =
+ let fml_entry _ (act_ident, atom) =
if act_ident = fml_ident then Some atom else None
in
- let slot = dst_slots.(i) in
+ let dst_ty = dst_tys.(i) in
match arr_search atab fml_entry with
Some atom ->
- trans_init_slot_from_atom
- CLONE_none
+ trans_init_ty_from_atom
(get_element_ptr_dyn_in_current_frame dst i)
- slot
- atom
+ dst_ty atom
| None ->
- let (src, _) = trans_lval base in
- trans_copy_slot
+ let (src, src_ty) = trans_lval base in
+ trans_copy_ty
(get_ty_params_of_current_frame()) true
- (get_element_ptr_dyn_in_current_frame dst i) slot
- (get_element_ptr_dyn_in_current_frame src i) slot
+ (get_element_ptr_dyn_in_current_frame dst i) dst_ty
+ (get_element_ptr_dyn_in_current_frame src i) src_ty
None
end
trec
- and trans_init_slot_from_atom
- (clone:clone_ctrl)
- (dst:Il.cell) (dst_slot:Ast.slot)
- (atom:Ast.atom)
+ and trans_init_ty_from_atom
+ (dst:Il.cell) (ty:Ast.ty) (atom:Ast.atom)
: unit =
- let is_alias_cell =
- match dst_slot.Ast.slot_mode with
- Ast.MODE_alias _ -> true
- | _ -> false
- in
- match atom with
- | Ast.ATOM_literal _ ->
- let src = trans_atom atom in
- if is_alias_cell
- then
- match clone with
- CLONE_none ->
- (* Aliasing a literal is a bit weird since nobody
- * else will ever see it, but it seems harmless.
- *)
- mov dst (Il.Cell (alias (Il.Mem (force_to_mem src))))
- | _ ->
- bug () "attempting to clone alias cell"
- else
- mov (deref_slot true dst dst_slot) src
- | Ast.ATOM_lval src_lval ->
- let (src, src_slot) = trans_lval src_lval in
- trans_init_slot_from_cell clone dst dst_slot src src_slot
+ let src = Il.Mem (force_to_mem (trans_atom atom)) in
+ trans_copy_ty (get_ty_params_of_current_frame())
+ true dst ty src ty None
and trans_init_slot_from_cell
+ (ty_params:Il.cell)
(clone:clone_ctrl)
(dst:Il.cell) (dst_slot:Ast.slot)
- (src:Il.cell) (src_slot:Ast.slot)
+ (src:Il.cell) (src_ty:Ast.ty)
: unit =
- assert (slot_ty src_slot = slot_ty dst_slot);
- let is_alias_cell =
- match dst_slot.Ast.slot_mode with
- Ast.MODE_alias _ -> true
- | _ -> false
- in
- match clone with
- CLONE_chan clone_task ->
+ let dst_ty = slot_ty dst_slot in
+ assert (src_ty = dst_ty);
+ match (dst_slot.Ast.slot_mode, clone) with
+ (Ast.MODE_alias, CLONE_none) ->
+ mov dst (Il.Cell (alias (Il.Mem (need_mem_cell src))))
+
+ | (Ast.MODE_interior, CLONE_none) ->
+ trans_copy_ty
+ ty_params true
+ dst dst_ty src src_ty None
+
+ | (Ast.MODE_alias, _) ->
+ bug () "attempting to clone into alias slot"
+
+ | (_, CLONE_chan clone_task) ->
let clone =
- if (type_contains_chan (slot_ty src_slot))
+ if (type_contains_chan src_ty)
then CLONE_all clone_task
else CLONE_none
in
- trans_init_slot_from_cell clone dst dst_slot src src_slot
- | CLONE_none ->
- if is_alias_cell
- then mov dst (Il.Cell (alias src))
- else
- trans_copy_slot
- (get_ty_params_of_current_frame())
- true dst dst_slot src src_slot None
- | CLONE_all clone_task ->
- if is_alias_cell
- then bug () "attempting to clone alias cell"
- else
- clone_slot
- (get_ty_params_of_current_frame())
- clone_task dst src dst_slot None
+ (* Feed back with massaged args. *)
+ trans_init_slot_from_cell ty_params
+ clone dst dst_slot src src_ty
+
+ | (_, CLONE_all clone_task) ->
+ clone_ty ty_params clone_task dst src src_ty None
+
+
+ and trans_init_slot_from_atom
+ (clone:clone_ctrl)
+ (dst:Il.cell) (dst_slot:Ast.slot)
+ (src_atom:Ast.atom)
+ : unit =
+ match (dst_slot.Ast.slot_mode, clone, src_atom) with
+ (Ast.MODE_alias, CLONE_none,
+ Ast.ATOM_literal _) ->
+ (* Aliasing a literal is a bit weird since nobody
+ * else will ever see it, but it seems harmless.
+ *)
+ let src = trans_atom src_atom in
+ mov dst (Il.Cell (alias (Il.Mem (force_to_mem src))))
+
+ | (Ast.MODE_alias, CLONE_chan _, _)
+ | (Ast.MODE_alias, CLONE_all _, _) ->
+ bug () "attempting to clone into alias slot"
+ | _ ->
+ let src = Il.Mem (force_to_mem (trans_atom src_atom)) in
+ trans_init_slot_from_cell
+ (get_ty_params_of_current_frame())
+ clone dst dst_slot src (atom_type cx src_atom)
+
and trans_be_fn
(cx:ctxt)
@@ -3376,9 +3354,10 @@ let trans_visitor
(* Emit arg1 of any call: the task pointer. *)
iflog (fun _ -> annotate "fn-call arg 1: task pointer");
trans_init_slot_from_cell
+ (get_ty_params_of_current_frame())
CLONE_none
arg_cell word_slot
- abi.Abi.abi_tp_cell word_slot
+ abi.Abi.abi_tp_cell word_ty
and trans_argN
(clone:clone_ctrl)
@@ -3509,9 +3488,11 @@ let trans_visitor
annotate
(Printf.sprintf "fn-call ty param %d of %d"
i n_ty_params));
- trans_init_slot_from_cell CLONE_none
+ trans_init_slot_from_cell
+ (get_ty_params_of_current_frame())
+ CLONE_none
(get_element_ptr callee_ty_params i) word_slot
- (get_tydesc None ty_param) word_slot
+ (get_tydesc None ty_param) word_ty
end
call.call_callee_ty_params;
@@ -3609,7 +3590,7 @@ let trans_visitor
(Printf.sprintf
"extract bound arg %d as actual arg %d"
!bound_i arg_i));
- get_element_ptr closure_args_cell (!bound_i);
+ get_element_ptr closure_args_cell (!bound_i)
end
else
begin
@@ -3623,9 +3604,10 @@ let trans_visitor
iflog (fun _ -> annotate
(Printf.sprintf
"copy into actual-arg %d" arg_i));
- trans_copy_slot
- self_ty_params_cell
- true dst_cell slot src_cell slot None;
+ trans_init_slot_from_cell
+ self_ty_params_cell CLONE_none
+ dst_cell slot
+ (deref_slot false src_cell slot) (slot_ty slot);
incr (if is_bound then bound_i else unbound_i);
done;
assert ((!bound_i + !unbound_i) == n_args)
@@ -3765,7 +3747,7 @@ let trans_visitor
let (pat, block) = arm.node in
(* Translates the pattern and returns the addresses of the branch
* instructions, which are taken if the match fails. *)
- let rec trans_pat pat src_cell src_slot =
+ let rec trans_pat pat src_cell src_ty =
match pat with
Ast.PAT_lit lit ->
trans_compare Il.JNE (trans_lit lit) (Il.Cell src_cell)
@@ -3773,7 +3755,7 @@ let trans_visitor
| Ast.PAT_tag (lval, pats) ->
let tag_name = tag_ctor_name_to_tag_name (lval_to_name lval) in
let ty_tag =
- match slot_ty src_slot with
+ match src_ty with
Ast.TY_tag tag_ty -> tag_ty
| Ast.TY_iso ti -> (ti.Ast.iso_group).(ti.Ast.iso_index)
| _ -> bug cx "expected tag type"
@@ -3782,9 +3764,6 @@ let trans_visitor
let tag_number = arr_idx tag_keys tag_name in
let ty_tup = Hashtbl.find ty_tag tag_name in
- (* NB: follow any exterior pointer as we go. *)
- let src_cell = deref_slot false src_cell src_slot in
-
let tag_cell:Il.cell = get_element_ptr src_cell 0 in
let union_cell =
get_element_ptr_dyn_in_current_frame src_cell 1
@@ -3801,8 +3780,8 @@ let trans_visitor
let elem_cell =
get_element_ptr_dyn_in_current_frame tup_cell i
in
- let elem_slot = ty_tup.(i) in
- trans_pat elem_pat elem_cell elem_slot
+ let elem_ty = ty_tup.(i) in
+ trans_pat elem_pat elem_cell elem_ty
in
let elem_jumps = Array.mapi trans_elem_pat pats in
@@ -3811,11 +3790,10 @@ let trans_visitor
| Ast.PAT_slot (dst, _) ->
let dst_slot = get_slot cx dst.id in
let dst_cell = cell_of_block_slot dst.id in
- trans_copy_slot
- (get_ty_params_of_current_frame()) true
- dst_cell dst_slot
- src_cell src_slot
- None;
+ trans_init_slot_from_cell
+ (get_ty_params_of_current_frame())
+ CLONE_none dst_cell dst_slot
+ src_cell src_ty;
[] (* irrefutable *)
| Ast.PAT_wild -> [] (* irrefutable *)
@@ -3909,16 +3887,16 @@ let trans_visitor
let (dst_slot, _) = fo.Ast.for_slot in
let dst_cell = cell_of_block_slot dst_slot.id in
let (head_stmts, seq) = fo.Ast.for_seq in
- let (seq_cell, seq_slot) = trans_lval_full false seq in
- let unit_slot = seq_unit_slot (slot_ty seq_slot) in
+ let (seq_cell, seq_ty) = trans_lval_full false seq in
+ let unit_ty = seq_unit_ty seq_ty in
Array.iter trans_stmt head_stmts;
- iter_seq_slots ty_params seq_cell seq_cell unit_slot
+ iter_seq_parts ty_params seq_cell seq_cell unit_ty
begin
- fun _ src_cell unit_slot curr_iso ->
- trans_copy_slot
- ty_params true
+ fun _ src_cell unit_ty _ ->
+ trans_init_slot_from_cell
+ ty_params CLONE_none
dst_cell dst_slot.node
- src_cell unit_slot curr_iso;
+ src_cell unit_ty;
trans_block fo.Ast.for_body;
end
None
@@ -3978,13 +3956,10 @@ let trans_visitor
mov vr zero;
trans_call_glue (code_of_operand block_fptr) None [| vr; fp |]
- and trans_vec_append dst_cell dst_slot src_oper src_ty =
- let (dst_elt_slot, trim_trailing_null) =
- match slot_ty dst_slot with
- Ast.TY_str -> (interior_slot (Ast.TY_mach TY_u8), true)
- | Ast.TY_vec e -> (e, false)
- | _ -> bug () "unexpected dst type in trans_vec_append"
- in
+ and trans_vec_append dst_cell dst_ty src_oper src_ty =
+ let elt_ty = seq_unit_ty dst_ty in
+ let trim_trailing_null = dst_ty = Ast.TY_str in
+ assert (src_ty = dst_ty);
match src_ty with
Ast.TY_str
| Ast.TY_vec _ ->
@@ -3992,12 +3967,6 @@ let trans_visitor
let src_cell = need_cell src_oper in
let src_vec = deref src_cell in
let src_fill = get_element_ptr src_vec Abi.vec_elt_fill in
- let src_elt_slot =
- match src_ty with
- Ast.TY_str -> interior_slot (Ast.TY_mach TY_u8)
- | Ast.TY_vec e -> e
- | _ -> bug () "unexpected src type in trans_vec_append"
- in
let dst_vec = deref dst_cell in
let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
if trim_trailing_null
@@ -4018,12 +3987,11 @@ let trans_visitor
let dst_fill = get_element_ptr dst_vec Abi.vec_elt_fill in
(* Copy loop: *)
- let pty s = Il.AddrTy (slot_referent_type abi s) in
- let dptr = next_vreg_cell (pty dst_elt_slot) in
- let sptr = next_vreg_cell (pty src_elt_slot) in
- let dlim = next_vreg_cell (pty dst_elt_slot) in
- let dst_elt_sz = slot_sz_in_current_frame dst_elt_slot in
- let src_elt_sz = slot_sz_in_current_frame src_elt_slot in
+ let eltp_rty = Il.AddrTy (referent_type abi elt_ty) in
+ let dptr = next_vreg_cell eltp_rty in
+ let sptr = next_vreg_cell eltp_rty in
+ let dlim = next_vreg_cell eltp_rty in
+ let elt_sz = ty_sz_in_current_frame elt_ty in
let dst_data =
get_element_ptr_dyn_in_current_frame
dst_vec Abi.vec_elt_data
@@ -4041,20 +4009,20 @@ let trans_visitor
emit (Il.jmp Il.JMP Il.CodeNone);
let back_jmp_targ = mark () in
(* copy slot *)
- trans_copy_slot
+ trans_copy_ty
(get_ty_params_of_current_frame()) true
- (deref dptr) dst_elt_slot
- (deref sptr) src_elt_slot
+ (deref dptr) elt_ty
+ (deref sptr) elt_ty
None;
- add_to dptr dst_elt_sz;
- add_to sptr src_elt_sz;
+ add_to dptr elt_sz;
+ add_to sptr elt_sz;
patch fwd_jmp;
check_interrupt_flag ();
let back_jmp =
trans_compare Il.JB (Il.Cell dptr) (Il.Cell dlim) in
List.iter
(fun j -> patch_existing j back_jmp_targ) back_jmp;
- let v = next_vreg_cell word_ty in
+ let v = next_vreg_cell word_sty in
mov v (Il.Cell src_fill);
add_to dst_fill (Il.Cell v);
| t ->
@@ -4064,14 +4032,14 @@ let trans_visitor
and trans_copy_binop dst binop a_src =
- let (dst_cell, dst_slot) = trans_lval_maybe_init false dst in
+ let (dst_cell, dst_ty) = trans_lval_maybe_init false dst in
let src_oper = trans_atom a_src in
- match slot_ty dst_slot with
+ match dst_ty with
Ast.TY_str
| Ast.TY_vec _ when binop = Ast.BINOP_add ->
- trans_vec_append dst_cell dst_slot src_oper (atom_type cx a_src)
+ trans_vec_append dst_cell dst_ty src_oper (atom_type cx a_src)
| _ ->
- let dst_cell = deref_slot false dst_cell dst_slot in
+ let (dst_cell, _) = deref_ty false dst_cell dst_ty in
let op = trans_binop binop in
emit (Il.binary op dst_cell (Il.Cell dst_cell) src_oper);
@@ -4159,46 +4127,43 @@ let trans_visitor
end
| Ast.STMT_init_rec (dst, atab, base) ->
- let (slot_cell, slot) = trans_lval_init dst in
- let (trec, dst_slots) =
- match slot_ty slot with
+ let (slot_cell, ty) = trans_lval_init dst in
+ let (trec, dst_tys) =
+ match ty with
Ast.TY_rec trec -> (trec, Array.map snd trec)
| _ ->
bugi cx stmt.id
"non-rec destination type in stmt_init_rec"
in
- let dst_cell = deref_slot true slot_cell slot in
+ let (dst_cell, _) = deref_ty true slot_cell ty in
begin
match base with
None ->
- let atoms =
- Array.map (fun (_, _, _, atom) -> atom) atab
- in
+ let atoms = Array.map snd atab in
trans_init_structural_from_atoms
- dst_cell dst_slots atoms
+ dst_cell dst_tys atoms
| Some base_lval ->
trans_init_rec_update
- dst_cell dst_slots trec atab base_lval
+ dst_cell dst_tys trec atab base_lval
end
- | Ast.STMT_init_tup (dst, mode_atoms) ->
- let (slot_cell, slot) = trans_lval_init dst in
- let dst_slots =
- match slot_ty slot with
+ | Ast.STMT_init_tup (dst, atoms) ->
+ let (slot_cell, ty) = trans_lval_init dst in
+ let dst_tys =
+ match ty with
Ast.TY_tup ttup -> ttup
| _ ->
bugi cx stmt.id
"non-tup destination type in stmt_init_tup"
in
- let atoms = Array.map (fun (_, _, atom) -> atom) mode_atoms in
- let dst_cell = deref_slot true slot_cell slot in
- trans_init_structural_from_atoms dst_cell dst_slots atoms
+ let (dst_cell, _) = deref_ty true slot_cell ty in
+ trans_init_structural_from_atoms dst_cell dst_tys atoms
| Ast.STMT_init_str (dst, s) ->
trans_init_str dst s
- | Ast.STMT_init_vec (dst, _, atoms) ->
+ | Ast.STMT_init_vec (dst, atoms) ->
trans_init_vec dst atoms
| Ast.STMT_init_port dst ->
@@ -4424,7 +4389,7 @@ let trans_visitor
let trans_obj_ctor
(obj_id:node_id)
- (state:Ast.header_slots)
+ (header:Ast.header_slots)
: unit =
trans_frame_entry obj_id;
@@ -4439,21 +4404,14 @@ let trans_visitor
all_args_cell Abi.calltup_elt_ty_params
in
- let obj_args_tup = Array.map (fun (sloti,_) -> sloti.node) state in
- let obj_args_slot = interior_slot (Ast.TY_tup obj_args_tup) in
- let state_ty =
- Ast.TY_tup [| interior_slot Ast.TY_type;
- obj_args_slot |]
- in
- let state_rty = slot_referent_type abi (interior_slot state_ty) in
- let state_ptr_slot = exterior_slot state_ty in
- let state_ptr_rty = slot_referent_type abi state_ptr_slot in
- let state_malloc_sz =
- calculate_sz_in_current_frame
- (SIZE_rt_add
- ((SIZE_fixed (word_n Abi.exterior_rc_header_size)),
- (Il.referent_ty_size word_bits state_rty)))
+ let obj_args_tup =
+ Array.map (fun (sloti,_) -> (slot_ty sloti.node)) header
in
+ let obj_args_ty = Ast.TY_tup obj_args_tup in
+ let state_ty = Ast.TY_tup [| Ast.TY_type; obj_args_ty |] in
+ let state_ptr_ty = Ast.TY_exterior state_ty in
+ let state_ptr_rty = referent_type abi state_ptr_ty in
+ let state_malloc_sz = exterior_allocation_size state_ty in
let ctor_ty = Hashtbl.find cx.ctxt_all_item_types obj_id in
let obj_ty =
@@ -4508,10 +4466,17 @@ let trans_visitor
* because the arg slot ids are actually given layout
* positions inside the object state, and are at different
* offsets within that state than within the current
- * frame. So we manually drop the argument tuple here,
- * without mentioning the arg slot ids.
+ * frame. So we manually drop the argument slots here,
+ * without mentioning the slot ids.
*)
- drop_slot frame_ty_params frame_args obj_args_slot None;
+ Array.iteri
+ (fun i (sloti, _) ->
+ let cell =
+ get_element_ptr_dyn_in_current_frame
+ frame_args i
+ in
+ drop_slot frame_ty_params cell sloti.node None)
+ header;
trans_frame_exit obj_id false;
in
@@ -4682,27 +4647,32 @@ let trans_visitor
| Ast.TY_iso tiso -> get_iso_tag tiso
| _ -> bugi cx tagid "unexpected fn type for tag constructor"
in
- let slots =
- Array.map (fun sloti -> referent_to_slot cx sloti.id) header_tup
- in
let tag_keys = sorted_htab_keys ttag in
let i = arr_idx tag_keys (Ast.NAME_base (Ast.BASE_ident n)) in
let _ = log cx "tag variant: %s -> tag value #%d" n i in
let (dst_cell, dst_slot) = get_current_output_cell_and_slot() in
let dst_cell = deref_slot true dst_cell dst_slot in
- let src = get_explicit_args_for_current_frame () in
let tag_cell = get_element_ptr dst_cell 0 in
let union_cell = get_element_ptr_dyn_in_current_frame dst_cell 1 in
let tag_body_cell = get_variant_ptr union_cell i in
let tag_body_rty = snd (need_mem_cell tag_body_cell) in
+ let ty_params = get_ty_params_of_current_frame() in
(* A clever compiler will inline this. We are not clever. *)
iflog (fun _ -> annotate (Printf.sprintf "write tag #%d" i));
mov tag_cell (imm (Int64.of_int i));
iflog (fun _ -> annotate ("copy tag-content tuple: tag_body_rty=" ^
(Il.string_of_referent_ty tag_body_rty)));
- trans_copy_tup
- (get_ty_params_of_current_frame())
- true tag_body_cell src slots;
+ Array.iteri
+ begin
+ fun i sloti ->
+ let slot = sloti.node in
+ let ty = slot_ty slot in
+ trans_copy_ty ty_params true
+ (get_element_ptr_dyn_in_current_frame tag_body_cell i) ty
+ (deref_slot false (cell_of_block_slot sloti.id) slot) ty
+ None;
+ end
+ header_tup;
trace_str cx.ctxt_sess.Session.sess_trace_tag
("finished tag constructor " ^ n);
trans_frame_exit tagid true;
diff --git a/src/boot/me/transutil.ml b/src/boot/me/transutil.ml
index cb867fef..8c6b8bc3 100644
--- a/src/boot/me/transutil.ml
+++ b/src/boot/me/transutil.ml
@@ -112,29 +112,35 @@ let word_ty_signed_mach (abi:Abi.abi) : ty_mach =
;;
-let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
- let ty = slot_ty slot in
- match ty with
- Ast.TY_port _
- | Ast.TY_chan _
- | Ast.TY_task
- | Ast.TY_str -> MEM_rc_opaque
- | Ast.TY_vec _ ->
- if type_has_state ty
- then MEM_gc
+let rec ty_mem_ctrl (ty:Ast.ty) : mem_ctrl =
+ match ty with
+ Ast.TY_port _
+ | Ast.TY_chan _
+ | Ast.TY_task
+ | Ast.TY_str -> MEM_rc_opaque
+ | Ast.TY_vec _ ->
+ if type_has_state ty
+ then MEM_gc
+ else MEM_rc_opaque
+ | Ast.TY_exterior t ->
+ if type_has_state t
+ then MEM_gc
+ else
+ if type_is_structured t
+ then MEM_rc_struct
else MEM_rc_opaque
- | _ ->
- match slot.Ast.slot_mode with
- Ast.MODE_exterior _ when type_is_structured ty ->
- if type_has_state ty
- then MEM_gc
- else MEM_rc_struct
- | Ast.MODE_exterior _ ->
- if type_has_state ty
- then MEM_gc
- else MEM_rc_opaque
- | _ ->
- MEM_interior
+ | Ast.TY_mutable t
+ | Ast.TY_constrained (t, _) ->
+ ty_mem_ctrl t
+ | _ ->
+ MEM_interior
+;;
+
+let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
+ match slot.Ast.slot_mode with
+ Ast.MODE_alias -> MEM_interior
+ | Ast.MODE_interior ->
+ ty_mem_ctrl (slot_ty slot)
;;
@@ -200,33 +206,33 @@ let next_power_of_two (x:int64) : int64 =
Int64.add 1L (!xr)
;;
-let iter_tup_slots
+let iter_tup_parts
(get_element_ptr:'a -> int -> 'a)
(dst_ptr:'a)
(src_ptr:'a)
(slots:Ast.ty_tup)
- (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
Array.iteri
begin
- fun i slot ->
+ fun i ty ->
f (get_element_ptr dst_ptr i)
(get_element_ptr src_ptr i)
- slot curr_iso
+ ty curr_iso
end
slots
;;
-let iter_rec_slots
+let iter_rec_parts
(get_element_ptr:'a -> int -> 'a)
(dst_ptr:'a)
(src_ptr:'a)
(entries:Ast.ty_rec)
- (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+ (f:'a -> 'a -> Ast.ty -> (Ast.ty_iso option) -> unit)
(curr_iso:Ast.ty_iso option)
: unit =
- iter_tup_slots get_element_ptr dst_ptr src_ptr
+ iter_tup_parts get_element_ptr dst_ptr src_ptr
(Array.map snd entries) f curr_iso
;;
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 346c6e39..5311a4a4 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -33,6 +33,23 @@ type binopsig =
| BINOPSIG_plus_plus_plus (* plusable a * plusable a -> plusable a *)
;;
+
+(* In some instances we will strip off a layer of mutability or exterior-ness,
+ * as trans is willing to transplant and/or overlook mutability / exterior
+ * differences wrt. many operators.
+ *
+ * Note: there is a secondary mutability-checking pass in effect.ml to ensure
+ * you're not actually mutating the insides of an immutable. That's not the
+ * typechecker's job.
+ *)
+let simplified t =
+ match t with
+ Ast.TY_mutable (Ast.TY_exterior t) -> t
+ | Ast.TY_mutable t -> t
+ | Ast.TY_exterior t -> t
+ | _ -> t
+;;
+
let rec tyspec_to_str (ts:tyspec) : string =
let fmt = Format.fprintf in
@@ -253,17 +270,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
(dct:dict)
(fields:Ast.ty_rec)
: unit =
- let rec find_slot (query:Ast.ident) i : Ast.slot =
- if i = Array.length fields
- then fail ()
- else match fields.(i) with
- (ident, slot) ->
- if ident = query then slot
- else find_slot query (i + 1)
+ let find_ty (query:Ast.ident) : Ast.ty =
+ match atab_search fields query with
+ None -> fail()
+ | Some t -> t
in
let check_entry ident tv =
- unify_slot (find_slot ident 0) None tv
+ unify_ty (find_ty ident) tv
in
Hashtbl.iter check_entry dct
in
@@ -290,18 +304,20 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| Ast.TY_fn _ | Ast.TY_obj _
| Ast.TY_param _ | Ast.TY_native _ | Ast.TY_type -> false
| Ast.TY_named _ -> bug () "unexpected named type"
+ | Ast.TY_exterior ty
+ | Ast.TY_mutable ty
| Ast.TY_constrained (ty, _) ->
is_comparable_or_ordered comparable ty
in
let floating (ty:Ast.ty) : bool =
- match ty with
+ match simplified ty with
Ast.TY_mach TY_f32 | Ast.TY_mach TY_f64 -> true
| _ -> false
in
let integral (ty:Ast.ty) : bool =
- match ty with
+ match simplified ty with
Ast.TY_int | Ast.TY_uint | Ast.TY_mach TY_u8 | Ast.TY_mach TY_u16
| Ast.TY_mach TY_u32 | Ast.TY_mach TY_u64 | Ast.TY_mach TY_i8
| Ast.TY_mach TY_i16 | Ast.TY_mach TY_i32
@@ -313,7 +329,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
let numeric (ty:Ast.ty) : bool = (integral ty) || (floating ty) in
let plusable (ty:Ast.ty) : bool =
- match ty with
+ match simplified ty with
Ast.TY_str -> true
| Ast.TY_vec _ -> true
| _ -> numeric ty
@@ -369,7 +385,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| (TYSPEC_collection tv, TYSPEC_resolved (params, ty)) ->
begin
match ty with
- Ast.TY_vec slot -> unify_slot slot None tv
+ Ast.TY_vec ty -> unify_ty ty tv
| Ast.TY_str -> unify_ty (Ast.TY_mach TY_u8) tv
| _ -> fail ()
end;
@@ -439,12 +455,12 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| (TYSPEC_tuple tvs, TYSPEC_resolved (params, ty)) ->
begin
match ty with
- Ast.TY_tup (elem_slots:Ast.slot array) ->
- if (Array.length elem_slots) < (Array.length tvs)
+ Ast.TY_tup (elem_tys:Ast.ty array) ->
+ if (Array.length elem_tys) <> (Array.length tvs)
then fail ()
else
let check_elem i tv =
- unify_slot (elem_slots.(i)) None tv
+ unify_ty (elem_tys.(i)) tv
in
Array.iteri check_elem tvs
| _ -> fail ()
@@ -455,9 +471,9 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| (TYSPEC_vector tv, TYSPEC_resolved (params, ty)) ->
begin
match ty with
- Ast.TY_vec slot ->
- unify_slot slot None tv;
- TYSPEC_resolved (params, ty)
+ Ast.TY_vec ty ->
+ unify_ty ty tv;
+ TYSPEC_resolved (params, Ast.TY_vec ty)
| _ -> fail ()
end
@@ -942,7 +958,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
unify_lval' base base_tv;
match !(resolve_tyvar base_tv) with
TYSPEC_resolved (_, ty) ->
- unify_ty (slot_ty (project_type_to_slot ty comp)) tv
+ unify_ty (project_type ty comp) tv
| _ ->
()
@@ -981,7 +997,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| Ast.STMT_init_rec (lval, fields, Some base) ->
let dct = Hashtbl.create 10 in
let tvrec = ref (TYSPEC_record dct) in
- let add_field (ident, _, _, atom) =
+ let add_field (ident, atom) =
let tv = ref TYSPEC_all in
unify_atom atom tv;
Hashtbl.add dct ident tv
@@ -994,7 +1010,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
| Ast.STMT_init_rec (lval, fields, None) ->
let dct = Hashtbl.create 10 in
- let add_field (ident, _, _, atom) =
+ let add_field (ident, atom) =
let tv = ref TYSPEC_all in
unify_atom atom tv;
Hashtbl.add dct ident tv
@@ -1003,7 +1019,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
unify_lval lval (ref (TYSPEC_record dct))
| Ast.STMT_init_tup (lval, members) ->
- let member_to_tv (_, _, atom) =
+ let member_to_tv atom =
let tv = ref TYSPEC_all in
unify_atom atom tv;
tv
@@ -1011,7 +1027,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
let member_tvs = Array.map member_to_tv members in
unify_lval lval (ref (TYSPEC_tuple member_tvs))
- | Ast.STMT_init_vec (lval, _, atoms) ->
+ | Ast.STMT_init_vec (lval, atoms) ->
let tv = ref TYSPEC_all in
let unify_with_tv atom = unify_atom atom tv in
Array.iter unify_with_tv atoms;
@@ -1181,8 +1197,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
Ast.TY_fn (tsig, _) ->
begin
let vec_str =
- interior_slot (Ast.TY_vec
- (interior_slot Ast.TY_str))
+ interior_slot (Ast.TY_vec Ast.TY_str)
in
match tsig.Ast.sig_input_slots with
[| |] -> ()
@@ -1236,13 +1251,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
let tag_tv = ref TYSPEC_all in
unify_ty tag_ty tag_tv;
unify_tyvars expected tag_tv;
- List.iter
- begin
- fun slot ->
- match slot.Ast.slot_ty with
- Some ty -> expect ty
- | None -> bug () "no slot type in tag slot tuple"
- end
+ List.iter expect
(List.rev (Array.to_list tag_ty_tup));
| Ast.PAT_slot (sloti, _) ->
@@ -1336,8 +1345,14 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
let defn = Hashtbl.find cx.ctxt_all_defns id in
match defn with
DEFN_slot slot_defn ->
- Hashtbl.replace cx.ctxt_all_defns id
- (DEFN_slot { slot_defn with Ast.slot_ty = Some ty })
+ begin
+ match slot_defn.Ast.slot_ty with
+ Some _ -> ()
+ | None ->
+ Hashtbl.replace cx.ctxt_all_defns id
+ (DEFN_slot { slot_defn with
+ Ast.slot_ty = Some ty })
+ end
| _ -> bug () "check_auto_tyvar: no slot defn"
in
@@ -1349,7 +1364,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
begin
match !(resolve_tyvar tv) with
TYSPEC_resolved ([||], ty) ->
- (Ast.TY_vec (interior_slot ty))
+ (Ast.TY_vec ty)
| _ ->
err (Some id)
"unresolved vector-element type in %s (%d)"
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index d42aaf6d..79e47845 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -419,7 +419,7 @@ let condition_assigning_visitor
raise_precondition s.id precond;
raise_postcondition s.id postcond
- | Ast.STMT_init_vec (dst, _, atoms) ->
+ | Ast.STMT_init_vec (dst, atoms) ->
let precond = slot_inits (atoms_slots cx atoms) in
let postcond = slot_inits (lval_slots cx dst) in
raise_precondition s.id precond;
@@ -980,13 +980,19 @@ let lifecycle_visitor
if initializing
then
begin
- Hashtbl.add cx.ctxt_copy_stmt_is_init s.id ();
+ iflog cx
+ begin
+ fun _ ->
+ log cx "noting lval %a init at stmt %a"
+ Ast.sprintf_lval lv_dst Ast.sprintf_stmt s
+ end;
+ Hashtbl.replace cx.ctxt_copy_stmt_is_init s.id ();
init_lval lv_dst
end;
| Ast.STMT_init_rec (lv_dst, _, _)
| Ast.STMT_init_tup (lv_dst, _)
- | Ast.STMT_init_vec (lv_dst, _, _)
+ | Ast.STMT_init_vec (lv_dst, _)
| Ast.STMT_init_str (lv_dst, _)
| Ast.STMT_init_port lv_dst
| Ast.STMT_init_chan (lv_dst, _) ->
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index 203acfce..64c08724 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -262,7 +262,7 @@ and walk_mod_item
item
-and walk_ty_tup v ttup = Array.iter (walk_slot v) ttup
+and walk_ty_tup v ttup = Array.iter (walk_ty v) ttup
and walk_ty_tag v ttag = Hashtbl.iter (fun _ t -> walk_ty_tup v t) ttag
@@ -273,8 +273,8 @@ and walk_ty
let children _ =
match ty with
Ast.TY_tup ttup -> walk_ty_tup v ttup
- | Ast.TY_vec s -> walk_slot v s
- | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_slot v s) trec
+ | Ast.TY_vec s -> walk_ty v s
+ | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_ty v s) trec
| Ast.TY_tag ttag -> walk_ty_tag v ttag
| Ast.TY_iso tiso -> Array.iter (walk_ty_tag v) tiso.Ast.iso_group
| Ast.TY_fn tfn -> walk_ty_fn v tfn
@@ -301,6 +301,8 @@ and walk_ty
| Ast.TY_nil -> ()
| Ast.TY_task -> ()
| Ast.TY_any -> ()
+ | Ast.TY_exterior m -> walk_ty v m
+ | Ast.TY_mutable m -> walk_ty v m
in
walk_bracketed
v.visit_ty_pre
@@ -448,16 +450,16 @@ and walk_stmt
| Ast.STMT_init_rec (lv, atab, base) ->
walk_lval v lv;
- Array.iter (fun (_, _, _, a) -> walk_atom v a) atab;
+ Array.iter (fun (_, a) -> walk_atom v a) atab;
walk_option (walk_lval v) base;
- | Ast.STMT_init_vec (lv, _, atoms) ->
+ | Ast.STMT_init_vec (lv, atoms) ->
walk_lval v lv;
Array.iter (walk_atom v) atoms
| Ast.STMT_init_tup (lv, mut_atoms) ->
walk_lval v lv;
- Array.iter (fun (_, _, a) -> walk_atom v a) mut_atoms
+ Array.iter (walk_atom v) mut_atoms
| Ast.STMT_init_str (lv, _) ->
walk_lval v lv
@@ -469,6 +471,10 @@ and walk_stmt
walk_option (walk_lval v) port;
walk_lval v chan;
+ | Ast.STMT_init_exterior (dst, src) ->
+ walk_lval v dst;
+ walk_atom v src
+
| Ast.STMT_for f ->
walk_stmt_for f