@fraczak/k 7.0.0 → 7.0.1

package/backends/wasm/src/wasm.mjs

@@ -13,7 +13,8 @@ import {
   patternToPropertyList,
   propertyListToPattern,
   Value,
-  specializeKVM
+  specializeKVM,
+  specializeObjectRelations
 } from "@fraczak/k/backend-api.mjs";
 import { intersectPropertyListPatterns } from "@fraczak/k/codecs/runtime/codec.mjs";
 import { propertyListToFilter } from "@fraczak/k/codecs/runtime/show-value.mjs";
@@ -304,7 +305,8 @@ function compileModule(mainRelName, defs) {
 
     kvmFunc.name = nameMap.get(name) || cleanName(name);
     cleanCallNames(kvmFunc.body, nameMap);
-    wats.push(lowerToWasm(kvmFunc, kvmFunc.name));
+    const wasmText = lowerToWasm(kvmFunc, kvmFunc.name);
+    wats.push(wasmText);
   }
 
   return {
@@ -611,8 +613,10 @@ async function compileWasmArtifactFromObject(object, { entry = null, inputEnvelo
     if (!mainRel) throw new Error(`No main relation (${mainRelName}) defined in object`);
     const inputPattern = getPatternPropertyList(mainRel.typePatternGraph, mainRel.def.patterns[0]);
     const outputPattern = getPatternPropertyList(mainRel.typePatternGraph, mainRel.def.patterns[1]);
-    if (classifyTyping(inputPattern, outputPattern).program === "polymorphic") {
-      defs = annotateObjectWithInputFilter(object, mainRelName, inputPattern, inputEnvelopePattern);
+    const typing = classifyTyping(inputPattern, outputPattern);
+    if (typing.program === "polymorphic") {
+      const specialized = specializeObjectRelations(object, mainRelName, inputEnvelopePattern);
+      defs = { rels: specialized.rels, relAlias: specialized.relAlias, compileStats: specialized.compileStats };
       typingMode = "specialized";
     }
   }
@@ -635,7 +639,9 @@ async function compileWasmArtifact(
     const inputPattern = getPatternPropertyList(mainRel.typePatternGraph, mainRel.def.patterns[0]);
     const outputPattern = getPatternPropertyList(mainRel.typePatternGraph, mainRel.def.patterns[1]);
     if (classifyTyping(inputPattern, outputPattern).program === "polymorphic") {
-      defs = annotateSourceWithInputFilter(fullSource, inputPattern, inputEnvelopePattern, options);
+      const obj = { format: "k-object", rels: defs.rels, relAlias: defs.relAlias, compileStats: defs.compileStats, main: "__main__" };
+      const specialized = specializeObjectRelations(obj, "__main__", inputEnvelopePattern);
+      defs = { rels: specialized.rels, relAlias: specialized.relAlias, compileStats: specialized.compileStats };
       typingMode = "specialized";
     }
   }
@@ -723,20 +729,18 @@ function readArenaValue(exports, ptr, pattern, patternNodeId, patternPropertyLis
 
     if (patternNode.kind === NODE_KIND.OPEN_PRODUCT || patternNode.kind === NODE_KIND.CLOSED_PRODUCT) {
       const N = view.getUint32(frame.ptr + 4, true);
-      if (N !== patternNode.edges.length) {
-        throw new Error(`Cannot decode product pointer ${frame.ptr}: arena field count ${N} does not match output pattern`);
-      }
       const product = {};
       frame.assign(Value.product(product, patternForNode(patternPropertyList, frame.patternNodeId)));
       for (let i = N - 1; i >= 0; i--) {
-        const edge = patternNode.edges[i];
-        const offset = view.getUint32(frame.ptr + 8 + 4 * i, true);
-        const childPtr = view.getUint32(frame.ptr + offset, true);
+        const tagId = view.getUint32(frame.ptr + 8 + 4 * i, true);
+        const label = tags.getTag(tagId) || patternNode.edges[i]?.label;
+        const edge = patternNode.edges.find((candidate) => candidate.label === label);
+        const childPtr = view.getUint32(frame.ptr + 8 + 4 * N + 4 * i, true);
         stack.push({
           ptr: wasmPtr(childPtr),
-          patternNodeId: edge.target,
+          patternNodeId: edge?.target ?? null,
           assign(value) {
-            product[edge.label] = value;
+            product[label] = value;
           }
         });
       }
@@ -787,8 +791,9 @@ function writeValueToArena(exports, value, pattern, patternNodeId, arenaValues,
       view.setUint32(frame.ptr, 8 + 8 * N, true);
       view.setUint32(frame.ptr + 4, N, true);
       for (let i = 0; i < N; i++) {
+        const tagId = tags.getId(frame.fields[i].label);
         const offset = 8 + 4 * N + 4 * i;
-        view.setUint32(frame.ptr + 8 + 4 * i, offset, true);
+        view.setUint32(frame.ptr + 8 + 4 * i, tagId, true);
         view.setUint32(frame.ptr + offset, frame.childPtrs[i], true);
       }
       arenaValues.set(frame.ptr, valueWithPatternNode(frame.value, patternPropertyList, frame.patternNodeId));
@@ -820,6 +825,13 @@ function writeValueToArena(exports, value, pattern, patternNodeId, arenaValues,
         ? Object.keys(frame.value.product)
             .sort()
             .map((label) => ({ label, patternNodeId: frame.patternNodeId }))
+        : isOpenProduct
+        ? Object.keys(frame.value.product)
+            .sort()
+            .map((label) => {
+              const edge = patternNode.edges.find((e) => e.label === label);
+              return { label, patternNodeId: edge ? edge.target : null };
+            })
         : patternNode.edges.map((edge) => ({ label: edge.label, patternNodeId: edge.target }));
       const fieldLabels = new Set(fields.map(({ label }) => label));
       if (isClosedProduct) {
@@ -829,9 +841,17 @@ function writeValueToArena(exports, value, pattern, patternNodeId, arenaValues,
           }
         }
       }
-      for (const { label } of fields) {
-        if (!Object.hasOwn(frame.value.product, label)) {
-          throw new Error(`Product field '${label}' is required by input pattern node ${frame.patternNodeId}`);
+      if (isOpenProduct) {
+        for (const edge of patternNode.edges) {
+          if (!Object.hasOwn(frame.value.product, edge.label)) {
+            throw new Error(`Product field '${edge.label}' is required by input pattern node ${frame.patternNodeId}`);
+          }
+        }
+      } else {
+        for (const { label } of fields) {
+          if (!Object.hasOwn(frame.value.product, label)) {
+            throw new Error(`Product field '${label}' is required by input pattern node ${frame.patternNodeId}`);
+          }
         }
       }
 
@@ -841,6 +861,7 @@ function writeValueToArena(exports, value, pattern, patternNodeId, arenaValues,
         finishProduct: true,
         value: frame.value,
         patternNodeId: frame.patternNodeId,
+        fields,
         ptr,
         childPtrs,
         assign: frame.assign

package/backends/wasm/tests/perf-support.mjs

@@ -200,8 +200,7 @@ export function readArenaValue(exports, rootPtr, pattern, rootPatternNodeId, pat
 
       for (let i = N - 1; i >= 0; i--) {
         const edge = patternNode.edges[i];
-        const offsetVal = view.getUint32(ptr + 8 + 4 * i, true);
-        const childPtr = view.getUint32(ptr + offsetVal, true);
+        const childPtr = view.getUint32(ptr + 8 + 4 * N + 4 * i, true);
         const label = edge.label;
         stack.push({
           ptr: childPtr,
@@ -253,14 +252,14 @@ export function writeValueToArena(exports, rootValue, pattern, rootPatternNodeId
     const frame = stack.pop();
 
     if (frame.finishProduct) {
-      const { ptr, totalSize, N, childPtrs, assign } = frame;
+      const { ptr, totalSize, N, keys, childPtrs, assign } = frame;
       const view = new DataView(exports.memory.buffer);
       view.setUint32(ptr, totalSize, true);
       view.setUint32(ptr + 4, N, true);
 
       for (let i = 0; i < N; i++) {
         const offsetVal = 8 + 4 * N + 4 * i;
-        view.setUint32(ptr + 8 + 4 * i, offsetVal, true);
+        view.setUint32(ptr + 8 + 4 * i, getTagId(keys[i]), true);
         view.setUint32(ptr + offsetVal, childPtrs[i], true);
       }
       assign(ptr);
@@ -294,6 +293,7 @@ export function writeValueToArena(exports, rootValue, pattern, rootPatternNodeId
         ptr,
         totalSize,
         N,
+        keys,
         childPtrs,
         assign
       });

package/backends/wasm/tests/test-wasm.mjs

@@ -194,7 +194,7 @@ console.log("==> Running Product Operations Integration Tests");
     for (let i = 0; i < N; i++) {
       const offsetVal = 8 + 4 * N + 4 * i;
       const val = fieldsMap[keys[i]];
-      view.setUint32(ptr + 8 + 4 * i, offsetVal, true);
+      view.setUint32(ptr + 8 + 4 * i, getTagId(keys[i]), true);
       view.setUint32(ptr + offsetVal, val, true);
     }
     return ptr;
@@ -215,8 +215,8 @@ console.log("==> Running Product Operations Integration Tests");
   const view = new DataView(exports.memory.buffer);
   assert.equal(view.getUint32(ptrOut, true), 24, "Product total size should be 24");
   assert.equal(view.getUint32(ptrOut + 4, true), 2, "Product field count should be 2");
-  assert.equal(view.getUint32(ptrOut + 8, true), 16, "Offset of first field (x) should be 16");
-  assert.equal(view.getUint32(ptrOut + 12, true), 20, "Offset of second field (y) should be 20");
+  assert.equal(view.getUint32(ptrOut + 8, true), getTagId("x"), "TagId of first field (x)");
+  assert.equal(view.getUint32(ptrOut + 12, true), getTagId("y"), "TagId of second field (y)");
 
   // The first field value should be the projection of x from ptrIn (101)
   const valXPtr = view.getUint32(ptrOut + 16, true);
@@ -443,12 +443,12 @@ console.log("==> Running End-to-End Peano Addition & Serialization Tests");
   const runtimeWat = fs.readFileSync("runtime.wat", "utf8");
 
   const script = `
-    $ nat = < {} 0, nat +1 >;
-    0 = {} | 0 $ nat;
-    inc = | +1 $ nat;
-    dec = $ nat / +1;
-    add = $ { nat x, nat y } <
-      { . x dec x, . y inc y } add,
+    nat = ?< {} 0, nat +1 >;
+    0 = {} | 0 nat;
+    inc = | +1 nat;
+    dec = nat / +1;
+    add = ?{ nat x, nat y } = X <
+      { . x dec x, . y inc y } ?X add,
       . y
     >;
     ()
@@ -483,8 +483,7 @@ console.log("==> Running End-to-End Peano Addition & Serialization Tests");
 
       for (let i = 0; i < N; i++) {
         const edge = patternNode.edges[i];
-        const offsetVal = view.getUint32(ptr + 8 + 4 * i, true);
-        const childPtr = view.getUint32(ptr + offsetVal, true);
+        const childPtr = view.getUint32(ptr + 8 + 4 * N + 4 * i, true);
         productObj[edge.label] = readArenaValue(childPtr, pattern, edge.target);
       }
       return Value.product(productObj, pattern);
@@ -530,7 +529,7 @@ console.log("==> Running End-to-End Peano Addition & Serialization Tests");
 
       for (let i = 0; i < N; i++) {
         const offsetVal = 8 + 4 * N + 4 * i;
-        view.setUint32(ptr + 8 + 4 * i, offsetVal, true);
+        view.setUint32(ptr + 8 + 4 * i, getTagId(keys[i]), true);
         view.setUint32(ptr + offsetVal, childPtrs[i], true);
       }
       return ptr;
@@ -580,8 +579,8 @@ console.log("==> Running End-to-End Peano Addition & Serialization Tests");
     const view = new DataView(exports.memory.buffer);
     view.setUint32(ptr, 24, true);
     view.setUint32(ptr + 4, 2, true);
-    view.setUint32(ptr + 8, 16, true);
-    view.setUint32(ptr + 12, 20, true);
+    view.setUint32(ptr + 8, getTagId("x"), true);
+    view.setUint32(ptr + 12, getTagId("y"), true);
     view.setUint32(ptr + 16, xPtr, true);
     view.setUint32(ptr + 20, yPtr, true);
     return ptr;

package/browser/vfs-data.mjs

@@ -1,6 +1,6 @@
 // Auto-generated by scripts/build-repl-html.mjs - DO NOT EDIT MANUALLY
 export const vfsData = {
-  "backends/wasm/runtime.wat": "(module\n  (memory (export \"memory\") 1)\n\n  ;; Start allocation at byte offset 1024 to leave a safety margin and avoid returning 0 (nullptr)\n  (global $arena_free (export \"arena_free\") (mut i32) (i32.const 1024))\n  ;; Maximum address of the currently allocated pages (1 page = 64KB)\n  (global $arena_max (export \"arena_max\") (mut i32) (i32.const 65536))\n  ;; Out-of-memory status flags\n  (global $oom_flag (export \"oom_flag\") (mut i32) (i32.const 0))\n  (global $oom_size (export \"oom_size\") (mut i32) (i32.const 0))\n\n  ;; Bump allocator function: aligns allocation size to 8 bytes, grows memory if needed, and returns the pointer\n  (func $alloc (export \"alloc\") (param $size i32) (result i32)\n    (local $old_free i32)\n    (local $new_free i32)\n    (local $pages_needed i32)\n    (local $grow_res i32)\n\n    ;; Check if size exceeds maximum allocatable size\n    local.get $size\n    i32.const -8\n    i32.gt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    ;; 1. Align size to 8 bytes: size = (size + 7) & ~8\n    local.get $size\n    i32.const 7\n    i32.add\n    i32.const -8\n    i32.and\n    local.set $size\n\n    ;; Get current free pointer\n    global.get $arena_free\n    local.set $old_free\n\n    ;; Calculate proposed new free pointer\n    local.get $old_free\n    local.get $size\n    i32.add\n    local.set $new_free\n\n    ;; Check for 32-bit unsigned overflow\n    local.get $new_free\n    local.get $old_free\n    i32.lt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    ;; 2. Check if we exceed current memory size\n    local.get $new_free\n    global.get $arena_max\n    i32.gt_u\n    if\n      ;; Calculate how many additional pages we need to grow\n      local.get $new_free\n      global.get $arena_max\n      i32.sub\n      i32.const 65535\n      i32.add\n      i32.const 65536\n      i32.div_u\n      local.set $pages_needed\n\n      ;; Try to grow memory by $pages_needed\n      local.get $pages_needed\n      memory.grow\n      local.set $grow_res\n\n      ;; If grow returns -1, we are out of memory\n      local.get $grow_res\n      i32.const -1\n      i32.eq\n      if\n        i32.const 1\n        global.set $oom_flag\n        local.get $size\n        global.set $oom_size\n        unreachable\n      end\n\n      ;; Update arena_max: arena_max = arena_max + pages_needed * 65536\n      global.get $arena_max\n      local.get $pages_needed\n      i32.const 65536\n      i32.mul\n      i32.add\n      global.set $arena_max\n    end\n\n    ;; 3. Perform the allocation\n    local.get $new_free\n    global.set $arena_free\n\n    local.get $old_free\n  )\n\n  ;; Return a checkpoint that can be restored after a temporary result is consumed.\n  (func $arena_mark (export \"arena_mark\") (result i32)\n    global.get $arena_free\n  )\n\n  ;; Bulk-free allocations made after a checkpoint. Memory pages remain available for reuse.\n  (func $arena_reset (export \"arena_reset\") (param $mark i32)\n    local.get $mark\n    i32.const 1024\n    i32.lt_u\n    if\n      unreachable\n    end\n\n    local.get $mark\n    global.get $arena_free\n    i32.gt_u\n    if\n      unreachable\n    end\n\n    local.get $mark\n    global.set $arena_free\n  )\n\n  ;; Compaction staging globals\n  (global $compact_buf_start (mut i32) (i32.const 0))\n  (global $compact_buf_free (mut i32) (i32.const 0))\n\n  ;; Ensure memory capacity in staging buffer\n  (func $ensure_buf_capacity (param $size i32)\n    (local $needed i32)\n    (local $pages i32)\n    (local $grow_res i32)\n\n    global.get $compact_buf_free\n    local.get $size\n    i32.add\n    local.set $needed\n\n    ;; Check for 32-bit overflow\n    local.get $needed\n    global.get $compact_buf_free\n    i32.lt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    local.get $needed\n    global.get $arena_max\n    i32.gt_u\n    if\n      local.get $needed\n      global.get $arena_max\n      i32.sub\n      i32.const 65535\n      i32.add\n      i32.const 65536\n      i32.div_u\n      local.set $pages\n\n      local.get $pages\n      memory.grow\n      local.set $grow_res\n\n      local.get $grow_res\n      i32.const -1\n      i32.eq\n      if\n        i32.const 1\n        global.set $oom_flag\n        local.get $size\n        global.set $oom_size\n        unreachable\n      end\n\n      global.get $arena_max\n      local.get $pages\n      i32.const 65536\n      i32.mul\n      i32.add\n      global.set $arena_max\n    end\n  )\n\n  ;; Initialize compaction staging buffer at current arena top\n  (func $compact_start (export \"compact_start\")\n    global.get $arena_free\n    global.set $compact_buf_start\n    global.get $arena_free\n    global.set $compact_buf_free\n  )\n\n  ;; Compact an object graph reachable from $root down toward $mark\n  (func $compact_obj (export \"compact_obj\") (param $root i32) (param $mark i32) (result i32)\n    (local $curr i32)\n    (local $first_final i32)\n    (local $prev_dest i32)\n    (local $dest i32)\n    (local $final_ptr i32)\n    (local $tag i32)\n    (local $payload i32)\n    (local $size i32)\n    (local $alignedSize i32)\n    (local $N i32)\n    (local $i i32)\n    (local $offsetVal i32)\n    (local $fieldPtr i32)\n    (local $child_final i32)\n\n    local.get $root\n    local.set $curr\n    i32.const 0\n    local.set $prev_dest\n\n    (block $break_chain\n      (loop $chain_loop\n        ;; 1. Check null / empty\n        local.get $curr\n        i32.eqz\n        if\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            i32.const 0\n            i32.store offset=8\n          end\n          br $break_chain\n        end\n\n        ;; 2. Check if < mark\n        local.get $curr\n        local.get $mark\n        i32.lt_u\n        if\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            local.get $curr\n            i32.store offset=8\n          end\n          local.get $first_final\n          i32.eqz\n          if\n            local.get $curr\n            local.set $first_final\n          end\n          br $break_chain\n        end\n\n        ;; 3. Check if forwarded\n        local.get $curr\n        i32.load offset=0\n        local.set $size\n\n        local.get $size\n        i32.const -1\n        i32.eq\n        if\n          local.get $curr\n          i32.load offset=4\n          local.set $final_ptr\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            local.get $final_ptr\n            i32.store offset=8\n          end\n          local.get $first_final\n          i32.eqz\n          if\n            local.get $final_ptr\n            local.set $first_final\n          end\n          br $break_chain\n        end\n\n        ;; 4. Compute final_ptr = mark + (compact_buf_free - compact_buf_start)\n        local.get $mark\n        global.get $compact_buf_free\n        global.get $compact_buf_start\n        i32.sub\n        i32.add\n        local.set $final_ptr\n\n        local.get $first_final\n        i32.eqz\n        if\n          local.get $final_ptr\n          local.set $first_final\n        end\n\n        ;; If prev_dest != 0, patch its payload to final_ptr\n        local.get $prev_dest\n        if\n          local.get $prev_dest\n          local.get $final_ptr\n          i32.store offset=8\n        end\n\n        ;; 5. Check if Variant (size == 12)\n        local.get $size\n        i32.const 12\n        i32.eq\n        if\n          i32.const 16\n          call $ensure_buf_capacity\n\n          local.get $curr\n          i32.load offset=4\n          local.set $tag\n          local.get $curr\n          i32.load offset=8\n          local.set $payload\n\n          local.get $curr\n          i32.const -1\n          i32.store offset=0\n          local.get $curr\n          local.get $final_ptr\n          i32.store offset=4\n\n          global.get $compact_buf_free\n          local.set $dest\n          global.get $compact_buf_free\n          i32.const 16\n          i32.add\n          global.set $compact_buf_free\n\n          local.get $dest\n          i32.const 12\n          i32.store offset=0\n          local.get $dest\n          local.get $tag\n          i32.store offset=4\n\n          local.get $dest\n          local.set $prev_dest\n          local.get $payload\n          local.set $curr\n          br $chain_loop\n        end\n\n        ;; 6. Product handling (size != 12)\n        local.get $size\n        i32.const 7\n        i32.add\n        i32.const -8\n        i32.and\n        local.set $alignedSize\n\n        local.get $alignedSize\n        call $ensure_buf_capacity\n\n        local.get $curr\n        i32.load offset=4\n        local.set $N\n\n        local.get $curr\n        i32.const -1\n        i32.store offset=0\n        local.get $curr\n        local.get $final_ptr\n        i32.store offset=4\n\n        global.get $compact_buf_free\n        local.set $dest\n        global.get $compact_buf_free\n        local.get $alignedSize\n        i32.add\n        global.set $compact_buf_free\n\n        local.get $dest\n        local.get $size\n        i32.store offset=0\n        local.get $dest\n        local.get $N\n        i32.store offset=4\n\n        i32.const 0\n        local.set $i\n        (block $break_prod\n          (loop $loop_prod\n            local.get $i\n            local.get $N\n            i32.ge_u\n            br_if $break_prod\n\n            local.get $curr\n            i32.const 8\n            local.get $i\n            i32.const 4\n            i32.mul\n            i32.add\n            i32.add\n            i32.load\n            local.set $offsetVal\n\n            local.get $dest\n            i32.const 8\n            local.get $i\n            i32.const 4\n            i32.mul\n            i32.add\n            i32.add\n            local.get $offsetVal\n            i32.store\n\n            local.get $curr\n            local.get $offsetVal\n            i32.add\n            i32.load\n            local.set $fieldPtr\n\n            local.get $fieldPtr\n            local.get $mark\n            call $compact_obj\n            local.set $child_final\n\n            local.get $dest\n            local.get $offsetVal\n            i32.add\n            local.get $child_final\n            i32.store\n\n            local.get $i\n            i32.const 1\n            i32.add\n            local.set $i\n            br $loop_prod\n          )\n        )\n        br $break_chain\n      )\n    )\n\n    local.get $first_final\n  )\n\n  ;; Finalize compaction by copying staging buffer into mark and resetting arena_free\n  (func $compact_finish (export \"compact_finish\") (param $mark i32)\n    (local $total_size i32)\n    global.get $compact_buf_free\n    global.get $compact_buf_start\n    i32.sub\n    local.set $total_size\n\n    local.get $total_size\n    i32.const 0\n    i32.gt_u\n    if\n      local.get $mark\n      global.get $compact_buf_start\n      local.get $total_size\n      memory.copy\n    end\n\n    local.get $mark\n    local.get $total_size\n    i32.add\n    global.set $arena_free\n  )\n)\n",
+  "backends/wasm/runtime.wat": "(module\n  (memory (export \"memory\") 1)\n\n  ;; Start allocation at byte offset 1024 to leave a safety margin and avoid returning 0 (nullptr)\n  (global $arena_free (export \"arena_free\") (mut i32) (i32.const 1024))\n  ;; Maximum address of the currently allocated pages (1 page = 64KB)\n  (global $arena_max (export \"arena_max\") (mut i32) (i32.const 65536))\n  ;; Out-of-memory status flags\n  (global $oom_flag (export \"oom_flag\") (mut i32) (i32.const 0))\n  (global $oom_size (export \"oom_size\") (mut i32) (i32.const 0))\n\n  ;; Bump allocator function: aligns allocation size to 8 bytes, grows memory if needed, and returns the pointer\n  (func $alloc (export \"alloc\") (param $size i32) (result i32)\n    (local $old_free i32)\n    (local $new_free i32)\n    (local $pages_needed i32)\n    (local $grow_res i32)\n\n    ;; Check if size exceeds maximum allocatable size\n    local.get $size\n    i32.const -8\n    i32.gt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    ;; 1. Align size to 8 bytes: size = (size + 7) & ~8\n    local.get $size\n    i32.const 7\n    i32.add\n    i32.const -8\n    i32.and\n    local.set $size\n\n    ;; Get current free pointer\n    global.get $arena_free\n    local.set $old_free\n\n    ;; Calculate proposed new free pointer\n    local.get $old_free\n    local.get $size\n    i32.add\n    local.set $new_free\n\n    ;; Check for 32-bit unsigned overflow\n    local.get $new_free\n    local.get $old_free\n    i32.lt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    ;; 2. Check if we exceed current memory size\n    local.get $new_free\n    global.get $arena_max\n    i32.gt_u\n    if\n      ;; Calculate how many additional pages we need to grow\n      local.get $new_free\n      global.get $arena_max\n      i32.sub\n      i32.const 65535\n      i32.add\n      i32.const 65536\n      i32.div_u\n      local.set $pages_needed\n\n      ;; Try to grow memory by $pages_needed\n      local.get $pages_needed\n      memory.grow\n      local.set $grow_res\n\n      ;; If grow returns -1, we are out of memory\n      local.get $grow_res\n      i32.const -1\n      i32.eq\n      if\n        i32.const 1\n        global.set $oom_flag\n        local.get $size\n        global.set $oom_size\n        unreachable\n      end\n\n      ;; Update arena_max: arena_max = arena_max + pages_needed * 65536\n      global.get $arena_max\n      local.get $pages_needed\n      i32.const 65536\n      i32.mul\n      i32.add\n      global.set $arena_max\n    end\n\n    ;; 3. Perform the allocation\n    local.get $new_free\n    global.set $arena_free\n\n    local.get $old_free\n  )\n\n  ;; Return a checkpoint that can be restored after a temporary result is consumed.\n  (func $arena_mark (export \"arena_mark\") (result i32)\n    global.get $arena_free\n  )\n\n  ;; Bulk-free allocations made after a checkpoint. Memory pages remain available for reuse.\n  (func $arena_reset (export \"arena_reset\") (param $mark i32)\n    local.get $mark\n    i32.const 1024\n    i32.lt_u\n    if\n      unreachable\n    end\n\n    local.get $mark\n    global.get $arena_free\n    i32.gt_u\n    if\n      unreachable\n    end\n\n    local.get $mark\n    global.set $arena_free\n  )\n\n  ;; Compaction staging globals\n  (global $compact_buf_start (mut i32) (i32.const 0))\n  (global $compact_buf_free (mut i32) (i32.const 0))\n\n  ;; Ensure memory capacity in staging buffer\n  (func $ensure_buf_capacity (param $size i32)\n    (local $needed i32)\n    (local $pages i32)\n    (local $grow_res i32)\n\n    global.get $compact_buf_free\n    local.get $size\n    i32.add\n    local.set $needed\n\n    ;; Check for 32-bit overflow\n    local.get $needed\n    global.get $compact_buf_free\n    i32.lt_u\n    if\n      i32.const 1\n      global.set $oom_flag\n      local.get $size\n      global.set $oom_size\n      unreachable\n    end\n\n    local.get $needed\n    global.get $arena_max\n    i32.gt_u\n    if\n      local.get $needed\n      global.get $arena_max\n      i32.sub\n      i32.const 65535\n      i32.add\n      i32.const 65536\n      i32.div_u\n      local.set $pages\n\n      local.get $pages\n      memory.grow\n      local.set $grow_res\n\n      local.get $grow_res\n      i32.const -1\n      i32.eq\n      if\n        i32.const 1\n        global.set $oom_flag\n        local.get $size\n        global.set $oom_size\n        unreachable\n      end\n\n      global.get $arena_max\n      local.get $pages\n      i32.const 65536\n      i32.mul\n      i32.add\n      global.set $arena_max\n    end\n  )\n\n  ;; Initialize compaction staging buffer at current arena top\n  (func $compact_start (export \"compact_start\")\n    global.get $arena_free\n    global.set $compact_buf_start\n    global.get $arena_free\n    global.set $compact_buf_free\n  )\n\n  ;; Compact an object graph reachable from $root down toward $mark\n  (func $compact_obj (export \"compact_obj\") (param $root i32) (param $mark i32) (result i32)\n    (local $curr i32)\n    (local $first_final i32)\n    (local $prev_dest i32)\n    (local $dest i32)\n    (local $final_ptr i32)\n    (local $tag i32)\n    (local $payload i32)\n    (local $size i32)\n    (local $alignedSize i32)\n    (local $N i32)\n    (local $i i32)\n    (local $offsetVal i32)\n    (local $fieldPtr i32)\n    (local $child_final i32)\n\n    local.get $root\n    local.set $curr\n    i32.const 0\n    local.set $prev_dest\n\n    (block $break_chain\n      (loop $chain_loop\n        ;; 1. Check null / empty\n        local.get $curr\n        i32.eqz\n        if\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            i32.const 0\n            i32.store offset=8\n          end\n          br $break_chain\n        end\n\n        ;; 2. Check if < mark\n        local.get $curr\n        local.get $mark\n        i32.lt_u\n        if\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            local.get $curr\n            i32.store offset=8\n          end\n          local.get $first_final\n          i32.eqz\n          if\n            local.get $curr\n            local.set $first_final\n          end\n          br $break_chain\n        end\n\n        ;; 3. Check if forwarded\n        local.get $curr\n        i32.load offset=0\n        local.set $size\n\n        local.get $size\n        i32.const -1\n        i32.eq\n        if\n          local.get $curr\n          i32.load offset=4\n          local.set $final_ptr\n          local.get $prev_dest\n          if\n            local.get $prev_dest\n            local.get $final_ptr\n            i32.store offset=8\n          end\n          local.get $first_final\n          i32.eqz\n          if\n            local.get $final_ptr\n            local.set $first_final\n          end\n          br $break_chain\n        end\n\n        ;; 4. Compute final_ptr = mark + (compact_buf_free - compact_buf_start)\n        local.get $mark\n        global.get $compact_buf_free\n        global.get $compact_buf_start\n        i32.sub\n        i32.add\n        local.set $final_ptr\n\n        local.get $first_final\n        i32.eqz\n        if\n          local.get $final_ptr\n          local.set $first_final\n        end\n\n        ;; If prev_dest != 0, patch its payload to final_ptr\n        local.get $prev_dest\n        if\n          local.get $prev_dest\n          local.get $final_ptr\n          i32.store offset=8\n        end\n\n        ;; 5. Check if Variant (size == 12)\n        local.get $size\n        i32.const 12\n        i32.eq\n        if\n          i32.const 16\n          call $ensure_buf_capacity\n\n          local.get $curr\n          i32.load offset=4\n          local.set $tag\n          local.get $curr\n          i32.load offset=8\n          local.set $payload\n\n          local.get $curr\n          i32.const -1\n          i32.store offset=0\n          local.get $curr\n          local.get $final_ptr\n          i32.store offset=4\n\n          global.get $compact_buf_free\n          local.set $dest\n          global.get $compact_buf_free\n          i32.const 16\n          i32.add\n          global.set $compact_buf_free\n\n          local.get $dest\n          i32.const 12\n          i32.store offset=0\n          local.get $dest\n          local.get $tag\n          i32.store offset=4\n\n          local.get $dest\n          local.set $prev_dest\n          local.get $payload\n          local.set $curr\n          br $chain_loop\n        end\n\n        ;; 6. Product handling (size != 12)\n        local.get $size\n        i32.const 7\n        i32.add\n        i32.const -8\n        i32.and\n        local.set $alignedSize\n\n        local.get $alignedSize\n        call $ensure_buf_capacity\n\n        local.get $curr\n        i32.load offset=4\n        local.set $N\n\n        local.get $curr\n        i32.const -1\n        i32.store offset=0\n        local.get $curr\n        local.get $final_ptr\n        i32.store offset=4\n\n        global.get $compact_buf_free\n        local.set $dest\n        global.get $compact_buf_free\n        local.get $alignedSize\n        i32.add\n        global.set $compact_buf_free\n\n        local.get $dest\n        local.get $size\n        i32.store offset=0\n        local.get $dest\n        local.get $N\n        i32.store offset=4\n\n        i32.const 0\n        local.set $i\n        (block $break_prod\n          (loop $loop_prod\n            local.get $i\n            local.get $N\n            i32.ge_u\n            br_if $break_prod\n\n            ;; Copy field tagId at offset 8 + 4*i\n            local.get $dest\n            i32.const 8\n            local.get $i\n            i32.const 4\n            i32.mul\n            i32.add\n            i32.add\n            local.get $curr\n            i32.const 8\n            local.get $i\n            i32.const 4\n            i32.mul\n            i32.add\n            i32.add\n            i32.load\n            i32.store\n\n            ;; Value slot offset is 8 + 4*N + 4*i\n            i32.const 8\n            local.get $N\n            i32.const 4\n            i32.mul\n            i32.add\n            local.get $i\n            i32.const 4\n            i32.mul\n            i32.add\n            local.set $offsetVal\n\n            local.get $curr\n            local.get $offsetVal\n            i32.add\n            i32.load\n            local.set $fieldPtr\n\n            local.get $fieldPtr\n            local.get $mark\n            call $compact_obj\n            local.set $child_final\n\n            local.get $dest\n            local.get $offsetVal\n            i32.add\n            local.get $child_final\n            i32.store\n\n            local.get $i\n            i32.const 1\n            i32.add\n            local.set $i\n            br $loop_prod\n          )\n        )\n        br $break_chain\n      )\n    )\n\n    local.get $first_final\n  )\n\n  ;; Finalize compaction by copying staging buffer into mark and resetting arena_free\n  (func $compact_finish (export \"compact_finish\") (param $mark i32)\n    (local $total_size i32)\n    global.get $compact_buf_free\n    global.get $compact_buf_start\n    i32.sub\n    local.set $total_size\n\n    local.get $total_size\n    i32.const 0\n    i32.gt_u\n    if\n      local.get $mark\n      global.get $compact_buf_start\n      local.get $total_size\n      memory.copy\n    end\n\n    local.get $mark\n    local.get $total_size\n    i32.add\n    global.set $arena_free\n  )\n\n  ;; Lookup product field by tagId with predictedIndex hint\n  (func $product_get (export \"product_get\") (param $prod i32) (param $targetTagId i32) (param $predictedIndex i32) (result i32)\n    (local $size i32)\n    (local $N i32)\n    (local $i i32)\n\n    ;; 1. Null check\n    local.get $prod\n    i32.eqz\n    if\n      i32.const 0\n      return\n    end\n\n    ;; 2. Read totalSize at prod + 0\n    local.get $prod\n    i32.load offset=0\n    local.set $size\n\n    ;; 3. Validate product header (not a variant and size >= 8)\n    local.get $size\n    i32.const 12\n    i32.eq\n    if\n      i32.const 0\n      return\n    end\n    local.get $size\n    i32.const 8\n    i32.lt_u\n    if\n      i32.const 0\n      return\n    end\n\n    ;; 4. Read field count N at prod + 4\n    local.get $prod\n    i32.load offset=4\n    local.set $N\n\n    ;; 5. Validate size == 8 + 8 * N\n    local.get $size\n    i32.const 8\n    local.get $N\n    i32.const 8\n    i32.mul\n    i32.add\n    i32.ne\n    if\n      i32.const 0\n      return\n    end\n\n    ;; 6. Fast path: check predictedIndex if in range [0, N)\n    local.get $predictedIndex\n    i32.const 0\n    i32.ge_s\n    if\n      local.get $predictedIndex\n      local.get $N\n      i32.lt_u\n      if\n        ;; Load tagId at prod + 8 + 4 * predictedIndex\n        local.get $prod\n        i32.const 8\n        local.get $predictedIndex\n        i32.const 4\n        i32.mul\n        i32.add\n        i32.add\n        i32.load\n        local.get $targetTagId\n        i32.eq\n        if\n          ;; Match! Return value at prod + 8 + 4*N + 4*predictedIndex\n          local.get $prod\n          i32.const 8\n          local.get $N\n          i32.const 4\n          i32.mul\n          i32.add\n          local.get $predictedIndex\n          i32.const 4\n          i32.mul\n          i32.add\n          i32.add\n          i32.load\n          return\n        end\n      end\n    end\n\n    ;; 7. Scan path: check i = 0 .. N-1\n    i32.const 0\n    local.set $i\n    (block $break_scan\n      (loop $loop_scan\n        local.get $i\n        local.get $N\n        i32.ge_u\n        br_if $break_scan\n\n        ;; Load tagId at prod + 8 + 4 * i\n        local.get $prod\n        i32.const 8\n        local.get $i\n        i32.const 4\n        i32.mul\n        i32.add\n        i32.add\n        i32.load\n        local.get $targetTagId\n        i32.eq\n        if\n          ;; Match! Return value at prod + 8 + 4*N + 4*i\n          local.get $prod\n          i32.const 8\n          local.get $N\n          i32.const 4\n          i32.mul\n          i32.add\n          local.get $i\n          i32.const 4\n          i32.mul\n          i32.add\n          i32.add\n          i32.load\n          return\n        end\n\n        local.get $i\n        i32.const 1\n        i32.add\n        local.set $i\n        br $loop_scan\n      )\n    )\n\n    ;; 8. Not found: return 0\n    i32.const 0\n  )\n)\n",
   "core.k": "-- core.k — the k standard core library\n--\n-- Defines:\n--   1. bits — canonical binary number / bit-path relation\n--   2. string — unicode strings relation (used for labels)\n--   3. pattern — pattern graph relation\n\n---------------------------------------------------------------\n-- §1. Bits\n---------------------------------------------------------------\n\nbit = ?< {} 0, {} 1 >;\n\nbits = ?< {} _, bits 0, bits 1 > = bits;\n\n_ = {}|_;\n\n0 = _ |0;\n1 = _ |1;\n\n---------------------------------------------------------------\n-- §2. Unicode and String\n---------------------------------------------------------------\n\nstring = ? <\n  {} nil,\n  {\n    <\n      {\n        < {} 0, {} 1 >=Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6\n      }=Bits7 ascii,\n      {\n        <\n          { Bit 0, Bit 1, Bit 2 }=Bits3 h08_0F,\n          Bits7 h10_7F,\n          Bits7 h80_CF,\n          Bits3 hD0_D7,\n          {} hF9,\n          { Bit 0 }=Bits1 hFA_FB,\n          Bits1 hFC_FD,\n          Bits1 hFE_FF\n        > hi,\n        { Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6, Bit 7 }=Bits8 lo\n      } bmp_common,\n      {\n        <\n          { Bit 0, Bit 1, Bit 2, Bit 3 } hE0_EF,\n          Bits3 hF0_F7,\n          {} hF8\n        > hi,\n        Bits8 lo\n      } bmp_private_use,\n      {\n        Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6, Bit 7, Bit 8, Bit 9, Bit 10\n      } plane0,\n      { Bits8 mid, Bits8 lo } supplementary_plane1,\n      {\n        <\n          Bits1 p02_03,\n          { Bit 0, Bit 1 } p04_07,\n          Bits3 p08_0F,\n          {} p10\n        > plane,\n        Bits8 mid,\n        Bits8 lo\n      } supplementary_planes2_16\n    > car,\n    String cdr\n  } cons\n> = String;\n\n---------------------------------------------------------------\n-- §3. Pattern\n---------------------------------------------------------------\n\n-- Pattern: a cons-list of pattern nodes.\n-- Node 0 (first element) is the root.\n-- Edges reference nodes by their index in this list, encoded as bits.\n--\n-- The singleton pattern of pattern itself is a fixed constant.\n-- That constant is the implicit framing for all k wire formats:\n-- to decode any value, first decode a pattern under that constant,\n-- then decode the value under the pattern just obtained.\n\npattern = ? <\n  {} nil,\n  {\n    <\n      {} any,\n      <\n        {} nil,\n        {\n          {\n            <\n              {} nil,\n              {\n                <\n                  {\n                    < {} 0, {} 1 >=Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6\n                  }=Bits7 ascii,\n                  {\n                    <\n                      { Bit 0, Bit 1, Bit 2 }=Bits3 h08_0F,\n                      Bits7 h10_7F,\n                      Bits7 h80_CF,\n                      Bits3 hD0_D7,\n                      {} hF9,\n                      { Bit 0 }=Bits1 hFA_FB,\n                      Bits1 hFC_FD,\n                      Bits1 hFE_FF\n                    > hi,\n                    { Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6, Bit 7 }=Bits8 lo\n                  } bmp_common,\n                  {\n                    <\n                      { Bit 0, Bit 1, Bit 2, Bit 3 } hE0_EF,\n                      Bits3 hF0_F7,\n                      {} hF8\n                    > hi,\n                    Bits8 lo\n                  } bmp_private_use,\n                  {\n                    Bit 0, Bit 1, Bit 2, Bit 3, Bit 4, Bit 5, Bit 6, Bit 7, Bit 8, Bit 9, Bit 10\n                  } plane0,\n                  { Bits8 mid, Bits8 lo } supplementary_plane1,\n                  {\n                    <\n                      Bits1 p02_03,\n                      { Bit 0, Bit 1 } p04_07,\n                      Bits3 p08_0F,\n                      {} p10\n                    > plane,\n                    Bits8 mid,\n                    Bits8 lo\n                  } supplementary_planes2_16\n                > car,\n                String cdr\n              } cons\n            > = String label,\n            < Bits 0, Bits 1, {} _ > = Bits target\n          } car,\n          Edges cdr\n        } cons\n      > = Edges open-product,\n      Edges open-union,\n      Edges closed-product,\n      Edges closed-union\n    > car,\n    Pattern cdr\n  } cons\n> = Pattern;\n\npattern\n",
   "arithmetics.k": "-- Examples for defining arithmetic functions natively\nswap_yes_no = < /yes |no, /no |yes >;\nyes = {}|yes;\nno = yes swap_yes_no;\n\nbits = ?< {} _, bits 0, bits 1 > = bits;\n\n0b = {} | _;\n-- |1 = | 1;\n-- |0  = | 0;\n\n0 = 0b |0;\nsucc = {inv x, 0b y} _inc;\n1 = 0 succ;\n2 = 1 succ;\n3 = 2 succ;\n4 = 3 succ;\n5 = 4 succ;\n6 = 5 succ;\n7 = 6 succ;\n8 = 7 succ;\n9 = 8 succ;\n10 = 9 succ;\n11 = 10 succ;\n12 = 11 succ;\n\nempty = < /_ yes, no >;\nempty? = {empty /yes if, () then} .then;\n\nconcat = {.x inv x, .y y} concat_; \nconcat_ = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x empty? if, .y then} .then,\n    < \n      {.x /0 x, .y |0 y}, \n      {.x /1 x, .y |1 y}\n    > concat_ \n  >;\ninv = {()x, 0b r} _inv; \n_inv = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x empty? if, .r then} .then,\n    < \n      {.x /0 x, .r |0 r}, \n      {.x /1 x, .r |1 r}\n   > _inv\n  >;\n\ninOrder = {.x inv x, .y inv y, yes inOrder} inOrder_;\ninOrder_ = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x </0,/1> if1, .y /_ if2, .inOrder swap_yes_no then} .then,\n    {.x /_ if, .inOrder then} .then,\n    < \n      {.x /0 x, .y /0 y, .inOrder inOrder}, \n      {.x /1 x, .y /1 y, .inOrder inOrder},\n      {.x /0 x, .y /1 y, .inOrder inOrder}, \n      {.x /1 y, .y /0 x, .inOrder swap_yes_no inOrder}\n    > inOrder_\n  >;\n\nGT = {inOrder /no if, () then} . then;\n\nEQ = {inOrder /yes if, {.x y, .y x} inOrder /yes and, () then} .then;\n\n--------------------------------------\nint = ?< <bits 0, bits 1, {} _>=bits \"+\", bits \"-\" >;\n\nremove_leading_zeros = <\n  /0 remove_leading_zeros, \n  ()\n>;\nnat = remove_leading_zeros <empty? 0, ()>;\nint = nat | '+';\nabs = </'+',/'-'>;\n\npos? = {/'+' remove_leading_zeros /1 if, () then} .then;\nneg? = {/'-' if, () then} .then; \nzero_int? = {/'+' /0 empty? if, () then} .then;\nminus_one? = {/'-' /1 empty? if, () then} .then;\n\ninc = <\n  /'+' {inv x, 0b y} _inc nat |'+',\n  minus_one? 0 int,\n  /'-' {inv x, 0b y} _dec nat |'-'\n>;\n\n_inc = ?{ <X 0, X 1, {} _>=X x, ... } <\n    {.x empty? if, .y |1 then} .then,\n    {.x /0 x, .y |1 y} concat_, \n    {.x /1 x, .y |0  y} _inc\n>; \n\ndec = <\n  zero_int? 1 |'-',\n  /'+' {inv x, 0b y} _dec nat |'+',\n  /'-' {inv x, 0b y} _inc nat |'-'\n>;\n\n_dec = ?{ <X 0, X 1, {} _>=X x, ... } <\n    {.x /1 x, .y |0  y} concat_, \n    {.x /0 x, .y |1 y} _dec\n>;\n\nc0 = {}|0;\nc1 = {}|1;\n\nplus =\n< \n  {.x/'+' inv x, .y/'+' inv y, c0 c } _plus inv nat | '+',\n  {.x/'-' inv x, .y/'-' inv y, c0 c } _plus inv nat | '-',\n  {.y/'-' x, .x/'+' y} GT {.x inv x, .y inv y, c0 c} _minus inv nat | '-',\n  {.x/'+' inv x, .y/'-' inv y, c0 c} _minus inv nat |'+',\n  {.x/'-' x, .y/'+' y} GT {.x inv x, .y inv y, c0 c} _minus inv nat | '-',\n  {.y/'+' inv x, .x/'-' inv y, c0 c} _minus inv nat | '+'\n>;\n\nswap_sign = <\n  zero_int?,\n  /'+' | '-',\n  /'-' | '+'\n>;\n\nminus =\n  {.x x, .y swap_sign y} plus;\n\n_plus = {.x x, .y y, .c c, 0b r} _plus_;\n\n_plus_ =\n  -- least significant bit first addition with carry\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.x empty? if, .y empty? and, .c/0 c, .r inv then} .then,\n    {.x empty? if, .y empty? and, {.r x, 1 r} _inv then} .then,\n    {.x empty? if, .c/0 and, {.r x, .y r} _inv then} .then,\n\n    <\n      {.x y, .y empty? x, .c c, .r r},\n      {<.c/0 0, 1> x, .y y, .x empty? c0 c, .r r},\n\n      {.x /0 x, .y /0 y, .c/0 c0 c, .r |0 r},\n      {.x /0 x, .y /0 y, .c/1 c0 c, .r |1 r},\n\n      {.x /0 x, .y /1 y, .c/0 c0 c, .r |1 r},\n      {.x /0 x, .y /1 y, .c/1 c1 c, .r |0 r},\n      {.x /1 x, .y /0 y, .c/0 c0 c, .r |1 r},\n      {.x /1 x, .y /0 y, .c/1 c1 c, .r |0 r},\n\n      {.x /1 x, .y /1 y, .c/0 c1 c, .r |0 r},\n      {.x /1 x, .y /1 y, .c/1 c1 c, .r |1 r}\n    > _plus_\n  >\n;\n\n_minus = {.x x, .y y, .c c, 0b r} _minus_;\n\n_minus_ =\n  -- least significant bit first substraction with carry\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.y empty? if, .c/0 and, {.r x, .x r} _inv then} .then,\n    <\n      {.x/0 x, .y empty? y, .c/1 c1 c, .r |1 r},\n      {.x/1 x, .y empty? y, .c/1 c0 c, .r |0 r},\n\n      {.x/0 x, .y/0   y, .c/0 c0 c, .r |0 r},\n      {.x/0 x, .y/0   y, .c/1 c1 c, .r |1 r},  \n      {.x/0 x, .y/1   y, .c/0 c1 c, .r |1 r},\n      {.x/0 x, .y/1   y, .c/1 c1 c, .r |0 r},\n      {.x/1 x, .y/0   y, .c/0 c0 c, .r |1 r},\n      {.x/1 x, .y/0   y, .c/1 c0 c, .r |0 r},\n      {.x/1 x, .y/1   y, .c/0 c0 c, .r |0 r},\n      {.x/1 x, .y/1   y, .c/1 c1 c, .r |1 r}\n    > _minus_\n  >\n;\n\nsign_plus = {}|'+';\nsign_minus = {}|'-';\nget_sign = </'+' sign_plus, /'-' sign_minus>;\n\ntimes =\n  {\n    <\n      {.x/'+' if, .y /'+' and} sign_plus, \n      {.x/'-' if, .y /'-' and} sign_plus, \n      sign_minus\n    > sign,\n    {\n      0b result,\n      .x abs inv _x,\n      .y abs y\n    } _times result\n  }\n  <\n    {.sign/'+' if, .result inv int then} .then,\n    {.sign/'-' if, .result inv int swap_sign then} .then \n  >\n;\n\n_times =\n  ?{ <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    { .y empty? if, .result then } .then,\n    <\n      { \n        .result |0  result, \n        ._x _x, \n        .y /0 y\n      },\n      { \n        {._x x, .result |0  y, c0 c } _plus result, \n        ._x _x, \n        .y /1 y \n      }\n    > _times\n  >\n;\n\n// ----------------------------------------------------------------------\n// Integer Division: Adaptive Hybrid Algorithm\n// ----------------------------------------------------------------------\n\nshift_in_0 = inv |0 inv nat;\nshift_in_1 = inv |1 inv nat;\nsub_bits = {.x inv x, .y inv y, c0 c} _minus inv nat;\n\n_div_restoring =\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.x empty? if, {.q inv int div, .r rem} then} .then,\n    <\n      {.x /0 x, .r shift_in_0 r, .y y, .q q},\n      {.x /1 x, .r shift_in_1 r, .y y, .q q}\n    >\n    {\n      .x x,\n      .y y,\n      .q q,\n      .r r,\n      {.y x, .r y} inOrder test\n    }\n    <\n      {.test /yes if, {.x x, .y y, .q |1 q, {.r x, .y y} sub_bits r} then} .then,\n      {.test /no  if, {.x x, .y y, .q |0 q, .r r} then} .then\n    >\n    _div_restoring\n  >;\n\n_pad_down = ?{ <X 0, X 1, {} _>=X x, <S 0, S 1, {} _>=S steps, ... }\n  <\n    {.x empty? if, {._y _y, .steps steps} then} .then,\n    {\n      .x </0, /1> x,\n      ._y |0 _y,\n      .steps |0 steps\n    } _pad_down\n  >;\n\n_align_down = ?{ <X 0, X 1, {} _>=X x, <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    {\n      .x </0, /1> x,\n      .y </0, /1> y,\n      ._y _y\n    } _align_down,\n\n    {\n      .y empty? if,\n      {.x x, ._y _y, 0b steps} _pad_down then\n    } .then,\n\n    {\n      .x empty? if,\n      .y empty? and,\n      {._y _y, 0b steps} then\n    } .then\n  >;\n\n_div_down = ?{ <X 0, X 1, {} _>=X steps, ... }\n  {\n    .x x,\n    ._y _y,\n    .steps steps,\n    .q q,\n    ._y inv nat y_scaled\n  }\n  {\n    .x x,\n    ._y _y,\n    .steps steps,\n    .q q,\n    .y_scaled y_scaled,\n    {.y_scaled x, .x y} inOrder test\n  }\n  <\n    {\n      .test /yes if,\n      {\n        {.x int x, .y_scaled int y} minus /+ x,\n        .q |1 q,\n        ._y _y,\n        .steps steps\n      } then\n    } .then,\n    {\n      .test /no if,\n      {.x x, .q |0 q, ._y _y, .steps steps} then\n    } .then\n  >\n  <\n    {\n      .steps empty? if,\n      {.q inv int div, .x rem} then\n    } .then,\n    {\n      .x x,\n      ._y /0 _y,\n      .steps /0 steps,\n      .q q\n    } _div_down\n  >;\n\n_check_2y = ?{ <X 0, X 1, {} _>=X x, <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    {.x empty? if, {} | down_shift then} .then,\n    {.y empty? if, {} | restore then} .then,\n    {.x </0, /1> empty? if, {} | down_shift then} .then,\n    {\n      .x </0, /1> </0, /1> x,\n      .y </0, /1> y\n    } _check_2y\n  >;\n\ndiv =\n  {\n    <\n      { .x/'+' if, .y get_sign then } .then,\n      { .x/'-' if, .y swap_sign get_sign then } .then\n    > sign,\n    .x abs remove_leading_zeros x_norm,\n    .y abs remove_leading_zeros y_norm\n  }\n  <\n    {\n      .x_norm empty? if,\n      { 0 int div, 0 rem } then\n    } .then,\n    {\n      {.y_norm x, .x_norm y} GT if,\n      { 0 int div, .x_norm rem } then\n    } .then,\n    {\n      .sign sign,\n      {\n        .x_norm x,\n        .y_norm y,\n        {.x_norm x, .y_norm y} _check_2y choice\n      }\n      <\n        {\n          .choice /down_shift if,\n          {\n            .x x,\n            {.x x, .y y, .y inv _y} _align_down aligned\n          }\n          {\n            .x x,\n            .aligned._y _y,\n            .aligned.steps steps,\n            0b q\n          } _div_down then\n        } .then,\n        {\n          .choice /restore if,\n          {.x x, .y y, 0 r, 0b q} _div_restoring then\n        } .then\n      > res\n    }\n    <\n      {.sign/'+' if, {.res.div div, .res.rem rem} then} .then,\n      { .res.div swap_sign div, .res.rem rem }\n    >\n  >;\n\nmod =\n  {{.x int x, .y int y} div .rem rem} .rem;\n\ngcd =\n  <\n    {.y x, .x y} GT, \n    ()\n  > _gcd\n;\n\n_gcd = ?{ <X 0, X 1, {} _>=X x, ... } <\n  { .y remove_leading_zeros empty? if, .x nat then } .then,\n  { .y x, mod y } _gcd\n>;\n\nlcm = \n  {{.x int x, gcd int y} div .div x, .y int y} times abs\n;\n\nfactorial = {()n, 1 int acc} factorial_;\nfactorial_ =  <\n  {.n zero_int? if, .acc then} .then,\n  {.n pos? dec n, {.n x, .acc y} times acc} factorial_\n>;\n\nfib_ =\n  <\n    {.n int zero_int? if, .\"fib(n),fib(n.1)\" then} .then,\n    { .n int dec /\"+\" n,\n      .\"fib(n),fib(n.1)\" {plus x, .x y} \"fib(n),fib(n.1)\"\n    } fib_\n  >\n;\n\nfib = {() n, {1 int x, 0 int y} \"fib(n),fib(n.1)\"} fib_ .x;\n\n--------------------\n\nrat = {.n int n, .d int d } normalize_rat;\n\nnormalize_rat =\n  < \n    { .d/\"-\" if, \n      {\n        .n swap_sign n, \n        .d swap_sign d\n      } then\n     } .then,\n    ()\n  >\n  {() x, {.n abs x,.d abs y} gcd int y}\n  {\n    {.x.n x,.y y} div .div n, \n    {.x.d x,.y y} div .div d\n  }\n;\n\nplus_rat = \n  { \n    .x x, \n    .y y,\n    {.x.d abs x,.y.d abs y} lcm int lcm\n  }\n  { \n    {\n      {.x.n x, {.lcm x, .x.d y} div .div y} times x,\n      {.y.n x, {.lcm x, .y.d y} div .div y} times y\n     } plus n, \n    .lcm d\n  }\n  normalize_rat\n;\n\ntimes_rat = \n  { \n    {.x.n x,.y.n y} times n, \n    {.x.d x,.y.d y} times d\n  } \n  normalize_rat;\n\nminus_rat = \n  {\n    .x x, \n    .y {.n swap_sign n, .d d} y\n  } \n  plus_rat;\n\ninverse_rat = \n  { .d n, .n d }\n  normalize_rat\n;\n\ndiv_rat = \n  { .x x, .y inverse_rat y} times_rat\n;\n\nint_rat = \n  { .n n, .d d, {.n x,.d y} div div }\n  { .div.div int, {.div.rem int n, .d d} rat}\n;\n\n()",
   "Examples/arithmetics.k": "-- Examples for defining arithmetic functions natively\nswap_yes_no = < /yes |no, /no |yes >;\nyes = {}|yes;\nno = yes swap_yes_no;\n\nbits = ?< {} _, bits 0, bits 1 > = bits;\n\n0b = {} | _;\n-- |1 = | 1;\n-- |0  = | 0;\n\n0 = 0b |0;\nsucc = {inv x, 0b y} _inc;\n1 = 0 succ;\n2 = 1 succ;\n3 = 2 succ;\n4 = 3 succ;\n5 = 4 succ;\n6 = 5 succ;\n7 = 6 succ;\n8 = 7 succ;\n9 = 8 succ;\n10 = 9 succ;\n11 = 10 succ;\n12 = 11 succ;\n\nempty = < /_ yes, no >;\nempty? = {empty /yes if, () then} .then;\n\nconcat = {.x inv x, .y y} concat_; \nconcat_ = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x empty? if, .y then} .then,\n    < \n      {.x /0 x, .y |0 y}, \n      {.x /1 x, .y |1 y}\n    > concat_ \n  >;\ninv = {()x, 0b r} _inv; \n_inv = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x empty? if, .r then} .then,\n    < \n      {.x /0 x, .r |0 r}, \n      {.x /1 x, .r |1 r}\n   > _inv\n  >;\n\ninOrder = {.x inv x, .y inv y, yes inOrder} inOrder_;\ninOrder_ = ?{ <X 0, X 1, {} _>=X x, ... }\n  < \n    {.x </0,/1> if1, .y /_ if2, .inOrder swap_yes_no then} .then,\n    {.x /_ if, .inOrder then} .then,\n    < \n      {.x /0 x, .y /0 y, .inOrder inOrder}, \n      {.x /1 x, .y /1 y, .inOrder inOrder},\n      {.x /0 x, .y /1 y, .inOrder inOrder}, \n      {.x /1 y, .y /0 x, .inOrder swap_yes_no inOrder}\n    > inOrder_\n  >;\n\nGT = {inOrder /no if, () then} . then;\n\nEQ = {inOrder /yes if, {.x y, .y x} inOrder /yes and, () then} .then;\n\n--------------------------------------\nint = ?< <bits 0, bits 1, {} _>=bits \"+\", bits \"-\" >;\n\nremove_leading_zeros = <\n  /0 remove_leading_zeros, \n  ()\n>;\nnat = remove_leading_zeros <empty? 0, ()>;\nint = nat | '+';\nabs = </'+',/'-'>;\n\npos? = {/'+' remove_leading_zeros /1 if, () then} .then;\nneg? = {/'-' if, () then} .then; \nzero_int? = {/'+' /0 empty? if, () then} .then;\nminus_one? = {/'-' /1 empty? if, () then} .then;\n\ninc = <\n  /'+' {inv x, 0b y} _inc nat |'+',\n  minus_one? 0 int,\n  /'-' {inv x, 0b y} _dec nat |'-'\n>;\n\n_inc = ?{ <X 0, X 1, {} _>=X x, ... } <\n    {.x empty? if, .y |1 then} .then,\n    {.x /0 x, .y |1 y} concat_, \n    {.x /1 x, .y |0  y} _inc\n>; \n\ndec = <\n  zero_int? 1 |'-',\n  /'+' {inv x, 0b y} _dec nat |'+',\n  /'-' {inv x, 0b y} _inc nat |'-'\n>;\n\n_dec = ?{ <X 0, X 1, {} _>=X x, ... } <\n    {.x /1 x, .y |0  y} concat_, \n    {.x /0 x, .y |1 y} _dec\n>;\n\nc0 = {}|0;\nc1 = {}|1;\n\nplus =\n< \n  {.x/'+' inv x, .y/'+' inv y, c0 c } _plus inv nat | '+',\n  {.x/'-' inv x, .y/'-' inv y, c0 c } _plus inv nat | '-',\n  {.y/'-' x, .x/'+' y} GT {.x inv x, .y inv y, c0 c} _minus inv nat | '-',\n  {.x/'+' inv x, .y/'-' inv y, c0 c} _minus inv nat |'+',\n  {.x/'-' x, .y/'+' y} GT {.x inv x, .y inv y, c0 c} _minus inv nat | '-',\n  {.y/'+' inv x, .x/'-' inv y, c0 c} _minus inv nat | '+'\n>;\n\nswap_sign = <\n  zero_int?,\n  /'+' | '-',\n  /'-' | '+'\n>;\n\nminus =\n  {.x x, .y swap_sign y} plus;\n\n_plus = {.x x, .y y, .c c, 0b r} _plus_;\n\n_plus_ =\n  -- least significant bit first addition with carry\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.x empty? if, .y empty? and, .c/0 c, .r inv then} .then,\n    {.x empty? if, .y empty? and, {.r x, 1 r} _inv then} .then,\n    {.x empty? if, .c/0 and, {.r x, .y r} _inv then} .then,\n\n    <\n      {.x y, .y empty? x, .c c, .r r},\n      {<.c/0 0, 1> x, .y y, .x empty? c0 c, .r r},\n\n      {.x /0 x, .y /0 y, .c/0 c0 c, .r |0 r},\n      {.x /0 x, .y /0 y, .c/1 c0 c, .r |1 r},\n\n      {.x /0 x, .y /1 y, .c/0 c0 c, .r |1 r},\n      {.x /0 x, .y /1 y, .c/1 c1 c, .r |0 r},\n      {.x /1 x, .y /0 y, .c/0 c0 c, .r |1 r},\n      {.x /1 x, .y /0 y, .c/1 c1 c, .r |0 r},\n\n      {.x /1 x, .y /1 y, .c/0 c1 c, .r |0 r},\n      {.x /1 x, .y /1 y, .c/1 c1 c, .r |1 r}\n    > _plus_\n  >\n;\n\n_minus = {.x x, .y y, .c c, 0b r} _minus_;\n\n_minus_ =\n  -- least significant bit first substraction with carry\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.y empty? if, .c/0 and, {.r x, .x r} _inv then} .then,\n    <\n      {.x/0 x, .y empty? y, .c/1 c1 c, .r |1 r},\n      {.x/1 x, .y empty? y, .c/1 c0 c, .r |0 r},\n\n      {.x/0 x, .y/0   y, .c/0 c0 c, .r |0 r},\n      {.x/0 x, .y/0   y, .c/1 c1 c, .r |1 r},  \n      {.x/0 x, .y/1   y, .c/0 c1 c, .r |1 r},\n      {.x/0 x, .y/1   y, .c/1 c1 c, .r |0 r},\n      {.x/1 x, .y/0   y, .c/0 c0 c, .r |1 r},\n      {.x/1 x, .y/0   y, .c/1 c0 c, .r |0 r},\n      {.x/1 x, .y/1   y, .c/0 c0 c, .r |0 r},\n      {.x/1 x, .y/1   y, .c/1 c1 c, .r |1 r}\n    > _minus_\n  >\n;\n\nsign_plus = {}|'+';\nsign_minus = {}|'-';\nget_sign = </'+' sign_plus, /'-' sign_minus>;\n\ntimes =\n  {\n    <\n      {.x/'+' if, .y /'+' and} sign_plus, \n      {.x/'-' if, .y /'-' and} sign_plus, \n      sign_minus\n    > sign,\n    {\n      0b result,\n      .x abs inv _x,\n      .y abs y\n    } _times result\n  }\n  <\n    {.sign/'+' if, .result inv int then} .then,\n    {.sign/'-' if, .result inv int swap_sign then} .then \n  >\n;\n\n_times =\n  ?{ <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    { .y empty? if, .result then } .then,\n    <\n      { \n        .result |0  result, \n        ._x _x, \n        .y /0 y\n      },\n      { \n        {._x x, .result |0  y, c0 c } _plus result, \n        ._x _x, \n        .y /1 y \n      }\n    > _times\n  >\n;\n\n// ----------------------------------------------------------------------\n// Integer Division: Adaptive Hybrid Algorithm\n// ----------------------------------------------------------------------\n\nshift_in_0 = inv |0 inv nat;\nshift_in_1 = inv |1 inv nat;\nsub_bits = {.x inv x, .y inv y, c0 c} _minus inv nat;\n\n_div_restoring =\n  ?{ <X 0, X 1, {} _>=X x, ... }\n  <\n    {.x empty? if, {.q inv int div, .r rem} then} .then,\n    <\n      {.x /0 x, .r shift_in_0 r, .y y, .q q},\n      {.x /1 x, .r shift_in_1 r, .y y, .q q}\n    >\n    {\n      .x x,\n      .y y,\n      .q q,\n      .r r,\n      {.y x, .r y} inOrder test\n    }\n    <\n      {.test /yes if, {.x x, .y y, .q |1 q, {.r x, .y y} sub_bits r} then} .then,\n      {.test /no  if, {.x x, .y y, .q |0 q, .r r} then} .then\n    >\n    _div_restoring\n  >;\n\n_pad_down = ?{ <X 0, X 1, {} _>=X x, <S 0, S 1, {} _>=S steps, ... }\n  <\n    {.x empty? if, {._y _y, .steps steps} then} .then,\n    {\n      .x </0, /1> x,\n      ._y |0 _y,\n      .steps |0 steps\n    } _pad_down\n  >;\n\n_align_down = ?{ <X 0, X 1, {} _>=X x, <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    {\n      .x </0, /1> x,\n      .y </0, /1> y,\n      ._y _y\n    } _align_down,\n\n    {\n      .y empty? if,\n      {.x x, ._y _y, 0b steps} _pad_down then\n    } .then,\n\n    {\n      .x empty? if,\n      .y empty? and,\n      {._y _y, 0b steps} then\n    } .then\n  >;\n\n_div_down = ?{ <X 0, X 1, {} _>=X steps, ... }\n  {\n    .x x,\n    ._y _y,\n    .steps steps,\n    .q q,\n    ._y inv nat y_scaled\n  }\n  {\n    .x x,\n    ._y _y,\n    .steps steps,\n    .q q,\n    .y_scaled y_scaled,\n    {.y_scaled x, .x y} inOrder test\n  }\n  <\n    {\n      .test /yes if,\n      {\n        {.x int x, .y_scaled int y} minus /+ x,\n        .q |1 q,\n        ._y _y,\n        .steps steps\n      } then\n    } .then,\n    {\n      .test /no if,\n      {.x x, .q |0 q, ._y _y, .steps steps} then\n    } .then\n  >\n  <\n    {\n      .steps empty? if,\n      {.q inv int div, .x rem} then\n    } .then,\n    {\n      .x x,\n      ._y /0 _y,\n      .steps /0 steps,\n      .q q\n    } _div_down\n  >;\n\n_check_2y = ?{ <X 0, X 1, {} _>=X x, <Y 0, Y 1, {} _>=Y y, ... }\n  <\n    {.x empty? if, {} | down_shift then} .then,\n    {.y empty? if, {} | restore then} .then,\n    {.x </0, /1> empty? if, {} | down_shift then} .then,\n    {\n      .x </0, /1> </0, /1> x,\n      .y </0, /1> y\n    } _check_2y\n  >;\n\ndiv =\n  {\n    <\n      { .x/'+' if, .y get_sign then } .then,\n      { .x/'-' if, .y swap_sign get_sign then } .then\n    > sign,\n    .x abs remove_leading_zeros x_norm,\n    .y abs remove_leading_zeros y_norm\n  }\n  <\n    {\n      .x_norm empty? if,\n      { 0 int div, 0 rem } then\n    } .then,\n    {\n      {.y_norm x, .x_norm y} GT if,\n      { 0 int div, .x_norm rem } then\n    } .then,\n    {\n      .sign sign,\n      {\n        .x_norm x,\n        .y_norm y,\n        {.x_norm x, .y_norm y} _check_2y choice\n      }\n      <\n        {\n          .choice /down_shift if,\n          {\n            .x x,\n            {.x x, .y y, .y inv _y} _align_down aligned\n          }\n          {\n            .x x,\n            .aligned._y _y,\n            .aligned.steps steps,\n            0b q\n          } _div_down then\n        } .then,\n        {\n          .choice /restore if,\n          {.x x, .y y, 0 r, 0b q} _div_restoring then\n        } .then\n      > res\n    }\n    <\n      {.sign/'+' if, {.res.div div, .res.rem rem} then} .then,\n      { .res.div swap_sign div, .res.rem rem }\n    >\n  >;\n\nmod =\n  {{.x int x, .y int y} div .rem rem} .rem;\n\ngcd =\n  <\n    {.y x, .x y} GT, \n    ()\n  > _gcd\n;\n\n_gcd = ?{ <X 0, X 1, {} _>=X x, ... } <\n  { .y remove_leading_zeros empty? if, .x nat then } .then,\n  { .y x, mod y } _gcd\n>;\n\nlcm = \n  {{.x int x, gcd int y} div .div x, .y int y} times abs\n;\n\nfactorial = {()n, 1 int acc} factorial_;\nfactorial_ =  <\n  {.n zero_int? if, .acc then} .then,\n  {.n pos? dec n, {.n x, .acc y} times acc} factorial_\n>;\n\nfib_ =\n  <\n    {.n int zero_int? if, .\"fib(n),fib(n.1)\" then} .then,\n    { .n int dec /\"+\" n,\n      .\"fib(n),fib(n.1)\" {plus x, .x y} \"fib(n),fib(n.1)\"\n    } fib_\n  >\n;\n\nfib = {() n, {1 int x, 0 int y} \"fib(n),fib(n.1)\"} fib_ .x;\n\n--------------------\n\nrat = {.n int n, .d int d } normalize_rat;\n\nnormalize_rat =\n  < \n    { .d/\"-\" if, \n      {\n        .n swap_sign n, \n        .d swap_sign d\n      } then\n     } .then,\n    ()\n  >\n  {() x, {.n abs x,.d abs y} gcd int y}\n  {\n    {.x.n x,.y y} div .div n, \n    {.x.d x,.y y} div .div d\n  }\n;\n\nplus_rat = \n  { \n    .x x, \n    .y y,\n    {.x.d abs x,.y.d abs y} lcm int lcm\n  }\n  { \n    {\n      {.x.n x, {.lcm x, .x.d y} div .div y} times x,\n      {.y.n x, {.lcm x, .y.d y} div .div y} times y\n     } plus n, \n    .lcm d\n  }\n  normalize_rat\n;\n\ntimes_rat = \n  { \n    {.x.n x,.y.n y} times n, \n    {.x.d x,.y.d y} times d\n  } \n  normalize_rat;\n\nminus_rat = \n  {\n    .x x, \n    .y {.n swap_sign n, .d d} y\n  } \n  plus_rat;\n\ninverse_rat = \n  { .d n, .n d }\n  normalize_rat\n;\n\ndiv_rat = \n  { .x x, .y inverse_rat y} times_rat\n;\n\nint_rat = \n  { .n n, .d d, {.n x,.d y} div div }\n  { .div.div int, {.div.rem int n, .d d} rat}\n;\n\n()",

package/kir.mjs

@@ -8,6 +8,7 @@ import { compileObject, decodeObject, hydrateObject } from "./object.mjs";
 import { exportPatternGraph } from "./codecs/runtime/codec.mjs";
 import { patternToPropertyList } from "./codecs/runtime/pattern-json.mjs";
 import { propertyListToFilter } from "./codecs/runtime/show-value.mjs";
+import { TypePatternGraph } from "./TypePatternGraph.mjs";
 
 const KIR_FORMAT = "k-ir";
 const KIR_VERSION = 1;
@@ -240,6 +241,11 @@ function resolveRelation(object, relationName = null) {
   const alias = object.relAlias?.[name];
   if (alias && object.rels?.[alias]) return { name: alias, rel: object.rels[alias] };
   if (alias && object.rels?.[name]) return { name, rel: object.rels[name] };
+  if (alias) {
+    for (const [k, rel] of Object.entries(object.rels || {})) {
+      if (object.relAlias?.[k] === alias) return { name: k, rel };
+    }
+  }
 
   throw new Error(`Relation '${name}' not found`);
 }
@@ -264,7 +270,188 @@ function relationLibraryWithTarget(object, targetRel) {
   };
 }
 
-function relationPatternPropertyList(rel, index) {
+function addPropertyListToPatternGraph(graph, propertyList) {
+  const kindToPattern = {
+    any: "(...)",
+    "open-product": "{...}",
+    "open-union": "<...>",
+    "closed-product": "{}",
+    "closed-union": "<>"
+  };
+  const nodes = propertyList.map(([kind]) =>
+    graph.addNewNode({ pattern: kindToPattern[kind] })
+  );
+
+  propertyList.forEach(([, edges], nodeIndex) => {
+    for (const [label, target] of edges) {
+      graph.edges[nodes[nodeIndex]][label] = [nodes[target]];
+    }
+  });
+
+  return nodes[0];
+}
+
+function cloneRelation(rel) {
+  const clonedGraph = new TypePatternGraph(
+    rel.typePatternGraph.registerCodeDef,
+    rel.typePatternGraph.findCode
+  );
+  clonedGraph.patterns.nodes = JSON.parse(JSON.stringify(rel.typePatternGraph.patterns.nodes));
+  clonedGraph.patterns.parent = [...rel.typePatternGraph.patterns.parent];
+  clonedGraph.edges = JSON.parse(JSON.stringify(rel.typePatternGraph.edges));
+  clonedGraph.codeId = { ...rel.typePatternGraph.codeId };
+
+  return {
+    ...rel,
+    def: JSON.parse(JSON.stringify(rel.def)),
+    typePatternGraph: clonedGraph,
+    typeDerivation: { ...(rel.typeDerivation || {}) }
+  };
+}
+
+function findCallSites(exp) {
+  const calls = [];
+  function visit(node) {
+    if (!node) return;
+    if (node.op === "ref") calls.push(node);
+    if (node.comp) node.comp.forEach(visit);
+    if (node.items) node.items.forEach(visit);
+    if (node.union) node.union.forEach(visit);
+    if (node.product) node.product.forEach((item) => visit(item.exp));
+    if (node.fields) node.fields.forEach((item) => visit(item.expr));
+  }
+  visit(exp);
+  return calls;
+}
+
+function findRelation(rels, relAlias, name) {
+  if (!name) return null;
+  if (rels[name]) return { name, rel: rels[name] };
+  const alias = relAlias?.[name];
+  if (alias && rels[alias]) return { name: alias, rel: rels[alias] };
+  if (alias) {
+    for (const [k, rel] of Object.entries(rels)) {
+      if (relAlias?.[k] === alias) return { name: k, rel };
+    }
+  }
+  return null;
+}
+
+export function specializeObjectRelations(object, entryRelationName = null, inputPattern = null) {
+  if (object?.format !== "k-object") {
+    throw new Error("specializeObjectRelations requires a k object");
+  }
+
+  const baseRels = Object.fromEntries(
+    Object.entries(object.rels || {}).map(([name, rel]) => [name, cloneRelation(rel)])
+  );
+  for (const [aliasName, hash] of Object.entries(object.relAlias || {})) {
+    if (!baseRels[aliasName]) {
+      const match = Object.entries(baseRels).find(([k]) => object.relAlias?.[k] === hash);
+      if (match) baseRels[aliasName] = match[1];
+    }
+  }
+
+  const entry = findRelation(
+    baseRels,
+    object.relAlias,
+    entryRelationName || object.main || "__main__"
+  );
+  if (!entry) return object;
+
+  const specializedRels = new Map();
+  const specializedCounts = new Map();
+  const newRels = {};
+
+  const entryRel = cloneRelation(entry.rel);
+  newRels[entry.name] = entryRel;
+
+  if (Array.isArray(inputPattern) && inputPattern.length > 0) {
+    const inRoot = addPropertyListToPatternGraph(entryRel.typePatternGraph, inputPattern);
+    try {
+      entryRel.typePatternGraph.unify("specialize", entryRel.def.patterns[0], inRoot);
+    } catch {
+      // Best-effort entry unification
+    }
+    specializedRels.set(entry.name + "::" + JSON.stringify(inputPattern), entry.name);
+  }
+
+  const worklist = [entry.name];
+  while (worklist.length > 0) {
+    const currentName = worklist.shift();
+    const currentRel = newRels[currentName];
+    if (!currentRel) continue;
+
+    const calls = findCallSites(currentRel.def);
+    for (const call of calls) {
+      const target = findRelation(baseRels, object.relAlias, call.ref);
+      if (!target) continue;
+
+      const argPatternId = call.patterns?.[0];
+      if (argPatternId != null) {
+        const argRoot = currentRel.typePatternGraph.find(argPatternId);
+        const argPropList = patternToPropertyList(
+          exportPatternGraph(currentRel.typePatternGraph, argRoot)
+        );
+        const argSig = JSON.stringify(argPropList);
+        const specKey = target.name + "::" + argSig;
+
+        let specName = specializedRels.get(specKey);
+        if (!specName) {
+          const count = (specializedCounts.get(target.name) || 0) + 1;
+          specializedCounts.set(target.name, count);
+          specName = count === 1 ? target.name : `${target.name}$${count}`;
+          specializedRels.set(specKey, specName);
+
+          const targetRel = cloneRelation(target.rel);
+          const tInRoot = addPropertyListToPatternGraph(targetRel.typePatternGraph, argPropList);
+          try {
+            targetRel.typePatternGraph.unify("specialize", targetRel.def.patterns[0], tInRoot);
+          } catch {
+            // Unification failure: keep target unspecialized
+          }
+          newRels[specName] = targetRel;
+          worklist.push(specName);
+        }
+
+        call.ref = specName;
+
+        const targetRel = newRels[specName];
+        const outPatternId = targetRel.def.patterns?.[1];
+        const retPatternId = call.patterns?.[1];
+        if (outPatternId != null && retPatternId != null) {
+          const outRoot = targetRel.typePatternGraph.find(outPatternId);
+          const retPropList = patternToPropertyList(
+            exportPatternGraph(targetRel.typePatternGraph, outRoot)
+          );
+          const rRetRoot = addPropertyListToPatternGraph(currentRel.typePatternGraph, retPropList);
+          try {
+            currentRel.typePatternGraph.unify("specialize", retPatternId, rRetRoot);
+          } catch {
+            // Keep existing call return pattern on unification error
+          }
+        }
+      }
+    }
+  }
+
+  const resultRels = {
+    ...baseRels,
+    ...newRels
+  };
+  const resultRelAlias = { ...(object.relAlias || {}) };
+  for (const name of Object.keys(newRels)) {
+    if (!resultRelAlias[name]) resultRelAlias[name] = name;
+  }
+
+  return {
+    ...object,
+    rels: resultRels,
+    relAlias: resultRelAlias
+  };
+}
+
+export function relationPatternPropertyList(rel, index) {
   return expPatternPropertyList(rel, rel.def, index);
 }
 
@@ -284,28 +471,35 @@ export function retypeObjectRelationForBackend(object, relationName, inputPatter
   }
 
   const target = resolveRelation(object, relationName);
-  const source = `?${propertyListToFilter(inputPattern)} __kir_target__`;
-  const retypedObject = hydrateObject(compileObject(source, {
-    source: options.source || "<kir-retype>",
-    libraries: [relationLibraryWithTarget(object, target.rel)]
-  }));
-  const kir = objectToKIRP(retypedObject);
-  const entryName = retypedObject.main || "__main__";
-  const retypedRel = retypedObject.rels[entryName];
-  const entryInputPattern = relationPatternPropertyList(retypedRel, 0);
+  const specializedObject = specializeObjectRelations(object, target.name, inputPattern);
+  const specializedRel = resolveRelation(specializedObject, target.name);
+  const kir = objectToKIRP(specializedObject);
 
   return {
-    relation: relationName || object.main,
-    retypedObject,
+    relation: target.name,
+    retypedObject: specializedObject,
     kir,
-    entryName,
-    inputPattern: entryInputPattern,
-    outputPattern: relationPatternPropertyList(retypedRel, 1)
+    entryName: target.name,
+    inputPattern: relationPatternPropertyList(specializedRel.rel, 0),
+    outputPattern: relationPatternPropertyList(specializedRel.rel, 1)
   };
 }
 
 export function retypeObjectRelation(object, relationName, inputPattern, options = {}) {
-  return retypeObjectRelationForBackend(object, relationName, inputPattern, options).kir;
+  if (object?.format !== "k-object") {
+    throw new Error("KIR retyping requires a k object");
+  }
+  if (!Array.isArray(inputPattern)) {
+    throw new Error("KIR retyping requires an input pattern property list");
+  }
+
+  const target = resolveRelation(object, relationName);
+  const source = `?${propertyListToFilter(inputPattern)} __kir_target__`;
+  const retypedObject = hydrateObject(compileObject(source, {
+    source: options.source || "<kir-retype>",
+    libraries: [relationLibraryWithTarget(object, target.rel)]
+  }));
+  return objectToKIRP(retypedObject);
 }
 
 export { KIR_FORMAT, KIR_VERSION };
@@ -314,8 +508,10 @@ export default {
   KIR_FORMAT,
   KIR_VERSION,
   objectToKIRP,
+  relationPatternPropertyList,
   retypeObjectRelation,
-  retypeObjectRelationForBackend
+  retypeObjectRelationForBackend,
+  specializeObjectRelations
 };
 
 function helpText() {

package/package.json

@@ -1,6 +1,6 @@
 {
     "name": "@fraczak/k",
-    "version": "7.0.0",
+    "version": "7.0.1",
     "description": "k — a language for content-addressable schemas and data transformations over algebraic data types (products and tagged unions); includes runtime, contract derivation, REPL, and codec toolchain",
     "publishConfig": {
         "access": "public"