destructors: heap(v), drop(v, f) / v.drop(f) / v.drop = f, struct drop methods, collector drops after the sweep (once, resurrection), freed blocks forget their drop, temporaries drop at statement end with a hint, actor send check; o3: no collection inside a region (pending until the outermost exit), no drops set or ended inside o3; spec 3.11.6, 4.10.3-4, 6.15

5 files changed, 125 insertions, 6 deletions

diff --git a/src/compiler/analyzer.zc b/src/compiler/analyzer.zc
index d1f6f3d..34c0a8b 100644
--- a/src/compiler/analyzer.zc
+++ b/src/compiler/analyzer.zc
@@ -389,6 +389,7 @@ int newloc(int n) {
 	if (if_local) if_local[i] = 0;
  if (!local_origin_mask) local_origin_mask = chk_resize(0, 0, loccap); local_origin_mask[i] = 0;
  if (!local_cell) local_cell = chk_resize(0, 0, loccap); local_cell[i] = 0;
+ if (!local_dropset) local_dropset = chk_resize(0, 0, loccap); local_dropset[i] = 0;
  if (!local_captured) local_captured = chk_resize(0, 0, loccap); local_captured[i] = 0;
  if (!local_ended) local_ended = chk_resize(0, 0, loccap); local_ended[i] = 0;
  if (!local_end_info) local_end_info = chk_resize(0, 0, loccap); local_end_info[i] = 0;
@@ -920,6 +921,7 @@ int touch(int i) {
 // an expression of class c used as a plain value (a lend, an operand). a new
 // object can't be used that way, since nothing would own it.
 int plainuse(int c) {
+	if (c == C_FRESH && drop_tail == here && fchk && infn) { drop_temporary(); return C_PLAIN; }
 	if (c == C_FRESH) cerr("a new object can't be used as a plain value; bind it to a name first");
 	if (c >= C_VAR) touch(c - C_VAR);
 	return C_PLAIN;
@@ -933,6 +935,7 @@ int szclass(int n) {
 // freeing an owned local. one that holds a typed object with no pointer
 // fields goes back through recycle_leaf, which knows its class
 int freevar(int i) {
+ if (o3on && fchk && ldroppable(i)) cerrn(i, "has drop and can't end inside an o3 region");
  if (local_captured && local_captured[i]) { lit(0); laddr(lslot[i]); op(O_ST); return 0; }
 	vaddr(i); op(O_LD);
 	if (lleaf[i] && !o3on && !dry && lookup(s_recycle_leaf) >= 0) {
@@ -966,7 +969,7 @@ int exit_vars(int dep, int final) {
 // block ends.
 int unused_check(int from) {
 	while (from < nloc) {
-		if (fchk && lown[from] && !lused[from] && !(lrskind[from] == RS_PARAM && rt.eq_w(lname[from], "_"))) serrn(lname[from], "owned object is never used");
+		if (fchk && lown[from] && !lused[from] && !ldroppable(from) && !(lrskind[from] == RS_PARAM && rt.eq_w(lname[from], "_"))) serrn(lname[from], "owned object is never used");
 		from++;
 	}
 	return 0;
diff --git a/src/compiler/base.zc b/src/compiler/base.zc
index b326c80..2fcc7f7 100644
--- a/src/compiler/base.zc
+++ b/src/compiler/base.zc
@@ -255,6 +255,10 @@ int fn_return_type;	// a consistent return type inferred from the function body
 const int EF_READ = 1, EF_WRITE = 2, EF_RETAIN = 4, EF_CONSUME = 8, EF_UNKNOWN = 16, EF_ALIAS = 32, EF_IDENTITY = 64;
 word effect_symbols, effect_edges, effect_requirements, effect_current; int effect_floor, effect_argument_base;
 word local_origin, local_origin_mask, local_cell, local_captured, local_ended, local_end_info; word effect_value, argorigin_mask; int capture_enabled; word[1] capture_dummy;
+// drops (docs/design/destructors.md): the code position just past a drop form (a fresh
+// value with a drop still on the stack there), the type `this` gets in the next closure,
+// a local whose drop is set, an actor send whose arguments are checked, and o3 block depth.
+int drop_tail = -1, send_check, o3blk; word closure_this, local_dropset;
 int borrow_pending, borrow_depth, borrow_jump = -1, borrow_entry; word borrow_slots;
 int argorigin = -1, argtemporary, argowner = -1; word argowner_fact;
 int stubgen;		// 1 while an extern's generated stub is compiled: the stub gets no hints
@@ -748,6 +752,7 @@ int reserve_locals(int need) {
 	if (local_origin) local_origin = chk_resize(local_origin, nloc, cap);
  if (local_origin_mask) local_origin_mask = chk_resize(local_origin_mask, nloc, cap);
  if (local_cell) local_cell = chk_resize(local_cell, nloc, cap);
+ if (local_dropset) local_dropset = chk_resize(local_dropset, nloc, cap);
  if (local_captured) local_captured = chk_resize(local_captured, nloc, cap);
  if (local_ended) local_ended = chk_resize(local_ended, nloc, cap);
  if (local_end_info) local_end_info = chk_resize(local_end_info, nloc, cap);
diff --git a/src/compiler/builtins.zc b/src/compiler/builtins.zc
index 5efe379..8c00636 100644
--- a/src/compiler/builtins.zc
+++ b/src/compiler/builtins.zc
@@ -838,6 +838,99 @@ int array_member(int c, int n) {
 	if (n == intern("pop")) return array_pop(t);
 	return array_resize(t);
 }
+// ---- drops and heap() (docs/design/destructors.md) ----
+
+// a pointer to a struct whose body declares drop: its values drop through the type
+int tdroppable(word t) {
+	word e;
+	if (!t || !isptr(t)) return 0;
+	e = t[4];
+	return e[0] == TY_STRUCT && e[3] >= 0 && methof(e, intern("drop")) >= 0;
+}
+// local i holds a value with a drop: one set on it, or one its type declares
+int ldroppable(int i) { return (local_dropset && local_dropset[i]) || tdroppable(ltype[i]); }
+// entering o3 from normal code: the collector waits until the outermost region is left
+int o3_enter_code() { callname(intern("rt.o3_enter")); op(O_DROP); return 0; }
+// a fresh value with a drop that nothing holds: it is held in a hidden slot and
+// dropped when the full statement ends
+int drop_temporary() {
+	emit_borrow_hold();
+	if (hint_begin(tpack(), HINT_SMALL)) { rt.put_s("value with drop is never bound; it drops at the end of this statement"); dg_close(); }
+	return 0;
+}
+// the value is on the stack. compile the drop (the next expression, usually fn() { ... }
+// with this bound to the value), attach it with rt.set_drop, and leave the value there
+// with the class and facts it had. owner is the local that owns the value, or -1.
+int drop_attach(word vty, int owner) {
+	word t = xty, af = xaf, ev = effect_value; int bor = xbor, st = xstr, c;
+	if (o3on) serr("a drop can't be set inside an o3 region");
+	if (owner >= 0 && fchk && local_dropset) {
+		if (local_dropset[owner]) cerrn(owner, "drop is already set");
+		local_dropset[owner] = 1;
+	}
+	lit(0); op(O_PICK);
+	closure_this = vty; c = expr(); rval(); closure_this = 0;
+	if (c >= C_VAR) touch(c - C_VAR);
+	callname(intern("rt.set_drop")); op(O_DROP);
+	xty = t; xaf = af; effect_value = ev; xbor = bor; xstr = st;
+	lv = 0; lvk = LV_NONE; xzero = 0; xconst = 0; xfloat = 0;
+	return 0;
+}
+// drop(v, fn() { ... }): v, with the drop attached
+int drop_call() {
+	int c, prior = 0, i = 0 - 1;
+	next(); expect(s_lp);
+	if (tk == T_ID) { peek(); if (pk_tk == T_OP && (pk_tv == s_comma)) { i = findloc(tv); if (i >= 0) prior = ltag[i] & LREAD; } }
+	c = expr(); rval();
+	i = 0 - 1;
+	if (c >= C_VAR) i = lroot(c - C_VAR);
+	if (i >= 0 && prior && fchk) cerrn(i, "drop set after the value was used");
+	tcneed(isptr(xty) || xty == tword, "drop needs a heap value", xty);
+	expect(s_comma);
+	drop_attach(xty, i);
+	expect(s_rp);
+	if (c == C_FRESH) drop_tail = here;
+	return c;
+}
+// v.drop(fn() { ... }) gives v back; v.drop = fn() { ... }; is a statement
+int drop_member(int c, word borrowed) {
+	int prior = 0, i = 0 - 1, assign = is_op(s_eq);
+	if (lv && lvk == LV_LOCAL) prior = ltag[lvi] & LREAD;
+	rval();
+	xaf = borrowed;
+	if (c >= C_VAR) { i = lroot(c - C_VAR); touch(c - C_VAR); }
+	if (i >= 0 && prior && fchk) cerrn(i, "drop set after the value was used");
+	next();
+	if (assign && c == C_FRESH && fchk && infn) { drop_temporary(); c = C_PLAIN; }
+	drop_attach(xty, i);
+	if (!assign) expect(s_rp);
+	if (c == C_FRESH) drop_tail = here;
+	if (assign) { xty = tint; xaf = 0; xbor = 0 - 1; return C_PLAIN; }
+	return c;
+}
+// heap(v): v copied into a fresh owned block sized to it
+int heap_box() {
+	int c, place = tpack(), ms; word t;
+	next(); expect(s_lp);
+	c = expr(); rval(); plainuse(c);
+	expect(s_rp);
+	t = xty;
+	stamp_site();
+	if (isagg(t)) {
+		lit(tsz(t)); lit(t); callname(intern("rt.heap_copy"));
+		newsz = tsz(t); xty = tptr(t);
+		if (t[0] == TY_STRUCT) { ms = methof(t, intern("drop")); if (ms >= 0) { fnref(ms); callname(intern("rt.set_tdrop")); } }
+	} else if (isptr(t) && t[4][0] == TY_CHAR) {
+		callname(intern("rt.heap_s")); newsz = -1; xty = t;
+	} else {
+		if (xfloat) xfloat = 0;
+		lit(t); callname(intern("rt.heap_w")); newsz = 1; xty = tptr(t);
+	}
+	newleaf = 0;
+	xaf = af_new(newsz, 2, place);
+	lv = 0; lvk = LV_NONE; xzero = 0; xconst = 0; xstr = 0; xbor = 0 - 1; effect_value = 0;
+	return C_FRESH;
+}
 // compile sizeof(T) or sizeof(e): the size of a type or expression in words.
 int kw_sizeof() {
 	int t;
diff --git a/src/compiler/expr.zc b/src/compiler/expr.zc
index 8768658..e6acfc8 100644
--- a/src/compiler/expr.zc
+++ b/src/compiler/expr.zc
@@ -68,6 +68,7 @@ int args(int tags, word ft, int bs, int fat) {
 		freeing = sname[cs] == s_free || sname[cs] == s_recycle;
 		harmless = sname[cs] == s_put_s || rt.eq_w(sname[cs], "rt.put_n") || rt.eq_w(sname[cs], "rt.put_c") || rt.eq_w(sname[cs], "len") || rt.eq_w(sname[cs], "cap");
 	}
+	int sending = send_check; send_check = 0;
 	xgive = 0; ifcall = 0 - 1; effect_argument_base = 0;
 	expect(s_lp);
 	if (!is_op(s_rp)) {
@@ -76,6 +77,10 @@ int args(int tags, word ft, int bs, int fat) {
 			closure_expected = 0;
 			if (ft && np + parameter_base < ft[3] && is_id(s_fn)) closure_expected = subst(ft[7 + np + parameter_base], bs);
 			place = tpack(); c = expr(); rval(); closure_expected = expected;
+			if (sending && fchk && ((c >= C_VAR && ldroppable(lroot(c - C_VAR))) || tdroppable(xty) || (c == C_FRESH && drop_tail == here))) {
+				if (c >= C_VAR) serrn(lname[lroot(c - C_VAR)], "has drop and can't be copied into a message"); else serr("a value with drop can't be copied into a message");
+			}
+			if (freeing && o3on && fchk && c >= C_VAR && ldroppable(lroot(c - C_VAR))) serrn(lname[lroot(c - C_VAR)], "has drop and can't end inside an o3 region");
    current = effect_origin(c); current_mask = effect_mask(c); origins = origins | current_mask; effect_args_mask(cs, np + parameter_base, current_mask);
    if (!np) origin = current; else if (origin != current) origin = -1;
    tag = (tags >> (np + np)) & 3;
@@ -176,6 +181,7 @@ int newtyped() {
 	expect(s_rp);
 	stamp_site();
 	if (fast) callname(s_new_k); else callname(s_new_t); vf_effect();
+	if (t[0] == TY_STRUCT && t[3] >= 0) { int dm = methof(t, intern("drop")); if (dm >= 0) { fnref(dm); callname(intern("rt.set_tdrop")); } }
 	xaf = af_new(length, 2, place);
 	lv = 0; lvk = LV_NONE; xty = tptr(t); xzero = 0; xstamp = 1;
 	return C_FRESH;
@@ -462,6 +468,7 @@ int call(int s) {
 	}
 	if (!(sflag[s] & F_DEF) || s == finsym) sflag[s] = sflag[s] | F_EARLY;	// called before its body: an owned return is not inferred for it
 	if (sflag[s] & F_EXT) { lit(sval[s][-1]); op(620); }	// an extern: the native call opcode, with the block's address
+	else if (!o3on && (sflag[s] & F_O3)) { o3_enter_code(); fnref(s); op(O_CALL); callname(intern("rt.o3_leave")); op(O_DROP); }	// into o3 from normal code: no collection until it returns
 	else { fnref(s); op(O_CALL); }
 	if (!o3on && (sflag[s] & F_O3) && ft) {	// non-o3 called o3: fatten the result here, not inside the callee
 		rhs_type = subst(ft[4], bs);
@@ -649,14 +656,18 @@ word closure_layout(int closure_index, int count) {
 int closure() {
 	char* xcf;
 	int np = 0; char*[24] pn; word[24] pty; int hop, entry, i, t, envl, ncap, c, result, declared = 0, tags = 0, tag, lt, lfl = tline; word[24] ptags;
-	word expected = closure_expected; closure_expected = 0;
+	word expected = closure_expected, this_type = closure_this; closure_expected = 0; closure_this = 0;
 	reserve_closures(nclo + 1);
 	if (o3on) serr("closures can't be made inside an o3 region");
 	next();
 	// fn:type(args) names the result; returns are coerced and checked against it
 	if (accept(s_colon)) declared = ptype0();
 	expect(s_lp);
-	if (!is_op(s_rp)) {
+	if (this_type) {	// a drop: fn() { ... } gets the value as this, borrowed
+		pn[0] = s_this; pty[0] = this_type; ptags[0] = 1; pnoffs[0] = toff; pnplaces[0] = tpack(); np = 1;
+		if (!is_op(s_rp)) serr("a drop takes no parameters; the value is this");
+	}
+	if (!is_op(s_rp) && !this_type) {
 		while (1) {
 			pty[np] = tword;
 			if (expected && expected[0] == TY_FN && np < expected[3]) pty[np] = expected[7 + np];
@@ -1022,6 +1033,7 @@ int primary() {
 	// wins over a global (a top-level function or constant) of the same name
 	if (mstruct && !ginst) { ms = lookup(methname(mstruct, n)); if (ms >= 0 && (skind[ms] == K_CONST || (skind[ms] == K_FN && (sflag[ms] & F_STATIC)))) s = ms; }
 	if (s < 0 && rt.eq_w(n, "new")) s = source_lookup(s_new);
+	if (s < 0 && (rt.eq_w(n, "heap") || rt.eq_w(n, "drop"))) { peek(); if (pk_tk == T_OP && pk_tv == s_lp) { if (rt.eq_w(n, "heap")) return heap_box(); return drop_call(); } }
 	if (s >= 0) rs_put(toff, RS_SYM, rs_sym(s), s);
 	if (s >= 0 && skind[s] == K_KW) {
 		if (!(sflag[s] & F_EXPR)) dien(n, "can't be used inside an expression");
@@ -1185,6 +1197,8 @@ word field(int c) {
 	}
 	fieldpos = tpack(); n = name(); fieldoff = nameoff;
 	st = xty;
+	if (rt.eq_w(n, "drop") && (is_op(s_lp) || is_op(s_eq)) && (isptr(st) || st == tword) && !(isptr(st) && st[4][0] == TY_STRUCT && tfindfield(st[4], n) >= 0)) return drop_member(c, borrowed);
+	if (rt.eq_w(n, "send") && is_op(s_lp) && isptr(st) && st[4][0] == TY_STRUCT && tfindfield(st[4], intern("__mailbox")) >= 0) send_check = 1;
 	if (st[0] == TY_ARR || st[0] == TY_DYN) {
 		if (pmatch) probe_member(st);
 		if (is_op(s_lp) && array_method(n)) { xaf = borrowed; return array_member(c, n); }
diff --git a/src/compiler/stmt.zc b/src/compiler/stmt.zc
index 0182728..6d5abe7 100644
--- a/src/compiler/stmt.zc
+++ b/src/compiler/stmt.zc
@@ -30,7 +30,7 @@ int stmt_inner() {
 		if (tv == s_semi) { next(); return 0; }
 		if (tv == s_lb) { block(); return 0; }
 	}
-	c = expr(); rval(); op(O_DROP);
+	c = expr(); rval(); if (c == C_FRESH && drop_tail == here) c = plainuse(c); op(O_DROP);
 	expect(s_semi);
 	discard(c);
 	return 0;
@@ -145,7 +145,7 @@ int localdecl(int typed) {
 			if (t && t[0] == TY_DYN && is_op(s_lb)) c = array_dynamic_literal(t); else c = expr();
 			rval(); nomagic = 0; kc = xconst && !xfloat;
 			if (kc) ltag[i] = ltag[i] | LCONST;
-			if (c == C_FRESH) { lnsz[i] = newsz; lleaf[i] = newleaf; }
+			if (c == C_FRESH) { lnsz[i] = newsz; lleaf[i] = newleaf; if (drop_tail == here) local_dropset[i] = 1; }
 			if (t) fcoerce(t);
 			vaddr(i);
 			op(O_ST);
@@ -683,6 +683,7 @@ int kw_return() {
  borrow_cleanup();
 	defer_run(1, 0);	// the value is on the stack; the deferred code is stack neutral
 	exit_vars(1, 0);
+	if (o3blk) { callname(intern("rt.o3_leave")); op(O_DROP); }	// a return leaves the o3 block too
 	epichain = fixnew(here, epichain);
 	lit(rt.MW - 1); op(O_JMP);
 	live = 0;
@@ -699,7 +700,9 @@ int kw_o3() {
 	next();
 	if (!is_op(s_lb)) { o3one = 1; localdecl(1); o3one = 0; return 0; }
 	if (o3on || !infn) return block();
+	o3_enter_code();
 	reserve_code(2); lo = here + 2; lit(lo); op(O_JMP);
+	o3blk++;
 	o3on = 1; o3reset();
 	save = nloc; outer = nloc;
 	i = lbase;
@@ -713,7 +716,7 @@ int kw_o3() {
 		i++;
 	}
 	block();
-	o3on = 0;
+	o3on = 0; o3blk--;
 	if (no3pend >= o3pendcap) { o3pend = chk_resize(o3pend, no3pend * 67, o3pendcap * 2 * 67); o3pendcap = o3pendcap * 2; }
 	{
 		p = o3pend + no3pend * 67; p[0] = lo; p[1] = here; p[2] = no3sl;
@@ -733,6 +736,7 @@ int kw_o3() {
 		}
 		i++;
 	}
+	callname(intern("rt.o3_leave")); op(O_DROP);
 	return 0;
 }
 // unchecked turns the analyzer off for one statement