region rule (25.3c): keep() and intern(), frame_keeps, and --arena-strict

keep(x) copies a string, a slice (header and elements) or a record (shallow) onto the heap; intern(s)
hands back one heap string per distinct text from a fixed table in the runtime (FNV-1a, 65536 slots,
copied the first time; past 49152 only copied). Both are how frame code keeps what it made on purpose:
the escape analysis takes the copy as the heap's and leaves the argument LOCAL.

The analysis now records why a class escapes (the store, the event, the global it reached) and
ludic deps lists every allocation frame code makes and keeps - fkeep lines, 'ludic deps --keeps',
the frame_keeps number --check ratchets - leaving out what is under @alloc_ok and a push's growth
(25.5's capacities). --arena-strict (or 'arena strict') makes each an error naming the store, before
anything is emitted. A test: a template stored into a state is the one error; keep and intern of the
next two, an @alloc_ok push and a scratch temporary are not; 195 frames of arena resets under
R3D_ARENA_CHECK=1 later the kept and interned texts read as made, and intern gives the same string.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

selfhost/backend/emit_call.ludic

@@ -695,6 +695,11 @@ function emit_call(e: Node) -> Val {
   }
   if (name == "len") { return emit_len(e) }
   if (name == "push") { return emit_push(e) }
+  if (name == "keep") and len(e.kids) == 1 { return emit_keep(emit_expr(e.kids[0])) }
+  if (name == "intern") and len(e.kids) == 1 {
+    let s = emit_expr(e.kids[0])
+    return val(emit_bind(`call ptr @lp_intern(ptr {s.code})`), "string")
+  }
   if (name == "string") {                            # string(x): int/bool/fixed/long -> text, a string passes through
     let a = emit_expr(e.kids[0])
     if (llty(a.ty) == "ptr") { return a }

selfhost/backend/emit_escape.ludic

@@ -18,6 +18,13 @@ const ES_ESC: int = 1
 const ES_HEAP: int = 2
 
 var g_es_flag: []int = new []int
+var g_es_why: []Node = new []Node                   # per class: the statement that made it escape
+var g_es_swhy: []Node = new []Node                  # per store edge: its statement
+var g_es_stmt: Node = null                          # the statement being walked
+var g_es_aok: int = 0                               # inside a statement under @alloc_ok
+var g_es_site_aok: []bool = new []bool              # the site is (not reported by the region rule)
+var g_es_site_grow: []bool = new []bool             # the site is a push's growth (25.5's capacities, not the rule)
+var g_es_done: bool = false
 var g_es_ft: []int = new []int                      # flow edges
 var g_es_ff: []int = new []int
 var g_es_st: []int = new []int                      # store edges: value, target
@@ -38,15 +45,20 @@ var g_es_lc: []int = new []int
 var g_es_cur: int = -1
 var g_es_heap: int = -1                             # the one class for globals, states and the unknown
 
-function es_new(flags: int) -> int { push(g_es_flag, flags);  return len(g_es_flag) - 1 }
+function es_new(flags: int) -> int { push(g_es_flag, flags);  push(g_es_why, null);  return len(g_es_flag) - 1 }
 function es_flow(a: int, b: int) -> void { if a >= 0 and b >= 0 { push(g_es_ff, a);  push(g_es_ft, b) } }
 function es_store(v: int, t: int) -> void {
   if v < 0 { return }
-  if t < 0 { g_es_flag[v] = g_es_flag[v] | ES_ESC;  return }
+  if t < 0 { es_escape(v);  return }
   push(g_es_sv, v)
   push(g_es_st, t)
+  push(g_es_swhy, g_es_stmt)
+}
+function es_escape(v: int) -> void {
+  if v < 0 { return }
+  g_es_flag[v] = g_es_flag[v] | ES_ESC
+  if g_es_why[v] == null { g_es_why[v] = g_es_stmt }
 }
-function es_escape(v: int) -> void { if v >= 0 { g_es_flag[v] = g_es_flag[v] | ES_ESC } }
 
 function es_local(name: pointer) -> int {
   var i = len(g_es_ln) - 1
@@ -71,6 +83,8 @@ function es_site(n: Node) -> int {
   push(g_es_site, n)
   push(g_es_site_cls, c)
   push(g_es_site_fn, g_es_cur)
+  push(g_es_site_aok, g_es_aok > 0)
+  push(g_es_site_grow, false)
   return c
 }
 
@@ -156,11 +170,15 @@ function es_call(e: Node) -> int {
       es_args_walk(e)
       return es_site(e)
     }
+    if (nm == "keep") or (nm == "intern") {
+      es_args_walk(e)
+      return g_es_heap
+    }
     if (nm == "push") and len(e.kids) >= 2 {
       let t = es_val(e.kids[0])
       es_store(es_val(e.kids[1]), t)
       # the grown buffer is the list's own
-      push(g_es_site, e);  push(g_es_site_cls, t);  push(g_es_site_fn, g_es_cur)
+      push(g_es_site, e);  push(g_es_site_cls, t);  push(g_es_site_fn, g_es_cur);  push(g_es_site_aok, g_es_aok > 0);  push(g_es_site_grow, true)
       return -1
     }
     if (nm == "words") or (nm == "floats") or (nm == "doubles") or (nm == "buffer") or (nm == "bytes") or (nm == "fixeds") or (nm == "pointers") {
@@ -228,7 +246,18 @@ function es_call(e: Node) -> int {
 
 function es_walk(n: Node) -> void {
   if n == null { return }
+  if n.uns == FR_AOK_STMT and n.kind != E_ID {
+    g_es_aok += 1
+    es_walk_in(n)
+    g_es_aok -= 1
+    return
+  }
+  es_walk_in(n)
+}
+
+function es_walk_in(n: Node) -> void {
   let k = n.kind
+  if k == S_LET or k == S_ASSIGN or k == S_RETURN or k == S_EXPR or k == S_EMIT { g_es_stmt = n }
   if k == S_LET {
     let c = es_bind_local(n.s)
     es_flow(es_val(n.a), c)
@@ -293,14 +322,22 @@ function es_solve() -> void {
       let a = g_es_ff[i]
       let b = g_es_ft[i]
       if (g_es_flag[a] & ES_HEAP) != 0 and (g_es_flag[b] & ES_HEAP) == 0 { g_es_flag[b] = g_es_flag[b] | ES_HEAP;  changed = true }
-      if (g_es_flag[b] & ES_ESC) != 0 and (g_es_flag[a] & ES_ESC) == 0 { g_es_flag[a] = g_es_flag[a] | ES_ESC;  changed = true }
+      if (g_es_flag[b] & ES_ESC) != 0 and (g_es_flag[a] & ES_ESC) == 0 {
+        g_es_flag[a] = g_es_flag[a] | ES_ESC
+        g_es_why[a] = g_es_why[b]
+        changed = true
+      }
       i += 1
     }
     i = 0
     while i < len(g_es_sv) {
       let v = g_es_sv[i]
       let t = g_es_st[i]
-      if (g_es_flag[t] & (ES_ESC | ES_HEAP)) != 0 and (g_es_flag[v] & ES_ESC) == 0 { g_es_flag[v] = g_es_flag[v] | ES_ESC;  changed = true }
+      if (g_es_flag[t] & (ES_ESC | ES_HEAP)) != 0 and (g_es_flag[v] & ES_ESC) == 0 {
+        g_es_flag[v] = g_es_flag[v] | ES_ESC
+        g_es_why[v] = g_es_swhy[i]
+        changed = true
+      }
       i += 1
     }
   }
@@ -322,6 +359,8 @@ function es_solve() -> void {
 var g_es_local_n: int = 0
 var g_es_esc_n: int = 0
 function escape_analyse() -> void {
+  if g_es_done { return }
+  g_es_done = true
   g_es_heap = es_new(ES_ESC | ES_HEAP)
   ck_tab_init(g_es_fk, g_es_fv)
   var i = 0
@@ -400,3 +439,38 @@ function escape_report() -> void {
   let tot = `escape: {itoa(g_es_local_n)} local, {itoa(g_es_esc_n)} kept\n`
   file_write(file_stderr(), tot, len(tot))
 }
+
+# keep(x): x copied onto the heap - a string's bytes, a slice's header and elements, a record's
+# fields (shallow) - so a frame's value can become a state's on purpose (25.3's region rule)
+function emit_keep(a: Val) -> Val {
+  if (a.ty == "string") {
+    let n = emit_bind(`call i64 @strlen(ptr {a.code})`)
+    let n1 = emit_bind(`add i64 {n}, 1`)
+    let p = emit_bind(`call ptr @lp_malloc(i64 {n1})`)
+    emit(`  call ptr @memcpy(ptr {p}, ptr {a.code}, i64 {n1})\n`)
+    return val(p, "string")
+  }
+  if is_slice_ty(a.ty) {
+    let esz = emit_sizeof(llty(slice_elem(a.ty)))
+    let hsz = emit_sizeof("%LSlice")
+    let h = emit_bind(`call ptr @lp_malloc(i64 {hsz})`)
+    let od = emit_bind(`load ptr, ptr {slice_field(a.code, 0)}`)
+    let ln = emit_bind(`load i32, ptr {slice_field(a.code, 1)}`)
+    let ln64 = emit_bind(`zext i32 {ln} to i64`)
+    let bytes = emit_bind(`mul i64 {ln64}, {esz}`)
+    let b1 = emit_bind(`add i64 {bytes}, 1`)
+    let d = emit_bind(`call ptr @lp_malloc(i64 {b1})`)
+    emit(`  call ptr @memcpy(ptr {d}, ptr {od}, i64 {bytes})\n`)
+    emit(`  store ptr {d}, ptr {slice_field(h, 0)}\n`)
+    emit(`  store i32 {ln}, ptr {slice_field(h, 1)}\n`)
+    emit(`  store i32 {ln}, ptr {slice_field(h, 2)}\n`)
+    return val(h, a.ty)
+  }
+  if layout_node(a.ty) != null {
+    let sz = emit_sizeof(layout_ty(a.ty))
+    let p = emit_bind(`call ptr @lp_malloc(i64 {sz})`)
+    emit(`  call ptr @memcpy(ptr {p}, ptr {a.code}, i64 {sz})\n`)
+    return val(p, a.ty)
+  }
+  return a
+}

selfhost/backend/emit_fence.ludic

@@ -120,6 +120,7 @@ function fence_flag(a: pointer) -> bool {
   if str_starts(a, "--fence-warm=") { g_fence_warm = fence_int(a[13..len(a)]);  g_fence_flagged = true;  return true }
   if str_starts(a, "--fence-census=") { g_fence_census = a[15..len(a)];  g_fence_flagged = true;  return true }
   if (a == "--arena") { g_arena = true;  return true }
+  if (a == "--arena-strict") { g_arena = true;  g_arena_strict = true;  return true }
   return false
 }
 
@@ -152,6 +153,7 @@ function fence_manifest_read(txt: pointer) -> void {
     if (len(ws) == 3) and (ws[0] == "fence") and (ws[1] == "warm") { g_fence_warm = fence_int(ws[2]) }
     if (len(ws) == 3) and (ws[0] == "fence") and (ws[1] == "census") { g_fence_census = ws[2] }
     if (len(ws) == 2) and (ws[0] == "arena") and (ws[1] == "on") { g_arena = true }
+    if (len(ws) == 2) and (ws[0] == "arena") and (ws[1] == "strict") { g_arena = true;  g_arena_strict = true }
     i = e + 1
   }
 }
@@ -182,6 +184,7 @@ function fence_table(name: pointer, ty: pointer, vals: []pointer) -> void {
 
 # the runtime, and the tables this program's sites size
 function emit_fence_runtime() -> void {
+  emit_fence_intern()
   if g_target_win { emit_fence_win();  return }
   if not g_fprintf_declared { emith("declare i32 @fprintf(ptr, ptr, ...)\n");  g_fprintf_declared = true }
   if not g_atexit_declared { emith("declare i32 @atexit(ptr)\n");  g_atexit_declared = true }

selfhost/backend/emit_fence_ir.ludic

@@ -1314,3 +1314,67 @@ function emit_fence_win() -> void {
   emith("  ret i64 0\n")
   emith("}\n")
 }
+function emit_fence_intern() -> void {
+  emith("@lp_itab = global [65536 x ptr] zeroinitializer\n")
+  emith("@lp_icount = global i64 0\n")
+  emith("define internal ptr @lp_copystr(ptr %s, i64 %n) {\n")
+  emith("entry:\n")
+  emith("  %n1 = add i64 %n, 1\n")
+  emith("  %p = call ptr @lp_malloc(i64 %n1)\n")
+  emith("  call ptr @memcpy(ptr %p, ptr %s, i64 %n1)\n")
+  emith("  ret ptr %p\n")
+  emith("}\n")
+  emith("define ptr @lp_intern(ptr %s) {\n")
+  emith("entry:\n")
+  emith("  %null = icmp eq ptr %s, null\n")
+  emith("  br i1 %null, label %none, label %hl\n")
+  emith("none:\n")
+  emith("  ret ptr null\n")
+  emith("hl:\n")
+  emith("  %i = phi i64 [ 0, %entry ], [ %i1, %hb ]\n")
+  emith("  %h = phi i64 [ -3750763034362895579, %entry ], [ %h2, %hb ]\n")
+  emith("  %cp = getelementptr i8, ptr %s, i64 %i\n")
+  emith("  %c = load i8, ptr %cp\n")
+  emith("  %end = icmp eq i8 %c, 0\n")
+  emith("  br i1 %end, label %probe, label %hb\n")
+  emith("hb:\n")
+  emith("  %cz = zext i8 %c to i64\n")
+  emith("  %h1 = xor i64 %h, %cz\n")
+  emith("  %h2 = mul i64 %h1, 1099511628211\n")
+  emith("  %i1 = add i64 %i, 1\n")
+  emith("  br label %hl\n")
+  emith("probe:\n")
+  emith("  %k = phi i64 [ 0, %hl ], [ %k1, %next ]\n")
+  emith("  %far = icmp uge i64 %k, 64\n")
+  emith("  br i1 %far, label %copy_only, label %look\n")
+  emith("look:\n")
+  emith("  %slot0 = add i64 %h, %k\n")
+  emith("  %slot = and i64 %slot0, 65535\n")
+  emith("  %sp = getelementptr [65536 x ptr], ptr @lp_itab, i64 0, i64 %slot\n")
+  emith("  %v = load ptr, ptr %sp\n")
+  emith("  %empty = icmp eq ptr %v, null\n")
+  emith("  br i1 %empty, label %store, label %cmp\n")
+  emith("cmp:\n")
+  emith("  %r = call i32 @strcmp(ptr %v, ptr %s)\n")
+  emith("  %same = icmp eq i32 %r, 0\n")
+  emith("  br i1 %same, label %found, label %next\n")
+  emith("next:\n")
+  emith("  %k1 = add i64 %k, 1\n")
+  emith("  br label %probe\n")
+  emith("found:\n")
+  emith("  ret ptr %v\n")
+  emith("store:\n")
+  emith("  %cnt = load i64, ptr @lp_icount\n")
+  emith("  %full = icmp uge i64 %cnt, 49152\n")
+  emith("  br i1 %full, label %copy_only, label %keep\n")
+  emith("keep:\n")
+  emith("  %c2 = call ptr @lp_copystr(ptr %s, i64 %i)\n")
+  emith("  store ptr %c2, ptr %sp\n")
+  emith("  %cnt1 = add i64 %cnt, 1\n")
+  emith("  store i64 %cnt1, ptr @lp_icount\n")
+  emith("  ret ptr %c2\n")
+  emith("copy_only:\n")
+  emith("  %c3 = call ptr @lp_copystr(ptr %s, i64 %i)\n")
+  emith("  ret ptr %c3\n")
+  emith("}\n")
+}

selfhost/backend/emit_frame.ludic

@@ -190,4 +190,40 @@ function deps_frame(f: pointer) -> void {
     i += 1
   }
   deps_line(f, `frame_allocs {itoa(total)}`)
+  deps_keeps(f, seen)
+}
+
+var g_arena_strict: bool = false                    # --arena-strict / `arena strict`: a keep in frame code is an error
+# 25.3's region rule: an allocation in frame code that is kept past its frame (stored into a state,
+# a queue, a global, an event) is a `fkeep` line - and under strict an error naming the store.
+# keep(...) / intern(...) is the copy on purpose; @alloc_ok("why") says it is bounded
+function deps_keeps(f: pointer, seen: []bool) -> void {
+  escape_analyse()
+  var n = 0
+  var s = 0
+  while s < len(g_es_site) {
+    let c = g_es_site_cls[s]
+    let fi = g_es_site_fn[s]
+    if c >= 0 and fi >= 0 and (g_es_flag[c] & ES_ESC) != 0 and not g_es_site_aok[s] and not g_es_site_grow[s] {
+      let d = g_es_fnode[fi]
+      let k = dr_index(d.s)
+      if k >= 0 and seen[k] and not fr_alloc_ok(d.s) and d.file != null and not is_runtime_file(d.file) {
+        let site = g_es_site[s]
+        let why = g_es_why[c]
+        var at = "?"
+        if why != null and why.file != null { at = `{why.file}:{itoa(why.line)}` }
+        var kind = fr_alloc_kind(site, false)
+        if kind == null { kind = "text" }
+        deps_line(f, `fkeep {kind} {d.file}:{itoa(site.line)} {at} {fr_chain(k)}`)
+        if g_arena_strict {
+          let m = `{d.file}:{itoa(site.line)}: error: frame code keeps what it makes: this {kind} is kept at {at} ({fr_chain(k)}) - keep(...) or intern(...) to copy it on purpose, or @alloc_ok("why")\n`
+          file_write(file_stderr(), m, len(m))
+        }
+        n += 1
+      }
+    }
+    s += 1
+  }
+  deps_line(f, `frame_keeps {itoa(n)}`)
+  if g_arena_strict and n > 0 { exit(1) }
 }

selfhost/check/check_call.ludic

@@ -95,6 +95,11 @@ function ck_walk_args(e: Node) -> void {
 }
 # the builtins whose type is their name, and push, whose element must fit the slice
 function ck_builtin(e: Node, name: pointer) -> pointer {
+  if (name == "keep") and len(e.kids) == 1 { return ck_expr(e.kids[0]) }       # 25.3: a copy on the heap, the same type
+  if (name == "intern") and len(e.kids) == 1 {                                   # 25.3: one heap string per distinct text
+    ck_walk_args(e)
+    return "string"
+  }
   if (name == "string") or (name == "int") or (name == "float") or (name == "fixed") or (name == "long") or (name == "double") {
     ck_walk_args(e)
     return name

selfhost/main.ludic

@@ -232,6 +232,11 @@ entry {
   check_program()                                 # L4: the types agree before anything is emitted
   if g_es_report { escape_report() }              # 25.3: which allocations never outlive their frame
   else if g_arena { escape_analyse() }             # 25.3: and they allocate from the frame's scratch
+  if g_arena_strict and (getenv_or("LUDIC_DEPS", "") == "") {   # 25.3: the region rule, before anything is emitted
+    let sink = file_open("/dev/null", "wb")
+    deps_reach(sink)
+    file_close(sink)
+  }
   if g_migrate { mg_finish() }
   # --check: every check a build makes - the emitter refuses things too (a bind to a function that is
   # gone, an unknown name) - and nothing written