@fraczak/k 6.4.0 → 6.5.0

package/CHANGELOG.md

@@ -7,6 +7,23 @@ This project uses [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 ---
 
+## [6.5.0] — 2026-09-22 — Tail-loop arena compaction & OOM diagnostics
+
+### WebAssembly Backend
+
+- Added threshold-based arena compaction in self-tail-recursive loops to reclaim dead scratch space, allowing deep computations (e.g. multi-thousand-bit arithmetic) without exhausting linear memory.
+- Added explicit Out-Of-Memory error reporting (`OutOfMemoryError`), tracking allocation failure and 32-bit offset overflow via exported runtime globals.
+
+### Runtime & REPL
+
+- Replaced recursive traversal in `codecs/runtime/show-value.mjs` and `Value.mjs` with iterative loops, eliminating `Maximum call stack size exceeded` errors when rendering deep variant chains.
+
+### Examples
+
+- Converted arithmetic helper functions in `Examples/arithmetics.k` to tail-recursive relations.
+
+---
+
 ## [6.2.3] — 2026-06-03 — Unified k compiler output
 
 ### Toolchain

package/Examples/arithmetics.k

@@ -39,22 +39,33 @@ empty? = {empty /yes if, () then} .then;
 concat = ${bits x, bits y} {.x inv x, .y y} concat_; 
 concat_ = ${bits x, bits y} 
   < 
-    {.x /0 x, .y |0  y} concat_, 
-    {.x /1 x, .y |1 y} concat_, 
-    .y 
+    {.x empty? if, .y then} .then,
+    < 
+      {.x /0 x, .y |0 y}, 
+      {.x /1 x, .y |1 y}
+    > concat_ 
   >;
 inv = {()x, 0b r} _inv; 
-_inv = ${bits x, bits r} < {.x /0 x, .r |0  r} _inv, {.x /1 x, .r |1 r} _inv, .r >;
+_inv = ${bits x, bits r} 
+  < 
+    {.x empty? if, .r then} .then,
+    < 
+      {.x /0 x, .r |0 r}, 
+      {.x /1 x, .r |1 r}
+   > _inv
+  >;
 
 inOrder = ${bits x, bits y} {.x inv x, .y inv y, yes inOrder} inOrder_;
 inOrder_ = ${bits x, bits y, yes_no inOrder} 
   < 
-    {.x /0 x, .y /0 y, .inOrder inOrder} inOrder_, 
-    {.x /1 x, .y /1 y, .inOrder inOrder} inOrder_,
-    {.x /0 x, .y /1 y, .inOrder inOrder} inOrder_, 
-    {.x /1 y, .y /0 x, .inOrder swap_yes_no inOrder} inOrder_, 
-    {.x </0,/1> if, .inOrder swap_yes_no then} .then, 
-    .inOrder
+    {.x </0,/1> if1, .y /_ if2, .inOrder swap_yes_no then} .then,
+    {.x /_ if, .inOrder then} .then,
+    < 
+      {.x /0 x, .y /0 y, .inOrder inOrder}, 
+      {.x /1 x, .y /1 y, .inOrder inOrder},
+      {.x /0 x, .y /1 y, .inOrder inOrder}, 
+      {.x /1 y, .y /0 x, .inOrder swap_yes_no inOrder}
+    > inOrder_
   >;
 
 GT = {inOrder /no if, () then} . then;
@@ -63,18 +74,21 @@ EQ = GT {.x y, .y x} GT;
 
 toBitList = {inv x, nil r} _toBitList; 
 _toBitList = < 
-  {.x empty? if, .r then }.then, 
-  {.x /0 x, {0 car, .r cdr} cons r} _toBitList, 
-  {.x /1 x, {1 car, .r cdr} cons r} _toBitList 
+  {.x empty? if, .r then}.then, 
+  <
+    {.x /0 x, {0 car, .r cdr} cons r}, 
+    {.x /1 x, {1 car, .r cdr} cons r}
+  > _toBitList 
 >;
-fromBitList =
-< 
-  cdr <
-    {car /0 if, cdr fromBitList |0  then} .then, 
-    {car /1 if, cdr fromBitList |1 then} .then
-  >, 
-  0b
-> $bits;
+fromBitList = {() l, 0b r} _fromBitList inv $bits;
+_fromBitList =
+  <
+    {.l nil? if, .r then} .then,
+    <
+      {.l car /0 if, {.l cdr l, .r |0 r} then} .then,
+      {.l car /1 if, {.l cdr l, .r |1 r} then} .then
+    > _fromBitList
+  >;
 
 --------------------------------------
 $ int = < bits '+', bits '-' >;
@@ -99,9 +113,9 @@ inc = $int <
 > $int;
 
 _inc = ${bits x, bits y} <
+    {.x empty? if, .y |1 then} .then,
     {.x /0 x, .y |1 y} concat_, 
-    {.x /1 x, .y |0  y} _inc,
-    .y |1
+    {.x /1 x, .y |0  y} _inc
 >; 
 
 dec = $int <
@@ -149,38 +163,44 @@ _plus_ =
     {.x empty? if, .y empty? and, {.r x, 1 r} _inv then} .then,
     {.x empty? if, .c/0 and, {.r x, .y r} _inv then} .then,
 
-    {.x y, .y empty? x, .c c, .r r} _plus_,
-    {<.c/0 0, 1> x, 
-              .y y, .x empty? c0 c, .r r} _plus_,
+    <
+      {.x y, .y empty? x, .c c, .r r},
+      {<.c/0 0, 1> x, .y y, .x empty? c0 c, .r r},
 
-    {.x /0 x, .y /0 y, .c/0 c0 c, .r |0 r} _plus_,
-    {.x /0 x, .y /0 y, .c/1 c0 c, .r |1 r} _plus_,
+      {.x /0 x, .y /0 y, .c/0 c0 c, .r |0 r},
+      {.x /0 x, .y /0 y, .c/1 c0 c, .r |1 r},
 
-    {.x /0 x, .y /1 y, .c/0 c0 c, .r |1 r} _plus_,
-    {.x /0 x, .y /1 y, .c/1 c1 c, .r |0 r} _plus_,
-    {.x /1 x, .y /0 y, .c/0 c0 c, .r |1 r} _plus_,
-    {.x /1 x, .y /0 y, .c/1 c1 c, .r |0 r} _plus_,
+      {.x /0 x, .y /1 y, .c/0 c0 c, .r |1 r},
+      {.x /0 x, .y /1 y, .c/1 c1 c, .r |0 r},
+      {.x /1 x, .y /0 y, .c/0 c0 c, .r |1 r},
+      {.x /1 x, .y /0 y, .c/1 c1 c, .r |0 r},
 
-    {.x /1 x, .y /1 y, .c/0 c1 c, .r |0 r} _plus_,
-    {.x /1 x, .y /1 y, .c/1 c1 c, .r |1 r} _plus_
+      {.x /1 x, .y /1 y, .c/0 c1 c, .r |0 r},
+      {.x /1 x, .y /1 y, .c/1 c1 c, .r |1 r}
+    > _plus_
   >
 ;
 
-_minus =
-  -- least significat bit first substraction with carry
-  ${bits x, bits y, carry c}
+_minus = {.x x, .y y, .c c, 0b r} _minus_;
+
+_minus_ =
+  -- least significant bit first substraction with carry
+  ${bits x, bits y, carry c, bits r}
   <
-    {.x then, .y empty? if, .c/0 and} .then,
-    {.x/1 then, .y empty? if, .c/1 and} .then |0,
-    {.x/0 x, .y empty? y, .c/1 c1 c} _minus |1,
-    {.x/0 x, .y/0   y, .c/0 c0 c} _minus |0,
-    {.x/0 x, .y/0   y, .c/1 c1 c} _minus |1,  
-    {.x/0 x, .y/1   y, .c/0 c1 c} _minus |1,
-    {.x/0 x, .y/1   y, .c/1 c1 c} _minus |0,
-    {.x/1 x, .y/0   y, .c/0 c0 c} _minus |1,
-    {.x/1 x, .y/0   y, .c/1 c0 c} _minus |0,
-    {.x/1 x, .y/1   y, .c/0 c0 c} _minus |0,
-    {.x/1 x, .y/1   y, .c/1 c1 c} _minus |1
+    {.y empty? if, .c/0 and, {.r x, .x r} _inv then} .then,
+    <
+      {.x/0 x, .y empty? y, .c/1 c1 c, .r |1 r},
+      {.x/1 x, .y empty? y, .c/1 c0 c, .r |0 r},
+
+      {.x/0 x, .y/0   y, .c/0 c0 c, .r |0 r},
+      {.x/0 x, .y/0   y, .c/1 c1 c, .r |1 r},  
+      {.x/0 x, .y/1   y, .c/0 c1 c, .r |1 r},
+      {.x/0 x, .y/1   y, .c/1 c1 c, .r |0 r},
+      {.x/1 x, .y/0   y, .c/0 c0 c, .r |1 r},
+      {.x/1 x, .y/0   y, .c/1 c0 c, .r |0 r},
+      {.x/1 x, .y/1   y, .c/0 c0 c, .r |0 r},
+      {.x/1 x, .y/1   y, .c/1 c1 c, .r |1 r}
+    > _minus_
   >
 ;
 
@@ -212,16 +232,18 @@ _times =
   ${bits result, bits _x, bits y}
   <
     { .y empty? if, .result then } .then,
-    { 
-      .result |0  result, 
-      ._x _x, 
-      .y /0 y
-    } _times,
-    { 
-      {._x x, .result |0  y, c0 c } _plus result, 
-      ._x _x, 
-      .y /1 y 
-    } _times
+    <
+      { 
+        .result |0  result, 
+        ._x _x, 
+        .y /0 y
+      },
+      { 
+        {._x x, .result |0  y, c0 c } _plus result, 
+        ._x _x, 
+        .y /1 y 
+      }
+    > _times
   >
 ;
 
@@ -327,17 +349,18 @@ lcm =
   {{.x int x, .y int y} times x, gcd int y} div .div abs
 ;
 
- factorial = <
-  zero_int? 1 int,
-  /"+" int {dec factorial x, () y} times
+factorial = {()n, 1 int acc} factorial_;
+factorial_ =  <
+  {.n zero_int? if, .acc then} .then,
+  {.n pos? dec n, {.n x, .acc y} times acc} factorial_
 >;
 
 fib_ =
   <
+    {.n int zero_int? if, ."fib(n),fib(n.1)" then} .then,
     { .n int dec /"+" n,
       ."fib(n),fib(n.1)" {plus x, .x y} "fib(n),fib(n.1)"
-    } fib_,
-    ."fib(n),fib(n.1)"
+    } fib_
   >
 ;
 

package/Value.mjs

@@ -176,8 +176,14 @@ class Value {
 
   toString() {
     if (isVariant(this)) {
-      // return `{${JSON.stringify(this.tag)}:${this.value.toString()}}`;
-      return `${this.value.toString()}|${pLabel(this.tag)}`;
+      const tags = [];
+      let curr = this;
+      while (isVariant(curr)) {
+        tags.push(pLabel(curr.tag));
+        curr = curr.value;
+      }
+      const base = curr ? curr.toString() : "";
+      return tags.length === 0 ? base : `${base}|${tags.reverse().join("|")}`;
     }
     if (isProduct(this)) {
       return `{${Object.entries(this.product).map(([k, v]) => `${JSON.stringify(k)}:${v.toString()}`).join(',')}}`;

package/backends/wasm/TECHNICAL-DEBT.md

@@ -31,12 +31,18 @@ paths do not reclaim temporary values until the whole run ends.
 
 Tail-call lowering now avoids allocating replacement input products for some
 self-tail-recursive loops by keeping top-level product fields in Wasm locals.
-That improves arithmetic workloads such as `factorial:o`, but it is still only
-a first step. Large runs still allocate far more arena memory than the final
-result requires because intermediate relation results, accumulator fragments,
-and temporary products remain in the bump arena.
+Furthermore, self-tail-recursive loops now incorporate threshold-based arena
+compaction: when arena growth within a tail loop exceeds 1 MB, live accumulator
+and argument graphs are compacted down to the loop entry mark using an iterative
+staging-and-copy mechanism in `runtime.wat`, freeing dead scratch data while
+preserving performance for hot short-lived loops.
 
-Future memory-management targets:
+Additionally, linear memory exhaustion and 32-bit unsigned offset overflow are
+now tracked explicitly via exported flags (`oom_flag`, `oom_size`) in `runtime.wat`,
+which the JS runtime intercepts to throw a descriptive `OutOfMemoryError` instead
+of an untyped `unreachable` trap.
+
+Remaining memory-management targets:
 
 - Add allocation profiling that attributes arena growth to generated relations
   and static allocation sites. Large regressions should be visible without
@@ -47,14 +53,6 @@ Future memory-management targets:
 - Introduce safe lifetime boundaries for successful non-tail calls. The runtime
   needs a way to reclaim scratch values after a callee result has been consumed
   without copying large live values on every call.
-- Make arena checkpoints part of code generation decisions, not just union
-  failure handling. Tail loops should be able to reset dead scratch space while
-  preserving the next live input/result.
 - Keep unsigned pointer handling explicit. Wasm arena addresses are `i32`
   offsets, and JavaScript sees exported `i32` values as signed numbers, so all
   JS-side arena offsets must be normalized before `DataView` access.
-
-The preferred direction is performance first: reduce allocation volume in hot
-generated loops before adding a general garbage collector or compaction pass.
-Copying live arena values can control memory, but it risks slowing exactly the
-large recursive arithmetic workloads that motivated tail-call lowering.

package/backends/wasm/runtime.wat

@@ -2,9 +2,12 @@
   (memory (export "memory") 1)
 
   ;; Start allocation at byte offset 1024 to leave a safety margin and avoid returning 0 (nullptr)
-  (global $arena_free (mut i32) (i32.const 1024))
+  (global $arena_free (export "arena_free") (mut i32) (i32.const 1024))
   ;; Maximum address of the currently allocated pages (1 page = 64KB)
-  (global $arena_max (mut i32) (i32.const 65536))
+  (global $arena_max (export "arena_max") (mut i32) (i32.const 65536))
+  ;; Out-of-memory status flags
+  (global $oom_flag (export "oom_flag") (mut i32) (i32.const 0))
+  (global $oom_size (export "oom_size") (mut i32) (i32.const 0))
 
   ;; Bump allocator function: aligns allocation size to 8 bytes, grows memory if needed, and returns the pointer
   (func $alloc (export "alloc") (param $size i32) (result i32)
@@ -13,6 +16,18 @@
     (local $pages_needed i32)
     (local $grow_res i32)
 
+    ;; Check if size exceeds maximum allocatable size
+    local.get $size
+    i32.const -8
+    i32.gt_u
+    if
+      i32.const 1
+      global.set $oom_flag
+      local.get $size
+      global.set $oom_size
+      unreachable
+    end
+
     ;; 1. Align size to 8 bytes: size = (size + 7) & ~8
     local.get $size
     i32.const 7
@@ -31,6 +46,18 @@
     i32.add
     local.set $new_free
 
+    ;; Check for 32-bit unsigned overflow
+    local.get $new_free
+    local.get $old_free
+    i32.lt_u
+    if
+      i32.const 1
+      global.set $oom_flag
+      local.get $size
+      global.set $oom_size
+      unreachable
+    end
+
     ;; 2. Check if we exceed current memory size
     local.get $new_free
     global.get $arena_max
@@ -56,6 +83,10 @@
       i32.const -1
       i32.eq
       if
+        i32.const 1
+        global.set $oom_flag
+        local.get $size
+        global.set $oom_size
         unreachable
       end
 
@@ -99,4 +130,346 @@
     local.get $mark
     global.set $arena_free
   )
+
+  ;; Compaction staging globals
+  (global $compact_buf_start (mut i32) (i32.const 0))
+  (global $compact_buf_free (mut i32) (i32.const 0))
+
+  ;; Ensure memory capacity in staging buffer
+  (func $ensure_buf_capacity (param $size i32)
+    (local $needed i32)
+    (local $pages i32)
+    (local $grow_res i32)
+
+    global.get $compact_buf_free
+    local.get $size
+    i32.add
+    local.set $needed
+
+    ;; Check for 32-bit overflow
+    local.get $needed
+    global.get $compact_buf_free
+    i32.lt_u
+    if
+      i32.const 1
+      global.set $oom_flag
+      local.get $size
+      global.set $oom_size
+      unreachable
+    end
+
+    local.get $needed
+    global.get $arena_max
+    i32.gt_u
+    if
+      local.get $needed
+      global.get $arena_max
+      i32.sub
+      i32.const 65535
+      i32.add
+      i32.const 65536
+      i32.div_u
+      local.set $pages
+
+      local.get $pages
+      memory.grow
+      local.set $grow_res
+
+      local.get $grow_res
+      i32.const -1
+      i32.eq
+      if
+        i32.const 1
+        global.set $oom_flag
+        local.get $size
+        global.set $oom_size
+        unreachable
+      end
+
+      global.get $arena_max
+      local.get $pages
+      i32.const 65536
+      i32.mul
+      i32.add
+      global.set $arena_max
+    end
+  )
+
+  ;; Initialize compaction staging buffer at current arena top
+  (func $compact_start (export "compact_start")
+    global.get $arena_free
+    global.set $compact_buf_start
+    global.get $arena_free
+    global.set $compact_buf_free
+  )
+
+  ;; Compact an object graph reachable from $root down toward $mark
+  (func $compact_obj (export "compact_obj") (param $root i32) (param $mark i32) (result i32)
+    (local $curr i32)
+    (local $first_final i32)
+    (local $prev_dest i32)
+    (local $dest i32)
+    (local $final_ptr i32)
+    (local $tag i32)
+    (local $payload i32)
+    (local $size i32)
+    (local $alignedSize i32)
+    (local $N i32)
+    (local $i i32)
+    (local $offsetVal i32)
+    (local $fieldPtr i32)
+    (local $child_final i32)
+
+    local.get $root
+    local.set $curr
+    i32.const 0
+    local.set $prev_dest
+
+    (block $break_chain
+      (loop $chain_loop
+        ;; 1. Check null / empty
+        local.get $curr
+        i32.eqz
+        if
+          local.get $prev_dest
+          if
+            local.get $prev_dest
+            i32.const 0
+            i32.store offset=8
+          end
+          br $break_chain
+        end
+
+        ;; 2. Check if < mark
+        local.get $curr
+        local.get $mark
+        i32.lt_u
+        if
+          local.get $prev_dest
+          if
+            local.get $prev_dest
+            local.get $curr
+            i32.store offset=8
+          end
+          local.get $first_final
+          i32.eqz
+          if
+            local.get $curr
+            local.set $first_final
+          end
+          br $break_chain
+        end
+
+        ;; 3. Check if forwarded
+        local.get $curr
+        i32.load offset=0
+        local.set $size
+
+        local.get $size
+        i32.const -1
+        i32.eq
+        if
+          local.get $curr
+          i32.load offset=4
+          local.set $final_ptr
+          local.get $prev_dest
+          if
+            local.get $prev_dest
+            local.get $final_ptr
+            i32.store offset=8
+          end
+          local.get $first_final
+          i32.eqz
+          if
+            local.get $final_ptr
+            local.set $first_final
+          end
+          br $break_chain
+        end
+
+        ;; 4. Compute final_ptr = mark + (compact_buf_free - compact_buf_start)
+        local.get $mark
+        global.get $compact_buf_free
+        global.get $compact_buf_start
+        i32.sub
+        i32.add
+        local.set $final_ptr
+
+        local.get $first_final
+        i32.eqz
+        if
+          local.get $final_ptr
+          local.set $first_final
+        end
+
+        ;; If prev_dest != 0, patch its payload to final_ptr
+        local.get $prev_dest
+        if
+          local.get $prev_dest
+          local.get $final_ptr
+          i32.store offset=8
+        end
+
+        ;; 5. Check if Variant (size == 12)
+        local.get $size
+        i32.const 12
+        i32.eq
+        if
+          i32.const 16
+          call $ensure_buf_capacity
+
+          local.get $curr
+          i32.load offset=4
+          local.set $tag
+          local.get $curr
+          i32.load offset=8
+          local.set $payload
+
+          local.get $curr
+          i32.const -1
+          i32.store offset=0
+          local.get $curr
+          local.get $final_ptr
+          i32.store offset=4
+
+          global.get $compact_buf_free
+          local.set $dest
+          global.get $compact_buf_free
+          i32.const 16
+          i32.add
+          global.set $compact_buf_free
+
+          local.get $dest
+          i32.const 12
+          i32.store offset=0
+          local.get $dest
+          local.get $tag
+          i32.store offset=4
+
+          local.get $dest
+          local.set $prev_dest
+          local.get $payload
+          local.set $curr
+          br $chain_loop
+        end
+
+        ;; 6. Product handling (size != 12)
+        local.get $size
+        i32.const 7
+        i32.add
+        i32.const -8
+        i32.and
+        local.set $alignedSize
+
+        local.get $alignedSize
+        call $ensure_buf_capacity
+
+        local.get $curr
+        i32.load offset=4
+        local.set $N
+
+        local.get $curr
+        i32.const -1
+        i32.store offset=0
+        local.get $curr
+        local.get $final_ptr
+        i32.store offset=4
+
+        global.get $compact_buf_free
+        local.set $dest
+        global.get $compact_buf_free
+        local.get $alignedSize
+        i32.add
+        global.set $compact_buf_free
+
+        local.get $dest
+        local.get $size
+        i32.store offset=0
+        local.get $dest
+        local.get $N
+        i32.store offset=4
+
+        i32.const 0
+        local.set $i
+        (block $break_prod
+          (loop $loop_prod
+            local.get $i
+            local.get $N
+            i32.ge_u
+            br_if $break_prod
+
+            local.get $curr
+            i32.const 8
+            local.get $i
+            i32.const 4
+            i32.mul
+            i32.add
+            i32.add
+            i32.load
+            local.set $offsetVal
+
+            local.get $dest
+            i32.const 8
+            local.get $i
+            i32.const 4
+            i32.mul
+            i32.add
+            i32.add
+            local.get $offsetVal
+            i32.store
+
+            local.get $curr
+            local.get $offsetVal
+            i32.add
+            i32.load
+            local.set $fieldPtr
+
+            local.get $fieldPtr
+            local.get $mark
+            call $compact_obj
+            local.set $child_final
+
+            local.get $dest
+            local.get $offsetVal
+            i32.add
+            local.get $child_final
+            i32.store
+
+            local.get $i
+            i32.const 1
+            i32.add
+            local.set $i
+            br $loop_prod
+          )
+        )
+        br $break_chain
+      )
+    )
+
+    local.get $first_final
+  )
+
+  ;; Finalize compaction by copying staging buffer into mark and resetting arena_free
+  (func $compact_finish (export "compact_finish") (param $mark i32)
+    (local $total_size i32)
+    global.get $compact_buf_free
+    global.get $compact_buf_start
+    i32.sub
+    local.set $total_size
+
+    local.get $total_size
+    i32.const 0
+    i32.gt_u
+    if
+      local.get $mark
+      global.get $compact_buf_start
+      local.get $total_size
+      memory.copy
+    end
+
+    local.get $mark
+    local.get $total_size
+    i32.add
+    global.set $arena_free
+  )
 )