Initial PHP host implementation

ext/php/src/codecs.php

@@ -0,0 +1,203 @@
+<?php
+
+declare(strict_types=1);
+
+namespace Arboricx;
+
+use function Arboricx\{leaf, stem, fork, isLeaf, isStem, isFork, reduce, stemChild, forkLeft, forkRight, same_tree, formatTree};
+
+function ofNumber(int $n): int
+{
+    if ($n < 0) throw new \InvalidArgumentException('ofNumber: negative values not supported');
+    if ($n === 0) return leaf();
+    $bitTree = ($n % 2) === 1 ? stem(leaf()) : leaf();
+    return fork($bitTree, ofNumber(intdiv($n, 2)));
+}
+
+function toNumber(int $tree): array
+{
+    $tree = reduce($tree);
+    if (isLeaf($tree)) return [true, 0];
+    if (!isFork($tree)) return [false, 'Invalid Tree Calculus number'];
+
+    $bitTree = reduce(forkLeft($tree));
+    if (isLeaf($bitTree)) {
+        $bit = 0;
+    } elseif (isStem($bitTree) && isLeaf(stemChild($bitTree))) {
+        $bit = 1;
+    } else {
+        return [false, 'Invalid bit in Tree Calculus number'];
+    }
+
+    [$ok, $rest] = toNumber(forkRight($tree));
+    return $ok ? [true, $bit + 2 * $rest] : [false, $rest];
+}
+
+function ofList(array $elements): int
+{
+    $result = leaf();
+    for ($i = count($elements) - 1; $i >= 0; $i--) {
+        $result = fork($elements[$i], $result);
+    }
+    return $result;
+}
+
+function toList(int $tree): array
+{
+    $tree = reduce($tree);
+    if (isLeaf($tree)) return [true, []];
+    if (!isFork($tree)) return [false, 'Invalid Tree Calculus list'];
+
+    [$ok, $rest] = toList(forkRight($tree));
+    if (!$ok) return [false, $rest];
+    array_unshift($rest, forkLeft($tree));
+    return [true, $rest];
+}
+
+function ofString(string $s): int
+{
+    $bytes = [];
+    for ($i = 0, $len = strlen($s); $i < $len; $i++) {
+        $bytes[] = ofNumber(ord($s[$i]));
+    }
+    return ofList($bytes);
+}
+
+function toString(int $tree): array
+{
+    [$ok, $elements] = toList($tree);
+    if (!$ok) return [false, $elements];
+
+    $result = '';
+    foreach ($elements as $elem) {
+        [$ok2, $num] = toNumber($elem);
+        if (!$ok2 || $num < 0 || $num > 255) {
+            return [false, 'Invalid character code in Tree Calculus string'];
+        }
+        $result .= chr($num);
+    }
+    return [true, $result];
+}
+
+function ofBytes(string $s): int
+{
+    return ofString($s);
+}
+
+function toBytes(int $tree): array
+{
+    return toString($tree);
+}
+
+function unwrapResult(int $tree): array
+{
+    $tree = reduce($tree);
+    if (!isFork($tree)) return ['error', null, 'Result is not a valid ok/err pair'];
+
+    $tag = reduce(forkLeft($tree));
+    $restPair = reduce(forkRight($tree));
+    if (!isFork($restPair)) return ['error', null, 'Result payload is not a valid pair'];
+
+    $value = forkLeft($restPair);
+    $rest = forkRight($restPair);
+    $isTrue = same_tree($tag, stem(leaf()));
+    return $isTrue ? ['ok', $value, $rest] : ['err', $value, $rest];
+}
+
+const HOST_TREE_TAG   = 0;
+const HOST_STRING_TAG = 1;
+const HOST_NUMBER_TAG = 2;
+const HOST_BOOL_TAG   = 3;
+const HOST_LIST_TAG   = 4;
+const HOST_BYTES_TAG  = 5;
+
+function unwrapHostValue(int $tree): array
+{
+    $tree = reduce($tree);
+    if (!isFork($tree)) throw new \InvalidArgumentException('Host ABI value must be a pair');
+
+    $tag = reduce(forkLeft($tree));
+    $payload = forkRight($tree);
+    [$ok, $tagNum] = toNumber($tag);
+    if (!$ok) throw new \InvalidArgumentException('Host ABI tag must be a number');
+    return [(int)$tagNum, $payload];
+}
+
+function isBool(int $tree): bool
+{
+    $tree = reduce($tree);
+    return isLeaf($tree) || (isStem($tree) && isLeaf(stemChild($tree)));
+}
+
+function isNumber(int $tree): bool
+{
+    [$ok, $_] = toNumber($tree);
+    return $ok;
+}
+
+function isList(int $tree): bool
+{
+    [$ok, $_] = toList($tree);
+    return $ok;
+}
+
+function isString(int $tree): bool
+{
+    [$ok, $elements] = toList($tree);
+    if (!$ok) return false;
+    foreach ($elements as $elem) if (!isNumber($elem)) return false;
+    return true;
+}
+
+function decodeHostPayload(int $tag, int $payload): array
+{
+    switch ($tag) {
+        case HOST_TREE_TAG:
+            return ['type' => 'tree', 'value' => formatTree($payload)];
+        case HOST_STRING_TAG:
+            [$ok, $str] = toString($payload);
+            if (!$ok) throw new \InvalidArgumentException('Host ABI string decode failed: ' . $str);
+            return ['type' => 'string', 'value' => $str];
+        case HOST_NUMBER_TAG:
+            [$ok, $num] = toNumber($payload);
+            if (!$ok) throw new \InvalidArgumentException('Host ABI number decode failed: ' . $num);
+            return ['type' => 'number', 'value' => $num];
+        case HOST_BOOL_TAG:
+            if (!isBool($payload)) throw new \InvalidArgumentException('Host ABI bool decode failed');
+            return ['type' => 'bool', 'value' => isLeaf(reduce($payload)) ? false : true];
+        case HOST_LIST_TAG:
+            [$ok, $xs] = toList($payload);
+            if (!$ok) throw new \InvalidArgumentException('Host ABI list decode failed: ' . $xs);
+            return ['type' => 'list', 'value' => $xs];
+        case HOST_BYTES_TAG:
+            [$ok, $bytes] = toBytes($payload);
+            if (!$ok) throw new \InvalidArgumentException('Host ABI bytes decode failed: ' . $bytes);
+            return ['type' => 'bytes', 'value' => $bytes];
+        default:
+            throw new \InvalidArgumentException('Unknown Host ABI tag: ' . $tag);
+    }
+}
+
+function decodeResult(int $tree): string
+{
+    $tree = reduce($tree);
+    if (isLeaf($tree)) return 't';
+
+    [$ok, $str] = toString($tree);
+    if ($ok && $str !== '') {
+        $valid = true;
+        for ($i = 0; $i < strlen($str); $i++) {
+            $n = ord($str[$i]);
+            if ($n < 32 || $n > 126) { $valid = false; break; }
+        }
+        if ($valid) return '"' . $str . '"';
+    }
+
+    [$ok, $num] = toNumber($tree);
+    if ($ok) return (string)$num;
+
+    [$ok, $xs] = toList($tree);
+    if ($ok) return '[' . implode(', ', array_map(fn($x) => decodeResult($x), $xs)) . ']';
+
+    return formatTree($tree);
+}

ext/php/src/functions.php

@@ -0,0 +1,259 @@
+<?php
+
+declare(strict_types=1);
+
+namespace Arboricx;
+
+/**
+ * Arena-backed Tree Calculus representation.
+ *
+ * Node refs are ints:
+ *   0 = Leaf
+ *   tag 1 = Stem(child)
+ *   tag 2 = Fork(left, right)
+ *   tag 3 = App(function, argument) -- evaluator-internal thunk
+ *   tag 4 = Ind(target)             -- update-in-place indirection
+ */
+
+$GLOBALS['ARB_TAG'] = [0 => 0];
+$GLOBALS['ARB_A']   = [0 => 0];
+$GLOBALS['ARB_B']   = [0 => 0];
+$GLOBALS['ARB_NEXT'] = 1;
+$GLOBALS['ARB_CONS_CACHE'] = [];
+
+function newNode(int $tag, int $a, int $b = 0): int
+{
+    $id = $GLOBALS['ARB_NEXT']++;
+    $GLOBALS['ARB_TAG'][$id] = $tag;
+    $GLOBALS['ARB_A'][$id] = $a;
+    $GLOBALS['ARB_B'][$id] = $b;
+    return $id;
+}
+
+function updateInd(int $node, int $target): void
+{
+    if ($node === 0 || $node === $target) return;
+    $GLOBALS['ARB_TAG'][$node] = 4;
+    $GLOBALS['ARB_A'][$node] = $target;
+    $GLOBALS['ARB_B'][$node] = 0;
+}
+
+function deref(int $t): int
+{
+    while ($t !== 0 && ($GLOBALS['ARB_TAG'][$t] ?? -1) === 4) {
+        $next = $GLOBALS['ARB_A'][$t];
+        if ($next === $t) break;
+        $t = $next;
+    }
+    return $t;
+}
+
+function leaf(): int { return 0; }
+function stem(int $child): int { return newNode(1, $child); }
+function fork(int $left, int $right): int { return newNode(2, $left, $right); }
+function appNode(int $f, int $x): int { return newNode(3, $f, $x); }
+function tree(): int { return 0; }
+
+function tag(int $t): int { $t = deref($t); return $GLOBALS['ARB_TAG'][$t] ?? -1; }
+function argA(int $t): int { $t = deref($t); return $GLOBALS['ARB_A'][$t]; }
+function argB(int $t): int { $t = deref($t); return $GLOBALS['ARB_B'][$t]; }
+
+function isLeaf(int $t): bool { return deref($t) === 0; }
+function isStem(int $t): bool { return tag($t) === 1; }
+function isFork(int $t): bool { return tag($t) === 2; }
+function isApp(int $t): bool { return tag($t) === 3; }
+function isTree(int $t): bool { $tag = tag($t); return $tag === 0 || $tag === 1 || $tag === 2; }
+function isTerm(int $t): bool { $tag = tag($t); return $tag === 0 || $tag === 1 || $tag === 2 || $tag === 3; }
+
+function stemChild(int $t): int { return argA($t); }
+function forkLeft(int $t): int { return argA($t); }
+function forkRight(int $t): int { return argB($t); }
+function appFunc(int $t): int { return argA($t); }
+function appArg(int $t): int { return argB($t); }
+
+function app(int $f, int $x): int { return appNode($f, $x); }
+
+function newStemFast(int $child, array &$TAG, array &$A, array &$B): int
+{
+    $id = $GLOBALS['ARB_NEXT']++;
+    $TAG[$id] = 1;
+    $A[$id] = $child;
+    $B[$id] = 0;
+    return $id;
+}
+
+function newForkFast(int $left, int $right, array &$TAG, array &$A, array &$B): int
+{
+    $id = $GLOBALS['ARB_NEXT']++;
+    $TAG[$id] = 2;
+    $A[$id] = $left;
+    $B[$id] = $right;
+    return $id;
+}
+
+function newAppFast(int $f, int $x, array &$TAG, array &$A, array &$B): int
+{
+    $id = $GLOBALS['ARB_NEXT']++;
+    $TAG[$id] = 3;
+    $A[$id] = $f;
+    $B[$id] = $x;
+    return $id;
+}
+
+function apply_(int $a, int $b, int $fuel = 1_000_000): int
+{
+    return reduce(app($a, $b), $fuel);
+}
+
+function reduce(int $term, int $fuel = 1_000_000): int
+{
+    return whnf($term, $fuel);
+}
+
+function whnf(int $term, int &$fuel): int
+{
+    $TAG =& $GLOBALS['ARB_TAG'];
+    $A   =& $GLOBALS['ARB_A'];
+    $B   =& $GLOBALS['ARB_B'];
+
+    while (true) {
+        // deref term
+        while ($term !== 0 && $TAG[$term] === 4) {
+            $term = $A[$term];
+        }
+
+        if ($TAG[$term] !== 3) {
+            return $term;
+        }
+
+        $orig = $term;
+        $f = whnf($A[$term], $fuel);
+        $x = $B[$term];
+
+        // deref function result
+        while ($f !== 0 && $TAG[$f] === 4) {
+            $f = $A[$f];
+        }
+        $ftag = $TAG[$f];
+
+        // apply Leaf b = Stem b
+        if ($f === 0) {
+            $result = newStemFast($x, $TAG, $A, $B);
+            if ($orig !== $result) { $TAG[$orig] = 4; $A[$orig] = $result; $B[$orig] = 0; }
+            return $result;
+        }
+
+        // apply (Stem a) b = Fork a b
+        if ($ftag === 1) {
+            $result = newForkFast($A[$f], $x, $TAG, $A, $B);
+            if ($orig !== $result) { $TAG[$orig] = 4; $A[$orig] = $result; $B[$orig] = 0; }
+            return $result;
+        }
+
+        if ($ftag !== 2) {
+            throw new \RuntimeException('apply: function did not reduce to tree');
+        }
+
+        $left = whnf($A[$f], $fuel);
+        $right = $B[$f];
+
+        // deref left
+        while ($left !== 0 && $TAG[$left] === 4) {
+            $left = $A[$left];
+        }
+        $ltag = $TAG[$left];
+
+        // apply (Fork Leaf a) _ = a
+        if ($left === 0) {
+            $term = $right;
+            if ($orig !== $term) { $TAG[$orig] = 4; $A[$orig] = $term; $B[$orig] = 0; }
+            continue;
+        }
+
+        // apply (Fork (Stem a) b) c = (a c) (b c)
+        if ($ltag === 1) {
+            $term = newAppFast(
+                newAppFast($A[$left], $x, $TAG, $A, $B),
+                newAppFast($right, $x, $TAG, $A, $B),
+                $TAG, $A, $B
+            );
+            if ($orig !== $term) { $TAG[$orig] = 4; $A[$orig] = $term; $B[$orig] = 0; }
+            continue;
+        }
+
+        if ($ltag !== 2) {
+            throw new \RuntimeException('apply: invalid Fork left child');
+        }
+
+        $arg = whnf($x, $fuel);
+        while ($arg !== 0 && $TAG[$arg] === 4) {
+            $arg = $A[$arg];
+        }
+        $atag = $TAG[$arg];
+
+        // apply (Fork (Fork a b) c) Leaf = a
+        if ($arg === 0) {
+            $term = $A[$left];
+            if ($orig !== $term) { $TAG[$orig] = 4; $A[$orig] = $term; $B[$orig] = 0; }
+            continue;
+        }
+
+        // apply (Fork (Fork a b) c) (Stem u) = b u
+        if ($atag === 1) {
+            $term = newAppFast($B[$left], $A[$arg], $TAG, $A, $B);
+            if ($orig !== $term) { $TAG[$orig] = 4; $A[$orig] = $term; $B[$orig] = 0; }
+            continue;
+        }
+
+        // apply (Fork (Fork a b) c) (Fork u v) = (c u) v
+        if ($atag === 2) {
+            $term = newAppFast(
+                newAppFast($right, $A[$arg], $TAG, $A, $B),
+                $B[$arg],
+                $TAG, $A, $B
+            );
+            if ($orig !== $term) { $TAG[$orig] = 4; $A[$orig] = $term; $B[$orig] = 0; }
+            continue;
+        }
+
+        throw new \RuntimeException('apply: argument did not reduce to tree');
+    }
+}
+
+function normalize(int $term, int &$fuel): int
+{
+    $term = whnf($term, $fuel);
+    if (isStem($term)) return stem(normalize(stemChild($term), $fuel));
+    if (isFork($term)) return fork(normalize(forkLeft($term), $fuel), normalize(forkRight($term), $fuel));
+    return $term;
+}
+
+function same_tree(int $a, int $b): bool
+{
+    $a = deref($a); $b = deref($b);
+    if ($a === $b) return true;
+    if (tag($a) !== tag($b)) return false;
+    if (isLeaf($a)) return true;
+    if (isStem($a)) return same_tree(stemChild($a), stemChild($b));
+    if (isFork($a)) return same_tree(forkLeft($a), forkLeft($b)) && same_tree(forkRight($a), forkRight($b));
+    if (isApp($a)) return same_tree(appFunc($a), appFunc($b)) && same_tree(appArg($a), appArg($b));
+    return false;
+}
+
+function typeTag(int $t): string
+{
+    return match (tag($t)) {
+        0 => 'leaf', 1 => 'stem', 2 => 'fork', 3 => 'app', 4 => 'ind', default => 'unknown'
+    };
+}
+
+function formatTree(int $t, int $depth = 0): string
+{
+    $t = deref($t);
+    if ($depth > 200) return '...';
+    if (isLeaf($t)) return 'Leaf';
+    if (isStem($t)) return 'Stem(' . formatTree(stemChild($t), $depth + 1) . ')';
+    if (isFork($t)) return 'Fork(' . formatTree(forkLeft($t), $depth + 1) . ', ' . formatTree(forkRight($t), $depth + 1) . ')';
+    if (isApp($t)) return 'App(' . formatTree(appFunc($t), $depth + 1) . ', ' . formatTree(appArg($t), $depth + 1) . ')';
+    return 'Unknown';
+}

ext/php/src/kernel.php

@@ -0,0 +1,164 @@
+<?php
+
+declare(strict_types=1);
+
+namespace Arboricx;
+
+/**
+ * kernel.php — Hardcoded tricu kernel entrypoints.
+ *
+ * The kernel is the self-hosted Arboricx runtime written in Tree Calculus,
+ * compiled to a raw Tree Calculus term. We hardcode it as a **ternary string**
+ * and parse it on demand.
+ *
+ * Ternary string format (from Research.hs toTernaryString):
+ *   '0' → Leaf
+ *   '1' ++ rest → Stem(parse(rest))
+ *   '2' ++ rest → Fork(parse(rest), parse(rest))
+ *
+ * The Kernel class holds these constants and exposes them as Tree values.
+ */
+
+use function Arboricx\{leaf, stem, fork, isLeaf, isStem, isFork};
+
+// ── Kernel constants ────────────────────────────────────────────────────────
+
+// ── File loading ────────────────────────────────────────────────────────────
+
+/**
+ * Load a kernel ternary string from a .ternary file.
+ *
+ * Convention: ext/php/src/kernel_<name>.ternary
+ *
+ * @param string $name  e.g. 'run_arboricx_to_string'
+ * @return string The ternary string, or '' if file not found
+ */
+function loadKernelTernary(string $name): string
+{
+    // Determine the base directory: go up from this file to ext/php/src/
+    $dir = dirname(__FILE__);
+    $file = $dir . '/' . $name . '.ternary';
+    if (file_exists($file)) {
+        $content = file_get_contents($file);
+        if ($content !== false) {
+            return trim($content);
+        }
+    }
+    return '';
+}
+
+// ── Kernel constants (fallbacks — actual values loaded from .ternary files) ─
+
+/**
+ * runArboricxToString — the primary Host ABI entrypoint.
+ *
+ * This is the compiled Tree Calculus term for:
+ *
+ *   runArboricxToString = (bs args :
+ *     bindResult (runArboricxArgsByName [] bs args)
+ *       (value rest :
+ *         wrapHostValue hostString? hostString value rest))
+ *
+ * Loaded from ext/php/src/kernel_run_arboricx_to_string.ternary
+ * if it exists, otherwise falls back to the constant below.
+ *
+ * @var string
+ */
+const KERNEL_RUN_ARBORICX_TO_STRING = '';
+
+/**
+ * runArboricxByNameToString — named-export variant.
+ *
+ *   runArboricxByNameToString = (nameBytes bs args : ...)
+ *
+ * Loaded from ext/php/src/kernel_run_arboricx_by_name_to_string.ternary
+ * if it exists, otherwise falls back to the constant below.
+ *
+ * @var string
+ */
+const KERNEL_RUN_ARBORICX_BY_NAME_TO_STRING = '';
+
+// ── Parser ──────────────────────────────────────────────────────────────────
+
+/**
+ * Parse a ternary string into a Tree Calculus value.
+ *
+ * Grammar:
+ *   term → '0' → Leaf
+ *        → '1' term → Stem(term)
+ *        → '2' term term → Fork(term, term)
+ *
+ * @param string $s  The ternary string to parse
+ * @param int    &$pos  Current position (passed by reference)
+ * @return int The parsed Tree value node id
+ */
+function parseTernary(string $s, int &$pos = 0): int
+{
+    if ($pos >= strlen($s)) {
+        throw new \RuntimeException('parseTernary: unexpected end of string');
+    }
+
+    $char = $s[$pos];
+    $pos++;
+
+    return match ($char) {
+        '0' => leaf(),
+        '1' => stem(parseTernary($s, $pos)),
+        '2' => fork(parseTernary($s, $pos), parseTernary($s, $pos)),
+        default => throw new \RuntimeException(
+            "parseTernary: unexpected char '$char' at position $pos"
+        ),
+    };
+}
+
+// ── Kernel accessors ────────────────────────────────────────────────────────
+
+/**
+ * Get the runArboricxToString kernel tree.
+ *
+ * Tries loading from ext/php/src/kernel_run_arboricx_to_string.ternary first,
+ * then falls back to the KERNEL_RUN_ARBORICX_TO_STRING constant.
+ *
+ * Returns the parsed Tree Calculus value, or null if not configured.
+ */
+function getRunArboricxToString(): ?int
+{
+    // Try file first
+    $term = loadKernelTernary('kernel_run_arboricx_to_string');
+    if ($term === '') {
+        $term = KERNEL_RUN_ARBORICX_TO_STRING;
+    }
+    if ($term === '') {
+        return null;
+    }
+    $pos = 0;
+    $tree = parseTernary($term, $pos);
+    if ($pos !== strlen($term)) {
+        throw new \RuntimeException('kernel ternary has trailing data: parsed ' . $pos . ' of ' . strlen($term) . ' bytes');
+    }
+    return $tree;
+}
+
+/**
+ * Get the runArboricxByNameToString kernel tree.
+ *
+ * Tries loading from ext/php/src/kernel_run_arboricx_by_name_to_string.ternary
+ * first, then falls back to the KERNEL_RUN_ARBORICX_BY_NAME_TO_STRING constant.
+ */
+function getRunArboricxByNameToString(): ?int
+{
+    // Try file first
+    $term = loadKernelTernary('kernel_run_arboricx_by_name_to_string');
+    if ($term === '') {
+        $term = KERNEL_RUN_ARBORICX_BY_NAME_TO_STRING;
+    }
+    if ($term === '') {
+        return null;
+    }
+    $pos = 0;
+    $tree = parseTernary($term, $pos);
+    if ($pos !== strlen($term)) {
+        throw new \RuntimeException('kernel ternary has trailing data: parsed ' . $pos . ' of ' . strlen($term) . ' bytes');
+    }
+    return $tree;
+}