Compare commits
57 Commits
dea4e986d3
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| a4fcc1cb36 | |||
| fdebb6c13d | |||
| 2e2db07bd6 | |||
| 7cea3d1559 | |||
| ac90d23b46 | |||
| 4bf2ce56dd | |||
| bf30d5945e | |||
| 7ae3fc33f4 | |||
| 1c17d4c94a | |||
| e2a1744508 | |||
| 020fa769a9 | |||
| 2e13583de3 | |||
| 593aa96193 | |||
| e2d035286d | |||
| 8d5e76db1c | |||
| e3dcf5edd7 | |||
| 8f7684a1bb | |||
| 983a0cc5a7 | |||
| d6df01105c | |||
| 31bf7094f4 | |||
| e0b1e95729 | |||
| ea748b2e5e | |||
| d37d443021 | |||
| d7a7a8134c | |||
| 8a673e282d | |||
| 1885c9b4ba | |||
| fa58f4ef3a | |||
| e9eb2daaf2 | |||
| 1f72a6969d | |||
| 2e8a0a4c46 | |||
| d0886ad886 | |||
| 2773109b87 | |||
| 6dd4c3e607 | |||
| 343ecbf4c4 | |||
| e3117e3ac8 | |||
| d9f25a2b5a | |||
| a002365651 | |||
| 1d84bf7cfa | |||
| e8ab61dbaa | |||
| 37d57044e2 | |||
| 44ab13c889 | |||
| dee85efabf | |||
| 89bb73ed99 | |||
| 1c4c49e68d | |||
| e7a6426060 | |||
| 7e16607d96 | |||
| a36ff638a9 | |||
| 0cd849447f | |||
| fe453b9b96 | |||
| fb09b4666e | |||
| efbe9350ed | |||
| 2627627493 | |||
| c008126b14 | |||
| 6b97b210ca | |||
|
|
71653311ce | ||
| 0cdc0bfc34 | |||
| c36d963640 |
@@ -1,65 +0,0 @@
|
|||||||
name: Test, Build, and Release
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
tags:
|
|
||||||
- '*'
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
test:
|
|
||||||
container:
|
|
||||||
image: docker.matri.cx/nix-runner:v0.1.0
|
|
||||||
credentials:
|
|
||||||
username: ${{ secrets.REGISTRY_USERNAME }}
|
|
||||||
password: ${{ secrets.REGISTRY_PASSWORD }}
|
|
||||||
steps:
|
|
||||||
- uses: actions/checkout@v3
|
|
||||||
with:
|
|
||||||
fetch-depth: 0
|
|
||||||
|
|
||||||
- name: Set up cache for Cabal
|
|
||||||
uses: actions/cache@v4
|
|
||||||
with:
|
|
||||||
path: |
|
|
||||||
~/.cache/cabal
|
|
||||||
~/.config/cabal
|
|
||||||
~/.local/state/cabal
|
|
||||||
key: cabal-${{ hashFiles('tricu.cabal') }}
|
|
||||||
restore-keys: |
|
|
||||||
cabal-
|
|
||||||
|
|
||||||
- name: Initialize Cabal and update package list
|
|
||||||
run: |
|
|
||||||
nix develop --command cabal update
|
|
||||||
|
|
||||||
- name: Run test suite
|
|
||||||
run: |
|
|
||||||
nix develop --command cabal test
|
|
||||||
|
|
||||||
build:
|
|
||||||
needs: test
|
|
||||||
container:
|
|
||||||
image: docker.matri.cx/nix-runner:v0.1.0
|
|
||||||
credentials:
|
|
||||||
username: ${{ secrets.REGISTRY_USERNAME }}
|
|
||||||
password: ${{ secrets.REGISTRY_PASSWORD }}
|
|
||||||
steps:
|
|
||||||
- uses: actions/checkout@v3
|
|
||||||
with:
|
|
||||||
fetch-depth: 0
|
|
||||||
|
|
||||||
- name: Build and shrink binary
|
|
||||||
run: |
|
|
||||||
nix build
|
|
||||||
cp -L ./result/bin/tricu ./tricu
|
|
||||||
chmod 755 ./tricu
|
|
||||||
nix develop --command upx ./tricu
|
|
||||||
|
|
||||||
- name: Release binary
|
|
||||||
uses: akkuman/gitea-release-action@v1
|
|
||||||
with:
|
|
||||||
files: |-
|
|
||||||
./tricu
|
|
||||||
token: '${{ secrets.RELEASE_TOKEN }}'
|
|
||||||
body: '${{ gitea.event.head_commit.message }}'
|
|
||||||
prerelease: true
|
|
||||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -6,6 +6,7 @@
|
|||||||
/Dockerfile
|
/Dockerfile
|
||||||
/config.dhall
|
/config.dhall
|
||||||
/result
|
/result
|
||||||
|
/result*
|
||||||
.aider*
|
.aider*
|
||||||
WD
|
WD
|
||||||
bin/
|
bin/
|
||||||
|
|||||||
57
AGENTS.md
Normal file
57
AGENTS.md
Normal file
@@ -0,0 +1,57 @@
|
|||||||
|
# AGENTS.md - tricu Project Guide
|
||||||
|
|
||||||
|
> For AI agents and contributors working in this repository.
|
||||||
|
|
||||||
|
## Build & Test
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Tests
|
||||||
|
nix flake check
|
||||||
|
|
||||||
|
# Build tricu executable
|
||||||
|
nix build .#
|
||||||
|
```
|
||||||
|
|
||||||
|
### Never call `cabal` directly
|
||||||
|
|
||||||
|
> **Rule of thumb:** if it builds, links, or tests, it goes through `nix`.
|
||||||
|
|
||||||
|
## Project Overview
|
||||||
|
|
||||||
|
**tricu** (pronounced "tree-shoe") is a programming-language experiment written primarily in Haskell.
|
||||||
|
|
||||||
|
Core types are in `src/Research.hs`.
|
||||||
|
|
||||||
|
### File extensions
|
||||||
|
|
||||||
|
- `.hs` - Haskell source
|
||||||
|
- `.tri` - tricu language source (used in `lib/`, `test/`, `demos/`)
|
||||||
|
- `.arboricx` - Portable executable bundle
|
||||||
|
- `.dag` - Serialized kernel DAG (used by `gen_kernel.zig` at build time)
|
||||||
|
|
||||||
|
### Haskell tests
|
||||||
|
|
||||||
|
Tests live in `test/Spec.hs` and use **Tasty** + **HUnit**.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
nix flake check
|
||||||
|
```
|
||||||
|
|
||||||
|
## tricu Language Quick Reference
|
||||||
|
|
||||||
|
```
|
||||||
|
t → Leaf (the base term)
|
||||||
|
t t → Stem Leaf
|
||||||
|
t t t → Fork Leaf Leaf
|
||||||
|
|
||||||
|
x = t → Define term x = Leaf
|
||||||
|
id = (a : a) → Lambda identity (eliminates to tree calculus)
|
||||||
|
head (map f xs) → From lib/list.tri
|
||||||
|
|
||||||
|
!import "./path.tri" NS → Import file under namespace
|
||||||
|
|
||||||
|
-- line comment
|
||||||
|
```
|
||||||
|
|
||||||
|
CRITICAL:
|
||||||
|
When working with `tricu` `.tri` files ***YOU MUST REVIEW notes/tricu-normalization-rules.md***
|
||||||
130
README.md
130
README.md
@@ -2,28 +2,19 @@
|
|||||||
|
|
||||||
## Introduction
|
## Introduction
|
||||||
|
|
||||||
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included.
|
tricu (pronounced "tree-shoe") is an experimental programming language written in Haskell. It is fundamentally based on the application of [Triage Calculus](https://olydis.medium.com/a-visual-introduction-to-tree-calculus-2f4a34ceffc2), an extended form of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf). I refer to this "family" of calculi as TC below.
|
||||||
|
|
||||||
*This experiment has concluded. tricu will see no further development or bugfixes.*
|
|
||||||
|
|
||||||
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
|
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
|
||||||
|
|
||||||
|
In the `ext/` directory there are implementations of TC evaluators and tooling in other languages. Here be dragons; beware.
|
||||||
|
|
||||||
|
I have fully embraced the slopmachine (LLM-assisted development) for this project. Nothing is stable or sacred. We will discover sanity at the end of the journey but we won't strive for it until then.
|
||||||
|
|
||||||
|
This README.md is 100% human written. No other .md file will be until stabilization.
|
||||||
|
|
||||||
## Acknowledgements
|
## Acknowledgements
|
||||||
|
|
||||||
Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog).
|
Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog). The addition of Triage rules were suggested by [Johannes Bader](https://johannes-bader.com/). Johannes is also the creator of [treecalcul.us](https://treecalcul.us) which has a great intuitive code playground using his language LambAda.
|
||||||
|
|
||||||
[treecalcul.us](https://treecalcul.us) is an excellent website with an intuitive Tree Calculus code playground created by [Johannes Bader](https://johannes-bader.com/) that introduced me to Tree Calculus.
|
|
||||||
|
|
||||||
## Features
|
|
||||||
|
|
||||||
- Tree Calculus **operator**: `t`
|
|
||||||
- **Immutable definitions**: `x = t t`
|
|
||||||
- **Lambda abstraction**: `id = (a : a)`
|
|
||||||
- **List, Number, and String** literals: `[(2) ("Hello")]`
|
|
||||||
- **Function application**: `not (not false)`
|
|
||||||
- **Higher order/first-class functions**: `map (a : append a "!") [("Hello")]`
|
|
||||||
- **Intensionality** blurs the distinction between functions and data (see REPL examples)
|
|
||||||
- **Content-addressed store**: save, version, tag, and recall your tricu terms.
|
|
||||||
|
|
||||||
## REPL examples
|
## REPL examples
|
||||||
|
|
||||||
@@ -46,33 +37,8 @@ tricu > "(t (t (t t) (t t t)) (t t (t t t)))"
|
|||||||
tricu < -- or calculate its size (/demos/size.tri)
|
tricu < -- or calculate its size (/demos/size.tri)
|
||||||
tricu < size not?
|
tricu < size not?
|
||||||
tricu > 12
|
tricu > 12
|
||||||
|
|
||||||
tricu < !help
|
|
||||||
tricu version 0.20.0
|
|
||||||
Available commands:
|
|
||||||
!exit - Exit the REPL
|
|
||||||
!clear - Clear the screen
|
|
||||||
!reset - Reset preferences for selected versions
|
|
||||||
!help - Show tricu version and available commands
|
|
||||||
!output - Change output format (tree|fsl|ast|ternary|ascii|decode)
|
|
||||||
!definitions - List all defined terms in the content store
|
|
||||||
!import - Import definitions from file (definitions are stored)
|
|
||||||
!watch - Watch a file for changes (definitions are stored)
|
|
||||||
!versions - Show all versions of a term by name
|
|
||||||
!select - Select a specific version of a term for subsequent lookups
|
|
||||||
!tag - Add or update a tag for a term by hash or name
|
|
||||||
```
|
```
|
||||||
|
|
||||||
## Content Store
|
|
||||||
|
|
||||||
tricu uses a "content store" SQLite database that saves and versions your definitions persistently.
|
|
||||||
|
|
||||||
* **Persistent definitions:** Any term you define in the REPL is automatically saved.
|
|
||||||
* **Content-addressed:** Terms are stored based on a SHA256 hash of their content. This means identical terms are stored only once, even if they have different names.
|
|
||||||
* **Versioning and history:** If you redefine a name, the Content Store keeps a record of previous definitions associated with that name. You can explore the history of a term and access older versions.
|
|
||||||
* **Tagging:** You can assign tags to versions of your terms to organize and quickly switch between related function versions.
|
|
||||||
* **Querying:** The store allows you to search for terms by name, hash, or tags.
|
|
||||||
|
|
||||||
## Installation and Use
|
## Installation and Use
|
||||||
|
|
||||||
You can easily build and run this project using [Nix](https://nixos.org/download/).
|
You can easily build and run this project using [Nix](https://nixos.org/download/).
|
||||||
@@ -84,30 +50,64 @@ You can easily build and run this project using [Nix](https://nixos.org/download
|
|||||||
|
|
||||||
`./result/bin/tricu --help`
|
`./result/bin/tricu --help`
|
||||||
|
|
||||||
|
## Usage
|
||||||
|
|
||||||
|
### CLI
|
||||||
|
|
||||||
|
Evaluate one or more files:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
tricu eval program.tri
|
||||||
|
tricu eval --format decode program.tri
|
||||||
|
tricu eval --output result.txt program.tri
|
||||||
```
|
```
|
||||||
tricu Evaluator and REPL
|
|
||||||
|
|
||||||
tricu [COMMAND] ... [OPTIONS]
|
Unchecked eval parses annotation syntax, discards contract metadata, skips
|
||||||
tricu: Exploring Tree Calculus
|
producer-side View Contract checks during workspace module auto-builds, and does
|
||||||
|
not publish unchecked View refs.
|
||||||
|
|
||||||
Common flags:
|
```sh
|
||||||
-? --help Display help message
|
tricu eval --unchecked program.tri
|
||||||
-V --version Print version information
|
|
||||||
|
|
||||||
tricu [repl] [OPTIONS]
|
|
||||||
Start interactive REPL
|
|
||||||
|
|
||||||
tricu eval [OPTIONS]
|
|
||||||
Evaluate tricu and return the result of the final expression.
|
|
||||||
|
|
||||||
-f --file=FILE Input file path(s) for evaluation.
|
|
||||||
Defaults to stdin.
|
|
||||||
-t --form=FORM Optional output form: (tree|fsl|ast|ternary|ascii|decode).
|
|
||||||
Defaults to tricu-compatible `t` tree form.
|
|
||||||
|
|
||||||
tricu decode [OPTIONS]
|
|
||||||
Decode a Tree Calculus value into a string representation.
|
|
||||||
|
|
||||||
-f --file=FILE Optional input file path to attempt decoding.
|
|
||||||
Defaults to stdin.
|
|
||||||
```
|
```
|
||||||
|
|
||||||
|
Check View Contract annotations explicitly:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
tricu check program.tri
|
||||||
|
tricu check --store ./.tricu-store program.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
Compile/import/export Arboricx bundles:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
tricu arboricx compile --file program.tri --output program.arboricx
|
||||||
|
tricu arboricx import --file program.arboricx --module program
|
||||||
|
tricu arboricx export --module prelude --output prelude.arboricx
|
||||||
|
```
|
||||||
|
|
||||||
|
Inspect store aliases:
|
||||||
|
|
||||||
|
```sh
|
||||||
|
tricu store alias list --kind modules
|
||||||
|
tricu store alias get --kind modules prelude
|
||||||
|
```
|
||||||
|
|
||||||
|
### REPL
|
||||||
|
|
||||||
|
Running `tricu` with no subcommand starts the REPL. The REPL uses the same
|
||||||
|
filesystem content store and workspace module loader as the CLI.
|
||||||
|
|
||||||
|
Useful commands:
|
||||||
|
|
||||||
|
```text
|
||||||
|
!load FILE load/evaluate a .tri file without printing a result
|
||||||
|
!check FILE run View Contract checking for a file
|
||||||
|
!store [PATH] show or set the content-addressed store
|
||||||
|
!unchecked on evaluate loaded files without contract checking/publishing refs
|
||||||
|
!unchecked off return to normal producer-checked module loading
|
||||||
|
!format decode set output format by name
|
||||||
|
!env list current in-memory bindings
|
||||||
|
```
|
||||||
|
|
||||||
|
`!load` and `!check` support filename tab completion. Normal REPL input also
|
||||||
|
supports tab completion for names currently in the REPL environment.
|
||||||
|
|||||||
240
bench/ApplyStats.hs
Normal file
240
bench/ApplyStats.hs
Normal file
@@ -0,0 +1,240 @@
|
|||||||
|
{-# LANGUAGE BangPatterns #-}
|
||||||
|
|
||||||
|
module ApplyStats
|
||||||
|
( ApplyStats(..)
|
||||||
|
, emptyApplyStats
|
||||||
|
, emptyApplyStatsSampled
|
||||||
|
, applyCounted
|
||||||
|
, runApplyCounted
|
||||||
|
, runApplySampledWithProgress
|
||||||
|
, runApplyGlobalCounted
|
||||||
|
, printApplyStats
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Research
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
import qualified Data.List as L
|
||||||
|
import Data.Ord (comparing)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Debug.Trace (trace)
|
||||||
|
import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
|
||||||
|
import Data.IORef
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Threaded stats (slow but pure)
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
type Hash = Text
|
||||||
|
type AppKey = (Hash, Hash)
|
||||||
|
|
||||||
|
data ApplyStats = ApplyStats
|
||||||
|
{ totalApplyCalls :: !Int
|
||||||
|
, uniqueApps :: !(M.Map AppKey Int)
|
||||||
|
, sampleInterval :: !Int
|
||||||
|
, sampleCounter :: !Int
|
||||||
|
, progressEvery :: !Int
|
||||||
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
emptyApplyStats :: ApplyStats
|
||||||
|
emptyApplyStats = emptyApplyStatsSampled 1
|
||||||
|
|
||||||
|
emptyApplyStatsSampled :: Int -> ApplyStats
|
||||||
|
emptyApplyStatsSampled n = ApplyStats
|
||||||
|
{ totalApplyCalls = 0
|
||||||
|
, uniqueApps = M.empty
|
||||||
|
, sampleInterval = max 1 n
|
||||||
|
, sampleCounter = 0
|
||||||
|
, progressEvery = 0
|
||||||
|
}
|
||||||
|
|
||||||
|
bump :: T -> T -> ApplyStats -> ApplyStats
|
||||||
|
bump !f !x !st =
|
||||||
|
let !counter' = sampleCounter st + 1
|
||||||
|
!total' = totalApplyCalls st + 1
|
||||||
|
!stBase = st { totalApplyCalls = total'
|
||||||
|
, sampleCounter = counter'
|
||||||
|
}
|
||||||
|
!st' = if counter' `mod` sampleInterval st /= 0
|
||||||
|
then stBase
|
||||||
|
else let !hf = termHash f
|
||||||
|
!hx = termHash x
|
||||||
|
!k = (hf, hx)
|
||||||
|
!m = M.insertWith (+) k 1 (uniqueApps st)
|
||||||
|
in stBase { uniqueApps = m }
|
||||||
|
in case progressEvery st of
|
||||||
|
0 -> st'
|
||||||
|
n | total' `mod` n == 0 ->
|
||||||
|
trace ("apply calls so far: " ++ show total') st'
|
||||||
|
_ -> st'
|
||||||
|
|
||||||
|
termHash :: T -> Hash
|
||||||
|
termHash Leaf =
|
||||||
|
nodeHash NLeaf
|
||||||
|
termHash (Stem t) =
|
||||||
|
nodeHash (NStem (termHash t))
|
||||||
|
termHash (Fork l r) =
|
||||||
|
nodeHash (NFork (termHash l) (termHash r))
|
||||||
|
|
||||||
|
applyCounted :: T -> T -> ApplyStats -> (T, ApplyStats)
|
||||||
|
applyCounted !f !x !st0 =
|
||||||
|
let !st1 = bump f x st0
|
||||||
|
in applyStepCounted f x st1
|
||||||
|
|
||||||
|
applyStepCounted :: T -> T -> ApplyStats -> (T, ApplyStats)
|
||||||
|
applyStepCounted (Fork Leaf a) _ st =
|
||||||
|
(a, st)
|
||||||
|
applyStepCounted (Fork (Stem a) b) c st =
|
||||||
|
let (!ac, !st1) = applyCounted a c st
|
||||||
|
(!bc, !st2) = applyCounted b c st1
|
||||||
|
in applyCounted ac bc st2
|
||||||
|
applyStepCounted (Fork (Fork a _b) _c) Leaf st =
|
||||||
|
(a, st)
|
||||||
|
applyStepCounted (Fork (Fork _a b) _c) (Stem u) st =
|
||||||
|
applyCounted b u st
|
||||||
|
applyStepCounted (Fork (Fork _a _b) c) (Fork u v) st =
|
||||||
|
let (!cu, !st1) = applyCounted c u st
|
||||||
|
in applyCounted cu v st1
|
||||||
|
applyStepCounted Leaf b st =
|
||||||
|
(Stem b, st)
|
||||||
|
applyStepCounted (Stem a) b st =
|
||||||
|
(Fork a b, st)
|
||||||
|
|
||||||
|
runApplyCounted :: T -> T -> (T, ApplyStats)
|
||||||
|
runApplyCounted !f !x =
|
||||||
|
applyCounted f x emptyApplyStats
|
||||||
|
|
||||||
|
runApplySampled :: Int -> T -> T -> (T, ApplyStats)
|
||||||
|
runApplySampled !n !f !x =
|
||||||
|
applyCounted f x (emptyApplyStatsSampled n)
|
||||||
|
|
||||||
|
runApplySampledWithProgress :: Int -> Int -> T -> T -> (T, ApplyStats)
|
||||||
|
runApplySampledWithProgress !interval !progress !f !x =
|
||||||
|
let st = (emptyApplyStatsSampled interval) { progressEvery = progress }
|
||||||
|
in applyCounted f x st
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Global mutable stats (fast, unsafe, single-threaded only)
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{-# NOINLINE globalTotalCount #-}
|
||||||
|
globalTotalCount :: IORef Int
|
||||||
|
globalTotalCount = unsafePerformIO (newIORef 0)
|
||||||
|
|
||||||
|
{-# NOINLINE globalInterval #-}
|
||||||
|
globalInterval :: IORef Int
|
||||||
|
globalInterval = unsafePerformIO (newIORef 1)
|
||||||
|
|
||||||
|
{-# NOINLINE globalMap #-}
|
||||||
|
globalMap :: IORef (M.Map AppKey Int)
|
||||||
|
globalMap = unsafePerformIO (newIORef M.empty)
|
||||||
|
|
||||||
|
{-# NOINLINE globalProgress #-}
|
||||||
|
globalProgress :: IORef Int
|
||||||
|
globalProgress = unsafePerformIO (newIORef 0)
|
||||||
|
|
||||||
|
resetGlobalStats :: Int -> Int -> IO ()
|
||||||
|
resetGlobalStats !interval !progress = do
|
||||||
|
writeIORef globalTotalCount 0
|
||||||
|
writeIORef globalInterval (max 1 interval)
|
||||||
|
writeIORef globalMap M.empty
|
||||||
|
writeIORef globalProgress progress
|
||||||
|
|
||||||
|
readGlobalStats :: IO ApplyStats
|
||||||
|
readGlobalStats = do
|
||||||
|
total <- readIORef globalTotalCount
|
||||||
|
m <- readIORef globalMap
|
||||||
|
pure ApplyStats
|
||||||
|
{ totalApplyCalls = total
|
||||||
|
, uniqueApps = m
|
||||||
|
, sampleInterval = 0
|
||||||
|
, sampleCounter = 0
|
||||||
|
, progressEvery = 0
|
||||||
|
}
|
||||||
|
|
||||||
|
{-# INLINE globalBump #-}
|
||||||
|
globalBump :: T -> T -> ()
|
||||||
|
globalBump !f !x = unsafeDupablePerformIO $ do
|
||||||
|
!total <- readIORef globalTotalCount
|
||||||
|
let !total' = total + 1
|
||||||
|
writeIORef globalTotalCount total'
|
||||||
|
!interval <- readIORef globalInterval
|
||||||
|
!progress <- readIORef globalProgress
|
||||||
|
let !_ = if progress > 0 && total' `mod` progress == 0
|
||||||
|
then trace ("apply calls so far: " ++ show total') ()
|
||||||
|
else ()
|
||||||
|
if total' `mod` interval /= 0
|
||||||
|
then pure ()
|
||||||
|
else do
|
||||||
|
let !hf = termHash f
|
||||||
|
!hx = termHash x
|
||||||
|
!k = (hf, hx)
|
||||||
|
!m <- readIORef globalMap
|
||||||
|
writeIORef globalMap (M.insertWith (+) k 1 m)
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
applyGlobalCounted :: T -> T -> T
|
||||||
|
applyGlobalCounted !f !x =
|
||||||
|
let !_ = globalBump f x
|
||||||
|
in applyGlobalStep f x
|
||||||
|
|
||||||
|
applyGlobalStep :: T -> T -> T
|
||||||
|
applyGlobalStep (Fork Leaf a) _ = a
|
||||||
|
applyGlobalStep (Fork (Stem a) b) c =
|
||||||
|
applyGlobalCounted (applyGlobalCounted a c) (applyGlobalCounted b c)
|
||||||
|
applyGlobalStep (Fork (Fork a _b) _c) Leaf = a
|
||||||
|
applyGlobalStep (Fork (Fork _a b) _c) (Stem u) = applyGlobalCounted b u
|
||||||
|
applyGlobalStep (Fork (Fork _a _b) c) (Fork u v) =
|
||||||
|
applyGlobalCounted (applyGlobalCounted c u) v
|
||||||
|
applyGlobalStep Leaf b = Stem b
|
||||||
|
applyGlobalStep (Stem a) b = Fork a b
|
||||||
|
|
||||||
|
runApplyGlobalCounted :: Int -> Int -> T -> T -> IO (T, ApplyStats)
|
||||||
|
runApplyGlobalCounted !interval !progress !f !x = do
|
||||||
|
resetGlobalStats interval progress
|
||||||
|
let !result = applyGlobalCounted f x
|
||||||
|
!stats <- readGlobalStats
|
||||||
|
pure (result, stats)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Printing
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
printApplyStats :: ApplyStats -> IO ()
|
||||||
|
printApplyStats st = do
|
||||||
|
let !total = totalApplyCalls st
|
||||||
|
!uniq = M.size (uniqueApps st)
|
||||||
|
!ratio =
|
||||||
|
if uniq == 0
|
||||||
|
then 0 :: Double
|
||||||
|
else fromIntegral total / fromIntegral uniq
|
||||||
|
|
||||||
|
counts =
|
||||||
|
reverse
|
||||||
|
. L.sortBy (comparing snd)
|
||||||
|
. M.toList
|
||||||
|
$ uniqueApps st
|
||||||
|
|
||||||
|
repeated =
|
||||||
|
filter ((> 1) . snd) counts
|
||||||
|
|
||||||
|
top20 = take 20 repeated
|
||||||
|
|
||||||
|
putStrLn $ "total apply calls: " ++ show total
|
||||||
|
putStrLn $ "unique application patterns: " ++ show uniq
|
||||||
|
putStrLn $ "duplication ratio total/unique: " ++ show ratio
|
||||||
|
putStrLn $ "repeated application patterns: " ++ show (length repeated)
|
||||||
|
|
||||||
|
putStrLn "top repeated application counts:"
|
||||||
|
mapM_ printTop top20
|
||||||
|
where
|
||||||
|
short h = T.unpack (T.take 12 h)
|
||||||
|
|
||||||
|
printTop ((hf, hx), n) =
|
||||||
|
putStrLn $
|
||||||
|
" " ++ show n
|
||||||
|
++ "x apply "
|
||||||
|
++ short hf
|
||||||
|
++ " "
|
||||||
|
++ short hx
|
||||||
125
bench/Bench.hs
Normal file
125
bench/Bench.hs
Normal file
@@ -0,0 +1,125 @@
|
|||||||
|
{-# LANGUAGE BangPatterns #-}
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Criterion.Main
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import ApplyStats (runApplyCounted, runApplyGlobalCounted, printApplyStats)
|
||||||
|
import Eval
|
||||||
|
import FileEval
|
||||||
|
import Parser
|
||||||
|
import Research
|
||||||
|
|
||||||
|
-- | Pre-process a demo file and return its AST.
|
||||||
|
loadDemo :: FilePath -> IO [TricuAST]
|
||||||
|
loadDemo = preprocessFile
|
||||||
|
|
||||||
|
-- | Evaluate a pre-processed demo to its result term.
|
||||||
|
runDemo :: [TricuAST] -> T
|
||||||
|
runDemo ast = result (evalTricu Map.empty ast)
|
||||||
|
|
||||||
|
-- | Build an environment from a library file.
|
||||||
|
loadLib :: FilePath -> IO Env
|
||||||
|
loadLib = evaluateFile
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
!equalityAst <- loadDemo "demos/equality.tri"
|
||||||
|
!sizeAst <- loadDemo "demos/size.tri"
|
||||||
|
!toSourceAst <- loadDemo "demos/toSource.tri"
|
||||||
|
!levelOrderAst <- loadDemo "demos/levelOrderTraversal.tri"
|
||||||
|
!patternAst <- loadDemo "demos/patternMatching.tri"
|
||||||
|
!listLib <- loadLib "lib/list.tri"
|
||||||
|
|
||||||
|
-- Stress benchmark environment: Arboricx parser + size + toSource
|
||||||
|
!arboricxLib <- loadLib "lib/arboricx/dispatch.tri"
|
||||||
|
!sizeEnv <- evaluateFileWithContext arboricxLib "demos/size.tri"
|
||||||
|
!toSourceEnv <- evaluateFileWithContext sizeEnv "demos/toSource.tri"
|
||||||
|
|
||||||
|
-- Print apply stats for toSource not?
|
||||||
|
let Just toSource = Map.lookup "toSource" toSourceEnv
|
||||||
|
Just notTerm = Map.lookup "not?" toSourceEnv
|
||||||
|
(_result, stats) = runApplyCounted toSource notTerm
|
||||||
|
printApplyStats stats
|
||||||
|
|
||||||
|
-- Print apply stats for readArboricxContainer against id.arboricx
|
||||||
|
!idBundleBytes <- BS.readFile "test/fixtures/id.arboricx"
|
||||||
|
let Just readContainer = Map.lookup "readArboricxContainer" sizeEnv
|
||||||
|
bundleTree = ofBytes idBundleBytes
|
||||||
|
(_result2, stats2) <- runApplyGlobalCounted 100000 1000000 readContainer bundleTree
|
||||||
|
printApplyStats stats2
|
||||||
|
|
||||||
|
defaultMain
|
||||||
|
[ bgroup "demos"
|
||||||
|
[ bench "equality" $ whnf runDemo equalityAst
|
||||||
|
, bench "size" $ whnf runDemo sizeAst
|
||||||
|
, bench "toSource" $ whnf runDemo toSourceAst
|
||||||
|
, bench "levelOrderTraversal" $ whnf runDemo levelOrderAst
|
||||||
|
, bench "patternMatching" $ whnf runDemo patternAst
|
||||||
|
]
|
||||||
|
|
||||||
|
, bgroup "lib/list.tri"
|
||||||
|
[ bench "append strings" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"append \"Hello, \" \"world!\""
|
||||||
|
, bench "map over 3 elements" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"head (tail (map (a : (t t t)) [(t) (t) (t)]))"
|
||||||
|
, bench "equal? same" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"equal? (t t t) (t t t)"
|
||||||
|
, bench "equal? different" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"equal? (t t) (t t t)"
|
||||||
|
, bench "triage Leaf" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"test t"
|
||||||
|
, bench "triage Stem" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"test (t t)"
|
||||||
|
, bench "triage Fork" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"test (t t t)"
|
||||||
|
, bench "not? true" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"not? (t t)"
|
||||||
|
, bench "not? false" $ whnf
|
||||||
|
(result . evalTricu listLib . parseTricu)
|
||||||
|
"not? t"
|
||||||
|
]
|
||||||
|
|
||||||
|
, bgroup "stress"
|
||||||
|
[ bench "size runArboricxTyped" $ whnf
|
||||||
|
(result . evalTricu sizeEnv . parseTricu)
|
||||||
|
"size runArboricxTyped"
|
||||||
|
, bench "equal? runArboricxTyped runArboricxTyped" $ whnf
|
||||||
|
(result . evalTricu sizeEnv . parseTricu)
|
||||||
|
"equal? runArboricxTyped runArboricxTyped"
|
||||||
|
, bench "size readArboricxBundle" $ whnf
|
||||||
|
(result . evalTricu sizeEnv . parseTricu)
|
||||||
|
"size readArboricxBundle"
|
||||||
|
, bench "equal? readArboricxBundle readArboricxBundle" $ whnf
|
||||||
|
(result . evalTricu sizeEnv . parseTricu)
|
||||||
|
"equal? readArboricxBundle readArboricxBundle"
|
||||||
|
]
|
||||||
|
|
||||||
|
, bgroup "raw-apply"
|
||||||
|
[ bench "rule-1 (Fork Leaf a) b" $ whnf
|
||||||
|
(\n -> apply (Fork Leaf (ofNumber n)) (ofNumber 42))
|
||||||
|
1000
|
||||||
|
, bench "rule-2 (Fork (Stem a) b) c" $ whnf
|
||||||
|
(\n -> apply (Fork (Stem (ofNumber n)) (ofNumber n)) (ofNumber 42))
|
||||||
|
1000
|
||||||
|
, bench "rule-3a (Fork (Fork a b) c) Leaf" $ whnf
|
||||||
|
(\n -> apply (Fork (Fork (ofNumber n) (ofNumber n)) (ofNumber n)) Leaf)
|
||||||
|
1000
|
||||||
|
, bench "rule-3b (Fork (Fork a b) c) (Stem u)" $ whnf
|
||||||
|
(\n -> apply (Fork (Fork (ofNumber n) (ofNumber n)) (ofNumber n)) (Stem Leaf))
|
||||||
|
1000
|
||||||
|
, bench "rule-3c (Fork (Fork a b) c) (Fork u v)" $ whnf
|
||||||
|
(\n -> apply (Fork (Fork (ofNumber n) (ofNumber n)) (ofNumber n)) (Fork Leaf Leaf))
|
||||||
|
1000
|
||||||
|
]
|
||||||
|
|
||||||
|
]
|
||||||
@@ -1,5 +1,4 @@
|
|||||||
!import "../lib/base.tri" !Local
|
!import "prelude" !Local
|
||||||
!import "../lib/list.tri" !Local
|
|
||||||
|
|
||||||
main = lambdaEqualsTC
|
main = lambdaEqualsTC
|
||||||
|
|
||||||
|
|||||||
57
demos/interactionTrees.tri
Normal file
57
demos/interactionTrees.tri
Normal file
@@ -0,0 +1,57 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Interaction Tree Effect Runtime
|
||||||
|
--
|
||||||
|
-- The IO system is an interaction-tree effect runtime interpreted by a
|
||||||
|
-- small-step machine with a cooperative scheduler. Primitive actions
|
||||||
|
-- (putStr, readFile, writeFile, ...) are tagged nodes in an interaction
|
||||||
|
-- tree. Sequencing is performed by the single generic `bind` constructor.
|
||||||
|
--
|
||||||
|
-- pure x -- lift a pure value into IO
|
||||||
|
-- bind action k -- run action, then apply k to its result
|
||||||
|
-- thenIO a b -- run a, discard its result, then run b
|
||||||
|
-- mapIO action f -- run action, then apply f to its result inside pure
|
||||||
|
--
|
||||||
|
-- The runtime supports several effects beyond basic IO:
|
||||||
|
-- ask -- read the current environment
|
||||||
|
-- local f action -- run action with environment transformed by f
|
||||||
|
-- get -- read the current mutable state
|
||||||
|
-- put s -- replace the mutable state
|
||||||
|
-- fork action -- spawn a concurrent task, returning a handle
|
||||||
|
-- await handle -- wait for a forked task to complete
|
||||||
|
-- yield -- yield control to the scheduler
|
||||||
|
-- sleep ms -- suspend current task for N milliseconds
|
||||||
|
--
|
||||||
|
-- File operations return a Result tree (see lib/base.tri):
|
||||||
|
-- ok value -- pair true (pair value t)
|
||||||
|
-- err msg -- pair false (pair msg t)
|
||||||
|
--
|
||||||
|
-- Use onReadFile / onWriteFile for convenient branching.
|
||||||
|
--
|
||||||
|
-- See demos/interactionTrees/ for smaller focused examples.
|
||||||
|
|
||||||
|
-- Cooperative async demo.
|
||||||
|
-- fork runs an action in the background.
|
||||||
|
-- sleep suspends the current task for N milliseconds.
|
||||||
|
-- await waits for a forked task and returns its value.
|
||||||
|
--
|
||||||
|
-- Here the child sleeps for 2 s while the parent prints immediately.
|
||||||
|
-- The parent's message appears first, proving interleaving.
|
||||||
|
|
||||||
|
asyncDemo = (
|
||||||
|
bind (fork
|
||||||
|
(bind (sleep 2000) (_ :
|
||||||
|
bind (putStrLn "2000ms done sleeping!") (_ :
|
||||||
|
pure "child2000 done"))))
|
||||||
|
(handle2000 :
|
||||||
|
bind (fork
|
||||||
|
(bind (sleep 5000) (_ :
|
||||||
|
bind (putStrLn "5000ms done sleeping!") (_ :
|
||||||
|
pure "child5000 done"))))
|
||||||
|
(handle5000 :
|
||||||
|
bind (putStrLn "Parent first!") (_ :
|
||||||
|
bind (await handle5000) (_ :
|
||||||
|
await handle2000)))))
|
||||||
|
|
||||||
|
main = io asyncDemo
|
||||||
22
demos/interactionTrees/arboricxServer.tri
Normal file
22
demos/interactionTrees/arboricxServer.tri
Normal file
@@ -0,0 +1,22 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "arboricx.server" !Local
|
||||||
|
|
||||||
|
-- Arboricx HTTP registry server demo.
|
||||||
|
-- Run with --allow-write ./store --allow-read ./store
|
||||||
|
--
|
||||||
|
-- Endpoints:
|
||||||
|
-- GET /_arboricx/health -> "OK"
|
||||||
|
-- POST /_arboricx/bundle -> upload bundle, returns hash
|
||||||
|
-- GET /_arboricx/bundle/hash/:h -> download bundle by hash
|
||||||
|
--
|
||||||
|
-- Example usage:
|
||||||
|
-- curl http://localhost:9050/_arboricx/health
|
||||||
|
-- curl -X POST --data-binary @mybundle.arboricx http://localhost:9050/_arboricx/bundles
|
||||||
|
-- curl http://localhost:9050/_arboricx/bundle/hash/<hash>
|
||||||
|
|
||||||
|
main = io (thenIO
|
||||||
|
(putStrLn "Starting Arboricx server on 127.0.0.1:9050")
|
||||||
|
(thenIO
|
||||||
|
(void (ensureStore "/tmp/store"))
|
||||||
|
(arboricxServer "/tmp/store" "127.0.0.1" 9050)))
|
||||||
28
demos/interactionTrees/echoServer.tri
Normal file
28
demos/interactionTrees/echoServer.tri
Normal file
@@ -0,0 +1,28 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "socket" !Local
|
||||||
|
|
||||||
|
-- Main accept+echo loop. Recursion via y.
|
||||||
|
echoLoop = y (self : server :
|
||||||
|
withAccepted_ server
|
||||||
|
(err :
|
||||||
|
bind (putStrLn (append "accept error: " err)) (_ :
|
||||||
|
self server))
|
||||||
|
(clientSock addr :
|
||||||
|
bind (putStrLn (append "client from " addr)) (_ :
|
||||||
|
onResult_ (recv clientSock 4096)
|
||||||
|
(err :
|
||||||
|
bind (closeSocket clientSock) (_ :
|
||||||
|
self server))
|
||||||
|
(msg :
|
||||||
|
bind (send clientSock msg) (_ :
|
||||||
|
bind (closeSocket clientSock) (_ :
|
||||||
|
self server))))))
|
||||||
|
|
||||||
|
main = io (
|
||||||
|
onOk_ socket (server :
|
||||||
|
onOk_ (bindSocket server "127.0.0.1" 0) (_ :
|
||||||
|
onOk_ (listen server 5) (_ :
|
||||||
|
onOk_ (getSocketName server) (port :
|
||||||
|
bind (putStrLn (append "Echo server listening on port " (showNumber port))) (_ :
|
||||||
|
echoLoop server))))))
|
||||||
20
demos/interactionTrees/environment.tri
Normal file
20
demos/interactionTrees/environment.tri
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Environment effects: ask and local.
|
||||||
|
-- ask reads the current environment value.
|
||||||
|
-- local f action runs action with the env transformed by f.
|
||||||
|
--
|
||||||
|
-- The CLI starts with an empty (Leaf) environment. This demo uses
|
||||||
|
-- local to inject a real string so that ask returns something readable.
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
(bind
|
||||||
|
local (_ : "sandbox")
|
||||||
|
(bind ask (env :
|
||||||
|
bind (putStrLn (append "working in env: " env)) (_ :
|
||||||
|
pure "inside-done"))))
|
||||||
|
(outside :
|
||||||
|
bind (putStrLn (append "local returned: " outside)) (_ :
|
||||||
|
pure t))
|
||||||
18
demos/interactionTrees/forkAwait.tri
Normal file
18
demos/interactionTrees/forkAwait.tri
Normal file
@@ -0,0 +1,18 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Basic fork and await.
|
||||||
|
-- fork spawns a concurrent task and returns a handle.
|
||||||
|
-- await blocks until the task completes and returns its value.
|
||||||
|
|
||||||
|
worker = msg :
|
||||||
|
bind (putStrLn (append "working: " msg)) (_ :
|
||||||
|
pure (append msg "-result"))
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
(bind (fork (worker "job1")) (h1 :
|
||||||
|
bind (fork (worker "job2")) (h2 :
|
||||||
|
bind (await h1) (r1 :
|
||||||
|
bind (await h2) (r2 :
|
||||||
|
putStrLn (append "Got " (append r1 (append " and " r2))))))))
|
||||||
26
demos/interactionTrees/getLineAsync.tri
Normal file
26
demos/interactionTrees/getLineAsync.tri
Normal file
@@ -0,0 +1,26 @@
|
|||||||
|
-- Manual test for async getLine
|
||||||
|
--
|
||||||
|
-- Run with:
|
||||||
|
-- nix run .# -- eval -f demos/async-getline-test.tri --io
|
||||||
|
--
|
||||||
|
-- Expected behaviour:
|
||||||
|
-- 1. You immediately see:
|
||||||
|
-- Please enter your first name:
|
||||||
|
-- (this printed before you typed anything)
|
||||||
|
-- (this second line also printed before you typed anything)
|
||||||
|
-- 2. You type your name and press Enter.
|
||||||
|
-- 3. You see:
|
||||||
|
-- Hello, <name>!
|
||||||
|
|
||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
bind (fork getLine) (h :
|
||||||
|
bind (putStr "Please enter your first name: ") (_ :
|
||||||
|
bind (putStr "\n(this printed before you typed anything)\n") (_ :
|
||||||
|
bind (putStr "\n(this second line also printed before you typed anything)\n") (_ :
|
||||||
|
bind (await h) (name :
|
||||||
|
bind (putStr "Hello, ") (_ :
|
||||||
|
bind (putStr name) (_ :
|
||||||
|
putStr "!\n")))))))
|
||||||
10
demos/interactionTrees/greet.tri
Normal file
10
demos/interactionTrees/greet.tri
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Greet and return a pure value.
|
||||||
|
-- putStrLn writes to stdout; pure lifts "done" into IO.
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
bind (putStrLn (append "Hello, " "tricu"))
|
||||||
|
(_ : pure "")
|
||||||
16
demos/interactionTrees/httpServer.tri
Normal file
16
demos/interactionTrees/httpServer.tri
Normal file
@@ -0,0 +1,16 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "socket" !Local
|
||||||
|
!import "http" !Local
|
||||||
|
|
||||||
|
myRouter = (method path headers body :
|
||||||
|
matchBool
|
||||||
|
(okResponse (append "Hello from " (append path "\n")))
|
||||||
|
(methodNotAllowedResponse)
|
||||||
|
(strEq? method "GET"))
|
||||||
|
|
||||||
|
main = io (
|
||||||
|
onOk_ socket (server :
|
||||||
|
onOk_ (bindSocket server "127.0.0.1" 9050) (_ :
|
||||||
|
onOk_ (listen server 5) (_ :
|
||||||
|
serveForever server (httpHandler myRouter)))))
|
||||||
16
demos/interactionTrees/safeRead.tri
Normal file
16
demos/interactionTrees/safeRead.tri
Normal file
@@ -0,0 +1,16 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- readFile returns a Result. matchResult branches on ok / err.
|
||||||
|
-- Run with --allow-read PATH or --unsafe-io.
|
||||||
|
|
||||||
|
safeRead = (path :
|
||||||
|
bind (readFile path)
|
||||||
|
(result :
|
||||||
|
matchResult
|
||||||
|
(err rest : pure "ERROR: Unable to read file")
|
||||||
|
(contents rest : pure contents)
|
||||||
|
result))
|
||||||
|
|
||||||
|
main = io (safeRead "demos/interactionTrees/greet.tri")
|
||||||
23
demos/interactionTrees/shout.tri
Normal file
23
demos/interactionTrees/shout.tri
Normal file
@@ -0,0 +1,23 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Transform an IO result.
|
||||||
|
-- mapIO applies a pure function to the value produced by an action.
|
||||||
|
-- Run with --allow-read PATH or --unsafe-io.
|
||||||
|
|
||||||
|
safeRead = (path :
|
||||||
|
bind (readFile path)
|
||||||
|
(result :
|
||||||
|
matchResult
|
||||||
|
(err rest : pure "missing")
|
||||||
|
(contents rest : pure contents)
|
||||||
|
result))
|
||||||
|
|
||||||
|
shout = (path :
|
||||||
|
mapIO (safeRead path)
|
||||||
|
(text : append text "!!!"))
|
||||||
|
|
||||||
|
main = io (bind
|
||||||
|
(shout "demos/interactionTrees/greet.tri")
|
||||||
|
(text : putStrLn text))
|
||||||
22
demos/interactionTrees/state.tri
Normal file
22
demos/interactionTrees/state.tri
Normal file
@@ -0,0 +1,22 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Mutable state via get and put.
|
||||||
|
-- get reads the current state.
|
||||||
|
-- put replaces the state.
|
||||||
|
--
|
||||||
|
-- The CLI starts with an empty (Leaf) state. This demo puts
|
||||||
|
-- readable strings and prints them back out.
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
bind (put "idle") (_ :
|
||||||
|
bind get (s1 :
|
||||||
|
bind (putStrLn (append "state: " s1)) (_ :
|
||||||
|
bind (put "running") (_ :
|
||||||
|
bind get (s2 :
|
||||||
|
bind (putStrLn (append "state: " s2)) (_ :
|
||||||
|
bind (put "done") (_ :
|
||||||
|
bind get (s3 :
|
||||||
|
bind (putStrLn (append "state: " s3)) (_ :
|
||||||
|
pure t)))))))))
|
||||||
20
demos/interactionTrees/writeThenRead.tri
Normal file
20
demos/interactionTrees/writeThenRead.tri
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Write a file, then read it back.
|
||||||
|
-- thenIO discards the writeFile Result and continues.
|
||||||
|
-- Run with --unsafe-io (needs both read and write permissions).
|
||||||
|
|
||||||
|
writeThenRead = (path text :
|
||||||
|
thenIO
|
||||||
|
(writeFile path text)
|
||||||
|
(readFile path))
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
(bind (writeThenRead "/tmp/tricu-demo.txt" "hello from tricu")
|
||||||
|
(result :
|
||||||
|
matchResult
|
||||||
|
(err rest : putStrLn "error")
|
||||||
|
(contents rest : putStrLn contents)
|
||||||
|
result))
|
||||||
33
demos/interactionTrees/yield.tri
Normal file
33
demos/interactionTrees/yield.tri
Normal file
@@ -0,0 +1,33 @@
|
|||||||
|
!import "base" !Local
|
||||||
|
!import "list" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
|
||||||
|
-- Cooperative scheduling with yield.
|
||||||
|
-- yield returns control to the scheduler so other tasks can run.
|
||||||
|
--
|
||||||
|
-- Two tasks print alternately because each yields after every line.
|
||||||
|
|
||||||
|
--chatter = (name n :
|
||||||
|
-- bind (putStrLn (append name " says 1")) (_ :
|
||||||
|
-- bind yield (_ :
|
||||||
|
-- bind (putStrLn (append name " says 2")) (_ :
|
||||||
|
-- bind yield (_ :
|
||||||
|
-- bind (putStrLn (append name " says 3")) (_ :
|
||||||
|
-- pure n))))))
|
||||||
|
|
||||||
|
chatter = name n : bind <|
|
||||||
|
putStrLn (append name " says 1") (_ :
|
||||||
|
bind yield (_ :
|
||||||
|
bind (putStrLn (append name " says 2")) (_ :
|
||||||
|
bind yield (_ :
|
||||||
|
bind (putStrLn (append name " says 3")) (_ :
|
||||||
|
pure n)))))
|
||||||
|
|
||||||
|
|
||||||
|
main = io <|
|
||||||
|
bind (fork (chatter "A" "doneA")) (ha :
|
||||||
|
bind (fork (chatter "B" "doneB")) (hb :
|
||||||
|
bind yield (_ :
|
||||||
|
bind (await ha) (a :
|
||||||
|
bind (await hb) (b :
|
||||||
|
putStrLn (append "Finished: " (append a (append " " b))))))))
|
||||||
@@ -1,5 +1,4 @@
|
|||||||
!import "../lib/base.tri" Lib
|
!import "prelude" !Local
|
||||||
!import "../lib/list.tri" !Local
|
|
||||||
|
|
||||||
main = exampleTwo
|
main = exampleTwo
|
||||||
-- Level Order Traversal of a labelled binary tree
|
-- Level Order Traversal of a labelled binary tree
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
!import "../lib/patterns.tri" !Local
|
!import "patterns" !Local
|
||||||
|
|
||||||
-- We can do conditional pattern matching by providing a list of lists, where
|
-- We can do conditional pattern matching by providing a list of lists, where
|
||||||
-- each sublist contains a boolean expression and a function to return if said
|
-- each sublist contains a boolean expression and a function to return if said
|
||||||
|
|||||||
25
demos/runArboricxBundle.tri
Normal file
25
demos/runArboricxBundle.tri
Normal file
@@ -0,0 +1,25 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "arboricx" !Local
|
||||||
|
|
||||||
|
-- Read an Arboricx bundle from disk and execute it.
|
||||||
|
-- This demo loads test/fixtures/id.arboricx and applies the
|
||||||
|
-- default export to the string "hi". The id bundle simply
|
||||||
|
-- returns its argument, so the expected output is:
|
||||||
|
-- hi
|
||||||
|
--
|
||||||
|
-- Run with --allow-read test/fixtures/id.arboricx or --unsafe-io.
|
||||||
|
|
||||||
|
runBundle = (path arg :
|
||||||
|
bind (readFile path)
|
||||||
|
(result :
|
||||||
|
matchResult
|
||||||
|
(err rest : putStrLn "ERROR: Could not read bundle file")
|
||||||
|
(bundleBytes rest :
|
||||||
|
matchResult
|
||||||
|
(err rest : putStrLn "ERROR: Could not execute bundle")
|
||||||
|
(value rest : putStrLn value)
|
||||||
|
(runArboricx bundleBytes arg))
|
||||||
|
result))
|
||||||
|
|
||||||
|
main = io (runBundle "test/fixtures/id.arboricx" "hi")
|
||||||
@@ -1,5 +1,4 @@
|
|||||||
!import "../lib/base.tri" !Local
|
!import "prelude" !Local
|
||||||
!import "../lib/list.tri" !Local
|
|
||||||
|
|
||||||
main = size size
|
main = size size
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,4 @@
|
|||||||
!import "../lib/base.tri" !Local
|
!import "prelude" !Local
|
||||||
!import "../lib/list.tri" !Local
|
|
||||||
|
|
||||||
main = toSource not?
|
main = toSource not?
|
||||||
-- Thanks to intensionality, we can inspect the structure of a given value
|
-- Thanks to intensionality, we can inspect the structure of a given value
|
||||||
|
|||||||
190
demos/viewContracts.tri
Normal file
190
demos/viewContracts.tri
Normal file
@@ -0,0 +1,190 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- View Contracts in tricu
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- Verify this guide passes checking with:
|
||||||
|
--
|
||||||
|
-- tricu check demos/viewContracts.tri
|
||||||
|
--
|
||||||
|
-- Expected output:
|
||||||
|
--
|
||||||
|
-- ok
|
||||||
|
--
|
||||||
|
-- This file uses tricu syntax sugar. The lower-level portable View Tree
|
||||||
|
-- form is shown in demos/viewContracts/complete.tri.
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 1. What's the problem?
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- Programs grow by connecting definitions. A common mistake is connecting a
|
||||||
|
-- value with one shape to code that expects another shape:
|
||||||
|
--
|
||||||
|
-- a function expects Bool, but receives String
|
||||||
|
-- a function returns String, but its caller expects Bool
|
||||||
|
-- a list is expected to contain bytes, but contains strings
|
||||||
|
--
|
||||||
|
-- In a large program, those mistakes are often far away from where the bad value
|
||||||
|
-- was first introduced. View Contracts give tricu a portable way to check those
|
||||||
|
-- boundaries.
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 2. Views: useful built-in shapes
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- A View is a description of the shape we expect at a boundary. tricu includes
|
||||||
|
-- built-in Views for common shapes such as:
|
||||||
|
--
|
||||||
|
-- Bool
|
||||||
|
-- String
|
||||||
|
-- Byte
|
||||||
|
-- Unit
|
||||||
|
-- List View
|
||||||
|
-- Maybe View
|
||||||
|
-- Pair View1 View2
|
||||||
|
-- Fn [View1] View2
|
||||||
|
--
|
||||||
|
-- tricu has unconventional but intuitive sugar for annotations:
|
||||||
|
--
|
||||||
|
-- name =@View value
|
||||||
|
-- function argument@View =@ResultView body
|
||||||
|
--
|
||||||
|
-- These examples are ordinary checked source definitions.
|
||||||
|
|
||||||
|
message =@String "hello"
|
||||||
|
|
||||||
|
names =@(List String) [("Ada") ("Grace")]
|
||||||
|
|
||||||
|
chooseFirst left@String right@String =@String left
|
||||||
|
|
||||||
|
stringIdentity =@(Fn [String] String) (x : x)
|
||||||
|
|
||||||
|
-- Uncommenting the below definition demonstrates a plain View mismatch:
|
||||||
|
--
|
||||||
|
-- bad =@Bool "not a Bool"
|
||||||
|
--
|
||||||
|
-- `tricu check` reports that the value is known as String where Bool was
|
||||||
|
-- required.
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 3. Why don't you just have Types?
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- tricu is built on Tree Calculus. A defining feature of Tree Calculus is
|
||||||
|
-- intensionality: programs can inspect and construct program-shaped trees directly.
|
||||||
|
-- That intensional power is useful, but it makes ordinary sound static typing a
|
||||||
|
-- hard fit. A value can be both data and executable structure, and code can make
|
||||||
|
-- decisions based on tree shape in ways a conventional type checker may not be
|
||||||
|
-- able to predict soundly. This is an area of active research, not a settled
|
||||||
|
-- claim that Tree Calculus languages cannot ever have useful typed variants.
|
||||||
|
--
|
||||||
|
-- View Contracts are not advertised as "the type system for tricu". They are
|
||||||
|
-- a practical contract layer: portable metadata plus checker/runtime boundaries
|
||||||
|
-- that catch many real mistakes while leaving the underlying language intact.
|
||||||
|
|
||||||
|
-- For more information about sound typing for Tree Calculus:
|
||||||
|
-- https://github.com/barry-jay-personal/typed_tree_calculus
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 4. What are the Contracts about, then?
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- `List String` tells us that every element is a String. It does not tell us the
|
||||||
|
-- list has at least one element.
|
||||||
|
--
|
||||||
|
-- That matters for functions like `head`. Calling `head` on an empty list is a
|
||||||
|
-- bug. We want to express the stronger requirement:
|
||||||
|
--
|
||||||
|
-- this is a List String, and it is non-empty
|
||||||
|
--
|
||||||
|
-- That is what a guarded View is for.
|
||||||
|
|
||||||
|
-- A guard is ordinary tricu code. It receives the runtime value and returns:
|
||||||
|
--
|
||||||
|
-- guardOk value -- accept the value
|
||||||
|
-- guardFail -- reject the boundary
|
||||||
|
--
|
||||||
|
-- The guard does not write diagnostics. The checked runner reports where the
|
||||||
|
-- failing boundary came from.
|
||||||
|
|
||||||
|
requireNonEmpty = (xs :
|
||||||
|
lazyBool
|
||||||
|
(_ : guardFail)
|
||||||
|
(_ : guardOk xs)
|
||||||
|
(emptyList? xs))
|
||||||
|
|
||||||
|
-- A user-defined View can be parameterized just like an ordinary function.
|
||||||
|
--
|
||||||
|
-- NonEmptyList String
|
||||||
|
--
|
||||||
|
-- means "a List String guarded by requireNonEmpty".
|
||||||
|
|
||||||
|
NonEmptyList elem = viewGuarded (viewList elem) requireNonEmpty
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 5. Using a custom View in normal annotations
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- This value satisfies the custom contract.
|
||||||
|
|
||||||
|
contributors =@(NonEmptyList String) [("Ada") ("Grace")]
|
||||||
|
|
||||||
|
-- This function requires NonEmptyList String before its body can run. In a
|
||||||
|
-- library, this is the kind of contract you would put on an operation like
|
||||||
|
-- `head`: callers must prove the list is non-empty first.
|
||||||
|
|
||||||
|
acceptNames xs@(NonEmptyList String) =@String "accepted non-empty names"
|
||||||
|
|
||||||
|
primaryContributor =@String acceptNames contributors
|
||||||
|
|
||||||
|
-- Uncommenting this definition demonstrates a guarded View failure:
|
||||||
|
--
|
||||||
|
-- nobody =@(NonEmptyList String) []
|
||||||
|
--
|
||||||
|
-- The structure is fine (`[]` is a List String), but the runtime guard rejects
|
||||||
|
-- it because the list is empty.
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 6. Contracts protect callers too
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- Contracts can describe function results as well as arguments. If a function
|
||||||
|
-- promises to return `NonEmptyList String`, checked execution guards that result
|
||||||
|
-- before callers depend on it.
|
||||||
|
|
||||||
|
mkContributors name@String =@(NonEmptyList String) [(name)]
|
||||||
|
|
||||||
|
fromSingleName =@String acceptNames (mkContributors "Evelyn")
|
||||||
|
|
||||||
|
-- Uncommenting this version would fail because the result contract is too
|
||||||
|
-- strong for the implementation:
|
||||||
|
--
|
||||||
|
-- badContributors name@String =@(NonEmptyList String) []
|
||||||
|
|
||||||
|
-- ============================================================================
|
||||||
|
-- 7. Writing your own Views and Contracts
|
||||||
|
-- ============================================================================
|
||||||
|
--
|
||||||
|
-- The pattern is:
|
||||||
|
--
|
||||||
|
-- 1. Start with the closest structural View.
|
||||||
|
-- 2. Write a guard for the runtime fact the structure cannot express.
|
||||||
|
-- 3. Package them with viewGuarded.
|
||||||
|
-- 4. Use the new View in normal annotations.
|
||||||
|
--
|
||||||
|
-- Examples of useful guarded Views:
|
||||||
|
--
|
||||||
|
-- NonEmptyList String
|
||||||
|
-- SortedList Byte
|
||||||
|
-- FixedLengthBytes 32
|
||||||
|
-- ValidUserId
|
||||||
|
-- NonEmptyString
|
||||||
|
--
|
||||||
|
-- Guards are intentionally runtime checks. Use plain Views for ordinary shape
|
||||||
|
-- checking, and guarded Views when a boundary really must enforce a stronger
|
||||||
|
-- invariant.
|
||||||
|
|
||||||
|
main =@String primaryContributor
|
||||||
137
demos/viewContracts/README.md
Normal file
137
demos/viewContracts/README.md
Normal file
@@ -0,0 +1,137 @@
|
|||||||
|
# View Contract Demos
|
||||||
|
|
||||||
|
These demos exercise the finalized View Contract stack in `lib/view.tri`:
|
||||||
|
portable View Trees/checkable typed-program nodes, structural View flow checks,
|
||||||
|
runtime guarded Views, checked-exec, source annotations, and module-boundary
|
||||||
|
View metadata.
|
||||||
|
|
||||||
|
## End-user guide
|
||||||
|
|
||||||
|
Start here. `demos/viewContracts.tri` is written with normal source annotation
|
||||||
|
sugar and reads as a short guide to View Contracts: motivating structural
|
||||||
|
mismatches, explaining plain Views, noting why this is not a full static type
|
||||||
|
system, and building a custom `NonEmptyList` guarded View.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check demos/viewContracts.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
ok
|
||||||
|
```
|
||||||
|
|
||||||
|
## Complete explicit demo
|
||||||
|
|
||||||
|
`demos/viewContracts/complete.tri` shows the same layer from the portable
|
||||||
|
View Tree/checkable-program side. It uses explicit builders such as
|
||||||
|
`typedValue`, `typedRequire`, and `typedApply`, and demonstrates contextual guard
|
||||||
|
diagnostics, observation composition, reachability, and malformed guard output.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/complete.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
## Portable checker self-tests
|
||||||
|
|
||||||
|
Runs the checker self-test suite carried as ordinary `tricu` code.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/selfTests.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output is a list of `"ok"` strings.
|
||||||
|
|
||||||
|
## Diagnostic rendering
|
||||||
|
|
||||||
|
Shows a strict-mode structural View failure rendered for humans.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/diagnostic.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
"symbol 162 expected List Bool but got List String"
|
||||||
|
```
|
||||||
|
|
||||||
|
## Stdlib-shaped contracts
|
||||||
|
|
||||||
|
Checks successful higher-order contracts shaped like common stdlib APIs.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/stdlibContracts.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
["ok", "ok", "ok", "ok", "ok"]
|
||||||
|
```
|
||||||
|
|
||||||
|
These examples are structural View checks, not runtime guarded checks.
|
||||||
|
|
||||||
|
## Frontend emission layer
|
||||||
|
|
||||||
|
`frontendEmission/` documents the portable artifact shape a frontend can emit
|
||||||
|
after parsing/elaboration. The `*.source.txt` files are pseudo-source; the
|
||||||
|
matching `*.emitted.tri` files are explicit typed-program builder output.
|
||||||
|
|
||||||
|
This layer is still instructive because it shows the exact bridge between source
|
||||||
|
syntax and portable View Tree/checkable metadata.
|
||||||
|
|
||||||
|
## Source syntax sugar
|
||||||
|
|
||||||
|
The `sourceSyntax/` demos use ergonomic annotations and the `tricu check`
|
||||||
|
frontend. The frontend lowers annotations to the same typed-program nodes used by
|
||||||
|
the explicit demos above, then executes checked-exec so guarded annotations fail
|
||||||
|
through the portable runner.
|
||||||
|
|
||||||
|
Successful check:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check demos/viewContracts/sourceSyntax/success.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
ok
|
||||||
|
```
|
||||||
|
|
||||||
|
Labeled diagnostic check:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check demos/viewContracts/sourceSyntax/failure.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected first failing diagnostic:
|
||||||
|
|
||||||
|
```text
|
||||||
|
symbol 4 (x) expected Bool but got String
|
||||||
|
```
|
||||||
|
|
||||||
|
If the first definition is fixed or removed, the later application-result
|
||||||
|
failure demonstrates callee-aware labels:
|
||||||
|
|
||||||
|
```text
|
||||||
|
symbol 3 (g application result) expected String but got Bool
|
||||||
|
```
|
||||||
|
|
||||||
|
## Module boundary layer
|
||||||
|
|
||||||
|
`modules/` shows producer-checked module export Views flowing into a consumer
|
||||||
|
check as module-boundary evidence. During auto-build, annotated exports are
|
||||||
|
checked before the module manifest alias is published. Consumers then use the
|
||||||
|
manifest's View Contract metadata as assumptions, while compatibility is still
|
||||||
|
judged by `lib/view.tri`.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check demos/viewContracts/modules/success.tri
|
||||||
|
# ok
|
||||||
|
|
||||||
|
tricu check demos/viewContracts/modules/failure.tri
|
||||||
|
# symbol 3 (Util.toString application result) expected Bool but got String
|
||||||
|
```
|
||||||
119
demos/viewContracts/complete.tri
Normal file
119
demos/viewContracts/complete.tri
Normal file
@@ -0,0 +1,119 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
|
||||||
|
-- Complete explicit View Contract demo.
|
||||||
|
-- Run with: tricu eval demos/viewContracts/complete.tri -f decode
|
||||||
|
--
|
||||||
|
-- This file uses the low-level portable typed-program builders directly. It is
|
||||||
|
-- useful for understanding what source annotations lower to. For the end-user
|
||||||
|
-- guide, see demos/viewContracts.tri.
|
||||||
|
|
||||||
|
requireNonEmpty = (xs :
|
||||||
|
lazyBool
|
||||||
|
(_ : guardFail)
|
||||||
|
(_ : guardOk xs)
|
||||||
|
(emptyList? xs))
|
||||||
|
|
||||||
|
NonEmptyList = (elemView :
|
||||||
|
viewGuarded (viewList elemView) requireNonEmpty)
|
||||||
|
|
||||||
|
checkedResult = (result :
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(exec env :
|
||||||
|
matchResult
|
||||||
|
(runtimeDiag runtimeEnv : renderDiagnostic runtimeDiag)
|
||||||
|
(value runtimeEnv : value)
|
||||||
|
(runChecked exec))
|
||||||
|
result)
|
||||||
|
|
||||||
|
checkedContract = (program :
|
||||||
|
checkedResult (checkTypedProgramWith policyStrict program))
|
||||||
|
|
||||||
|
plainViewFailure =
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(exec env : "unexpected-ok")
|
||||||
|
(checkTypedProgramWith
|
||||||
|
policyStrict
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 (viewList viewString) [("Ada")])
|
||||||
|
(typedRequire 0 (viewList viewBool) t)]))
|
||||||
|
|
||||||
|
nonEmptyRootSuccess =
|
||||||
|
matchBool
|
||||||
|
"ok"
|
||||||
|
"unexpected-value"
|
||||||
|
(equal?
|
||||||
|
(checkedContract
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 (NonEmptyList viewString) [("Ada") ("Grace")])]))
|
||||||
|
[("Ada") ("Grace")])
|
||||||
|
|
||||||
|
nonEmptyRootFailure =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 (viewList viewString) [])
|
||||||
|
(typedRequire 0 (NonEmptyList viewString) [])])
|
||||||
|
|
||||||
|
firstNameSuccess =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
2
|
||||||
|
[(typedValue 0 (viewFn [(NonEmptyList viewString)] viewString) (xs : head xs))
|
||||||
|
(typedValue 1 (viewList viewString) [("Ada") ("Grace")])
|
||||||
|
(typedApply 2 0 1 "Ada")
|
||||||
|
(typedRequire 2 viewString "Ada")])
|
||||||
|
|
||||||
|
firstNameFailure =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
2
|
||||||
|
[(typedValue 0 (viewFn [(NonEmptyList viewString)] viewString) (xs : head xs))
|
||||||
|
(typedValue 1 (viewList viewString) [])
|
||||||
|
(typedApply 2 0 1 t)
|
||||||
|
(typedRequire 2 viewString t)])
|
||||||
|
|
||||||
|
resultGuardFailure =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
2
|
||||||
|
[(typedValue 0 (viewFn [(viewString)] (NonEmptyList viewString)) (name : []))
|
||||||
|
(typedValue 1 viewString "Ada")
|
||||||
|
(typedApply 2 0 1 [])])
|
||||||
|
|
||||||
|
observationComposition =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 viewString "Ada")
|
||||||
|
(typedRequire 0 (viewGuarded viewString (x : guardOk (append x " Lovelace"))) "Ada")
|
||||||
|
(typedRequire 0 (viewGuarded viewString (x : guardOk (append x "!"))) "Ada")])
|
||||||
|
|
||||||
|
unreachableGuard =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 viewString "only the root is checked")
|
||||||
|
(typedValue 1 (viewList viewString) [])
|
||||||
|
(typedRequire 1 (NonEmptyList viewString) [])])
|
||||||
|
|
||||||
|
malformedGuard =
|
||||||
|
checkedContract
|
||||||
|
(typedProgram
|
||||||
|
0
|
||||||
|
[(typedValue 0 (viewGuarded viewString (x : record 99 t)) "bad guard")])
|
||||||
|
|
||||||
|
main = [
|
||||||
|
(append "plain View structural failure: " plainViewFailure)
|
||||||
|
(append "NonEmptyList root success: " nonEmptyRootSuccess)
|
||||||
|
(append "NonEmptyList root failure: " nonEmptyRootFailure)
|
||||||
|
(append "NonEmptyList function argument success: " firstNameSuccess)
|
||||||
|
(append "NonEmptyList function argument failure: " firstNameFailure)
|
||||||
|
(append "NonEmptyList function result failure: " resultGuardFailure)
|
||||||
|
(append "guard observations compose: " observationComposition)
|
||||||
|
(append "unreachable guard does not run: " unreachableGuard)
|
||||||
|
(append "malformed guard result: " malformedGuard)]
|
||||||
9
demos/viewContracts/diagnostic.tri
Normal file
9
demos/viewContracts/diagnostic.tri
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
main =
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(env rest : "ok")
|
||||||
|
(checkTypedProgramWith policyStrict listMapWrongListArgContract)
|
||||||
116
demos/viewContracts/frontendEmission/README.md
Normal file
116
demos/viewContracts/frontendEmission/README.md
Normal file
@@ -0,0 +1,116 @@
|
|||||||
|
# Frontend Emission Demos
|
||||||
|
|
||||||
|
These examples show the layer between source-level View annotations and the
|
||||||
|
portable View Contract checker.
|
||||||
|
|
||||||
|
Each `*.source.txt` file is pseudo-source: it is not parsed by `tricu`. It shows
|
||||||
|
the information a frontend has after parsing/elaboration.
|
||||||
|
|
||||||
|
Each matching `*.emitted.tri` file shows the lowered typed-program metadata that
|
||||||
|
a frontend can emit today. A successful check returns checked-exec; these demos
|
||||||
|
focus on structural Views, so they report `"ok"` as soon as metadata checking
|
||||||
|
succeeds. Guarded programs should run the returned checked-exec with
|
||||||
|
`runChecked`, as shown in `demos/viewContracts.tri` and by `tricu check`.
|
||||||
|
|
||||||
|
## Successful map use
|
||||||
|
|
||||||
|
Pseudo-source:
|
||||||
|
|
||||||
|
```text
|
||||||
|
map : Fn [Fn [Bool] String, List Bool] (List String)
|
||||||
|
f : Fn [Bool] String
|
||||||
|
xs : List Bool
|
||||||
|
|
||||||
|
partial = map f
|
||||||
|
out = partial xs
|
||||||
|
|
||||||
|
require out : List String
|
||||||
|
```
|
||||||
|
|
||||||
|
Run the emitted artifact:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/frontendEmission/map-success.emitted.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
"ok"
|
||||||
|
```
|
||||||
|
|
||||||
|
## Wrong list argument
|
||||||
|
|
||||||
|
Pseudo-source:
|
||||||
|
|
||||||
|
```text
|
||||||
|
map : Fn [Fn [Bool] String, List Bool] (List String)
|
||||||
|
f : Fn [Bool] String
|
||||||
|
xs : List String
|
||||||
|
|
||||||
|
partial = map f
|
||||||
|
out = partial xs
|
||||||
|
```
|
||||||
|
|
||||||
|
Run:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/frontendEmission/map-wrong-list.emitted.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
"symbol 162 expected List Bool but got List String"
|
||||||
|
```
|
||||||
|
|
||||||
|
## Wrong filter predicate
|
||||||
|
|
||||||
|
Pseudo-source:
|
||||||
|
|
||||||
|
```text
|
||||||
|
filter : Fn [Fn [Bool] Bool, List Bool] (List Bool)
|
||||||
|
pred : Fn [Bool] String
|
||||||
|
xs : List Bool
|
||||||
|
|
||||||
|
partial = filter pred
|
||||||
|
out = partial xs
|
||||||
|
```
|
||||||
|
|
||||||
|
Run:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu eval demos/viewContracts/frontendEmission/filter-wrong-predicate.emitted.tri -f decode
|
||||||
|
```
|
||||||
|
|
||||||
|
Expected output:
|
||||||
|
|
||||||
|
```text
|
||||||
|
"symbol 181 expected Fn [Bool] Bool but got Fn [Bool] String"
|
||||||
|
```
|
||||||
|
|
||||||
|
## Lowering shape
|
||||||
|
|
||||||
|
A frontend does not need to expose `tricu` syntax internally. It only needs to
|
||||||
|
emit portable typed-program nodes:
|
||||||
|
|
||||||
|
```text
|
||||||
|
typedValue symbol view term
|
||||||
|
typedApply out callee arg term
|
||||||
|
typedRequire symbol view term
|
||||||
|
```
|
||||||
|
|
||||||
|
The source-level flow:
|
||||||
|
|
||||||
|
```text
|
||||||
|
out = map f xs
|
||||||
|
```
|
||||||
|
|
||||||
|
lowers to curried Tree Calculus application nodes:
|
||||||
|
|
||||||
|
```text
|
||||||
|
typedApply partial map f partialTerm
|
||||||
|
typedApply out partial xs outTerm
|
||||||
|
```
|
||||||
|
|
||||||
|
Function Views drive argument checking and result inference.
|
||||||
@@ -0,0 +1,17 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
-- Lowering of filter-wrong-predicate.source.txt to portable typed-program metadata.
|
||||||
|
-- Symbols:
|
||||||
|
-- 180 filter
|
||||||
|
-- 181 pred
|
||||||
|
-- 182 partial
|
||||||
|
|
||||||
|
program = listFilterWrongPredicateContract
|
||||||
|
|
||||||
|
main =
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(env rest : "unexpected-ok")
|
||||||
|
(checkTypedProgramWith policyStrict program)
|
||||||
20
demos/viewContracts/frontendEmission/map-success.emitted.tri
Normal file
20
demos/viewContracts/frontendEmission/map-success.emitted.tri
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
-- Lowering of map-success.source.txt to portable typed-program metadata.
|
||||||
|
-- Symbols:
|
||||||
|
-- 100 map
|
||||||
|
-- 101 f
|
||||||
|
-- 102 xs
|
||||||
|
-- 103 partial
|
||||||
|
-- 104 out
|
||||||
|
|
||||||
|
program =
|
||||||
|
listMapUseContract viewBool viewString 100 101 102 103 104
|
||||||
|
|
||||||
|
main =
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(env rest : "ok")
|
||||||
|
(checkTypedProgramWith policyStrict program)
|
||||||
@@ -0,0 +1,19 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
-- Lowering of map-wrong-list.source.txt to portable typed-program metadata.
|
||||||
|
-- Symbols:
|
||||||
|
-- 160 map
|
||||||
|
-- 161 f
|
||||||
|
-- 162 xs
|
||||||
|
-- 163 partial
|
||||||
|
-- 164 out
|
||||||
|
|
||||||
|
program = listMapWrongListArgContract
|
||||||
|
|
||||||
|
main =
|
||||||
|
matchResult
|
||||||
|
(diag env : renderDiagnostic diag)
|
||||||
|
(env rest : "unexpected-ok")
|
||||||
|
(checkTypedProgramWith policyStrict program)
|
||||||
30
demos/viewContracts/io-continuation.tri
Normal file
30
demos/viewContracts/io-continuation.tri
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
|
||||||
|
-- View Contracts inside IO continuations
|
||||||
|
-- Run with:
|
||||||
|
--
|
||||||
|
-- tricu eval demos/viewContracts/io-continuation.tri --io -f decode
|
||||||
|
--
|
||||||
|
-- Checked IO evaluation instruments continuation bodies once from source
|
||||||
|
-- annotations. The IO runtime still executes ordinary interaction-tree actions;
|
||||||
|
-- the returned continuations already contain the checked-exec guard boundaries.
|
||||||
|
|
||||||
|
requireNonEmpty = (xs :
|
||||||
|
lazyBool
|
||||||
|
(_ : guardFail)
|
||||||
|
(_ : guardOk xs)
|
||||||
|
(emptyList? xs))
|
||||||
|
|
||||||
|
NonEmptyList elem = viewGuarded (viewList elem) requireNonEmpty
|
||||||
|
|
||||||
|
acceptNames xs@(NonEmptyList String) =@String "accepted"
|
||||||
|
|
||||||
|
useHandler handler@(Fn [(NonEmptyList String)] String) xs@(List String) =@String
|
||||||
|
handler xs
|
||||||
|
|
||||||
|
-- The IO action yields an empty list. The higher-order boundary requires a
|
||||||
|
-- handler that accepts NonEmptyList String, so the continuation-internal pure
|
||||||
|
-- call fails before returning the next IO value.
|
||||||
|
main = io (bind (pure []) (xs : pure (useHandler acceptNames xs)))
|
||||||
51
demos/viewContracts/io.tri
Normal file
51
demos/viewContracts/io.tri
Normal file
@@ -0,0 +1,51 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
|
||||||
|
-- View Contracts + IO interaction trees
|
||||||
|
-- Run with:
|
||||||
|
--
|
||||||
|
-- tricu eval demos/viewContracts/io.tri --io -f decode
|
||||||
|
--
|
||||||
|
-- The IO runtime expects the top-level value to be an interaction tree wrapped
|
||||||
|
-- by the `io` sentinel:
|
||||||
|
--
|
||||||
|
-- pair "tricuIO" (pair version action)
|
||||||
|
--
|
||||||
|
-- View Contracts can validate that boundary before the IO driver starts. The IO
|
||||||
|
-- value is still just an interaction tree; this demo only checks how it was
|
||||||
|
-- exposed.
|
||||||
|
|
||||||
|
ioSentinel? = (value :
|
||||||
|
and?
|
||||||
|
(equal? (fst value) "tricuIO")
|
||||||
|
(equal? (fst (snd value)) 1))
|
||||||
|
|
||||||
|
requireIO = (value :
|
||||||
|
lazyBool
|
||||||
|
(_ : guardOk value)
|
||||||
|
(_ : guardFail)
|
||||||
|
(ioSentinel? value))
|
||||||
|
|
||||||
|
-- A first useful IO View is intentionally shallow:
|
||||||
|
--
|
||||||
|
-- viewAny -- accept any payload structurally
|
||||||
|
-- requireIO sentinel -- require the top-level IO wrapper at runtime
|
||||||
|
--
|
||||||
|
-- This does not prove every future continuation step is well-formed. It proves
|
||||||
|
-- the checked program exposes an IO interaction tree to the host driver.
|
||||||
|
viewIO = viewGuarded viewAny requireIO
|
||||||
|
|
||||||
|
checkedIO = (action :
|
||||||
|
matchResult
|
||||||
|
(diag env : io (pure (renderDiagnostic diag)))
|
||||||
|
(exec env :
|
||||||
|
matchResult
|
||||||
|
(runtimeDiag runtimeEnv : io (pure (renderDiagnostic runtimeDiag)))
|
||||||
|
(value runtimeEnv : value)
|
||||||
|
(runChecked exec))
|
||||||
|
(checkTypedProgramWith
|
||||||
|
policyStrict
|
||||||
|
(typedProgram 0 [(typedValue 0 viewIO action)])))
|
||||||
|
|
||||||
|
main = checkedIO (io (pure "checked interaction tree"))
|
||||||
17
demos/viewContracts/modules/README.md
Normal file
17
demos/viewContracts/modules/README.md
Normal file
@@ -0,0 +1,17 @@
|
|||||||
|
# Module View Contract demo
|
||||||
|
|
||||||
|
This demo shows producer-checked module export Views flowing into a consumer
|
||||||
|
check as trusted View Contract evidence.
|
||||||
|
|
||||||
|
```sh
|
||||||
|
tricu check demos/viewContracts/modules/success.tri
|
||||||
|
# ok
|
||||||
|
|
||||||
|
tricu check demos/viewContracts/modules/failure.tri
|
||||||
|
# symbol 3 (Util.toString application result) expected Bool but got String
|
||||||
|
```
|
||||||
|
|
||||||
|
`util.tri` is a local workspace module. During auto-build, its annotated exports
|
||||||
|
are checked before the module manifest alias is published. The consumer then
|
||||||
|
uses the manifest's View Contract metadata and View Tree export artifacts as
|
||||||
|
module-boundary assumptions; compatibility is still judged by `lib/view.tri`.
|
||||||
3
demos/viewContracts/modules/failure.tri
Normal file
3
demos/viewContracts/modules/failure.tri
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
!import "vc.demo.util" Util
|
||||||
|
|
||||||
|
foo x@Bool =@Bool Util.toString x
|
||||||
3
demos/viewContracts/modules/success.tri
Normal file
3
demos/viewContracts/modules/success.tri
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
!import "vc.demo.util" Util
|
||||||
|
|
||||||
|
foo x@Bool =@Bool Util.id x
|
||||||
1
demos/viewContracts/modules/tricu.workspace
Normal file
1
demos/viewContracts/modules/tricu.workspace
Normal file
@@ -0,0 +1 @@
|
|||||||
|
module vc.demo.util = util.tri
|
||||||
2
demos/viewContracts/modules/util.tri
Normal file
2
demos/viewContracts/modules/util.tri
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
id x@Bool =@Bool x
|
||||||
|
toString x@Bool =@String "ok"
|
||||||
3
demos/viewContracts/selfTests.tri
Normal file
3
demos/viewContracts/selfTests.tri
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
main = viewCatalogSelfTests
|
||||||
9
demos/viewContracts/sourceSyntax/failure.tri
Normal file
9
demos/viewContracts/sourceSyntax/failure.tri
Normal file
@@ -0,0 +1,9 @@
|
|||||||
|
-- Source-level View Contract diagnostic demo.
|
||||||
|
-- Run with: tricu check demos/viewContracts/sourceSyntax/failure.tri
|
||||||
|
|
||||||
|
makeBool x@String =@Bool x
|
||||||
|
|
||||||
|
xs =@(List String) [(g "hi")]
|
||||||
|
g y@String =@Bool y
|
||||||
|
|
||||||
|
main = "if you're seeing this instead of an error, you ran the file unchecked"
|
||||||
10
demos/viewContracts/sourceSyntax/success.tri
Normal file
10
demos/viewContracts/sourceSyntax/success.tri
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
-- Source-level View Contract syntax sugar demo.
|
||||||
|
-- Run with: tricu check demos/viewContracts/sourceSyntax/success.tri
|
||||||
|
|
||||||
|
message =@String "hello"
|
||||||
|
|
||||||
|
boxedMessages =@(Maybe (List String)) just [(message) ("world")]
|
||||||
|
|
||||||
|
chooseFirst x@String y@Byte =@String x
|
||||||
|
|
||||||
|
fromLambda =@(Fn [String] String) (x : x)
|
||||||
10
demos/viewContracts/stdlibContracts.tri
Normal file
10
demos/viewContracts/stdlibContracts.tri
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "view" !Local
|
||||||
|
!import "views.catalog" !Local
|
||||||
|
|
||||||
|
main = [
|
||||||
|
(typedContractCheck listMapBoolStringContract)
|
||||||
|
(typedContractCheck headMaybeBoolContract)
|
||||||
|
(typedContractCheck listFilterBoolContract)
|
||||||
|
(typedContractCheck listFoldStringBoolContract)
|
||||||
|
(typedContractCheck listMapMaybeBoolStringContract)]
|
||||||
364
docs/arboricx-bundle-format.md
Normal file
364
docs/arboricx-bundle-format.md
Normal file
@@ -0,0 +1,364 @@
|
|||||||
|
# Arboricx Portable Bundle Format Specification
|
||||||
|
|
||||||
|
**Version:** 1.1 (Indexed)
|
||||||
|
|
||||||
|
**Status:** Stable
|
||||||
|
|
||||||
|
**Author:** Slopmachines guided by James Eversole
|
||||||
|
|
||||||
|
The Arboricx Portable Bundle is a self-contained binary format for distributing Tree Calculus programs. It uses topological indexing instead of cryptographic hashing for node identity, making it writable from pure Tree Calculus and verifiable via structural inspection.
|
||||||
|
|
||||||
|
## Table of Contents
|
||||||
|
|
||||||
|
1. [Design Principles](#1-design-principles)
|
||||||
|
2. [Top-Level Container Layout](#2-top-level-container-layout)
|
||||||
|
3. [Header](#3-header)
|
||||||
|
4. [Section Directory](#4-section-directory)
|
||||||
|
5. [Section: Manifest (type 1)](#5-section-manifest-type-1)
|
||||||
|
6. [Section: Nodes (type 2)](#6-section-nodes-type-2)
|
||||||
|
7. [Node Payload Format](#7-node-payload-format)
|
||||||
|
8. [Tree Calculus Reduction Semantics](#8-tree-calculus-reduction-semantics)
|
||||||
|
9. [Binary Primitives](#9-binary-primitives)
|
||||||
|
10. [Bundle Verification](#10-bundle-verification)
|
||||||
|
11. [Canonicalization](#11-canonicalization)
|
||||||
|
12. [Known Section Types](#12-known-section-types)
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 1. Design Principles
|
||||||
|
|
||||||
|
- **No cryptographic primitives required.** Node identity is topological (array index), not a SHA-256 hash.
|
||||||
|
- **Self-contained.** A bundle includes all nodes reachable from its exports. No external references.
|
||||||
|
- **Deterministic.** Canonical bundles produce byte-identical output for identical input terms.
|
||||||
|
- **Small.** ~5 bytes per node entry (length + payload) versus ~36 bytes in hash-based formats.
|
||||||
|
- **Verifiable via structure.** Bounds checking and acyclicity verification replace hash recomputation.
|
||||||
|
|
||||||
|
Global artifact identity (for registries, lockfiles, or content-addressed caches) is achieved by hashing the complete canonical bundle file externally. The bundle format itself knows nothing about this hash.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 2. Top-Level Container Layout
|
||||||
|
|
||||||
|
```
|
||||||
|
+------------------+------------------+------------------+------------------+
|
||||||
|
| Header | Section Directory| Manifest Section | Nodes Section |
|
||||||
|
| (32 bytes) | (N × 32 bytes) | (variable) | (variable) |
|
||||||
|
+------------------+------------------+------------------+------------------+
|
||||||
|
```
|
||||||
|
|
||||||
|
Total bundle size = 32 + (sectionCount × 32) + manifestSize + nodesSize
|
||||||
|
|
||||||
|
All multi-byte integers use **big-endian** byte order.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 3. Header
|
||||||
|
|
||||||
|
| Offset | Size | Field | Description |
|
||||||
|
|--------|------|-------|-------------|
|
||||||
|
| 0 | 8 bytes | Magic | ASCII `"ARBORICX"` |
|
||||||
|
| 8 | 2 bytes | Major version | `u16` BE. Currently `1` |
|
||||||
|
| 10 | 2 bytes | Minor version | `u16` BE. Currently `0` |
|
||||||
|
| 12 | 4 bytes | Section count | `u32` BE. Number of entries in the section directory |
|
||||||
|
| 16 | 8 bytes | Flags | `u64` BE. Reserved; currently all zeros |
|
||||||
|
| 24 | 8 bytes | Directory offset | `u64` BE. Byte offset to the section directory (always `32`) |
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 4. Section Directory
|
||||||
|
|
||||||
|
Array of `N` entries, each exactly **32 bytes**.
|
||||||
|
|
||||||
|
| Offset (within entry) | Size | Field | Description |
|
||||||
|
|----------------------|------|-------|-------------|
|
||||||
|
| 0 | 4 bytes | Type | `u32` BE. Section type identifier |
|
||||||
|
| 4 | 2 bytes | Version | `u16` BE. Section-specific version |
|
||||||
|
| 6 | 2 bytes | Flags | `u16` BE. Bit 0 (`0x0001`) = critical section |
|
||||||
|
| 8 | 2 bytes | Compression | `u16` BE. `0` = none (currently the only value) |
|
||||||
|
| 10 | 2 bytes | Reserved | `u16` BE. Padding; must be zero |
|
||||||
|
| 12 | 8 bytes | Offset | `u64` BE. Byte offset from bundle start to section data |
|
||||||
|
| 20 | 8 bytes | Length | `u64` BE. Length of section data in bytes |
|
||||||
|
| 28 | 4 bytes | Reserved | Padding; must be zero |
|
||||||
|
|
||||||
|
**Verification:**
|
||||||
|
- Unknown critical sections are rejected.
|
||||||
|
- Compression must be `0` (none).
|
||||||
|
- Reserved fields must be zero.
|
||||||
|
|
||||||
|
**Note:** No per-section digest is stored. Integrity is verified at the distribution layer (e.g. SHA-256 of the complete bundle file) rather than inside the container.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 5. Section: Manifest (type 1)
|
||||||
|
|
||||||
|
Binary encoding of bundle metadata. Fixed-order core layout followed by optional TLV tail.
|
||||||
|
|
||||||
|
```
|
||||||
|
Manifest =
|
||||||
|
magic 8 bytes "ARBMNFST"
|
||||||
|
major u16 BE Manifest major version (1)
|
||||||
|
minor u16 BE Manifest minor version (1)
|
||||||
|
|
||||||
|
schema string "arboricx.bundle.manifest.v1"
|
||||||
|
bundleType string "tree-calculus-executable-object"
|
||||||
|
|
||||||
|
treeCalculus string "tree-calculus.v1"
|
||||||
|
treeHashAlgorithm string "indexed"
|
||||||
|
treeHashDomain string "arboricx.indexed.node.v1"
|
||||||
|
treeNodePayload string "arboricx.indexed.payload.v1"
|
||||||
|
|
||||||
|
runtimeSemantics string "tree-calculus.v1"
|
||||||
|
runtimeEvaluation string "normal-order"
|
||||||
|
runtimeAbi string "arboricx.abi.tree.v1"
|
||||||
|
capabilityCount u32 BE Number of capability strings (currently 0)
|
||||||
|
capabilities string[] Array of length-prefixed UTF-8 strings
|
||||||
|
|
||||||
|
closure u8 0 = complete
|
||||||
|
rootCount u32 BE Number of root entries
|
||||||
|
roots Root[] Array of root entries
|
||||||
|
exportCount u32 BE Number of export entries
|
||||||
|
exports Export[] Array of export entries
|
||||||
|
|
||||||
|
metadataFieldCount u32 BE Number of metadata TLV entries
|
||||||
|
metadataFields TLV[] Metadata tag-value entries
|
||||||
|
extensionFieldCount u32 BE Number of extension TLV entries (currently 0)
|
||||||
|
extensionFields TLV[] Extension entries (skipped by parsers)
|
||||||
|
```
|
||||||
|
|
||||||
|
### String Format
|
||||||
|
|
||||||
|
```
|
||||||
|
string =
|
||||||
|
length u32 BE Number of UTF-8 bytes
|
||||||
|
bytes byte[length] UTF-8 content
|
||||||
|
```
|
||||||
|
|
||||||
|
### Root Entry
|
||||||
|
|
||||||
|
```
|
||||||
|
Root =
|
||||||
|
index u32 BE Node index into the nodes section
|
||||||
|
role string Length-prefixed UTF-8 ("default" for first root, "root" for others)
|
||||||
|
```
|
||||||
|
|
||||||
|
### Export Entry
|
||||||
|
|
||||||
|
```
|
||||||
|
Export =
|
||||||
|
name string Length-prefixed UTF-8 export identifier
|
||||||
|
root u32 BE Node index into the nodes section
|
||||||
|
kind string Length-prefixed UTF-8 (currently "term")
|
||||||
|
abi string Length-prefixed UTF-8 ABI string
|
||||||
|
```
|
||||||
|
|
||||||
|
### TLV Entry
|
||||||
|
|
||||||
|
```
|
||||||
|
TLV =
|
||||||
|
tag u16 BE Tag identifier
|
||||||
|
length u32 BE Value length in bytes
|
||||||
|
value byte[length]
|
||||||
|
```
|
||||||
|
|
||||||
|
### Metadata Tags
|
||||||
|
|
||||||
|
| Tag | Name | Value |
|
||||||
|
|-----|------|-------|
|
||||||
|
| 1 | package | UTF-8 text |
|
||||||
|
| 2 | version | UTF-8 text |
|
||||||
|
| 3 | description | UTF-8 text |
|
||||||
|
| 4 | license | UTF-8 text |
|
||||||
|
| 5 | createdBy | UTF-8 text |
|
||||||
|
|
||||||
|
Unknown metadata tags are ignored. Unknown extension tags are skipped by length.
|
||||||
|
|
||||||
|
### Semantic Constraints
|
||||||
|
|
||||||
|
| Constraint | Value |
|
||||||
|
|-----------|-------|
|
||||||
|
| `schema` | `"arboricx.bundle.manifest.v1"` |
|
||||||
|
| `bundleType` | `"tree-calculus-executable-object"` |
|
||||||
|
| `treeCalculus` | `"tree-calculus.v1"` |
|
||||||
|
| `treeHashAlgorithm` | `"indexed"` |
|
||||||
|
| `treeHashDomain` | `"arboricx.indexed.node.v1"` |
|
||||||
|
| `treeNodePayload` | `"arboricx.indexed.payload.v1"` |
|
||||||
|
| `runtimeSemantics` | `"tree-calculus.v1"` |
|
||||||
|
| `runtimeAbi` | `"arboricx.abi.tree.v1"` |
|
||||||
|
| `closure` | `0` (complete) |
|
||||||
|
| `rootCount` | At least 1 |
|
||||||
|
| `exportCount` | At least 1 |
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 6. Section: Nodes (type 2)
|
||||||
|
|
||||||
|
```
|
||||||
|
NodesSection =
|
||||||
|
nodeCount u64 BE Total number of node entries
|
||||||
|
entries NodeEntry[]
|
||||||
|
```
|
||||||
|
|
||||||
|
### Node Entry
|
||||||
|
|
||||||
|
```
|
||||||
|
NodeEntry =
|
||||||
|
payloadLen u32 BE Length of payload in bytes
|
||||||
|
payload byte[payloadLen]
|
||||||
|
```
|
||||||
|
|
||||||
|
There is **no hash field**. The node is identified solely by its position in the array.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 7. Node Payload Format
|
||||||
|
|
||||||
|
Child references are `u32` big-endian indices into the node array. The array **must** be topologically sorted: every child index must be strictly less than the entry's own position.
|
||||||
|
|
||||||
|
### Leaf
|
||||||
|
|
||||||
|
```
|
||||||
|
Payload = 0x00
|
||||||
|
```
|
||||||
|
|
||||||
|
Exactly 1 byte.
|
||||||
|
|
||||||
|
### Stem
|
||||||
|
|
||||||
|
```
|
||||||
|
Payload = 0x01 || child_index (u32 BE)
|
||||||
|
```
|
||||||
|
|
||||||
|
Exactly 5 bytes.
|
||||||
|
|
||||||
|
### Fork
|
||||||
|
|
||||||
|
```
|
||||||
|
Payload = 0x02 || left_index (u32 BE) || right_index (u32 BE)
|
||||||
|
```
|
||||||
|
|
||||||
|
Exactly 9 bytes.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 8. Tree Calculus Reduction Semantics
|
||||||
|
|
||||||
|
The bundle represents a **Tree Calculus** term. The reduction rules are:
|
||||||
|
|
||||||
|
```
|
||||||
|
The t operator is left associative.
|
||||||
|
1. t t a b -> a
|
||||||
|
2. t (t a) b c -> a c (b c)
|
||||||
|
3a. t (t a b) c t -> a
|
||||||
|
3b. t (t a b) c (t u) -> b u
|
||||||
|
3c. t (t a b) c (t u v) -> c u v
|
||||||
|
```
|
||||||
|
|
||||||
|
**Closure:** The bundle declares `closure = "complete"`, meaning all nodes reachable from export roots are present in the nodes section. No external references exist.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 9. Binary Primitives
|
||||||
|
|
||||||
|
### u8
|
||||||
|
|
||||||
|
Single byte, value `0-255`.
|
||||||
|
|
||||||
|
### u16 (2 bytes)
|
||||||
|
|
||||||
|
```
|
||||||
|
value = (byte[0] << 8) | byte[1]
|
||||||
|
```
|
||||||
|
|
||||||
|
### u32 (4 bytes)
|
||||||
|
|
||||||
|
```
|
||||||
|
value = (byte[0] << 24) | (byte[1] << 16) | (byte[2] << 8) | byte[3]
|
||||||
|
```
|
||||||
|
|
||||||
|
### u64 (8 bytes)
|
||||||
|
|
||||||
|
```
|
||||||
|
value = (byte[0] << 56) | ... | byte[7]
|
||||||
|
```
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 10. Bundle Verification
|
||||||
|
|
||||||
|
1. **Magic check:** First 8 bytes must be `"ARBORICX"`.
|
||||||
|
2. **Version check:** Major version must be `1`.
|
||||||
|
3. **Section directory:** Parse all entries; reject unknown critical sections. Verify reserved fields are zero.
|
||||||
|
4. **Manifest parsing:** Decode fixed-order manifest; validate semantic constraints.
|
||||||
|
5. **Nodes section:** Parse all entries.
|
||||||
|
6. **Bounds checking:**
|
||||||
|
- Every root index `< nodeCount`
|
||||||
|
- Every export index `< nodeCount`
|
||||||
|
- In every Stem payload, `child_index < entry_position` and `child_index < nodeCount`
|
||||||
|
- In every Fork payload, both indices `< entry_position` and `< nodeCount`
|
||||||
|
7. **Acyclicity:** Guaranteed by the `child < parent` rule above.
|
||||||
|
8. **Closure:** Traverse from all root/export indices; confirm every reached index is valid.
|
||||||
|
|
||||||
|
No hash computation is required.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 11. Canonicalization
|
||||||
|
|
||||||
|
A bundle is **canonical** iff:
|
||||||
|
|
||||||
|
1. **Maximal deduplication.** No two entries represent structurally identical subtrees.
|
||||||
|
2. **Topological order.** Children precede parents.
|
||||||
|
3. **Deterministic post-order traversal.** Nodes are emitted in the order discovered by a left-to-right recursive post-order walk.
|
||||||
|
4. **No trailing bytes** in any section.
|
||||||
|
5. **Reserved fields are zero.**
|
||||||
|
|
||||||
|
Canonical bundles produce deterministic bytes and can be file-level hashed for global identity.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## 12. Known Section Types
|
||||||
|
|
||||||
|
| Type | Name | Required | Version | Description |
|
||||||
|
|------|------|----------|---------|-------------|
|
||||||
|
| 1 | Manifest | Yes | 1 | Bundle metadata |
|
||||||
|
| 2 | Nodes | Yes | 1 | Topological DAG node entries |
|
||||||
|
|
||||||
|
Unknown section types are permitted if not marked critical.
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Appendix A: Complete Example Layout
|
||||||
|
|
||||||
|
A minimal bundle for `Stem(Leaf)` (the Tree Calculus encoding of `t t`):
|
||||||
|
|
||||||
|
```
|
||||||
|
+---------------------------------------------------+
|
||||||
|
| Header (32 bytes) |
|
||||||
|
| Magic: "ARBORICX" |
|
||||||
|
| Major: 1, Minor: 0 |
|
||||||
|
| Section count: 2 |
|
||||||
|
| Flags: 0 |
|
||||||
|
| Dir offset: 32 |
|
||||||
|
+---------------------------------------------------+
|
||||||
|
| Section Directory (64 bytes = 2 × 32) |
|
||||||
|
| Entry 0: type=1 (manifest), offset=96, len=~200 |
|
||||||
|
| Entry 1: type=2 (nodes), offset=~296, len=10 |
|
||||||
|
+---------------------------------------------------+
|
||||||
|
| Manifest Section (~200 bytes) |
|
||||||
|
| Magic: "ARBMNFST", Version: 1.1 |
|
||||||
|
| Schema, bundleType, tree spec, runtime spec |
|
||||||
|
| Closure: 0, Roots: [1], Exports: ["main" -> 1] |
|
||||||
|
| Metadata TLVs, zero extension fields |
|
||||||
|
+---------------------------------------------------+
|
||||||
|
| Nodes Section (10 bytes) |
|
||||||
|
| Node count: 2 |
|
||||||
|
| Entry 0: payloadLen=1, payload=[0x00] |
|
||||||
|
| Entry 1: payloadLen=5, payload=[0x01, 0,0,0,0] |
|
||||||
|
+---------------------------------------------------+
|
||||||
|
```
|
||||||
|
|
||||||
|
---
|
||||||
|
|
||||||
|
## Appendix B: File Extension
|
||||||
|
|
||||||
|
Bundles use the `.arboricx` file extension. Plain source files use `.tri`.
|
||||||
596
docs/content-store-and-module-format.md
Normal file
596
docs/content-store-and-module-format.md
Normal file
@@ -0,0 +1,596 @@
|
|||||||
|
# Content Store and Module Format Design
|
||||||
|
|
||||||
|
Status: concrete design draft.
|
||||||
|
|
||||||
|
This document narrows the higher-level module-system direction into concrete
|
||||||
|
format and storage decisions. It intentionally avoids source/provenance details:
|
||||||
|
modules export usable portable artifacts, not edit history.
|
||||||
|
|
||||||
|
Related design overview: `docs/module-system-design.md`.
|
||||||
|
|
||||||
|
## 1. Scope
|
||||||
|
|
||||||
|
This document specifies the first target shape for:
|
||||||
|
|
||||||
|
- a neutral filesystem-backed content-addressed store;
|
||||||
|
- Arboricx Merkle node persistence;
|
||||||
|
- indexed Arboricx bundle import/export as transport;
|
||||||
|
- module manifests as immutable export maps;
|
||||||
|
- workspace aliases as mutable human-facing references;
|
||||||
|
- View Contract artifact attachment to module exports.
|
||||||
|
|
||||||
|
It does not specify:
|
||||||
|
|
||||||
|
- package manager semantics;
|
||||||
|
- dependency solving;
|
||||||
|
- source-level rebuild/provenance metadata;
|
||||||
|
- final import syntax;
|
||||||
|
- garbage collection;
|
||||||
|
- registry/sync protocol.
|
||||||
|
|
||||||
|
## 2. Non-Negotiable Boundaries
|
||||||
|
|
||||||
|
The content store is not `tricu`-specific and is not Haskell-specific.
|
||||||
|
|
||||||
|
The store may contain objects produced by `tricu`, Haskell, Tree Calculus tools,
|
||||||
|
Arboricx tooling, or future frontends. The store core only knows object bytes,
|
||||||
|
object kinds, hashes, aliases, and optionally structural references for known
|
||||||
|
portable formats.
|
||||||
|
|
||||||
|
View Contracts may be first-class artifact references because they are portable
|
||||||
|
Tree Calculus data checked by pure Tree Calculus code. They are not
|
||||||
|
Haskell-private semantics.
|
||||||
|
|
||||||
|
Source and build provenance are intentionally excluded from the first module
|
||||||
|
manifest format. A module manifest answers:
|
||||||
|
|
||||||
|
```text
|
||||||
|
What portable artifacts does this module export, and what portable contracts are
|
||||||
|
paired with them?
|
||||||
|
```
|
||||||
|
|
||||||
|
It does not answer:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Which source file, parser, frontend, or build command produced these artifacts?
|
||||||
|
```
|
||||||
|
|
||||||
|
## 3. Hashing Convention
|
||||||
|
|
||||||
|
Objects are content-addressed by SHA-256 over domain-separated canonical bytes.
|
||||||
|
|
||||||
|
General rule:
|
||||||
|
|
||||||
|
```text
|
||||||
|
hash = SHA256(domainUtf8 || 0x00 || canonicalPayloadBytes)
|
||||||
|
```
|
||||||
|
|
||||||
|
This matches the existing Merkle node convention in `Research.nodeHash`:
|
||||||
|
|
||||||
|
```text
|
||||||
|
SHA256("arboricx.merkle.node.v1" || 0x00 || nodePayload)
|
||||||
|
```
|
||||||
|
|
||||||
|
The domain string is part of the object format. It prevents identical payload
|
||||||
|
bytes in different formats from accidentally sharing identity.
|
||||||
|
|
||||||
|
Hashes are represented externally as 64 lowercase hexadecimal characters.
|
||||||
|
|
||||||
|
## 4. Filesystem Store Layout
|
||||||
|
|
||||||
|
The canonical filesystem store layout is:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/
|
||||||
|
objects/
|
||||||
|
abc/
|
||||||
|
abc123... -- object bytes, sharded by first 3 hex chars
|
||||||
|
aliases/
|
||||||
|
names/
|
||||||
|
modules/
|
||||||
|
packages/
|
||||||
|
manifests/
|
||||||
|
tmp/
|
||||||
|
```
|
||||||
|
|
||||||
|
The three-character shard follows the existing `lib/arboricx/server.tri`
|
||||||
|
convention.
|
||||||
|
|
||||||
|
### 4.1 Object paths
|
||||||
|
|
||||||
|
For object hash:
|
||||||
|
|
||||||
|
```text
|
||||||
|
abc123...
|
||||||
|
```
|
||||||
|
|
||||||
|
object bytes live at:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/objects/abc/abc123...
|
||||||
|
```
|
||||||
|
|
||||||
|
The object filename is the full hash. The shard directory is the first three hex
|
||||||
|
characters.
|
||||||
|
|
||||||
|
### 4.2 Atomic writes
|
||||||
|
|
||||||
|
Writers should use:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/tmp/<hash>.<nonce>.tmp
|
||||||
|
```
|
||||||
|
|
||||||
|
then atomically rename into:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/objects/<shard>/<hash>
|
||||||
|
```
|
||||||
|
|
||||||
|
Writing an existing object is idempotent if the existing bytes match the hash.
|
||||||
|
|
||||||
|
### 4.3 Store core metadata
|
||||||
|
|
||||||
|
The minimal filesystem store does not require sidecar metadata for every object.
|
||||||
|
Object kind can be known by context or by manifest references.
|
||||||
|
|
||||||
|
A later index may cache:
|
||||||
|
|
||||||
|
```text
|
||||||
|
hash -> kind
|
||||||
|
hash -> size
|
||||||
|
hash -> references
|
||||||
|
hash -> createdAt
|
||||||
|
```
|
||||||
|
|
||||||
|
but this index is not semantic identity.
|
||||||
|
|
||||||
|
## 5. Arboricx Merkle Node Object Format
|
||||||
|
|
||||||
|
The persistent Tree Calculus representation is a Merkle DAG of node objects.
|
||||||
|
|
||||||
|
Domain:
|
||||||
|
|
||||||
|
```text
|
||||||
|
arboricx.merkle.node.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
Canonical payloads:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Leaf = 0x00
|
||||||
|
Stem child = 0x01 || childHashRaw32
|
||||||
|
Fork left right
|
||||||
|
= 0x02 || leftHashRaw32 || rightHashRaw32
|
||||||
|
```
|
||||||
|
|
||||||
|
Where `childHashRaw32`, `leftHashRaw32`, and `rightHashRaw32` are the raw 32-byte
|
||||||
|
SHA-256 digests corresponding to child node hashes.
|
||||||
|
|
||||||
|
This is already implemented conceptually by:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Research.Node
|
||||||
|
Research.serializeNode
|
||||||
|
Research.deserializeNode
|
||||||
|
Research.nodeHash
|
||||||
|
```
|
||||||
|
|
||||||
|
The filesystem CAS should use this payload/hash convention directly.
|
||||||
|
|
||||||
|
## 6. Tree Roots
|
||||||
|
|
||||||
|
A Tree Calculus value stored in the CAS is identified by the hash of its root
|
||||||
|
Merkle node.
|
||||||
|
|
||||||
|
```text
|
||||||
|
treeRootHash = hash(rootNodePayload)
|
||||||
|
```
|
||||||
|
|
||||||
|
The complete tree is reconstructed by recursively loading node objects reachable
|
||||||
|
from the root.
|
||||||
|
|
||||||
|
Hydration is an interpretation step, not part of object identity. A client may
|
||||||
|
hydrate a root as a plain tree, a graph with explicit sharing, or another runtime
|
||||||
|
representation as long as the observable Tree Calculus value is the same. The
|
||||||
|
filesystem CAS provides structural dedupe and portable identity; it does not by
|
||||||
|
itself guarantee that a hydrated runtime value is the cheapest representation for
|
||||||
|
all workloads.
|
||||||
|
|
||||||
|
Merkle nodes are useful for explicit DAG-oriented tooling, audit, and bundle
|
||||||
|
packing. They are not the default representation for module executable exports:
|
||||||
|
storing every subtree as a separate filesystem object is pathologically slow for
|
||||||
|
large normal forms.
|
||||||
|
|
||||||
|
For module-backed evaluation and imports, a complete normalized named term is
|
||||||
|
stored as one canonical object:
|
||||||
|
|
||||||
|
```text
|
||||||
|
kind: arboricx.tree-term.v1
|
||||||
|
hash: <whole-term object hash>
|
||||||
|
abi: arboricx.abi.tree.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
The `arboricx.tree-term.v1` payload is a prefix encoding:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Leaf = 0x00
|
||||||
|
Stem t = 0x01 Tree
|
||||||
|
Fork l r = 0x02 Tree Tree
|
||||||
|
```
|
||||||
|
|
||||||
|
## 7. Arboricx Indexed Bundles
|
||||||
|
|
||||||
|
Indexed `.arboricx` bundles remain the transport/execution format.
|
||||||
|
|
||||||
|
They are:
|
||||||
|
|
||||||
|
- compact;
|
||||||
|
- self-contained;
|
||||||
|
- deterministic;
|
||||||
|
- suitable for restricted runtimes;
|
||||||
|
- suitable for HTTP serving and deployment.
|
||||||
|
|
||||||
|
They are not the canonical long-lived deduplicated store representation.
|
||||||
|
|
||||||
|
### 7.1 Pack
|
||||||
|
|
||||||
|
Packing converts one or more CAS tree roots into an indexed bundle:
|
||||||
|
|
||||||
|
```text
|
||||||
|
CAS tree roots -> indexed Arboricx bundle
|
||||||
|
```
|
||||||
|
|
||||||
|
The packer traverses reachable Merkle nodes, emits a compact indexed node table,
|
||||||
|
and writes a bundle manifest with export names and root indices.
|
||||||
|
|
||||||
|
### 7.3 Unpack
|
||||||
|
|
||||||
|
Unpacking converts a bundle into CAS nodes:
|
||||||
|
|
||||||
|
```text
|
||||||
|
indexed Arboricx bundle -> CAS tree roots
|
||||||
|
```
|
||||||
|
|
||||||
|
The unpacker verifies the bundle structure, reconstructs each exported tree, and
|
||||||
|
stores the corresponding Merkle nodes. It returns the tree root hash for each
|
||||||
|
bundle export.
|
||||||
|
|
||||||
|
## 8. Module Manifest v1
|
||||||
|
|
||||||
|
A module is an immutable manifest object. The module identity is the hash of its
|
||||||
|
canonical manifest bytes.
|
||||||
|
|
||||||
|
A module name is not identity. It is a workspace alias to a module manifest hash.
|
||||||
|
|
||||||
|
### 8.1 Domain
|
||||||
|
|
||||||
|
Proposed domain:
|
||||||
|
|
||||||
|
```text
|
||||||
|
arboricx.module-manifest.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
### 8.2 Purpose
|
||||||
|
|
||||||
|
A module manifest pairs human-facing export names with portable content objects
|
||||||
|
and optional portable contracts.
|
||||||
|
|
||||||
|
It exists to support:
|
||||||
|
|
||||||
|
- reproducible import resolution;
|
||||||
|
- executable export discovery;
|
||||||
|
- View Contract lookup for imported symbols;
|
||||||
|
- module-to-module reference tracking;
|
||||||
|
- transport/store interop.
|
||||||
|
|
||||||
|
It does not describe source provenance.
|
||||||
|
|
||||||
|
### 8.3 Conceptual shape
|
||||||
|
|
||||||
|
```text
|
||||||
|
moduleManifestV1:
|
||||||
|
imports:
|
||||||
|
- alias: <text>
|
||||||
|
kind: <object kind>
|
||||||
|
hash: <object hash>
|
||||||
|
|
||||||
|
exports:
|
||||||
|
- name: <text>
|
||||||
|
object:
|
||||||
|
kind: <object kind>
|
||||||
|
hash: <object hash>
|
||||||
|
abi: <abi identifier>
|
||||||
|
view: optional
|
||||||
|
kind: <view artifact kind>
|
||||||
|
hash: <view artifact hash>
|
||||||
|
catalog: optional
|
||||||
|
kind: <view catalog kind>
|
||||||
|
hash: <view catalog hash>
|
||||||
|
|
||||||
|
metadata: optional human-facing fields
|
||||||
|
```
|
||||||
|
|
||||||
|
### 8.4 Imports/references
|
||||||
|
|
||||||
|
The `imports` section is a manifest reference graph, not a store-level language
|
||||||
|
dependency graph.
|
||||||
|
|
||||||
|
Each entry records direct content-addressed references used by the module:
|
||||||
|
|
||||||
|
```text
|
||||||
|
alias: Prelude
|
||||||
|
kind: arboricx.module-manifest.v1
|
||||||
|
hash: <module hash>
|
||||||
|
```
|
||||||
|
|
||||||
|
This supports reproducibility, partial fetch, and audit. The content store core
|
||||||
|
stores this object but does not need to understand `Prelude` or import
|
||||||
|
semantics.
|
||||||
|
|
||||||
|
### 8.5 Exports
|
||||||
|
|
||||||
|
Each export is a record, not a single hash. This is required so executable
|
||||||
|
objects and advertised contracts cannot drift apart.
|
||||||
|
|
||||||
|
Minimal executable export:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name: "id"
|
||||||
|
object:
|
||||||
|
kind: arboricx.tree-term.v1
|
||||||
|
hash: <whole-term hash>
|
||||||
|
abi: arboricx.abi.tree.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
Export with View Contract:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name: "map"
|
||||||
|
object:
|
||||||
|
kind: arboricx.tree-term.v1
|
||||||
|
hash: <whole-term hash>
|
||||||
|
abi: arboricx.abi.tree.v1
|
||||||
|
view:
|
||||||
|
kind: arboricx.view-contract.type.v1
|
||||||
|
hash: <view type hash>
|
||||||
|
```
|
||||||
|
|
||||||
|
The manifest preserves the pairing between exported executable and exported
|
||||||
|
contract. For workspace modules built from local source, annotated exports are
|
||||||
|
checked before the manifest is published; only exports that pass producer-side
|
||||||
|
View Contract checking receive direct `arboricx.view-contract.type.v1` refs.
|
||||||
|
|
||||||
|
### 8.6 Metadata
|
||||||
|
|
||||||
|
Metadata is optional and human-facing. Initial fields may include:
|
||||||
|
|
||||||
|
```text
|
||||||
|
package
|
||||||
|
version
|
||||||
|
description
|
||||||
|
license
|
||||||
|
createdBy
|
||||||
|
```
|
||||||
|
|
||||||
|
Metadata is not source provenance and is not required for execution or checking.
|
||||||
|
|
||||||
|
## 9. View Contract Artifacts
|
||||||
|
|
||||||
|
View Contract artifacts are portable Arboricx-layer data. They may be stored
|
||||||
|
as content objects and referenced by module exports. `tricu` may emit these
|
||||||
|
objects, but the object kind is not tricu-specific.
|
||||||
|
|
||||||
|
Current artifact kind:
|
||||||
|
|
||||||
|
```text
|
||||||
|
arboricx.view-contract.type.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
`arboricx.view-contract.type.v1` is the direct export-view artifact. Its
|
||||||
|
payload is a canonical prefix binary encoding of the syntactic ViewType:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Name = 0x00 u32be(byte-length) utf8-name
|
||||||
|
Ref = 0x01 u32be(byte-length) utf8-ref
|
||||||
|
List = 0x02 ViewType
|
||||||
|
Maybe = 0x03 ViewType
|
||||||
|
Pair = 0x04 ViewType ViewType
|
||||||
|
Result = 0x05 ViewType ViewType
|
||||||
|
Fn = 0x06 u32be(argument-count) ViewType* ViewType
|
||||||
|
```
|
||||||
|
|
||||||
|
`utf8-ref` is tagged text:
|
||||||
|
|
||||||
|
```text
|
||||||
|
i:<decimal-integer> numeric/legacy ref
|
||||||
|
s:<text> symbolic user ref
|
||||||
|
```
|
||||||
|
|
||||||
|
Symbolic refs are the preferred user-authored form; numeric refs remain useful
|
||||||
|
for generated code, fixtures, and old low-level examples.
|
||||||
|
|
||||||
|
The object hash domain is the object kind:
|
||||||
|
|
||||||
|
```text
|
||||||
|
arboricx.view-contract.type.v1 \0 <payload>
|
||||||
|
```
|
||||||
|
|
||||||
|
### 9.1 Export-level pairing
|
||||||
|
|
||||||
|
The module manifest is the canonical pairing of an executable export and its
|
||||||
|
advertised contract:
|
||||||
|
|
||||||
|
```text
|
||||||
|
export name -> tree-term hash + optional view artifact hash
|
||||||
|
```
|
||||||
|
|
||||||
|
This avoids drift such as:
|
||||||
|
|
||||||
|
```text
|
||||||
|
map -> tree A
|
||||||
|
map.view -> contract B
|
||||||
|
```
|
||||||
|
|
||||||
|
where aliases might be retargeted independently.
|
||||||
|
|
||||||
|
### 9.2 Import checking
|
||||||
|
|
||||||
|
When a source file imports a module, a frontend can resolve an imported export,
|
||||||
|
decode its direct `arboricx.view-contract.type.v1` ref, and emit typed program
|
||||||
|
evidence locally:
|
||||||
|
|
||||||
|
```text
|
||||||
|
imported List.map has view Fn [...]
|
||||||
|
```
|
||||||
|
|
||||||
|
For locally built workspace modules this is backed by producer-side checking
|
||||||
|
before the module manifest alias is published, including imported view facts from
|
||||||
|
dependencies used by the producer source. External or prebuilt manifests are
|
||||||
|
trusted boundary declarations for now; they are not accompanied by proof objects.
|
||||||
|
The checker still consumes only local numeric symbols and typed-program evidence.
|
||||||
|
Global content hashes do not become checker symbols.
|
||||||
|
|
||||||
|
Correct split:
|
||||||
|
|
||||||
|
```text
|
||||||
|
local checker symbol: 3
|
||||||
|
presentation label: "List.map"
|
||||||
|
resolved object: sha256:...
|
||||||
|
exported view: Fn [...]
|
||||||
|
```
|
||||||
|
|
||||||
|
### 9.3 Execution hydration versus contract evidence
|
||||||
|
|
||||||
|
Execution imports should use a narrow, demand-driven path:
|
||||||
|
|
||||||
|
```text
|
||||||
|
module import -> selected executable exports -> hydrate selected tree-term objects
|
||||||
|
```
|
||||||
|
|
||||||
|
This path should not compute a dependency closure over other module exports.
|
||||||
|
Each selected executable export is already a complete Tree Calculus value.
|
||||||
|
|
||||||
|
Contract-aware checking may use a broader path:
|
||||||
|
|
||||||
|
```text
|
||||||
|
module import -> selected exports -> exported view type refs -> typed-program evidence
|
||||||
|
```
|
||||||
|
|
||||||
|
That path emits portable evidence and leaves compatibility policy decisions to
|
||||||
|
the Tree Calculus checker. typed programs and reusable catalogs do not need their
|
||||||
|
own binary object kinds today: they are ordinary Tree Calculus data and can be
|
||||||
|
stored as `arboricx.tree-term.v1` when persistence is useful.
|
||||||
|
|
||||||
|
## 10. Workspace Aliases
|
||||||
|
|
||||||
|
A workspace is mutable human-facing state over immutable content.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```text
|
||||||
|
List -> module manifest hash
|
||||||
|
Prelude -> module manifest hash
|
||||||
|
map -> tree-term hash
|
||||||
|
httpServer -> bundle hash
|
||||||
|
```
|
||||||
|
|
||||||
|
Aliases should live under:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/aliases/
|
||||||
|
```
|
||||||
|
|
||||||
|
Initial categories:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/aliases/modules/<name>
|
||||||
|
store/aliases/names/<name>
|
||||||
|
store/aliases/packages/<name>
|
||||||
|
```
|
||||||
|
|
||||||
|
Alias file contents should be simple and explicit, for example:
|
||||||
|
|
||||||
|
```text
|
||||||
|
kind: arboricx.module-manifest.v1
|
||||||
|
hash: abc123...
|
||||||
|
```
|
||||||
|
|
||||||
|
Exact encoding can be decided with the first implementation. The important rule
|
||||||
|
is that aliases are mutable pointers, not content identity.
|
||||||
|
|
||||||
|
## 11. Existing Convention Alignment
|
||||||
|
|
||||||
|
This design intentionally preserves existing conventions where they already fit:
|
||||||
|
|
||||||
|
- SHA-256 domain-separated Merkle node hashing;
|
||||||
|
- `Leaf` / `Stem` / `Fork` node payload tags `0x00`, `0x01`, `0x02`;
|
||||||
|
- three-character object sharding from `lib/arboricx/server.tri`;
|
||||||
|
- indexed Arboricx bundles as compact transport objects;
|
||||||
|
- optional human-facing export names in manifests;
|
||||||
|
- View Contract checker evidence as portable Tree Calculus data.
|
||||||
|
|
||||||
|
It replaces or demotes conventions that do not fit:
|
||||||
|
|
||||||
|
- SQLite `terms.names` comma-separated aliases become workspace aliases/indexes;
|
||||||
|
- SQLite `terms.tags` comma-separated tags become optional metadata/indexes;
|
||||||
|
- file imports as AST flattening become transitional behavior;
|
||||||
|
- names cease to be semantic identity.
|
||||||
|
|
||||||
|
## 12. Implementation Sketch
|
||||||
|
|
||||||
|
A staged implementation can proceed as follows:
|
||||||
|
|
||||||
|
1. Add filesystem CAS helpers alongside the existing SQLite store.
|
||||||
|
2. Store/load Arboricx Merkle nodes using the filesystem layout.
|
||||||
|
3. Implement tree-term storage and reconstruction from filesystem CAS.
|
||||||
|
4. Implement pack from CAS tree terms/Merkle roots to indexed Arboricx bundle.
|
||||||
|
5. Implement unpack from indexed Arboricx bundle to CAS tree terms/Merkle roots.
|
||||||
|
6. Define a concrete module manifest encoding.
|
||||||
|
7. Store/load module manifests as content-addressed objects.
|
||||||
|
8. Add workspace alias read/write helpers.
|
||||||
|
9. Teach import resolution to target module manifests/exports.
|
||||||
|
10. Attach exported View Contract artifacts to module exports.
|
||||||
|
11. Gradually migrate existing `!import` users.
|
||||||
|
|
||||||
|
## 13. Deferred Decisions
|
||||||
|
|
||||||
|
These are intentionally left out of the first concrete format:
|
||||||
|
|
||||||
|
- package version solving;
|
||||||
|
- registry/remotes protocol;
|
||||||
|
- garbage collection/reachability;
|
||||||
|
- source/provenance/build-record objects;
|
||||||
|
- editor/update workflows;
|
||||||
|
- rich visibility/export rules;
|
||||||
|
- final import syntax;
|
||||||
|
- whether module manifests also need a tree-native encoding.
|
||||||
|
|
||||||
|
## 14. Summary
|
||||||
|
|
||||||
|
The concrete v1 direction is:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Store:
|
||||||
|
filesystem-backed content-addressed objects
|
||||||
|
|
||||||
|
Hashing:
|
||||||
|
SHA256(domain || 0x00 || canonical payload)
|
||||||
|
|
||||||
|
Tree persistence:
|
||||||
|
Arboricx Merkle nodes
|
||||||
|
|
||||||
|
Transport:
|
||||||
|
indexed .arboricx bundles, packable from and unpackable to CAS roots
|
||||||
|
|
||||||
|
Modules:
|
||||||
|
immutable manifests pairing export names with object refs and optional View
|
||||||
|
Contract refs
|
||||||
|
|
||||||
|
Workspace:
|
||||||
|
mutable aliases from human names to immutable content hashes
|
||||||
|
```
|
||||||
|
|
||||||
|
This keeps the store portable, preserves Arboricx's compact transport role,
|
||||||
|
restores Merkle DAGs as the persistence model, and gives View Contracts a stable
|
||||||
|
module/export attachment point without making the store `tricu`-specific.
|
||||||
371
docs/guard-injection.md
Normal file
371
docs/guard-injection.md
Normal file
@@ -0,0 +1,371 @@
|
|||||||
|
# Guard Injection Semantics
|
||||||
|
|
||||||
|
This document describes the runtime guard model for View Contracts.
|
||||||
|
|
||||||
|
Views describe portable structural contracts. Guarded views refine those
|
||||||
|
contracts with executable predicates while keeping ordinary value-level code free
|
||||||
|
of `Maybe`, `Result`, sentinel, or host-language abort handling.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
viewGuarded baseView guard
|
||||||
|
```
|
||||||
|
|
||||||
|
A guarded view means: when this guarded view is observed along the reachable
|
||||||
|
checked-execution path, run `guard` against the runtime value.
|
||||||
|
|
||||||
|
## Goals
|
||||||
|
|
||||||
|
- Preserve ordinary value-level program shapes.
|
||||||
|
- Keep guard failure out of user code.
|
||||||
|
- Avoid Haskell-specific checker/runtime semantics.
|
||||||
|
- Represent guard boundaries explicitly in portable tree data.
|
||||||
|
- Make successful guarded execution transparent: guarded values are unwrapped
|
||||||
|
before ordinary code receives them.
|
||||||
|
- Prefer correctness-by-default over avoiding repeated predicate cost.
|
||||||
|
|
||||||
|
## Non-goals
|
||||||
|
|
||||||
|
- Preventing user-written guards from diverging.
|
||||||
|
- Letting guards author their own diagnostics.
|
||||||
|
- Solving IO interaction-tree composition.
|
||||||
|
- Finalizing long-term artifact identity policy.
|
||||||
|
- Deduplicating or hoisting repeated guard checks.
|
||||||
|
|
||||||
|
## Plain Views vs Guards
|
||||||
|
|
||||||
|
Plain Views still provide concrete benefits without guards:
|
||||||
|
|
||||||
|
- structural flow checking;
|
||||||
|
- portable API metadata;
|
||||||
|
- module/export contract metadata;
|
||||||
|
- content-store view-tree metadata;
|
||||||
|
- cross-frontend agreement on contract structure;
|
||||||
|
- diagnostics for wrong-view flows.
|
||||||
|
|
||||||
|
Guards are for invariants that require runtime value inspection, such as:
|
||||||
|
|
||||||
|
- non-empty list;
|
||||||
|
- sorted list;
|
||||||
|
- byte string of exactly 32 bytes;
|
||||||
|
- protocol payload with a valid checksum;
|
||||||
|
- domain-specific runtime predicate.
|
||||||
|
|
||||||
|
Guards are deliberately more expensive than ordinary Views. Use them when the
|
||||||
|
runtime contract must be enforced.
|
||||||
|
|
||||||
|
## Guard Result Protocol
|
||||||
|
|
||||||
|
Guards return one of two standardized shapes:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
guardOk value
|
||||||
|
guardFail
|
||||||
|
```
|
||||||
|
|
||||||
|
Guards do not provide diagnostics. The checked-exec runner owns diagnostics.
|
||||||
|
Malformed guard output is treated as a checked-runtime failure.
|
||||||
|
|
||||||
|
## Checked Execution Protocol
|
||||||
|
|
||||||
|
A successful typed-program check returns a checked-execution artifact, not a raw
|
||||||
|
payload.
|
||||||
|
|
||||||
|
Current constructors:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
checkedPure value
|
||||||
|
checkedFail diagnostic
|
||||||
|
checkedGuard view guard value continuation
|
||||||
|
checkedGuardWithContext context view guard value continuation
|
||||||
|
checkedBind exec continuation
|
||||||
|
```
|
||||||
|
|
||||||
|
`checkedGuard` is the compatibility/default constructor. It lowers to
|
||||||
|
`checkedGuardWithContext` with an unknown context. Checker-injected guard
|
||||||
|
boundaries use `checkedGuardWithContext` so failures can identify where the
|
||||||
|
boundary came from.
|
||||||
|
|
||||||
|
Runner:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
runChecked checkedExec
|
||||||
|
```
|
||||||
|
|
||||||
|
Semantics:
|
||||||
|
|
||||||
|
```text
|
||||||
|
runChecked (checkedPure value)
|
||||||
|
= checkedRuntimeOk value
|
||||||
|
|
||||||
|
runChecked (checkedFail diagnostic)
|
||||||
|
= checkedRuntimeFail diagnostic
|
||||||
|
|
||||||
|
runChecked (checkedGuardWithContext context view guard value continuation)
|
||||||
|
= case guard value of
|
||||||
|
guardOk checkedValue -> runChecked (continuation checkedValue)
|
||||||
|
guardFail -> checkedRuntimeFail (guardFailed context view)
|
||||||
|
malformed -> checkedRuntimeFail (malformedGuardResult context view malformed)
|
||||||
|
|
||||||
|
runChecked (checkedGuard view guard value continuation)
|
||||||
|
= runChecked (checkedGuardWithContext unknownContext view guard value continuation)
|
||||||
|
|
||||||
|
runChecked (checkedBind exec continuation)
|
||||||
|
= case runChecked exec of
|
||||||
|
checkedRuntimeOk value -> runChecked (continuation value)
|
||||||
|
checkedRuntimeFail diag -> checkedRuntimeFail diag
|
||||||
|
```
|
||||||
|
|
||||||
|
Important invariant:
|
||||||
|
|
||||||
|
> Guard failure is consumed by `runChecked`. It is never passed into ordinary
|
||||||
|
> user code.
|
||||||
|
|
||||||
|
## Checker Result Shape
|
||||||
|
|
||||||
|
`checkTypedProgramWith` returns checked-exec on success:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
ok checkedExec env
|
||||||
|
```
|
||||||
|
|
||||||
|
Even unguarded programs return:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
checkedPure rootPayload
|
||||||
|
```
|
||||||
|
|
||||||
|
Compatibility helper:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
checkedProgramTree result
|
||||||
|
```
|
||||||
|
|
||||||
|
`checkedProgramTree` runs/unwraps checked-exec to preserve older raw-tree helper
|
||||||
|
behavior.
|
||||||
|
|
||||||
|
The Haskell `tricu check` path now evaluates successful checker output through
|
||||||
|
`runChecked`, so source-level guarded annotations fail through the same portable
|
||||||
|
checked-exec protocol.
|
||||||
|
|
||||||
|
## Boundary Semantics
|
||||||
|
|
||||||
|
Guard insertion follows correctness-first semantics:
|
||||||
|
|
||||||
|
> Every guarded View observation on the reachable checked-execution path runs
|
||||||
|
> its guard.
|
||||||
|
|
||||||
|
Important boundary kinds:
|
||||||
|
|
||||||
|
### Guarded typed value
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedValue sym (viewGuarded base guard) payload
|
||||||
|
```
|
||||||
|
|
||||||
|
This observes `sym` as a guarded value. It also supplies base-view evidence for
|
||||||
|
flow checking.
|
||||||
|
|
||||||
|
### Guarded requirement
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedRequire sym (viewGuarded base guard) payload
|
||||||
|
```
|
||||||
|
|
||||||
|
The symbol must satisfy `base`; the guarded observation is attached to `sym` and
|
||||||
|
is enforced when `sym` is used or exposed along the reachable root path.
|
||||||
|
|
||||||
|
### Guarded function argument
|
||||||
|
|
||||||
|
For:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
viewFn [(viewGuarded base guard)] result
|
||||||
|
```
|
||||||
|
|
||||||
|
application checking guards the argument before the callee receives it.
|
||||||
|
|
||||||
|
### Guarded function result
|
||||||
|
|
||||||
|
For:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
viewFn [arg] (viewGuarded base guard)
|
||||||
|
```
|
||||||
|
|
||||||
|
application checking guards the application result before exposing it as the
|
||||||
|
result value.
|
||||||
|
|
||||||
|
### Guarded callee symbol
|
||||||
|
|
||||||
|
If a function symbol itself has a guarded observation, that guard runs before the
|
||||||
|
function value is applied. A successful guard may transform the function value;
|
||||||
|
the application uses the guarded value.
|
||||||
|
|
||||||
|
## Global Symbol Observations
|
||||||
|
|
||||||
|
Guarded `typedValue` and `typedRequire` nodes are **global per-symbol
|
||||||
|
observations**, not position-sensitive flow events.
|
||||||
|
|
||||||
|
All guarded observations for a symbol compose in typed-node order whenever that
|
||||||
|
symbol is used or exposed on the reachable checked-execution path.
|
||||||
|
|
||||||
|
This means a later requirement still applies to an earlier syntactic use:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedValue 1 viewString "x"
|
||||||
|
typedApply 2 f 1 "x"
|
||||||
|
typedRequire 1 (viewGuarded viewString guard) "x"
|
||||||
|
```
|
||||||
|
|
||||||
|
The guarded requirement is attached to symbol `1`; compiling the reachable root
|
||||||
|
path that uses symbol `1` runs that guard.
|
||||||
|
|
||||||
|
Rationale:
|
||||||
|
|
||||||
|
- typed programs are declarative symbol graphs, not imperative event traces;
|
||||||
|
- global observations are simpler and more correct-by-default;
|
||||||
|
- producers cannot accidentally bypass a guard by ordering a requirement too
|
||||||
|
late;
|
||||||
|
- staged raw/checked phases should use distinct symbols.
|
||||||
|
|
||||||
|
## Reachability and Repetition
|
||||||
|
|
||||||
|
Guards are not run eagerly for every guarded node in a program.
|
||||||
|
|
||||||
|
Execution is root-reachable:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
compileSymbol (typedProgramRoot program)
|
||||||
|
```
|
||||||
|
|
||||||
|
Only guarded observations reachable from the root checked-execution path run.
|
||||||
|
Unreachable guarded symbols do not pay guard cost and do not fail execution.
|
||||||
|
|
||||||
|
Repeated reachable uses rerun guards. There is currently no deduplication or
|
||||||
|
hoisting. This is intentional: each guarded observation/use is a runtime contract
|
||||||
|
boundary.
|
||||||
|
|
||||||
|
Future optimization policies may add explicit deduplication or hoisting, but the
|
||||||
|
baseline semantics are repeated, deterministic guard execution.
|
||||||
|
|
||||||
|
## Function and Application Compilation
|
||||||
|
|
||||||
|
Checked execution is built compositionally from typed-node dependencies:
|
||||||
|
|
||||||
|
1. compile the callee symbol;
|
||||||
|
2. compile the argument symbol;
|
||||||
|
3. run any guarded observations attached to the argument symbol;
|
||||||
|
4. run the guarded function-argument boundary, if present;
|
||||||
|
5. apply the callee to the checked argument;
|
||||||
|
6. run the guarded function-result boundary, if present;
|
||||||
|
7. run guarded observations attached to the application result symbol.
|
||||||
|
|
||||||
|
This handles nested and curried application chains because each `typedApply`
|
||||||
|
consumes one function argument and produces a symbol whose inferred view is the
|
||||||
|
function residual/result view.
|
||||||
|
|
||||||
|
## Diagnostics
|
||||||
|
|
||||||
|
Guards do not author diagnostics. The checked-exec runner renders diagnostics
|
||||||
|
from checker-owned boundary context plus the guarded View.
|
||||||
|
|
||||||
|
Checker-injected guard nodes carry portable structural context. Current context
|
||||||
|
kinds are:
|
||||||
|
|
||||||
|
- root `typedValue` exposure;
|
||||||
|
- root `typedRequire` exposure;
|
||||||
|
- non-root `typedValue` symbol observation;
|
||||||
|
- non-root `typedRequire` symbol observation;
|
||||||
|
- function argument boundary;
|
||||||
|
- function result boundary;
|
||||||
|
- unknown/default context for manually constructed `checkedGuard` values.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```text
|
||||||
|
guard failed at root typedValue symbol 0 for Guarded String
|
||||||
|
guard failed at root typedRequire symbol 3 for Guarded String
|
||||||
|
guard failed at typedRequire symbol 6 for Guarded String
|
||||||
|
guard failed at argument 0 of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded String
|
||||||
|
guard failed at result of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded String
|
||||||
|
malformed guard result at argument 0 of application symbol 2 (callee symbol 0, arg symbol 1) for Guarded String
|
||||||
|
```
|
||||||
|
|
||||||
|
Manually constructed `checkedGuard` values use unknown context and therefore
|
||||||
|
render without a boundary suffix:
|
||||||
|
|
||||||
|
```text
|
||||||
|
guard failed for String
|
||||||
|
malformed guard result for String
|
||||||
|
```
|
||||||
|
|
||||||
|
The context is diagnostic-only. It does not affect guard execution, View
|
||||||
|
compatibility, success/failure semantics, or continuation values.
|
||||||
|
|
||||||
|
The context deliberately contains raw portable data such as symbols and
|
||||||
|
application edges. It does not preserve source aliases such as `NonEmptyString`,
|
||||||
|
and it does not rely on Haskell-side post-processing or source-name annotation.
|
||||||
|
Named View rendering is a separate future design topic.
|
||||||
|
|
||||||
|
## Why Not Abort in Haskell?
|
||||||
|
|
||||||
|
A host-level abort primitive would move guard semantics into Haskell. The design
|
||||||
|
instead encodes guard failure in portable checked-exec artifacts and interprets
|
||||||
|
it with portable `tricu` code.
|
||||||
|
|
||||||
|
Haskell may evaluate the runner, but Haskell is not the semantic source of guard
|
||||||
|
validity or failure behavior.
|
||||||
|
|
||||||
|
## Why Not Maybe / Result Everywhere?
|
||||||
|
|
||||||
|
Returning `Maybe` or `Result` from every guarded boundary would infect ordinary
|
||||||
|
APIs. A function expecting a `List Byte` would have to accept
|
||||||
|
`Maybe (List Byte)` or `Result Error (List Byte)`, and every downstream caller
|
||||||
|
would need defensive handling.
|
||||||
|
|
||||||
|
The checked-exec runner avoids this. It unwraps successful guard results before
|
||||||
|
continuing and stops checked execution on failure.
|
||||||
|
|
||||||
|
## Known Sharp Edges
|
||||||
|
|
||||||
|
### Guard divergence
|
||||||
|
|
||||||
|
A user-written guard may diverge. This design handles intentional failure via
|
||||||
|
`guardFail`; it does not solve arbitrary nontermination. Fuel or timeouts are
|
||||||
|
separate runtime concerns.
|
||||||
|
|
||||||
|
### Payload trust
|
||||||
|
|
||||||
|
Typed nodes carry executable payloads. Guard injection must not expose an
|
||||||
|
unchecked precomputed payload at a guarded boundary. Boundaries are mediated by
|
||||||
|
checked-exec nodes.
|
||||||
|
|
||||||
|
This does not make malicious producer forgery impossible; it gives honest
|
||||||
|
frontends a portable, checkable protocol that avoids accidental bypasses.
|
||||||
|
|
||||||
|
### Cyclic typed-apply graphs
|
||||||
|
|
||||||
|
The current symbol compiler assumes typed programs are well-founded dependency
|
||||||
|
graphs as emitted by the frontend/lowering path. Cyclic typed-apply graphs are a
|
||||||
|
malformed-program validation concern, not a guard-specific semantic feature.
|
||||||
|
|
||||||
|
## Current Implementation Status
|
||||||
|
|
||||||
|
Implemented in `lib/view.tri` and exercised by tests:
|
||||||
|
|
||||||
|
- `guardOk` / `guardFail`;
|
||||||
|
- `checkedPure`, `checkedFail`, `checkedGuard`, `checkedGuardWithContext`, `checkedBind`;
|
||||||
|
- `runChecked`;
|
||||||
|
- success from `checkTypedProgramWith` returns checked-exec;
|
||||||
|
- `checkedProgramTree` compatibility helper;
|
||||||
|
- guarded root exposure;
|
||||||
|
- guarded `typedValue` and `typedRequire`;
|
||||||
|
- guarded function arguments and results;
|
||||||
|
- guarded callee observations;
|
||||||
|
- nested/curried application guard composition;
|
||||||
|
- global per-symbol observations;
|
||||||
|
- root-reachability behavior;
|
||||||
|
- repeated reachable uses rerun guards;
|
||||||
|
- source/Haskell `tricu check` integration;
|
||||||
|
- imported/module `VTGuarded` lowering to portable `viewGuarded`;
|
||||||
|
- portable guard boundary diagnostics with symbol/application context.
|
||||||
247
docs/host-abi.md
Normal file
247
docs/host-abi.md
Normal file
@@ -0,0 +1,247 @@
|
|||||||
|
# tricu Host ABI
|
||||||
|
|
||||||
|
This document specifies the first host-facing ABI for self-hosted Arboricx execution.
|
||||||
|
|
||||||
|
The ABI is intentionally small. A host language should only need to implement Tree Calculus construction/reduction plus a tiny set of canonical payload codecs. Higher-level execution policy lives in Tree Calculus.
|
||||||
|
|
||||||
|
## Goals
|
||||||
|
|
||||||
|
- Keep host-language implementations small and auditable.
|
||||||
|
- Preserve canonical Tree Calculus representations for payloads.
|
||||||
|
- Provide a stable tagged envelope so hosts do not need per-application result conventions.
|
||||||
|
- Reuse the existing `ok` / `err` result protocol.
|
||||||
|
- Support typed execution wrappers for common return types.
|
||||||
|
|
||||||
|
## Non-goals
|
||||||
|
|
||||||
|
- This ABI does not remove the need for host codecs entirely.
|
||||||
|
- This ABI does not define every possible application protocol.
|
||||||
|
- This ABI does not require auto-detecting arbitrary result types.
|
||||||
|
|
||||||
|
## Outer result protocol
|
||||||
|
|
||||||
|
Host ABI runners return the existing tricu result shape from `lib/binary.tri`:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok value rest = pair true (pair value rest)
|
||||||
|
err code rest = pair false (pair code rest)
|
||||||
|
```
|
||||||
|
|
||||||
|
On success, `value` is a host ABI value.
|
||||||
|
|
||||||
|
On failure, `code` is a canonical Tree Calculus number. The host may report the numeric code and optionally inspect `rest` for debugging.
|
||||||
|
|
||||||
|
## Host ABI value shape
|
||||||
|
|
||||||
|
A host ABI value is:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
pair tag payload
|
||||||
|
```
|
||||||
|
|
||||||
|
The `tag` says how the host should interpret `payload`.
|
||||||
|
|
||||||
|
The payload is always the canonical/raw Tree Calculus representation for that type. The ABI envelope tags the payload; it does not replace or recursively wrap canonical Tree Calculus data.
|
||||||
|
|
||||||
|
## Tags
|
||||||
|
|
||||||
|
Initial tags:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostTreeTag = 0
|
||||||
|
hostStringTag = 1
|
||||||
|
hostNumberTag = 2
|
||||||
|
hostBoolTag = 3
|
||||||
|
hostListTag = 4
|
||||||
|
hostBytesTag = 5
|
||||||
|
```
|
||||||
|
|
||||||
|
Planned/error tag, if needed later:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostErrorTag = 6
|
||||||
|
```
|
||||||
|
|
||||||
|
The first implementation keeps errors in the outer `err` result protocol rather than returning `hostError` inside `ok`.
|
||||||
|
|
||||||
|
## Constructors
|
||||||
|
|
||||||
|
The ABI constructors are:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostTree value
|
||||||
|
hostString bytes
|
||||||
|
hostNumber n
|
||||||
|
hostBool b
|
||||||
|
hostList xs
|
||||||
|
hostBytes bytes
|
||||||
|
```
|
||||||
|
|
||||||
|
Each constructor returns:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
pair tag payload
|
||||||
|
```
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostString "hello"
|
||||||
|
hostNumber 42
|
||||||
|
hostBool true
|
||||||
|
hostList [1 2 3]
|
||||||
|
hostTree (t t t)
|
||||||
|
```
|
||||||
|
|
||||||
|
## Payload conventions
|
||||||
|
|
||||||
|
Payloads use existing canonical tricu encodings:
|
||||||
|
|
||||||
|
| ABI value | Payload |
|
||||||
|
| --- | --- |
|
||||||
|
| `hostTree` | arbitrary raw Tree Calculus value |
|
||||||
|
| `hostString` | canonical string/byte-list representation |
|
||||||
|
| `hostNumber` | canonical tricu number |
|
||||||
|
| `hostBool` | canonical tricu bool (`false = t`, `true = t t`) |
|
||||||
|
| `hostList` | canonical tricu list (`t` empty, `pair head tail` cons) |
|
||||||
|
| `hostBytes` | canonical byte list |
|
||||||
|
|
||||||
|
`hostList` payloads are raw canonical lists, **not** lists of host ABI values.
|
||||||
|
|
||||||
|
## Accessors / matching
|
||||||
|
|
||||||
|
The first ABI should expose simple accessors:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostValueTag hostValue
|
||||||
|
hostValuePayload hostValue
|
||||||
|
```
|
||||||
|
|
||||||
|
A host can decode the envelope by destructuring the pair directly, but these helpers make the ABI explicit and testable.
|
||||||
|
|
||||||
|
## Validation predicates
|
||||||
|
|
||||||
|
Typed runners should validate that the raw application result can be interpreted as the requested type before wrapping it.
|
||||||
|
|
||||||
|
Initial predicates:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostNumber? value
|
||||||
|
hostBool? value
|
||||||
|
hostList? value
|
||||||
|
hostString? value
|
||||||
|
hostBytes? value
|
||||||
|
```
|
||||||
|
|
||||||
|
These predicates are structural checks over canonical encodings. They are not general semantic type inference.
|
||||||
|
|
||||||
|
Important ambiguity note:
|
||||||
|
|
||||||
|
Tree Calculus encodings are not globally disjoint. For example, `t` is also `false`, `0`, and `[]`. Typed runners intentionally interpret values according to the requested type.
|
||||||
|
|
||||||
|
## Error behavior
|
||||||
|
|
||||||
|
Typed ABI runners return an error if the application result does not match the requested type.
|
||||||
|
|
||||||
|
Initial error code:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
errHostCodecFailed = 14
|
||||||
|
```
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToString bundle args
|
||||||
|
```
|
||||||
|
|
||||||
|
returns:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok (hostString resultBytes) rest
|
||||||
|
```
|
||||||
|
|
||||||
|
if `resultBytes` is string-like, otherwise:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
err errHostCodecFailed result
|
||||||
|
```
|
||||||
|
|
||||||
|
where `result` is the raw application result that failed validation.
|
||||||
|
|
||||||
|
## Execution wrappers
|
||||||
|
|
||||||
|
The base self-hosted Arboricx runners are defined in `lib/arboricx.tri`:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxArgs bundleBytes args
|
||||||
|
runArboricxArgsByName nameBytes bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
Host ABI wrappers layer typed output envelopes on top:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToTree bundleBytes args
|
||||||
|
runArboricxToString bundleBytes args
|
||||||
|
runArboricxToNumber bundleBytes args
|
||||||
|
runArboricxToBool bundleBytes args
|
||||||
|
runArboricxToList bundleBytes args
|
||||||
|
runArboricxToBytes bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
Named-export variants:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxByNameToTree nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToString nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToNumber nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToBool nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToList nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToBytes nameBytes bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
## Host usage
|
||||||
|
|
||||||
|
For a bundle whose default export is an unapplied function:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
append "hello "
|
||||||
|
```
|
||||||
|
|
||||||
|
A host that expects a string result evaluates:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToString bundleBytes ["james"]
|
||||||
|
```
|
||||||
|
|
||||||
|
On success, the result is:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok (hostString "hello james") rest
|
||||||
|
```
|
||||||
|
|
||||||
|
The host then:
|
||||||
|
|
||||||
|
1. unwraps `ok`,
|
||||||
|
2. checks `hostStringTag`,
|
||||||
|
3. decodes the canonical string payload.
|
||||||
|
|
||||||
|
## Implementation reference
|
||||||
|
|
||||||
|
- Tree constructors, numbers, strings, and lists: `src/Research.hs`
|
||||||
|
- Result protocol: `lib/binary.tri`
|
||||||
|
- Arboricx parser/executor: `lib/arboricx.tri`
|
||||||
|
- Host ABI implementation: `lib/host-abi.tri` or `lib/arboricx.tri`, depending on final organization
|
||||||
|
|
||||||
|
## First-pass invariants
|
||||||
|
|
||||||
|
Tests should cover these invariants:
|
||||||
|
|
||||||
|
1. Each constructor stores the correct tag and payload.
|
||||||
|
2. `hostValueTag` and `hostValuePayload` destructure values correctly.
|
||||||
|
3. `runArboricxToTree` always wraps successful raw results as `hostTree`.
|
||||||
|
4. `runArboricxToString` wraps string-like results as `hostString`.
|
||||||
|
5. `runArboricxToNumber` wraps number-like results as `hostNumber`.
|
||||||
|
6. `runArboricxToBool` wraps canonical booleans as `hostBool`.
|
||||||
|
7. A typed runner returns `errHostCodecFailed` when validation fails.
|
||||||
|
8. Named-export typed runners select the requested export before wrapping.
|
||||||
505
docs/module-system-design.md
Normal file
505
docs/module-system-design.md
Normal file
@@ -0,0 +1,505 @@
|
|||||||
|
# Module System and Content Store Design
|
||||||
|
|
||||||
|
Status: design draft.
|
||||||
|
|
||||||
|
This document records the intended direction for reworking `tricu` modules,
|
||||||
|
imports, Arboricx storage/transport, and the content store. It is not an
|
||||||
|
implementation plan yet; it is a shared design target.
|
||||||
|
|
||||||
|
## 1. Problem Statement
|
||||||
|
|
||||||
|
The current module/import/content-store system is useful as a prototype, but it
|
||||||
|
is not coherent enough to build on indefinitely.
|
||||||
|
|
||||||
|
Current behavior combines several partially-overlapping systems:
|
||||||
|
|
||||||
|
- `!import "path.tri" Namespace` and `!import "path.tri" !Local` perform
|
||||||
|
filesystem-relative source preprocessing;
|
||||||
|
- imported definitions are flattened into one program;
|
||||||
|
- namespace qualification is implemented by string rewriting;
|
||||||
|
- evaluation uses a flat `Map String T` environment;
|
||||||
|
- the Haskell content store stores Tree Calculus Merkle nodes plus an ad hoc
|
||||||
|
`terms` table with comma-separated names and tags;
|
||||||
|
- the REPL can resolve names from the content store, including multiple versions;
|
||||||
|
- Arboricx bundles provide compact indexed transport objects;
|
||||||
|
- `lib/arboricx/server.tri` already sketches a filesystem-backed object store.
|
||||||
|
|
||||||
|
This works only when users and maintainers are mindful of sharp edges:
|
||||||
|
|
||||||
|
- names serve too many roles at once;
|
||||||
|
- modules are not first-class semantic objects;
|
||||||
|
- imports are closer to AST paste-and-prefix than resolution;
|
||||||
|
- `!Local` imports can create global collisions;
|
||||||
|
- content identity, human aliases, source files, and evaluated terms are not
|
||||||
|
cleanly separated;
|
||||||
|
- the SQLite schema is convenient but not a principled content-addressed store;
|
||||||
|
- Arboricx transport and long-lived storage are not clearly distinguished.
|
||||||
|
|
||||||
|
## 2. Design Principles
|
||||||
|
|
||||||
|
### 2.1 Content addressability is foundational
|
||||||
|
|
||||||
|
Immutable content should be identified by hashes. Human names should be metadata
|
||||||
|
or workspace aliases over content, not semantic identity.
|
||||||
|
|
||||||
|
This follows the core lesson from systems such as Unison: separate stable
|
||||||
|
content identity from ergonomic naming and namespace organization.
|
||||||
|
|
||||||
|
### 2.2 The content store is language-neutral
|
||||||
|
|
||||||
|
The content store must not be married to `tricu` or Haskell.
|
||||||
|
|
||||||
|
It stores a small set of portable Arboricx artifacts: module manifests,
|
||||||
|
complete tree terms, and direct View Contract types. Lower-level Merkle/bundle
|
||||||
|
formats exist for transport and DAG tooling, but the store core should treat all
|
||||||
|
objects as content-addressed bytes with formats/media types.
|
||||||
|
|
||||||
|
`tricu` and Haskell are clients/tooling. They are not the semantic owners of the
|
||||||
|
store.
|
||||||
|
|
||||||
|
### 2.3 View Contracts are portable enough to integrate
|
||||||
|
|
||||||
|
The store may integrate with View Contracts because the checker and evidence
|
||||||
|
format are pure Tree Calculus / portable tree data. View Contracts are not a
|
||||||
|
Haskell-private or `tricu`-private semantic layer.
|
||||||
|
|
||||||
|
The module resolver may emit typed-program evidence, but checker semantics remain
|
||||||
|
unchanged:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Haskell emits evidence.
|
||||||
|
tricu judges evidence.
|
||||||
|
```
|
||||||
|
|
||||||
|
### 2.4 Modules should reflect definitions as they actually exist
|
||||||
|
|
||||||
|
The module system should conform to the reality of content-addressed immutable
|
||||||
|
artifacts and mutable human aliases. We should not contort definitions to fit a
|
||||||
|
traditional text-file module system if that fights the storage model.
|
||||||
|
|
||||||
|
### 2.5 Transport and storage are different jobs
|
||||||
|
|
||||||
|
Indexed Arboricx bundles are excellent transport/execution objects. Merkle DAGs
|
||||||
|
are better long-lived persistence objects. These should remain separate but
|
||||||
|
interoperable representations.
|
||||||
|
|
||||||
|
## 3. Conceptual Architecture
|
||||||
|
|
||||||
|
```text
|
||||||
|
Content Store
|
||||||
|
neutral content-addressed object store
|
||||||
|
|
||||||
|
Arboricx CAS / Merkle Store
|
||||||
|
Tree Calculus node/object formats suitable for persistence and dedupe
|
||||||
|
|
||||||
|
Arboricx Bundle
|
||||||
|
compact indexed transport/execution format
|
||||||
|
|
||||||
|
View Contract Artifact
|
||||||
|
portable evidence/checker data over tree artifacts
|
||||||
|
|
||||||
|
Module Manifest
|
||||||
|
immutable export map from names to content objects and optional contracts
|
||||||
|
|
||||||
|
Workspace
|
||||||
|
mutable aliases, selected versions, package pins, and user-facing names
|
||||||
|
|
||||||
|
tricu
|
||||||
|
one frontend/toolchain that emits/consumes these portable artifacts
|
||||||
|
```
|
||||||
|
|
||||||
|
The content store stores objects. Arboricx defines important object formats.
|
||||||
|
View Contracts define portable checking artifacts. `tricu` produces and consumes
|
||||||
|
those formats.
|
||||||
|
|
||||||
|
### 3.1 Execution imports versus contract checking
|
||||||
|
|
||||||
|
Import resolution has two intentionally different performance profiles.
|
||||||
|
|
||||||
|
For normal execution/evaluation, resolving a module import should hydrate only
|
||||||
|
the executable exports directly demanded by the importing source. Exported Tree
|
||||||
|
Calculus values are complete normal forms: importing `foo` does not require
|
||||||
|
hydrating separate `bar` or `baz` exports that may have helped build it. This is
|
||||||
|
the fast path for `!import`, including `!Local` imports.
|
||||||
|
|
||||||
|
View Contract checking is a separate evidence-gathering path. It may load
|
||||||
|
exported direct view types for the symbols that participate in a check. That
|
||||||
|
slower path must remain behind the typed program boundary:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Haskell emits evidence.
|
||||||
|
tricu judges evidence.
|
||||||
|
```
|
||||||
|
|
||||||
|
Reusable view catalogs are ordinary tricu libraries/tree terms, not a separate
|
||||||
|
core CAS artifact kind.
|
||||||
|
|
||||||
|
For locally built workspace modules, advertised direct export views are
|
||||||
|
producer-checked before the manifest alias is written. Producer checking includes
|
||||||
|
advertised views from any imported modules used by that source, so a module
|
||||||
|
cannot publish a local annotated export that contradicts a dependency's exported
|
||||||
|
view. If producer checking fails, the module alias is not written.
|
||||||
|
|
||||||
|
Consumer checking then resolves selected module exports, decodes their
|
||||||
|
`arboricx.view-contract.type.v1` refs, and emits trusted `KnownView` evidence
|
||||||
|
for the local imported symbols. Those facts are module-boundary assumptions:
|
||||||
|
local workspace builds create them after producer-side checking, while external
|
||||||
|
or prebuilt manifests are trusted inputs for now. In all cases, compatibility
|
||||||
|
with local requirements is still judged by the portable checker in `lib/view.tri`.
|
||||||
|
|
||||||
|
## 4. Content Store Direction
|
||||||
|
|
||||||
|
### 4.1 Store core
|
||||||
|
|
||||||
|
The store core should be a content-addressed object store:
|
||||||
|
|
||||||
|
```text
|
||||||
|
hash -> object bytes
|
||||||
|
hash -> object kind / media type
|
||||||
|
hash -> optional metadata/index entries
|
||||||
|
```
|
||||||
|
|
||||||
|
The hash should be over canonical bytes with domain separation. The object kind
|
||||||
|
or media type determines how a client interprets those bytes.
|
||||||
|
|
||||||
|
Current module/check object kinds:
|
||||||
|
|
||||||
|
```text
|
||||||
|
arboricx.module-manifest.v1
|
||||||
|
arboricx.tree-term.v1
|
||||||
|
arboricx.view-contract.type.v1
|
||||||
|
```
|
||||||
|
|
||||||
|
Merkle nodes and indexed bundles remain lower-level Arboricx transport/DAG
|
||||||
|
formats, but they are not the module/eval storage model. typed programs and view
|
||||||
|
catalogs are ordinary tree terms unless a future external tooling use case proves
|
||||||
|
that they need their own object kind.
|
||||||
|
|
||||||
|
The store core should not need to know what a `tricu` definition means.
|
||||||
|
|
||||||
|
### 4.2 Filesystem-backed layout
|
||||||
|
|
||||||
|
The long-term store should converge with the direction already sketched in
|
||||||
|
`lib/arboricx/server.tri`:
|
||||||
|
|
||||||
|
```text
|
||||||
|
store/
|
||||||
|
objects/
|
||||||
|
abc/
|
||||||
|
abc123...object
|
||||||
|
aliases/
|
||||||
|
names/
|
||||||
|
modules/
|
||||||
|
packages/
|
||||||
|
manifests/
|
||||||
|
tmp/
|
||||||
|
```
|
||||||
|
|
||||||
|
SQLite may remain useful as an optional index/cache, but it should not be the
|
||||||
|
canonical store model.
|
||||||
|
|
||||||
|
### 4.3 Structural references, not language dependencies
|
||||||
|
|
||||||
|
The store may understand structural content references when they are part of an
|
||||||
|
object format. For example, a Merkle node naturally references child hashes:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Leaf
|
||||||
|
Stem childHash
|
||||||
|
Fork leftHash rightHash
|
||||||
|
```
|
||||||
|
|
||||||
|
This is not a `tricu` dependency graph. It is content structure.
|
||||||
|
|
||||||
|
Language/tool-level relationships such as "compiled from source", "exported by
|
||||||
|
module", or "checked with contract" can live in manifests or indexes. They
|
||||||
|
should not be required by the store core.
|
||||||
|
|
||||||
|
## 5. Arboricx Role
|
||||||
|
|
||||||
|
Arboricx should be understood as a family of portable Tree Calculus artifact
|
||||||
|
formats, not as a single storage mechanism.
|
||||||
|
|
||||||
|
### 5.1 Arboricx Bundle
|
||||||
|
|
||||||
|
The existing indexed `.arboricx` format remains the preferred transport and
|
||||||
|
execution object:
|
||||||
|
|
||||||
|
- compact;
|
||||||
|
- self-contained;
|
||||||
|
- deterministic;
|
||||||
|
- easy to parse in constrained runtimes;
|
||||||
|
- suitable for deployment and HTTP serving;
|
||||||
|
- structurally verifiable without hash recomputation per node.
|
||||||
|
|
||||||
|
It says:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Here is everything you need, densely packed.
|
||||||
|
```
|
||||||
|
|
||||||
|
### 5.2 Arboricx CAS / Merkle Store
|
||||||
|
|
||||||
|
The persistent store should use content-addressed structural objects:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Leaf
|
||||||
|
Stem childHash
|
||||||
|
Fork leftHash rightHash
|
||||||
|
```
|
||||||
|
|
||||||
|
This enables dedupe across definitions, modules, packages, and versions. A large
|
||||||
|
program that shares subtrees with other programs should not store those subtrees
|
||||||
|
multiple times.
|
||||||
|
|
||||||
|
It says:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Here are immutable objects, addressable independently.
|
||||||
|
```
|
||||||
|
|
||||||
|
### 5.3 Pack and unpack
|
||||||
|
|
||||||
|
Transport and storage should interoperate explicitly:
|
||||||
|
|
||||||
|
```text
|
||||||
|
CAS root(s) -> pack -> indexed Arboricx bundle
|
||||||
|
Arboricx bundle -> unpack -> CAS root(s)
|
||||||
|
```
|
||||||
|
|
||||||
|
The bundle can be treated as an opaque content-addressed blob by the store, and
|
||||||
|
it can also be unpacked into Merkle nodes for dedupe and partial reuse.
|
||||||
|
|
||||||
|
## 6. Modules
|
||||||
|
|
||||||
|
### 6.1 Module identity
|
||||||
|
|
||||||
|
A module should be an immutable manifest object. Its identity is the hash of its
|
||||||
|
canonical manifest bytes.
|
||||||
|
|
||||||
|
A module name is not identity. It is a workspace alias or package-level alias to
|
||||||
|
a module hash.
|
||||||
|
|
||||||
|
### 6.2 Module contents
|
||||||
|
|
||||||
|
A module manifest should primarily be an export map:
|
||||||
|
|
||||||
|
```text
|
||||||
|
module hash
|
||||||
|
exports:
|
||||||
|
name -> content reference
|
||||||
|
metadata:
|
||||||
|
package
|
||||||
|
version
|
||||||
|
description
|
||||||
|
license
|
||||||
|
createdBy
|
||||||
|
optional:
|
||||||
|
view contract artifact refs
|
||||||
|
ABI/media type info
|
||||||
|
source/provenance refs
|
||||||
|
```
|
||||||
|
|
||||||
|
The manifest should be portable and mostly format-oriented. It should not depend
|
||||||
|
on Haskell data structures or `tricu`-specific internal semantics.
|
||||||
|
|
||||||
|
### 6.3 Export entries
|
||||||
|
|
||||||
|
An export entry may eventually look conceptually like:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name: "map"
|
||||||
|
object: sha256:...
|
||||||
|
kind: arboricx.tree-term.v1
|
||||||
|
abi: arboricx.abi.tree.v1
|
||||||
|
view: sha256:... -- optional View Contract artifact
|
||||||
|
source: sha256:... -- optional source/provenance object
|
||||||
|
```
|
||||||
|
|
||||||
|
Executable module exports are complete normalized tree terms stored as one
|
||||||
|
`arboricx.tree-term.v1` object per named export. Merkle-node storage remains
|
||||||
|
available for DAG-oriented tooling, but module/eval imports should not store or
|
||||||
|
hydrate every subtree as a separate filesystem object.
|
||||||
|
|
||||||
|
### 6.4 Import behavior
|
||||||
|
|
||||||
|
Imports should resolve module aliases or content references to module manifests,
|
||||||
|
then bind selected exports into the local source scope.
|
||||||
|
|
||||||
|
Export selection has one intentional aggregator special case:
|
||||||
|
|
||||||
|
```text
|
||||||
|
module with local top-level definitions -> exports only those local definitions
|
||||||
|
module with only imports -> reexports the evaluated import env
|
||||||
|
```
|
||||||
|
|
||||||
|
This lets files such as `prelude.tri` act as explicit barrel modules without
|
||||||
|
making every ordinary module reexport its imports. A module that defines even one
|
||||||
|
local top-level name does not implicitly reexport imported names.
|
||||||
|
|
||||||
|
The future pipeline should be:
|
||||||
|
|
||||||
|
```text
|
||||||
|
parse source
|
||||||
|
resolve imports/names to module exports and content refs
|
||||||
|
lower source using resolved refs
|
||||||
|
emit a view-tree artifact
|
||||||
|
check evidence when requested
|
||||||
|
store/export artifacts
|
||||||
|
```
|
||||||
|
|
||||||
|
It should not be:
|
||||||
|
|
||||||
|
```text
|
||||||
|
paste imported ASTs into one file and rewrite strings
|
||||||
|
```
|
||||||
|
|
||||||
|
## 7. Workspace Layer
|
||||||
|
|
||||||
|
Mutable human-facing state belongs in a workspace layer.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```text
|
||||||
|
List -> module hash
|
||||||
|
Http -> module hash
|
||||||
|
map -> definition/tree hash
|
||||||
|
selected List version -> module hash
|
||||||
|
package pin prelude -> package/module hash
|
||||||
|
```
|
||||||
|
|
||||||
|
The workspace is where names, selections, pins, and aliases live. Renaming should
|
||||||
|
usually mutate workspace aliases, not immutable content objects.
|
||||||
|
|
||||||
|
This gives humans stable ergonomic names without making names semantic identity.
|
||||||
|
|
||||||
|
## 8. Definition Identity
|
||||||
|
|
||||||
|
There are two useful identities and we should support both.
|
||||||
|
|
||||||
|
### 8.1 Tree identity
|
||||||
|
|
||||||
|
A Tree Calculus value has a Merkle root hash. This identifies the executable tree
|
||||||
|
itself.
|
||||||
|
|
||||||
|
This is the right identity for:
|
||||||
|
|
||||||
|
- execution;
|
||||||
|
- dedupe;
|
||||||
|
- bundle roots;
|
||||||
|
- low-level artifact sharing.
|
||||||
|
|
||||||
|
### 8.2 Module/export identity
|
||||||
|
|
||||||
|
The module manifest is the higher-level artifact boundary. It pairs each export
|
||||||
|
name with its compiled tree term and optional direct View Contract type.
|
||||||
|
|
||||||
|
The content store should not require extra definition/source/provenance objects,
|
||||||
|
and fully untyped Tree Calculus code must remain valid.
|
||||||
|
|
||||||
|
## 9. View Contract Integration
|
||||||
|
|
||||||
|
View Contracts should attach to modules/exports as portable artifacts.
|
||||||
|
|
||||||
|
An imported definition can be assigned a local numeric symbol while lowering a
|
||||||
|
typed program. Its global identity remains a content hash or module export ref.
|
||||||
|
|
||||||
|
This is the intended split:
|
||||||
|
|
||||||
|
```text
|
||||||
|
typed program local symbol: 3
|
||||||
|
Debug label: "List.map"
|
||||||
|
Resolved object: sha256:...
|
||||||
|
Exported view: Fn [...]
|
||||||
|
```
|
||||||
|
|
||||||
|
De Bruijn-style integer symbols are still appropriate inside a typed program. They
|
||||||
|
are local evidence identifiers, not global content identity.
|
||||||
|
|
||||||
|
We should not make global objects depend on numeric checker symbols.
|
||||||
|
|
||||||
|
Untyped code remains valid with no contract artifact. If a boundary needs to
|
||||||
|
participate in checking but has no information, it may use `Any` or rely on
|
||||||
|
policy. We should not pretend all untyped functions have an infinite
|
||||||
|
`Any -> Any -> ...` contract.
|
||||||
|
|
||||||
|
## 10. Import Syntax Direction
|
||||||
|
|
||||||
|
Exact syntax is future work, but the current `!import` form should be considered
|
||||||
|
a transitional mechanism.
|
||||||
|
|
||||||
|
Future imports should distinguish:
|
||||||
|
|
||||||
|
- path-based source imports for local development;
|
||||||
|
- workspace/module alias imports;
|
||||||
|
- explicit content-addressed imports;
|
||||||
|
- selected/exposed names;
|
||||||
|
- qualified versus unqualified binding.
|
||||||
|
|
||||||
|
Possible directions:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
import "./list.tri" as List
|
||||||
|
import List exposing (map foldl)
|
||||||
|
import #abc123... as List
|
||||||
|
```
|
||||||
|
|
||||||
|
The syntax should be designed after the object/module model is clearer.
|
||||||
|
|
||||||
|
## 11. Migration Strategy
|
||||||
|
|
||||||
|
A plausible migration path:
|
||||||
|
|
||||||
|
1. Define the neutral object store model and filesystem layout.
|
||||||
|
2. Implement Merkle node persistence against that layout.
|
||||||
|
3. Add pack/unpack between CAS roots and indexed Arboricx bundles.
|
||||||
|
4. Replace ad hoc SQLite `terms` names/tags with workspace aliases or a clearer
|
||||||
|
index layer.
|
||||||
|
5. Define module manifest objects.
|
||||||
|
6. Teach source imports to resolve manifests/exports instead of rewriting ASTs.
|
||||||
|
7. Attach View Contract artifacts to module exports.
|
||||||
|
8. Gradually migrate existing `lib/` and `demos/` imports.
|
||||||
|
|
||||||
|
Compatibility shims may keep existing `!import` working during migration.
|
||||||
|
|
||||||
|
## 12. Open Questions
|
||||||
|
|
||||||
|
- What exact canonical byte format should store objects use?
|
||||||
|
- Should module manifests be binary, tree-encoded, or both?
|
||||||
|
- What media type/kind registry do we need first?
|
||||||
|
- How should object references be represented in source syntax?
|
||||||
|
- How should workspaces be stored and shared?
|
||||||
|
- What is the minimum useful module manifest?
|
||||||
|
- Should source files compile directly to module manifests, or should manifests
|
||||||
|
be produced by explicit package commands?
|
||||||
|
- How much Arboricx bundle metadata should reference CAS roots?
|
||||||
|
- What GC/reachability model should the store eventually use?
|
||||||
|
|
||||||
|
## 13. Summary
|
||||||
|
|
||||||
|
The desired design is:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Content store:
|
||||||
|
portable CAS for immutable objects and structural references
|
||||||
|
|
||||||
|
Arboricx bundle:
|
||||||
|
compact indexed transport/execution object
|
||||||
|
|
||||||
|
Arboricx CAS:
|
||||||
|
persistent Merkle DAG/object representation for dedupe and partial reuse
|
||||||
|
|
||||||
|
Modules:
|
||||||
|
immutable manifests mapping export names to content objects and optional
|
||||||
|
contracts
|
||||||
|
|
||||||
|
Workspace:
|
||||||
|
mutable human aliases, version selections, and package/module pins
|
||||||
|
|
||||||
|
View Contracts:
|
||||||
|
portable evidence artifacts attached to exports and checked by pure Tree
|
||||||
|
Calculus code
|
||||||
|
```
|
||||||
|
|
||||||
|
The key architectural rule is that hashes provide stable identity, while names
|
||||||
|
provide human usability. The module system should be built on that separation.
|
||||||
483
docs/self-hosted-arboricx-host.md
Normal file
483
docs/self-hosted-arboricx-host.md
Normal file
@@ -0,0 +1,483 @@
|
|||||||
|
# Self-hosted Arboricx Host Prototype
|
||||||
|
|
||||||
|
This document describes how to build a minimal host-language shell that can execute Arboricx bundles through the self-hosted tricu Arboricx parser/executor.
|
||||||
|
|
||||||
|
The intended reader is an implementation agent building a first prototype in a host language such as PHP. The same approach should generalize to any language with a small Tree Calculus evaluator.
|
||||||
|
|
||||||
|
See also: [`docs/host-abi.md`](./host-abi.md) for the precise host-facing ABI value tags and typed runner contract.
|
||||||
|
|
||||||
|
## Goal
|
||||||
|
|
||||||
|
Build a tiny host program that can:
|
||||||
|
|
||||||
|
1. Represent Tree Calculus values.
|
||||||
|
2. Reduce/evaluate Tree Calculus terms.
|
||||||
|
3. Load or embed the tricu Arboricx runtime kernel.
|
||||||
|
4. Read an application `.arboricx` bundle from disk.
|
||||||
|
5. Convert host inputs into canonical Tree Calculus values.
|
||||||
|
6. Apply the kernel to the application bundle and arguments.
|
||||||
|
7. Unwrap a standardized host ABI result.
|
||||||
|
8. Decode the host ABI payload back into host values.
|
||||||
|
|
||||||
|
A concrete target example:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
-- Application bundle root is an unapplied function:
|
||||||
|
append "hello "
|
||||||
|
```
|
||||||
|
|
||||||
|
The host should be able to call that bundle with the host string `"james"` and receive:
|
||||||
|
|
||||||
|
```text
|
||||||
|
hello james
|
||||||
|
```
|
||||||
|
|
||||||
|
With the Host ABI layer, the preferred conceptual call is:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToString <applicationBundleBytes> ["james"]
|
||||||
|
```
|
||||||
|
|
||||||
|
This returns:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok (hostString "hello james") rest
|
||||||
|
```
|
||||||
|
|
||||||
|
where `runArboricxToString` comes from the self-hosted Arboricx runtime kernel.
|
||||||
|
|
||||||
|
## Architectural overview
|
||||||
|
|
||||||
|
There are two Arboricx bundles involved:
|
||||||
|
|
||||||
|
1. **Kernel bundle**
|
||||||
|
- Contains the self-hosted Arboricx parser/executor written in tricu.
|
||||||
|
- Exposes ergonomic runtime entrypoints such as `runArboricxArgs` and Host ABI entrypoints such as `runArboricxToString`.
|
||||||
|
- This can be hardcoded as a Tree Calculus value in the host, or loaded by a minimal host-side Arboricx parser.
|
||||||
|
|
||||||
|
2. **Application bundle**
|
||||||
|
- The bundle the user wants to execute.
|
||||||
|
- Example: a bundle whose exported root is `append "hello "`, waiting for one more string argument.
|
||||||
|
- The host reads this file as raw bytes and encodes those bytes as a Tree Calculus byte list.
|
||||||
|
|
||||||
|
The minimal host does **not** need to understand the application bundle format if the kernel is already available as a Tree Calculus value. The host only passes the application bundle bytes to the kernel.
|
||||||
|
|
||||||
|
## Required host components
|
||||||
|
|
||||||
|
### 1. Tree representation
|
||||||
|
|
||||||
|
The host needs a representation for the three Tree Calculus constructors:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Leaf
|
||||||
|
Stem child
|
||||||
|
Fork left right
|
||||||
|
```
|
||||||
|
|
||||||
|
Use whatever is idiomatic for the host language. In PHP, for a prototype, simple classes or tagged arrays are sufficient.
|
||||||
|
|
||||||
|
Example shape:
|
||||||
|
|
||||||
|
```php
|
||||||
|
abstract class T {}
|
||||||
|
final class Leaf extends T {}
|
||||||
|
final class Stem extends T { public T $child; }
|
||||||
|
final class Fork extends T { public T $left; public T $right; }
|
||||||
|
```
|
||||||
|
|
||||||
|
or tagged arrays:
|
||||||
|
|
||||||
|
```php
|
||||||
|
['tag' => 'leaf']
|
||||||
|
['tag' => 'stem', 'child' => $t]
|
||||||
|
['tag' => 'fork', 'left' => $l, 'right' => $r]
|
||||||
|
```
|
||||||
|
|
||||||
|
The evaluator and codecs only need these three constructors.
|
||||||
|
|
||||||
|
### 2. Tree Calculus evaluator
|
||||||
|
|
||||||
|
The host must implement Tree Calculus reduction. This is the core VM.
|
||||||
|
|
||||||
|
The evaluator should use normal-order evaluation, matching the runtime semantics expected by Arboricx manifests:
|
||||||
|
|
||||||
|
```text
|
||||||
|
runtimeEvaluation = "normal-order"
|
||||||
|
```
|
||||||
|
|
||||||
|
The evaluator only needs the Tree Calculus reduction rules. There is no parser requirement for the host prototype if terms are constructed directly as trees.
|
||||||
|
|
||||||
|
Implementation notes:
|
||||||
|
|
||||||
|
- Evaluation must support application: a tree applied to another tree.
|
||||||
|
- In this codebase, application is represented structurally as `Fork function argument` before reduction.
|
||||||
|
- The evaluator repeatedly reduces until normal form or until a configured step/fuel limit is reached.
|
||||||
|
- Add a fuel limit for the first prototype to avoid infinite reductions during debugging.
|
||||||
|
|
||||||
|
Reference implementation locations:
|
||||||
|
|
||||||
|
- Haskell evaluator/reduction: `src/Research.hs`
|
||||||
|
- JavaScript Arboricx runtime evaluator: `ext/js/src/` if present in the checkout
|
||||||
|
|
||||||
|
Use those as references for exact reduction behavior.
|
||||||
|
|
||||||
|
### 3. Kernel availability
|
||||||
|
|
||||||
|
The host needs access to the self-hosted Arboricx runtime kernel as a Tree Calculus value.
|
||||||
|
|
||||||
|
There are two viable bootstrap strategies.
|
||||||
|
|
||||||
|
#### Strategy A: hardcode the kernel tree
|
||||||
|
|
||||||
|
For the first host prototype, this is recommended.
|
||||||
|
|
||||||
|
Workflow:
|
||||||
|
|
||||||
|
1. Compile/export the tricu kernel entrypoint as an Arboricx bundle or tree value.
|
||||||
|
2. Convert the selected exported kernel function into a host-language Tree Calculus literal.
|
||||||
|
3. Commit/embed that literal in the host implementation.
|
||||||
|
|
||||||
|
Then the host does not need any Arboricx parser of its own for the kernel. It only needs Tree Calculus reduction.
|
||||||
|
|
||||||
|
#### Strategy B: bootstrap the kernel from an Arboricx bundle
|
||||||
|
|
||||||
|
Alternatively, the host can implement a minimal Arboricx parser just sufficient to load the kernel bundle.
|
||||||
|
|
||||||
|
This is more work up front, but avoids hardcoding a huge tree literal.
|
||||||
|
|
||||||
|
If using this strategy, the host-side parser needs to:
|
||||||
|
|
||||||
|
1. Parse the Arboricx container.
|
||||||
|
2. Parse enough manifest/export data to locate the desired kernel export.
|
||||||
|
3. Parse node records.
|
||||||
|
4. Reconstruct the selected root Tree Calculus value from the Merkle node DAG.
|
||||||
|
|
||||||
|
This logic is exactly what the tricu self-hosted kernel does, so the hardcoded-kernel path is simpler for early ports.
|
||||||
|
|
||||||
|
## Kernel entrypoints
|
||||||
|
|
||||||
|
The ergonomic runtime API currently lives in `lib/arboricx.tri`.
|
||||||
|
|
||||||
|
### Raw execution entrypoints
|
||||||
|
|
||||||
|
These return raw application results inside the existing `ok` / `err` result protocol:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
readArboricxExecutableByName nameBytes bundleBytes
|
||||||
|
readArboricxExecutable bundleBytes
|
||||||
|
runArboricxByName nameBytes bundleBytes arg
|
||||||
|
runArboricx bundleBytes arg
|
||||||
|
runArboricxArgsByName nameBytes bundleBytes args
|
||||||
|
runArboricxArgs bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
`runArboricxArgs` accepts:
|
||||||
|
|
||||||
|
1. Raw application bundle bytes as a Tree Calculus byte list.
|
||||||
|
2. A Tree Calculus list of arguments.
|
||||||
|
|
||||||
|
For named exports, use `runArboricxArgsByName`, which accepts:
|
||||||
|
|
||||||
|
1. Export name as bytes.
|
||||||
|
2. Application bundle bytes as bytes.
|
||||||
|
3. Argument list.
|
||||||
|
|
||||||
|
### Host ABI typed entrypoints
|
||||||
|
|
||||||
|
For host-language ports, prefer the Host ABI typed runners. These wrap successful outputs in a tagged host ABI value so every host can decode the same envelope shape.
|
||||||
|
|
||||||
|
Default export variants:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToTree bundleBytes args
|
||||||
|
runArboricxToString bundleBytes args
|
||||||
|
runArboricxToNumber bundleBytes args
|
||||||
|
runArboricxToBool bundleBytes args
|
||||||
|
runArboricxToList bundleBytes args
|
||||||
|
runArboricxToBytes bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
Named export variants:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxByNameToTree nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToString nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToNumber nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToBool nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToList nameBytes bundleBytes args
|
||||||
|
runArboricxByNameToBytes nameBytes bundleBytes args
|
||||||
|
```
|
||||||
|
|
||||||
|
Recommended first host entrypoint for the `append "hello "` example:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToString
|
||||||
|
```
|
||||||
|
|
||||||
|
## Applying the kernel in the host evaluator
|
||||||
|
|
||||||
|
If the host has the Tree Calculus value for `runArboricxToString`, call it by constructing nested application trees.
|
||||||
|
|
||||||
|
In Tree Calculus application form:
|
||||||
|
|
||||||
|
```text
|
||||||
|
((runArboricxToString bundleBytesTree) argsTree)
|
||||||
|
```
|
||||||
|
|
||||||
|
Structurally, if `app(f, x)` constructs `Fork(f, x)`, then:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$expr = app(app($kernelRunArboricxToString, $bundleBytesTree), $argsTree);
|
||||||
|
$result = normalize($expr);
|
||||||
|
```
|
||||||
|
|
||||||
|
For named export execution:
|
||||||
|
|
||||||
|
```text
|
||||||
|
(((runArboricxByNameToString nameBytesTree) bundleBytesTree) argsTree)
|
||||||
|
```
|
||||||
|
|
||||||
|
Structurally:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$expr = app(
|
||||||
|
app(
|
||||||
|
app($kernelRunArboricxByNameToString, $nameBytesTree),
|
||||||
|
$bundleBytesTree
|
||||||
|
),
|
||||||
|
$argsTree
|
||||||
|
);
|
||||||
|
$result = normalize($expr);
|
||||||
|
```
|
||||||
|
|
||||||
|
## Result convention and Host ABI envelope
|
||||||
|
|
||||||
|
All runtime APIs return the existing tricu `ok` / `err` convention from `lib/binary.tri`:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok value rest = pair true (pair value rest)
|
||||||
|
err code rest = pair false (pair code rest)
|
||||||
|
```
|
||||||
|
|
||||||
|
The host should always unwrap this outer result first.
|
||||||
|
|
||||||
|
### Raw runners
|
||||||
|
|
||||||
|
Raw runners such as `runArboricxArgs` return:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok rawApplicationValue rest
|
||||||
|
```
|
||||||
|
|
||||||
|
The host must know how to interpret `rawApplicationValue`.
|
||||||
|
|
||||||
|
### Host ABI typed runners
|
||||||
|
|
||||||
|
Typed runners such as `runArboricxToString` return:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok hostAbiValue rest
|
||||||
|
```
|
||||||
|
|
||||||
|
A host ABI value has shape:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
pair tag payload
|
||||||
|
```
|
||||||
|
|
||||||
|
The payload is still the canonical/raw Tree Calculus representation for that type.
|
||||||
|
|
||||||
|
Initial tags are specified in [`docs/host-abi.md`](./host-abi.md):
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
hostTreeTag = 0
|
||||||
|
hostStringTag = 1
|
||||||
|
hostNumberTag = 2
|
||||||
|
hostBoolTag = 3
|
||||||
|
hostListTag = 4
|
||||||
|
hostBytesTag = 5
|
||||||
|
```
|
||||||
|
|
||||||
|
For example:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
runArboricxToString bundleBytes ["james"]
|
||||||
|
```
|
||||||
|
|
||||||
|
returns:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok (hostString "hello james") rest
|
||||||
|
```
|
||||||
|
|
||||||
|
which is structurally:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
ok (pair hostStringTag "hello james") rest
|
||||||
|
```
|
||||||
|
|
||||||
|
### Error shape
|
||||||
|
|
||||||
|
Expected error shape:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
err code rest
|
||||||
|
```
|
||||||
|
|
||||||
|
The error code is a Tree Calculus number. Error constants are defined in:
|
||||||
|
|
||||||
|
- `lib/binary.tri`
|
||||||
|
- `lib/arboricx/common.tri`
|
||||||
|
- `lib/arboricx.tri` for Host ABI codec errors, currently `errHostCodecFailed = 14`
|
||||||
|
|
||||||
|
Typed runners return `errHostCodecFailed` if the application result cannot be interpreted as the requested type.
|
||||||
|
|
||||||
|
A prototype host can report the numeric error code and optionally dump a compact representation of `rest`.
|
||||||
|
|
||||||
|
## Example execution flow
|
||||||
|
|
||||||
|
Suppose the application bundle exports this root:
|
||||||
|
|
||||||
|
```tricu
|
||||||
|
append "hello "
|
||||||
|
```
|
||||||
|
|
||||||
|
The bundle root is an unapplied function waiting for one more string argument.
|
||||||
|
|
||||||
|
Host flow:
|
||||||
|
|
||||||
|
1. Load kernel entrypoint tree:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$runArboricxToString = loadHardcodedKernelEntrypoint('runArboricxToString');
|
||||||
|
```
|
||||||
|
|
||||||
|
2. Read application bundle bytes:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$bytes = file_get_contents('append-hello.arboricx');
|
||||||
|
```
|
||||||
|
|
||||||
|
3. Encode bundle bytes as a Tree Calculus byte list:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$bundleBytesTree = encodeBytes($bytes);
|
||||||
|
```
|
||||||
|
|
||||||
|
4. Encode host argument(s):
|
||||||
|
|
||||||
|
```php
|
||||||
|
$arg = encodeString('james');
|
||||||
|
$args = encodeList([$arg]);
|
||||||
|
```
|
||||||
|
|
||||||
|
5. Build application expression:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$expr = app(app($runArboricxToString, $bundleBytesTree), $args);
|
||||||
|
```
|
||||||
|
|
||||||
|
6. Evaluate:
|
||||||
|
|
||||||
|
```php
|
||||||
|
$result = normalize($expr);
|
||||||
|
```
|
||||||
|
|
||||||
|
7. Unwrap `ok` result:
|
||||||
|
|
||||||
|
```php
|
||||||
|
[$ok, $hostValue, $rest] = unwrapResult($result);
|
||||||
|
if (!$ok) { throw new RuntimeException('Arboricx error'); }
|
||||||
|
```
|
||||||
|
|
||||||
|
8. Unwrap Host ABI envelope:
|
||||||
|
|
||||||
|
```php
|
||||||
|
[$tag, $payload] = unwrapHostValue($hostValue);
|
||||||
|
if ($tag !== HOST_STRING_TAG) { throw new RuntimeException('Expected string'); }
|
||||||
|
```
|
||||||
|
|
||||||
|
9. Decode the payload:
|
||||||
|
|
||||||
|
```php
|
||||||
|
echo decodeString($payload); // hello james
|
||||||
|
```
|
||||||
|
|
||||||
|
## What the kernel does internally
|
||||||
|
|
||||||
|
`runArboricxToString` performs the following steps inside Tree Calculus:
|
||||||
|
|
||||||
|
1. Parse and validate the raw Arboricx bundle bytes.
|
||||||
|
2. Parse the manifest.
|
||||||
|
3. Select the default export:
|
||||||
|
- use export named `main` if present,
|
||||||
|
- otherwise use the sole export if exactly one exists,
|
||||||
|
- otherwise return an error.
|
||||||
|
4. Read the nodes section.
|
||||||
|
5. Reconstruct the selected root tree from the Merkle DAG.
|
||||||
|
6. Apply each host-provided argument in order.
|
||||||
|
7. Validate that the raw result is string-like.
|
||||||
|
8. Return `ok (hostString result) rest`, or an `err`.
|
||||||
|
|
||||||
|
`runArboricxByNameToString` is identical except that it selects a named export.
|
||||||
|
|
||||||
|
Other typed runners follow the same pattern for their requested output type.
|
||||||
|
|
||||||
|
## Tests proving the expected behavior
|
||||||
|
|
||||||
|
The relevant Haskell tests are in `test/Spec.hs` under `manifestReadingTests`.
|
||||||
|
|
||||||
|
Important cases:
|
||||||
|
|
||||||
|
- `readArboricxExecutable: reconstructs default export tree`
|
||||||
|
- `readArboricxExecutableByName: selects named export`
|
||||||
|
- `runArboricx: applies host-provided argument to default export`
|
||||||
|
- `runArboricxArgs: applies host-provided argument list in order`
|
||||||
|
- `host ABI: constructors expose tag and payload`
|
||||||
|
- `runArboricxToTree: wraps raw result as hostTree`
|
||||||
|
- `runArboricxToString: wraps string result as hostString`
|
||||||
|
- `runArboricxToNumber: wraps number result as hostNumber`
|
||||||
|
- `runArboricxToBool: rejects non-bool result`
|
||||||
|
|
||||||
|
These tests demonstrate the host-shell contract:
|
||||||
|
|
||||||
|
- application bundle bytes are supplied as a Tree Calculus byte list,
|
||||||
|
- host arguments are supplied as canonical Tree Calculus values,
|
||||||
|
- execution returns an outer result-wrapped value,
|
||||||
|
- Host ABI typed runners return a tagged ABI envelope inside `ok`.
|
||||||
|
|
||||||
|
## Minimal PHP prototype checklist
|
||||||
|
|
||||||
|
A PHP prototype should implement:
|
||||||
|
|
||||||
|
- [ ] Tree data constructors: `Leaf`, `Stem`, `Fork`.
|
||||||
|
- [ ] Application helper: `app($f, $x) = Fork($f, $x)`.
|
||||||
|
- [ ] Normal-order Tree Calculus reducer.
|
||||||
|
- [ ] Fuel/step limit for debugging.
|
||||||
|
- [ ] Hardcoded kernel entrypoint tree for `runArboricxToString` for the first string-output prototype.
|
||||||
|
- [ ] Encode application bundle file bytes into a Tree Calculus byte list.
|
||||||
|
- [ ] Encode host argument values into Tree Calculus values.
|
||||||
|
- [ ] Build expression: `((runArboricxToString bundleBytes) args)`.
|
||||||
|
- [ ] Normalize expression.
|
||||||
|
- [ ] Unwrap outer `ok` / `err` result.
|
||||||
|
- [ ] Unwrap Host ABI `pair tag payload` envelope.
|
||||||
|
- [ ] Decode payload according to tag.
|
||||||
|
|
||||||
|
For exact codec details, reference the Haskell implementation in `src/Research.hs` and the existing JS runtime if available.
|
||||||
|
|
||||||
|
## Current recommendation
|
||||||
|
|
||||||
|
For the first PHP implementation:
|
||||||
|
|
||||||
|
1. Hardcode only the `runArboricxToString` kernel entrypoint as a Tree Calculus value.
|
||||||
|
2. Do not implement host-side Arboricx parsing yet.
|
||||||
|
3. Implement only enough codecs for:
|
||||||
|
- bytes,
|
||||||
|
- strings,
|
||||||
|
- lists,
|
||||||
|
- result unwrapping,
|
||||||
|
- Host ABI envelope unwrapping.
|
||||||
|
4. Use one test fixture: an Arboricx bundle whose root is `append "hello "`.
|
||||||
|
5. Assert that calling it with `"james"` returns an outer `ok`, then a `hostString`, then payload `"hello james"`.
|
||||||
|
|
||||||
|
Once that works, add named export support via `runArboricxByNameToString` and expand Host ABI tags/codecs as needed.
|
||||||
582
docs/view-contract-syntax.md
Normal file
582
docs/view-contract-syntax.md
Normal file
@@ -0,0 +1,582 @@
|
|||||||
|
# View Contract Syntax Design
|
||||||
|
|
||||||
|
## 1. Purpose
|
||||||
|
|
||||||
|
This document specifies source-level syntax sugar for emitting View Contract
|
||||||
|
metadata from annotated `tricu` definitions.
|
||||||
|
|
||||||
|
The syntax is frontend sugar. It lowers to ordinary typed-program nodes consumed
|
||||||
|
by the portable checker in `lib/view.tri` and catalog helpers in
|
||||||
|
`lib/views/catalog.tri`.
|
||||||
|
|
||||||
|
The checker remains independent of source syntax.
|
||||||
|
|
||||||
|
## 2. Definition Annotations
|
||||||
|
|
||||||
|
A definition may carry argument and return view annotations directly in its head.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name arg1@Type1 arg2@Type2 =@ReturnType body
|
||||||
|
```
|
||||||
|
|
||||||
|
This declares:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name : Fn [Type1 Type2] ReturnType
|
||||||
|
arg1 : Type1
|
||||||
|
arg2 : Type2
|
||||||
|
```
|
||||||
|
|
||||||
|
and lowers to View Contract metadata:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedDeclareFn nameSym [(Type1) (Type2)] ReturnType t
|
||||||
|
typedValue arg1Sym Type1 t
|
||||||
|
typedValue arg2Sym Type2 t
|
||||||
|
```
|
||||||
|
|
||||||
|
If body flow metadata is emitted, the body result is required to satisfy the
|
||||||
|
appropriate residual view.
|
||||||
|
|
||||||
|
## 3. Syntax Forms
|
||||||
|
|
||||||
|
### 3.1 Binder annotation
|
||||||
|
|
||||||
|
```tri
|
||||||
|
x@Bool
|
||||||
|
xs@(List Bool)
|
||||||
|
f@(Fn [Bool] String)
|
||||||
|
```
|
||||||
|
|
||||||
|
A binder annotation introduces a normal term binder and contributes an argument
|
||||||
|
view to the function contract.
|
||||||
|
|
||||||
|
### 3.2 Phantom argument annotation
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name @A @B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
A phantom argument annotation contributes an argument view to the function
|
||||||
|
contract but introduces no term binder.
|
||||||
|
|
||||||
|
This is useful for point-free and combinator-heavy definitions.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name @A @B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
declares:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name : Fn [A B] C
|
||||||
|
```
|
||||||
|
|
||||||
|
The body itself must satisfy the residual function view:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Fn [A B] C
|
||||||
|
```
|
||||||
|
|
||||||
|
### 3.3 Binder prefix with phantom tail
|
||||||
|
|
||||||
|
Phantom annotations may appear after binder annotations:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name x@A @B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
This declares:
|
||||||
|
|
||||||
|
```text
|
||||||
|
name : Fn [A B] C
|
||||||
|
x : A
|
||||||
|
```
|
||||||
|
|
||||||
|
The body must satisfy:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Fn [B] C
|
||||||
|
```
|
||||||
|
|
||||||
|
This allows a named binder prefix with a point-free tail.
|
||||||
|
|
||||||
|
### 3.4 Return annotation
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name x@A =@B body
|
||||||
|
name =@B body
|
||||||
|
```
|
||||||
|
|
||||||
|
`=@B` contributes the result view.
|
||||||
|
|
||||||
|
A definition with no arguments and a return annotation is a value contract, not a
|
||||||
|
zero-arity function contract:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name =@Bool body
|
||||||
|
```
|
||||||
|
|
||||||
|
lowers to:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedValue nameSym viewBool t
|
||||||
|
```
|
||||||
|
|
||||||
|
not:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedDeclareFn nameSym [] viewBool t
|
||||||
|
```
|
||||||
|
|
||||||
|
## 4. Ordering Rule
|
||||||
|
|
||||||
|
Phantom argument annotations may only appear at the end of the argument list.
|
||||||
|
|
||||||
|
Valid:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@A y@B =@C body
|
||||||
|
foo @A @B =@C body
|
||||||
|
foo x@A @B =@C body
|
||||||
|
foo x y@B @C =@D body
|
||||||
|
```
|
||||||
|
|
||||||
|
Invalid:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@A @B z@C =@D body
|
||||||
|
foo @A x@B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
Once a phantom `@Type` item appears, no later named binder may appear.
|
||||||
|
|
||||||
|
## 5. Contract-Bearing Definitions
|
||||||
|
|
||||||
|
A definition is contract-bearing if its head contains any of:
|
||||||
|
|
||||||
|
```text
|
||||||
|
binder@Type
|
||||||
|
@Type
|
||||||
|
=@Type
|
||||||
|
```
|
||||||
|
|
||||||
|
Ordinary unannotated definitions do not emit View Contract metadata.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x y = body
|
||||||
|
```
|
||||||
|
|
||||||
|
emits no contract metadata.
|
||||||
|
|
||||||
|
## 6. Unannotated Binders in Contract-Bearing Heads
|
||||||
|
|
||||||
|
In a contract-bearing definition, an unannotated binder contributes `Any`.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x y@Bool =@String body
|
||||||
|
```
|
||||||
|
|
||||||
|
means:
|
||||||
|
|
||||||
|
```text
|
||||||
|
foo : Fn [Any Bool] String
|
||||||
|
x : Any
|
||||||
|
y : Bool
|
||||||
|
```
|
||||||
|
|
||||||
|
This keeps mixed annotation lightweight without emitting contracts for fully
|
||||||
|
unannotated definitions.
|
||||||
|
|
||||||
|
## 7. Missing Return Annotation
|
||||||
|
|
||||||
|
If a contract-bearing definition has argument annotations but no return
|
||||||
|
annotation, the return view defaults to `Any`.
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@Bool = body
|
||||||
|
```
|
||||||
|
|
||||||
|
means:
|
||||||
|
|
||||||
|
```text
|
||||||
|
foo : Fn [Bool] Any
|
||||||
|
x : Bool
|
||||||
|
```
|
||||||
|
|
||||||
|
## 8. Type Annotation Grammar
|
||||||
|
|
||||||
|
Annotations are intentionally small at the attachment site.
|
||||||
|
|
||||||
|
After `@` or `=@`, the parser accepts either a single atomic view expression or
|
||||||
|
a parenthesized compound view expression.
|
||||||
|
|
||||||
|
Valid:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
x@Bool
|
||||||
|
x@(List Bool)
|
||||||
|
f@(Fn [Bool] String)
|
||||||
|
r@(Result String Bool)
|
||||||
|
name =@Bool body
|
||||||
|
name =@(List Bool) body
|
||||||
|
```
|
||||||
|
|
||||||
|
These are not structural annotations:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
x@List Bool
|
||||||
|
f@Fn [Bool] String
|
||||||
|
name =@List Bool body
|
||||||
|
```
|
||||||
|
|
||||||
|
They are parsed according to normal definition-head rules. For example,
|
||||||
|
`x@List Bool` means binder `x` has the atomic view expression `List`, followed by
|
||||||
|
an unannotated binder named `Bool`. Use parentheses when the annotation itself is
|
||||||
|
an application.
|
||||||
|
|
||||||
|
## 9. Type Grammar
|
||||||
|
|
||||||
|
View expressions are ordinary value-level expressions in a restricted annotation
|
||||||
|
grammar:
|
||||||
|
|
||||||
|
```text
|
||||||
|
ViewExpr
|
||||||
|
= name
|
||||||
|
| integer
|
||||||
|
| [ViewExpr...]
|
||||||
|
| ViewExpr ViewExpr
|
||||||
|
| (ViewExpr)
|
||||||
|
```
|
||||||
|
|
||||||
|
Built-in names lower to standard view values:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Any -> viewAny
|
||||||
|
Bool -> viewBool
|
||||||
|
String -> viewString
|
||||||
|
Byte -> viewByte
|
||||||
|
Unit -> viewUnit
|
||||||
|
```
|
||||||
|
|
||||||
|
Atomic refs lower explicitly. String refs are the preferred user-facing form;
|
||||||
|
numeric refs remain available for low-level/generated code:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Ref "Nat" -> viewRef "Nat"
|
||||||
|
Ref 10 -> viewRef 10
|
||||||
|
```
|
||||||
|
|
||||||
|
Additional named views and view constructors are ordinary `tricu` values:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
Nat = viewRef "Nat"
|
||||||
|
Box a = viewPair (viewRef "Box") a
|
||||||
|
|
||||||
|
idNat x@Nat =@Nat x
|
||||||
|
idBox x@(Box String) =@(Box String) x
|
||||||
|
```
|
||||||
|
|
||||||
|
The frontend resolves names and evaluates view expressions, but well-formedness
|
||||||
|
is judged by the self-hosted checker (`wellFormedView?` in `lib/view.tri`).
|
||||||
|
Malformed view values are rejected when checked or published.
|
||||||
|
|
||||||
|
## 10. List Syntax in Types
|
||||||
|
|
||||||
|
Function argument lists use the source type grammar:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
Fn [Bool String] Unit
|
||||||
|
Fn [(List Bool) (Maybe String)] Unit
|
||||||
|
```
|
||||||
|
|
||||||
|
The lowered typed program must still respect ordinary `tricu` list syntax, where
|
||||||
|
each list element is parenthesized when needed:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
viewFn [(viewBool) (viewString)] viewUnit
|
||||||
|
```
|
||||||
|
|
||||||
|
## 11. Residual Body View
|
||||||
|
|
||||||
|
For a contract-bearing definition, the full definition view is always:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Fn [allArgumentViews...] returnView
|
||||||
|
```
|
||||||
|
|
||||||
|
except for nullary value annotations, which use the return view directly.
|
||||||
|
|
||||||
|
The body obligation depends on how many argument views are represented by named
|
||||||
|
binders in the definition head.
|
||||||
|
|
||||||
|
Let:
|
||||||
|
|
||||||
|
```text
|
||||||
|
argViews = [A B C]
|
||||||
|
returnView = R
|
||||||
|
binderCount = number of named binders before the phantom tail
|
||||||
|
remaining = drop binderCount argViews
|
||||||
|
```
|
||||||
|
|
||||||
|
Then:
|
||||||
|
|
||||||
|
```text
|
||||||
|
bodyRequiredView = residual(remaining, returnView)
|
||||||
|
```
|
||||||
|
|
||||||
|
where:
|
||||||
|
|
||||||
|
```text
|
||||||
|
residual([], R) = R
|
||||||
|
residual([A ...], R) = Fn [A ...] R
|
||||||
|
```
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@A y@B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
Body required view:
|
||||||
|
|
||||||
|
```text
|
||||||
|
C
|
||||||
|
```
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo @A @B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
Body required view:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Fn [A B] C
|
||||||
|
```
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@A @B =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
Body required view:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Fn [B] C
|
||||||
|
```
|
||||||
|
|
||||||
|
## 12. Lowering Examples
|
||||||
|
|
||||||
|
### 12.1 Fully annotated binders
|
||||||
|
|
||||||
|
Source:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@Bool xs@(List Bool) =@String body
|
||||||
|
```
|
||||||
|
|
||||||
|
Definition contract:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedDeclareFn fooSym [(viewBool) (viewList viewBool)] viewString t
|
||||||
|
typedValue xSym viewBool t
|
||||||
|
typedValue xsSym (viewList viewBool) t
|
||||||
|
```
|
||||||
|
|
||||||
|
Body obligation:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedRequire bodySym viewString t
|
||||||
|
```
|
||||||
|
|
||||||
|
### 12.2 Pure phantom signature
|
||||||
|
|
||||||
|
Source:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo @Bool @(List Bool) =@String body
|
||||||
|
```
|
||||||
|
|
||||||
|
Definition contract:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedDeclareFn fooSym [(viewBool) (viewList viewBool)] viewString t
|
||||||
|
```
|
||||||
|
|
||||||
|
Body obligation:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedRequire bodySym (viewFn [(viewBool) (viewList viewBool)] viewString) t
|
||||||
|
```
|
||||||
|
|
||||||
|
### 12.3 Binder prefix with phantom tail
|
||||||
|
|
||||||
|
Source:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
foo x@Bool @(List Bool) =@String body
|
||||||
|
```
|
||||||
|
|
||||||
|
Definition contract:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedDeclareFn fooSym [(viewBool) (viewList viewBool)] viewString t
|
||||||
|
typedValue xSym viewBool t
|
||||||
|
```
|
||||||
|
|
||||||
|
Body obligation:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedRequire bodySym (viewFn [(viewList viewBool)] viewString) t
|
||||||
|
```
|
||||||
|
|
||||||
|
### 12.4 Value annotation
|
||||||
|
|
||||||
|
Source:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
message =@String "hello"
|
||||||
|
```
|
||||||
|
|
||||||
|
Definition contract:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedValue messageSym viewString t
|
||||||
|
```
|
||||||
|
|
||||||
|
Body obligation:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
typedRequire bodySym viewString t
|
||||||
|
```
|
||||||
|
|
||||||
|
## 13. `tricu check`
|
||||||
|
|
||||||
|
`tricu check` consumes an annotated program, lowers annotations to typed program
|
||||||
|
metadata, runs the checker, and reports either `ok` or rendered diagnostics.
|
||||||
|
|
||||||
|
Initial behavior:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check path/to/program.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
outputs checker success or errors. Diagnostics are rendered by the portable
|
||||||
|
checker, then annotated by the frontend with source/debug labels when available:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
id x@String =@Bool x
|
||||||
|
```
|
||||||
|
|
||||||
|
reports:
|
||||||
|
|
||||||
|
```text
|
||||||
|
symbol 1 (x) expected Bool but got String
|
||||||
|
```
|
||||||
|
|
||||||
|
Application result labels include the application head when known:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
xs =@(List String) [(g "hi")]
|
||||||
|
g y@String =@Bool y
|
||||||
|
```
|
||||||
|
|
||||||
|
reports:
|
||||||
|
|
||||||
|
```text
|
||||||
|
symbol 3 (g application result) expected String but got Bool
|
||||||
|
```
|
||||||
|
|
||||||
|
These labels are presentation-only metadata. The checker still judges only the
|
||||||
|
emitted typed-program evidence.
|
||||||
|
|
||||||
|
Future behavior may include:
|
||||||
|
|
||||||
|
```bash
|
||||||
|
tricu check --out path/to/executable.arboricx path/to/program.tri
|
||||||
|
```
|
||||||
|
|
||||||
|
which checks an annotated source program and emits an executable Arboricx bundle.
|
||||||
|
|
||||||
|
The checker library remains available independently of the CLI workflow.
|
||||||
|
|
||||||
|
## 14. Frontend Lowering Boundaries
|
||||||
|
|
||||||
|
The annotation syntax is frontend sugar. The canonical checker input remains a
|
||||||
|
plain typed program: ordinary `typedValue`, `typedDeclareFn`,
|
||||||
|
`typedRequire`, and `typedApply` nodes represented as portable `tricu`
|
||||||
|
data.
|
||||||
|
|
||||||
|
The frontend may emit richer evidence from source forms, but it does not decide
|
||||||
|
semantic compatibility. In short:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Haskell emits evidence.
|
||||||
|
tricu judges evidence.
|
||||||
|
```
|
||||||
|
|
||||||
|
Current source-driven evidence includes:
|
||||||
|
|
||||||
|
- literal views for strings, bytes, unit, and homogeneous list literals;
|
||||||
|
- expected element requirements for `List T` bodies;
|
||||||
|
- expected `Fn` requirements for lambda literals and curried application spines;
|
||||||
|
- application argument requirements when the callee has a known `Fn` view;
|
||||||
|
- expected constructor flow for unshadowed stdlib constructors:
|
||||||
|
- `pair` with expected `Pair A B`;
|
||||||
|
- `just` and `nothing` with expected `Maybe A`;
|
||||||
|
- `ok` and `err` with expected `Result E A`.
|
||||||
|
|
||||||
|
Constructor lowering only applies when the constructor name is not shadowed by a
|
||||||
|
local binder or top-level definition in the checked source. If a program defines
|
||||||
|
its own `pair`, `just`, `nothing`, `ok`, or `err`, checking falls back to normal
|
||||||
|
application evidence.
|
||||||
|
|
||||||
|
For tooling and regression tests, the frontend exposes a lowering-only API that
|
||||||
|
returns emitted typed program text without invoking the checker:
|
||||||
|
|
||||||
|
```hs
|
||||||
|
lowerSource :: String -> Either String String
|
||||||
|
```
|
||||||
|
|
||||||
|
It also exposes debug labels for symbols:
|
||||||
|
|
||||||
|
```hs
|
||||||
|
lowerSourceWithDebug :: String -> Either String (String, Map Integer String)
|
||||||
|
```
|
||||||
|
|
||||||
|
Debug labels are presentation metadata only. They are not part of checker
|
||||||
|
semantics and are not consumed by `lib/view.tri`.
|
||||||
|
|
||||||
|
`do` blocks have no separate View Contract semantics. The parser lowers them
|
||||||
|
through their explicit bind operator:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
do bind
|
||||||
|
x <- action
|
||||||
|
next x
|
||||||
|
```
|
||||||
|
|
||||||
|
becomes ordinary application/lambda structure. Checking then follows the known
|
||||||
|
`Fn` view of the bind operator, including the callback argument view when it is
|
||||||
|
available.
|
||||||
|
|
||||||
|
## 15. Summary
|
||||||
|
|
||||||
|
The annotation syntax is:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
name arg@A arg2@B =@C body
|
||||||
|
name @A @B =@C body
|
||||||
|
name arg@A @B =@C body
|
||||||
|
name =@C body
|
||||||
|
```
|
||||||
|
|
||||||
|
Core rules:
|
||||||
|
|
||||||
|
1. Binder annotations introduce binders and argument views.
|
||||||
|
2. Phantom annotations introduce argument views only.
|
||||||
|
3. Phantom annotations may only appear after all binders.
|
||||||
|
4. Unannotated binders in contract-bearing heads contribute `Any`.
|
||||||
|
5. Missing return annotations in contract-bearing heads default to `Any`.
|
||||||
|
6. Nullary `=@T` definitions are value contracts, not zero-arity functions.
|
||||||
|
7. Compound annotation types must be parenthesized.
|
||||||
|
8. Lowering emits ordinary typed-program nodes for the existing checker.
|
||||||
516
docs/view-contracts.md
Normal file
516
docs/view-contracts.md
Normal file
@@ -0,0 +1,516 @@
|
|||||||
|
# View Contracts and View Trees
|
||||||
|
|
||||||
|
## 1. Purpose
|
||||||
|
|
||||||
|
View Contracts are the portable checking layer for Tree Calculus programs.
|
||||||
|
|
||||||
|
The checker does not consume detached metadata about a separate executable. Its
|
||||||
|
canonical input is a typed, checkable tree artifact: ordinary tree data that
|
||||||
|
contains both the executable program payloads and the view/contract structure
|
||||||
|
needed to validate and transform them.
|
||||||
|
|
||||||
|
The checker consumes this artifact and returns either:
|
||||||
|
|
||||||
|
```text
|
||||||
|
checked-execution artifact
|
||||||
|
```
|
||||||
|
|
||||||
|
or:
|
||||||
|
|
||||||
|
```text
|
||||||
|
structured diagnostic
|
||||||
|
```
|
||||||
|
|
||||||
|
A checked-execution artifact is interpreted by `runChecked`. Unguarded programs
|
||||||
|
are represented as `checkedPure rootPayload`; guarded programs contain explicit
|
||||||
|
checked guard/bind nodes.
|
||||||
|
|
||||||
|
This keeps checking independent of any particular host implementation. A typed
|
||||||
|
artifact may be produced by any frontend, compiler, hand-written generator, or
|
||||||
|
future self-hosted `tricu` toolchain.
|
||||||
|
|
||||||
|
## 2. Design Principle
|
||||||
|
|
||||||
|
The model follows the same discipline as interaction trees.
|
||||||
|
|
||||||
|
Interaction trees use tagged structural envelopes with explicit executable
|
||||||
|
payloads:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
io action = pair "tricuIO" (pair version action)
|
||||||
|
pure x = pair 0 x
|
||||||
|
bind action k = pair 1 (pair action k)
|
||||||
|
```
|
||||||
|
|
||||||
|
The interpreter understands the outer structure, but it does not recursively
|
||||||
|
mistake every subtree for interpreter metadata. A continuation `k` is an opaque
|
||||||
|
executable tree until the interpreter reaches the `bind` step that applies it.
|
||||||
|
|
||||||
|
View trees use the same rule:
|
||||||
|
|
||||||
|
```text
|
||||||
|
structure says how to check;
|
||||||
|
opaque executable fields are only executed/applied by the checker at the
|
||||||
|
appropriate step.
|
||||||
|
```
|
||||||
|
|
||||||
|
This is the key distinction that allows Views to carry guards without confusing
|
||||||
|
ordinary program trees with View metadata.
|
||||||
|
|
||||||
|
## 3. Views
|
||||||
|
|
||||||
|
A View is an extrinsic contract over an ordinary Tree Calculus value. Tree
|
||||||
|
Calculus values do not carry native runtime types; a View describes how a value
|
||||||
|
may be treated by the checker or by a checked boundary.
|
||||||
|
|
||||||
|
Core View forms:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Any
|
||||||
|
Ref ref
|
||||||
|
Fn [argView...] resultView
|
||||||
|
List elemView
|
||||||
|
Maybe elemView
|
||||||
|
Pair leftView rightView
|
||||||
|
Result errView okView
|
||||||
|
Guarded baseView guard
|
||||||
|
```
|
||||||
|
|
||||||
|
`Ref` supports both generated/numeric and symbolic references. Symbolic refs are
|
||||||
|
preferred for user-authored views:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
UserId = viewRef "UserId"
|
||||||
|
```
|
||||||
|
|
||||||
|
A guarded view refines a base view with an executable guard:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
UserId = viewGuarded (viewRef "UserId") userIdGuard
|
||||||
|
```
|
||||||
|
|
||||||
|
The guard is ordinary program code. The View validator checks that the guarded
|
||||||
|
view envelope is well-formed, and recursively validates the `baseView`, but it
|
||||||
|
must treat the guard payload/reference as opaque executable data, not as another
|
||||||
|
View.
|
||||||
|
|
||||||
|
## 4. Polymorphic and Abstract Views
|
||||||
|
|
||||||
|
View Contracts support portable polymorphism over Views. The View language is
|
||||||
|
interpreted by the same portable checker model implemented in `tricu` terms.
|
||||||
|
|
||||||
|
Source syntax may use underscore-prefixed names as View variables inside
|
||||||
|
annotations:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
id x@_a =@_a x
|
||||||
|
const x@_a y@_b =@_a x
|
||||||
|
compose f@(Fn [_b] _c) g@(Fn [_a] _b) x@_a =@_c f (g x)
|
||||||
|
```
|
||||||
|
|
||||||
|
In the portable artifact, these lower to scoped View binders rather than
|
||||||
|
unscoped source-name conventions. This fits the existing View encoding style:
|
||||||
|
Views are tagged records with numeric tags and tagged fields. Polymorphic forms
|
||||||
|
are View records such as:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Var localId
|
||||||
|
Forall binders body
|
||||||
|
Exists binders body
|
||||||
|
```
|
||||||
|
|
||||||
|
The current durable encoding uses stable local binder IDs. For example,
|
||||||
|
`id x@_a =@_a x` exports a shape equivalent to:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Forall [0] (Fn [Var 0] (Var 0))
|
||||||
|
```
|
||||||
|
|
||||||
|
Source names like `_a` are for authoring; the artifact carries binder scope and
|
||||||
|
local IDs rather than relying on source-name identity.
|
||||||
|
|
||||||
|
`Forall` supports generic contracts:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
map f@(Fn [_a] _b) xs@(List _a) =@(List _b) ...
|
||||||
|
head xs@(NonEmptyList _a) =@_a ...
|
||||||
|
```
|
||||||
|
|
||||||
|
At each checked use, the checker instantiates quantified variables into
|
||||||
|
use-local internal variables and solves View compatibility constraints. The
|
||||||
|
portable checker uses structural use-local IDs rather than expensive numeric
|
||||||
|
freshening, and treats unconstrained variable-variable matches as constraints
|
||||||
|
that do not create substitution cycles. Concrete observations still bind these
|
||||||
|
variables when enough information is available. This is what lets explicitly
|
||||||
|
annotated higher-order boundaries accept polymorphic values, for example
|
||||||
|
`compose id id "x"`, and lets quantified values satisfy concrete requirements
|
||||||
|
such as `Fn [String] String`. It gives useful polymorphic contracts for
|
||||||
|
explicitly declared/imported View facts.
|
||||||
|
|
||||||
|
`Exists` supports checked abstraction boundaries. A module can expose a value as
|
||||||
|
"some representation `_repr` plus capabilities over `_repr`":
|
||||||
|
|
||||||
|
```text
|
||||||
|
Exists _repr.
|
||||||
|
Pair
|
||||||
|
(Fn [String] _repr) -- constructor
|
||||||
|
(Fn [_repr] String) -- renderer / eliminator
|
||||||
|
```
|
||||||
|
|
||||||
|
This does not make raw Tree Calculus inspection impossible. Unchecked code can
|
||||||
|
always inspect trees. It means checked clients cannot justify
|
||||||
|
representation-specific operations through the View system unless the package
|
||||||
|
exports an appropriate capability or eliminator.
|
||||||
|
|
||||||
|
This leads to an important distinction for future checked subsets:
|
||||||
|
|
||||||
|
```text
|
||||||
|
controlled observation: Bool/List/Maybe/Result/etc. eliminators with Views
|
||||||
|
raw observation: direct tree-shape inspection through triage-like power
|
||||||
|
```
|
||||||
|
|
||||||
|
Useful application code can live mostly in the controlled fragment and receive
|
||||||
|
explicit View validation over lambdas, application, let, and typed eliminators.
|
||||||
|
Low-level library code may still use raw intensionality, but should expose
|
||||||
|
disciplined Views and capabilities above it. Scott-encoded constructors and
|
||||||
|
eliminators are a natural tricu-native representation for these APIs.
|
||||||
|
|
||||||
|
Tree Calculus terms do not carry intrinsic principal Views, and raw intensional
|
||||||
|
code can invalidate parametric claims. View Contracts are an explicit evidence
|
||||||
|
and contract layer over tricu programs; limited polymorphic Views are supported
|
||||||
|
when they are declared or imported as facts with provenance.
|
||||||
|
|
||||||
|
The first stdlib annotation island starts with parametric functions that do not
|
||||||
|
inspect representation:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
id x@_a =@_a x
|
||||||
|
const x@_a y@_b =@_a x
|
||||||
|
compose f@(Fn [_b] _c) g@(Fn [_a] _b) x@_a =@_c f (g x)
|
||||||
|
```
|
||||||
|
|
||||||
|
Re-export-only modules preserve imported View metadata, so these contracts flow
|
||||||
|
through `prelude` rather than only through direct `base` imports.
|
||||||
|
|
||||||
|
Functions built on raw `t`/`triage` should enter the checked world through
|
||||||
|
trusted, controlled eliminator contracts rather than by treating arbitrary raw
|
||||||
|
inspection as parametric.
|
||||||
|
|
||||||
|
|
||||||
|
## 5. Guards
|
||||||
|
|
||||||
|
Guards are ordinary `tricu` values/functions grouped with the Views they refine.
|
||||||
|
|
||||||
|
Example:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
userIdGuard = value :
|
||||||
|
-- ordinary program that validates value
|
||||||
|
|
||||||
|
UserId = viewGuarded (viewRef "UserId") userIdGuard
|
||||||
|
|
||||||
|
loadUser id@UserId = ...
|
||||||
|
```
|
||||||
|
|
||||||
|
Guards return the standard checked-runtime protocol:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
guardOk value
|
||||||
|
guardFail
|
||||||
|
```
|
||||||
|
|
||||||
|
Guards do not author diagnostics. The checked-exec runner owns guard failure and
|
||||||
|
malformed-guard diagnostics using boundary context from the checked artifact.
|
||||||
|
|
||||||
|
Guards are injected by the checker. They are not discovered by the runtime as a
|
||||||
|
separate metadata layer. The checking process transforms a view tree into an
|
||||||
|
executable tree with the necessary guard applications inserted.
|
||||||
|
|
||||||
|
## 6. View Tree Artifact
|
||||||
|
|
||||||
|
The primary checker-facing artifact is a view executable term graph.
|
||||||
|
|
||||||
|
Conceptually:
|
||||||
|
|
||||||
|
```text
|
||||||
|
ViewTree
|
||||||
|
version
|
||||||
|
root node id
|
||||||
|
nodes
|
||||||
|
```
|
||||||
|
|
||||||
|
Each node is tagged tree data. Nodes combine executable payloads, view claims,
|
||||||
|
and structural relationships in one graph.
|
||||||
|
|
||||||
|
Representative node forms:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Value node view executableTree
|
||||||
|
Apply node calleeNode argNode expectedOrInferredView
|
||||||
|
Require node requiredView sourceNode
|
||||||
|
External node name view
|
||||||
|
```
|
||||||
|
|
||||||
|
This is not a mandatory final encoding; it is the semantic target. The important
|
||||||
|
property is that executable trees and checking structure are carried together in
|
||||||
|
a single portable artifact.
|
||||||
|
|
||||||
|
A node may contain opaque executable fields. Those fields are tree terms, but
|
||||||
|
they are not recursively decoded as view-tree nodes or Views unless the node's
|
||||||
|
semantics explicitly says so.
|
||||||
|
|
||||||
|
View facts may also carry explicit per-fact trust provenance:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Checked -- derived by checked lowering / checker validation
|
||||||
|
Trusted -- asserted by a trusted boundary, e.g. a primitive eliminator API
|
||||||
|
Unchecked -- raw or assumed; no parametricity/abstraction guarantee
|
||||||
|
```
|
||||||
|
|
||||||
|
In the portable view-tree envelope this provenance is represented as an optional
|
||||||
|
field on `typedValue` / `typedRequire` facts. In module manifests the same
|
||||||
|
provenance is carried beside the exported View Contract object reference so that
|
||||||
|
imports and re-exports preserve it without relying on module-level convention.
|
||||||
|
Absent provenance is interpreted conservatively as `Unchecked` at use sites.
|
||||||
|
|
||||||
|
For parametric checked definitions, the frontend now performs a conservative
|
||||||
|
raw-intensionality dependency pass over local definitions. If a definition with
|
||||||
|
scoped View variables depends directly or indirectly on raw `triage` / raw `t`
|
||||||
|
construction, or on an imported `Unchecked` fact, lowering fails and asks the
|
||||||
|
author to route observation through a trusted eliminator boundary. This is
|
||||||
|
intentionally provenance/dependency based; it is not an attempt to decide
|
||||||
|
whether arbitrary Tree Calculus reduction will ever reach rule 3.
|
||||||
|
|
||||||
|
View facts can be authored as ordinary value-level Tree Calculus metadata under
|
||||||
|
one conventional top-level name:
|
||||||
|
|
||||||
|
```text
|
||||||
|
viewFacts = [fact ...]
|
||||||
|
fact = pair exportName (pair provenance view)
|
||||||
|
```
|
||||||
|
|
||||||
|
where `exportName` is a string naming a value exported by the module,
|
||||||
|
`provenance` is `0 = Checked`, `1 = Trusted`, or `2 = Unchecked`, and `view` is
|
||||||
|
the same portable View record used by `view-tree` artifacts. The host evaluates
|
||||||
|
this value and decodes the data schema; it does not infer trust from source
|
||||||
|
syntax, AST shape, module name, or a Haskell-side catalog.
|
||||||
|
|
||||||
|
The initial trusted eliminator facts are authored this way in clearly separated
|
||||||
|
stdlib `viewFacts` sections:
|
||||||
|
|
||||||
|
```text
|
||||||
|
matchBool : forall r. r -> r -> Bool -> r
|
||||||
|
matchMaybe : forall a r. r -> (a -> r) -> Maybe a -> r
|
||||||
|
matchList : forall a r. r -> (a -> List a -> r) -> List a -> r
|
||||||
|
```
|
||||||
|
|
||||||
|
The `base` module provides small `facts*` authoring helpers for this advanced
|
||||||
|
metadata, e.g. `factsFact`, `factsChecked`, `factsTrusted`, `factsUnchecked`,
|
||||||
|
`factsForall`, `factsFn`, `factsVar`, `factsBool`, `factsString`, `factsByte`,
|
||||||
|
`factsUnit`, `factsMaybe`, and `factsList`. These helpers construct ordinary
|
||||||
|
Tree data; authority comes from the exported `viewFacts` value and its explicit
|
||||||
|
provenance tags. Loader validation rejects duplicate fact names and facts for
|
||||||
|
names the module does not export.
|
||||||
|
|
||||||
|
Initial derived stdlib annotations using this trusted kernel include:
|
||||||
|
|
||||||
|
```text
|
||||||
|
maybeMap : forall a b. (a -> b) -> Maybe a -> Maybe b
|
||||||
|
maybeBind : forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
|
||||||
|
maybeOr : forall a. a -> Maybe a -> a
|
||||||
|
```
|
||||||
|
|
||||||
|
Recursive list combinators are currently published as explicit `Trusted`
|
||||||
|
value-level facts rather than `Checked` source annotations, because their bodies
|
||||||
|
pass through raw fixed-point machinery that the conservative parametric taint
|
||||||
|
pass intentionally does not prove safe. This is the stabilized boundary: raw
|
||||||
|
stdlib kernels establish conventions with explicit authority; ordinary checked
|
||||||
|
clients consume those facts rather than re-proving the internals.
|
||||||
|
|
||||||
|
```text
|
||||||
|
headMaybe / lastMaybe / nthMaybe
|
||||||
|
append / map / filter / foldl / foldr
|
||||||
|
length / reverse / snoc / count / all? / any? / intersect
|
||||||
|
take / drop / splitAt / concatMap / find / partition / zipWith
|
||||||
|
string/list-byte helpers such as strLength, startsWith?, lines, words
|
||||||
|
```
|
||||||
|
|
||||||
|
## 7. Checker Semantics
|
||||||
|
|
||||||
|
The checker is an interpreter over the view tree.
|
||||||
|
|
||||||
|
For each node it may:
|
||||||
|
|
||||||
|
1. validate the node envelope;
|
||||||
|
2. validate Views referenced by the node;
|
||||||
|
3. check compatibility between expected and actual Views;
|
||||||
|
4. recursively check child nodes;
|
||||||
|
5. inject guards required by guarded Views;
|
||||||
|
6. produce the executable tree for that node;
|
||||||
|
7. memoize node results by node id.
|
||||||
|
|
||||||
|
The root node result is a checked-execution program.
|
||||||
|
|
||||||
|
In abstract form:
|
||||||
|
|
||||||
|
```text
|
||||||
|
checkViewTree : ViewTree -> Result CheckedExec Diagnostic
|
||||||
|
```
|
||||||
|
|
||||||
|
or, in self-hosted terms:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
checkViewTree viewTree = ... -- ok checkedExec / err diagnostic
|
||||||
|
```
|
||||||
|
|
||||||
|
## 8. Compatibility and Guard Injection
|
||||||
|
|
||||||
|
Structural compatibility is about Views. Guard injection is about producing the
|
||||||
|
checked-execution tree.
|
||||||
|
|
||||||
|
For example, if a node is required to satisfy:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
viewGuarded (viewRef "UserId") userIdGuard
|
||||||
|
```
|
||||||
|
|
||||||
|
then the checker verifies the underlying View relationship and emits executable
|
||||||
|
code that applies `userIdGuard` at the appropriate checked boundary.
|
||||||
|
|
||||||
|
The checker, not the runtime metadata system, owns this transformation.
|
||||||
|
|
||||||
|
## 9. Source Annotations
|
||||||
|
|
||||||
|
Source annotations are one frontend syntax for producing view-tree nodes.
|
||||||
|
|
||||||
|
Examples:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
Nat = viewRef "Nat"
|
||||||
|
Box a = viewPair (viewRef "Box") a
|
||||||
|
|
||||||
|
idNat x@Nat =@Nat x
|
||||||
|
idBox x@(Box String) =@(Box String) x
|
||||||
|
```
|
||||||
|
|
||||||
|
Annotations are value-level View expressions. Names such as `Nat` and `Box` are
|
||||||
|
ordinary program values/functions that evaluate to Views.
|
||||||
|
|
||||||
|
A frontend that supports this syntax should lower the source into a view tree
|
||||||
|
that contains the relevant executable terms, views, and checking structure. The
|
||||||
|
artifact must not depend on source names or on the frontend implementation that
|
||||||
|
produced it.
|
||||||
|
|
||||||
|
## 10. Contract Expressions
|
||||||
|
|
||||||
|
Contract-expression helpers remain useful as authoring/building tools, but they
|
||||||
|
are not the fundamental artifact model.
|
||||||
|
|
||||||
|
Preferred style for expression-oriented authoring is pipeline-first:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
mapBoolStringUse = cFn <|
|
||||||
|
[(viewFn [(viewBool)] viewString) (viewList viewBool)] (viewList viewString)
|
||||||
|
|> cApply (cFn [(viewBool)] viewString)
|
||||||
|
|> cApply (cValue (viewList viewBool))
|
||||||
|
|> cRequire (viewList viewString)
|
||||||
|
```
|
||||||
|
|
||||||
|
These helpers should be understood as convenient ways to build typed/checkable
|
||||||
|
structure, not as a permanent replacement for view-tree artifacts.
|
||||||
|
|
||||||
|
## 11. Artifact Direction
|
||||||
|
|
||||||
|
The target direction is to make the view tree the canonical checked-program
|
||||||
|
artifact.
|
||||||
|
|
||||||
|
Older split concepts remain useful internally or during development:
|
||||||
|
|
||||||
|
```text
|
||||||
|
tree term
|
||||||
|
view value
|
||||||
|
typed-program node
|
||||||
|
module/export manifest
|
||||||
|
```
|
||||||
|
|
||||||
|
But the durable design should avoid treating contracts as detached facts about a
|
||||||
|
separate program. The portable checker input is the checkable program itself.
|
||||||
|
|
||||||
|
In short:
|
||||||
|
|
||||||
|
```text
|
||||||
|
Do not store code over here and contracts over there.
|
||||||
|
Store a view tree: executable code plus the structure needed to check and guard it.
|
||||||
|
```
|
||||||
|
|
||||||
|
## 12. IO Interaction Trees
|
||||||
|
|
||||||
|
`tricu` IO is represented as ordinary interaction-tree data:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
io action = pair "tricuIO" (pair version action)
|
||||||
|
pure value = pair 0 value
|
||||||
|
bind action k = pair 1 (pair action k)
|
||||||
|
```
|
||||||
|
|
||||||
|
View Contracts do not change that representation. A checked program may produce
|
||||||
|
an ordinary IO interaction tree, and the existing IO driver can execute it
|
||||||
|
unchanged.
|
||||||
|
|
||||||
|
For source evaluation with contracts enabled, `tricu eval --io` performs an
|
||||||
|
additional frontend instrumentation pass over visible IO continuations. When a
|
||||||
|
continuation returns a `pure (...)` value that mentions source-annotated
|
||||||
|
functions, the frontend lowers that pure expression into the existing portable
|
||||||
|
checked-exec protocol before returning the next IO action.
|
||||||
|
|
||||||
|
This means source sugar works for practical checked IO paths such as:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
acceptNames xs@(NonEmptyList String) =@String "accepted"
|
||||||
|
|
||||||
|
main = io (bind (pure []) (xs : pure (acceptNames xs)))
|
||||||
|
```
|
||||||
|
|
||||||
|
and for explicit higher-order boundaries:
|
||||||
|
|
||||||
|
```tri
|
||||||
|
useHandler handler@(Fn [(NonEmptyList String)] String) xs@(List String) =@String
|
||||||
|
handler xs
|
||||||
|
|
||||||
|
main = io (bind (pure []) (xs : pure (useHandler acceptNames xs)))
|
||||||
|
```
|
||||||
|
|
||||||
|
The IO runtime does not perform View inference or guard injection at every step.
|
||||||
|
The source/frontend pass constructs checked-exec boundaries once; the runtime
|
||||||
|
only evaluates the resulting interaction tree.
|
||||||
|
|
||||||
|
Current limitations:
|
||||||
|
|
||||||
|
- This is source-visible instrumentation, not whole-program function-flow
|
||||||
|
tracking.
|
||||||
|
- Higher-order guarantees require explicit annotated boundaries.
|
||||||
|
- Raw prebuilt interaction trees, imported executable artifacts, and content-store
|
||||||
|
terms are not automatically re-instrumented unless they pass through this
|
||||||
|
source-lowering path.
|
||||||
|
- The IO action shape itself is only shallowly checkable unless users provide
|
||||||
|
guarded Views for the relevant boundaries.
|
||||||
|
- Continuation result Views are not inferred from external effects; dynamic IO
|
||||||
|
values should cross annotated/guarded boundaries when runtime enforcement is
|
||||||
|
required.
|
||||||
|
|
||||||
|
Making IO checking more complete is future work. In particular, a future design
|
||||||
|
may validate every continuation-produced action structurally, carry checked
|
||||||
|
wrappers with higher-order function values, or define a portable checked-IO
|
||||||
|
artifact instead of relying on Haskell/frontend source instrumentation.
|
||||||
|
|
||||||
|
## 13. Host Independence
|
||||||
|
|
||||||
|
No part of the core View Tree design is specific to Haskell or to the current implementation.
|
||||||
|
|
||||||
|
Any producer may emit a view-tree artifact if it follows the portable tree-data
|
||||||
|
encoding. Any checker implementation may consume it if it implements the typed
|
||||||
|
node semantics.
|
||||||
|
|
||||||
|
The current implementation can produce and consume these artifacts, but it is
|
||||||
|
not the semantic authority. The artifact format and the self-hosted checker
|
||||||
|
semantics are the authority.
|
||||||
1
ext/js/.gitignore
vendored
Normal file
1
ext/js/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
node_modules
|
||||||
29
ext/js/package-lock.json
generated
Normal file
29
ext/js/package-lock.json
generated
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
{
|
||||||
|
"name": "arboricx-runtime",
|
||||||
|
"version": "0.1.0",
|
||||||
|
"lockfileVersion": 3,
|
||||||
|
"requires": true,
|
||||||
|
"packages": {
|
||||||
|
"": {
|
||||||
|
"name": "arboricx-runtime",
|
||||||
|
"version": "0.1.0",
|
||||||
|
"license": "MIT",
|
||||||
|
"dependencies": {
|
||||||
|
"koffi": "^2.16.2"
|
||||||
|
},
|
||||||
|
"bin": {
|
||||||
|
"arboricx-run": "src/cli.js"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"node_modules/koffi": {
|
||||||
|
"version": "2.16.2",
|
||||||
|
"resolved": "https://registry.npmjs.org/koffi/-/koffi-2.16.2.tgz",
|
||||||
|
"integrity": "sha512-owU0MRwv6xkrVqCd+33uw6BaYppkTRXbO/rVdJNI2dvZG0gzyRhYwW25eWtc5pauwK8TGh3AbkFONSezdykfSA==",
|
||||||
|
"hasInstallScript": true,
|
||||||
|
"license": "MIT",
|
||||||
|
"funding": {
|
||||||
|
"url": "https://liberapay.com/Koromix"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
20
ext/js/package.json
Normal file
20
ext/js/package.json
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
{
|
||||||
|
"name": "arboricx-runtime",
|
||||||
|
"version": "0.1.0",
|
||||||
|
"description": "Arboricx portable bundle runtime — JavaScript host via libarboricx FFI",
|
||||||
|
"type": "module",
|
||||||
|
"main": "src/lib.js",
|
||||||
|
"bin": {
|
||||||
|
"arboricx-run": "src/cli.js"
|
||||||
|
},
|
||||||
|
"scripts": {
|
||||||
|
"test": "node --test test/*.test.js",
|
||||||
|
"inspect": "node src/cli.js inspect",
|
||||||
|
"run": "node src/cli.js run"
|
||||||
|
},
|
||||||
|
"dependencies": {
|
||||||
|
"koffi": "^2.16.0"
|
||||||
|
},
|
||||||
|
"keywords": ["arboricx", "tree-calculus", "trie", "runtime", "ffi"],
|
||||||
|
"license": "MIT"
|
||||||
|
}
|
||||||
104
ext/js/src/cli.js
Normal file
104
ext/js/src/cli.js
Normal file
@@ -0,0 +1,104 @@
|
|||||||
|
#!/usr/bin/env node
|
||||||
|
/**
|
||||||
|
* cli.js — Arboricx JS host shell via libarboricx C ABI.
|
||||||
|
*
|
||||||
|
* Usage:
|
||||||
|
* node cli.js inspect <bundle.arboricx>
|
||||||
|
* node cli.js run <bundle.arboricx> [args...]
|
||||||
|
*/
|
||||||
|
|
||||||
|
import { readFileSync } from 'node:fs';
|
||||||
|
import {
|
||||||
|
init,
|
||||||
|
free,
|
||||||
|
loadBundleDefault,
|
||||||
|
reduce,
|
||||||
|
app,
|
||||||
|
ofNumber,
|
||||||
|
ofString,
|
||||||
|
decode,
|
||||||
|
decodeType,
|
||||||
|
findLib,
|
||||||
|
} from './lib.js';
|
||||||
|
|
||||||
|
// ── Commands ─────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
function cmdInspect(bundlePath) {
|
||||||
|
const ctx = init();
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(bundlePath);
|
||||||
|
console.log(`Bundle: ${bundlePath}`);
|
||||||
|
console.log(`Size: ${bundle.length} bytes\n`);
|
||||||
|
|
||||||
|
const term = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, term);
|
||||||
|
|
||||||
|
const type = decodeType(ctx, result);
|
||||||
|
let value;
|
||||||
|
try {
|
||||||
|
value = decode(ctx, result);
|
||||||
|
} catch {
|
||||||
|
value = '(raw tree)';
|
||||||
|
}
|
||||||
|
|
||||||
|
console.log(`Type: ${type}`);
|
||||||
|
console.log(`Value: ${value}`);
|
||||||
|
} catch (e) {
|
||||||
|
console.error(`Error: ${e.message}`);
|
||||||
|
process.exit(1);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function cmdRun(bundlePath, args) {
|
||||||
|
const ctx = init();
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(bundlePath);
|
||||||
|
let term = loadBundleDefault(ctx, bundle);
|
||||||
|
|
||||||
|
for (const arg of args) {
|
||||||
|
const argTree = /^\d+$/.test(arg) ? ofNumber(ctx, BigInt(arg)) : ofString(ctx, arg);
|
||||||
|
term = app(ctx, term, argTree);
|
||||||
|
}
|
||||||
|
|
||||||
|
const result = reduce(ctx, term);
|
||||||
|
console.log(decode(ctx, result));
|
||||||
|
} catch (e) {
|
||||||
|
console.error(`Error: ${e.message}`);
|
||||||
|
process.exit(1);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Main ─────────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
const args = process.argv.slice(2);
|
||||||
|
const command = args[0];
|
||||||
|
|
||||||
|
switch (command) {
|
||||||
|
case 'inspect': {
|
||||||
|
if (args.length < 2) {
|
||||||
|
console.error('Usage: node cli.js inspect <bundle.arboricx>');
|
||||||
|
process.exit(1);
|
||||||
|
}
|
||||||
|
cmdInspect(args[1]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'run': {
|
||||||
|
if (args.length < 2) {
|
||||||
|
console.error('Usage: node cli.js run <bundle.arboricx> [args...]');
|
||||||
|
process.exit(1);
|
||||||
|
}
|
||||||
|
cmdRun(args[1], args.slice(2));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
default:
|
||||||
|
console.log('Arboricx JS Host (via libarboricx FFI)');
|
||||||
|
console.log('');
|
||||||
|
console.log('Usage:');
|
||||||
|
console.log(' node cli.js inspect <bundle.arboricx>');
|
||||||
|
console.log(' node cli.js run <bundle.arboricx> [args...]');
|
||||||
|
break;
|
||||||
|
}
|
||||||
224
ext/js/src/lib.js
Normal file
224
ext/js/src/lib.js
Normal file
@@ -0,0 +1,224 @@
|
|||||||
|
/**
|
||||||
|
* lib.js — FFI wrapper around libarboricx.so via koffi.
|
||||||
|
*
|
||||||
|
* Exports low-level C ABI bindings and high-level helpers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
import { existsSync } from 'node:fs';
|
||||||
|
import { dirname, join, resolve } from 'node:path';
|
||||||
|
import { fileURLToPath } from 'node:url';
|
||||||
|
import koffi from 'koffi';
|
||||||
|
|
||||||
|
const __dirname = dirname(fileURLToPath(import.meta.url));
|
||||||
|
|
||||||
|
koffi.opaque('arb_ctx_t');
|
||||||
|
|
||||||
|
// ── Library discovery ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function findLib() {
|
||||||
|
const env = process.env.ARBORICX_LIB;
|
||||||
|
if (env) {
|
||||||
|
if (existsSync(env)) return env;
|
||||||
|
throw new Error(`ARBORICX_LIB set but file not found: ${env}`);
|
||||||
|
}
|
||||||
|
|
||||||
|
const candidates = [
|
||||||
|
resolve(__dirname, 'libarboricx.so'),
|
||||||
|
'libarboricx.so',
|
||||||
|
'./libarboricx.so',
|
||||||
|
'/usr/local/lib/libarboricx.so',
|
||||||
|
'/usr/lib/libarboricx.so',
|
||||||
|
];
|
||||||
|
|
||||||
|
for (const p of candidates) {
|
||||||
|
if (existsSync(p)) return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
throw new Error('libarboricx.so not found. Set ARBORICX_LIB to its full path.');
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── FFI setup ───────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
let _lib = null;
|
||||||
|
let _libPath = null;
|
||||||
|
|
||||||
|
function ensureLib() {
|
||||||
|
if (_lib) return _lib;
|
||||||
|
const path = findLib();
|
||||||
|
_lib = koffi.load(path);
|
||||||
|
_libPath = path;
|
||||||
|
return _lib;
|
||||||
|
}
|
||||||
|
|
||||||
|
export function loadLib(path) {
|
||||||
|
if (_lib && _libPath === path) return;
|
||||||
|
_lib = koffi.load(path);
|
||||||
|
_libPath = path;
|
||||||
|
}
|
||||||
|
|
||||||
|
function getLib() {
|
||||||
|
if (_lib) return _lib;
|
||||||
|
return ensureLib();
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Context lifecycle ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function init(libPath) {
|
||||||
|
if (libPath) loadLib(libPath);
|
||||||
|
const lib = getLib();
|
||||||
|
const ctx = lib.func('arb_ctx_t *arboricx_init(void)')();
|
||||||
|
if (!ctx) throw new Error('arboricx_init failed');
|
||||||
|
return ctx;
|
||||||
|
}
|
||||||
|
|
||||||
|
export function free(ctx) {
|
||||||
|
getLib().func('void arboricx_free(arb_ctx_t *ctx)')(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Bundle loading ──────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function loadBundle(ctx, bytes, name) {
|
||||||
|
const result = getLib().func('uint32_t arb_load_bundle(arb_ctx_t *ctx, _In_ uint8_t *bytes, size_t len, const char *name)')(ctx, bytes, bytes.length, name);
|
||||||
|
if (result === 0) throw new Error(`arb_load_bundle failed for export "${name}"`);
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
export function loadBundleDefault(ctx, bytes) {
|
||||||
|
const result = getLib().func('uint32_t arb_load_bundle_default(arb_ctx_t *ctx, _In_ uint8_t *bytes, size_t len)')(ctx, bytes, bytes.length);
|
||||||
|
if (result === 0) throw new Error('arb_load_bundle_default failed');
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Reduction ───────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function reduce(ctx, root, fuel = 1_000_000_000n) {
|
||||||
|
const f = getLib().func('uint32_t arb_reduce(arb_ctx_t *ctx, uint32_t root, uint64_t fuel)');
|
||||||
|
return f(ctx, root, typeof fuel === 'bigint' ? fuel : BigInt(fuel));
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Tree construction ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function leaf(ctx) {
|
||||||
|
return getLib().func('uint32_t arb_leaf(arb_ctx_t *ctx)')(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function stem(ctx, child) {
|
||||||
|
return getLib().func('uint32_t arb_stem(arb_ctx_t *ctx, uint32_t child)')(ctx, child);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function fork(ctx, left, right) {
|
||||||
|
return getLib().func('uint32_t arb_fork(arb_ctx_t *ctx, uint32_t left, uint32_t right)')(ctx, left, right);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function app(ctx, func, arg) {
|
||||||
|
return getLib().func('uint32_t arb_app(arb_ctx_t *ctx, uint32_t func, uint32_t arg)')(ctx, func, arg);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Codec constructors ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function ofNumber(ctx, n) {
|
||||||
|
const big = typeof n === 'bigint' ? n : BigInt(n);
|
||||||
|
return getLib().func('uint32_t arb_of_number(arb_ctx_t *ctx, uint64_t n)')(ctx, big);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function ofString(ctx, s) {
|
||||||
|
return getLib().func('uint32_t arb_of_string(arb_ctx_t *ctx, const char *s)')(ctx, s);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function ofBytes(ctx, bytes) {
|
||||||
|
return getLib().func('uint32_t arb_of_bytes(arb_ctx_t *ctx, _In_ uint8_t *bytes, size_t len)')(ctx, bytes, bytes.length);
|
||||||
|
}
|
||||||
|
|
||||||
|
export function ofList(ctx, items) {
|
||||||
|
const arr = new Uint32Array(items);
|
||||||
|
return getLib().func('uint32_t arb_of_list(arb_ctx_t *ctx, _In_ uint32_t *items, size_t len)')(ctx, arr, arr.length);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Codec destructors ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function toNumber(ctx, root) {
|
||||||
|
const out = [0];
|
||||||
|
const ok = getLib().func('int arb_to_number(arb_ctx_t *ctx, uint32_t root, _Out_ uint64_t *out)')(ctx, root, out);
|
||||||
|
if (!ok) throw new Error('arb_to_number failed');
|
||||||
|
return typeof out[0] === 'bigint' ? Number(out[0]) : out[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
export function toString(ctx, root) {
|
||||||
|
const ptrOut = [null];
|
||||||
|
const lenOut = [0];
|
||||||
|
const ok = getLib().func('int arb_to_string(arb_ctx_t *ctx, uint32_t root, _Out_ uint8_t **out_ptr, _Out_ size_t *out_len)')(ctx, root, ptrOut, lenOut);
|
||||||
|
if (!ok) throw new Error('arb_to_string failed');
|
||||||
|
|
||||||
|
const bytes = koffi.decode(ptrOut[0], 'uint8_t', lenOut[0]);
|
||||||
|
const str = Buffer.from(bytes).toString('utf-8');
|
||||||
|
getLib().func('void arboricx_free_buf(arb_ctx_t *ctx, uint8_t *ptr, size_t len)')(ctx, ptrOut[0], lenOut[0]);
|
||||||
|
return str;
|
||||||
|
}
|
||||||
|
|
||||||
|
export function toBytes(ctx, root) {
|
||||||
|
const ptrOut = [null];
|
||||||
|
const lenOut = [0];
|
||||||
|
const ok = getLib().func('int arb_to_bytes(arb_ctx_t *ctx, uint32_t root, _Out_ uint8_t **out_ptr, _Out_ size_t *out_len)')(ctx, root, ptrOut, lenOut);
|
||||||
|
if (!ok) throw new Error('arb_to_bytes failed');
|
||||||
|
|
||||||
|
const bytes = Buffer.from(koffi.decode(ptrOut[0], 'uint8_t', lenOut[0]));
|
||||||
|
getLib().func('void arboricx_free_buf(arb_ctx_t *ctx, uint8_t *ptr, size_t len)')(ctx, ptrOut[0], lenOut[0]);
|
||||||
|
return bytes;
|
||||||
|
}
|
||||||
|
|
||||||
|
export function toBool(ctx, root) {
|
||||||
|
const out = [0];
|
||||||
|
const ok = getLib().func('int arb_to_bool(arb_ctx_t *ctx, uint32_t root, _Out_ int *out)')(ctx, root, out);
|
||||||
|
if (!ok) throw new Error('arb_to_bool failed');
|
||||||
|
return out[0] !== 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Result unwrapping ───────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function unwrapResult(ctx, root) {
|
||||||
|
const outOk = [0];
|
||||||
|
const outValue = [0];
|
||||||
|
const outRest = [0];
|
||||||
|
const ok = getLib().func('int arb_unwrap_result(arb_ctx_t *ctx, uint32_t root, _Out_ int *out_ok, _Out_ uint32_t *out_value, _Out_ uint32_t *out_rest)')(ctx, root, outOk, outValue, outRest);
|
||||||
|
if (!ok) throw new Error('arb_unwrap_result failed');
|
||||||
|
return { ok: outOk[0] !== 0, value: outValue[0], rest: outRest[0] };
|
||||||
|
}
|
||||||
|
|
||||||
|
export function unwrapHostValue(ctx, root) {
|
||||||
|
const outTag = [0n];
|
||||||
|
const outPayload = [0];
|
||||||
|
const ok = getLib().func('int arb_unwrap_host_value(arb_ctx_t *ctx, uint32_t root, _Out_ uint64_t *out_tag, _Out_ uint32_t *out_payload)')(ctx, root, outTag, outPayload);
|
||||||
|
if (!ok) throw new Error('arb_unwrap_host_value failed');
|
||||||
|
return { tag: outTag[0], payload: outPayload[0] };
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Kernel ──────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function kernelRoot(ctx) {
|
||||||
|
return getLib().func('uint32_t arb_kernel_root(arb_ctx_t *ctx)')(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── High-level helpers ──────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
export function decode(ctx, root) {
|
||||||
|
try {
|
||||||
|
return toBool(ctx, root) ? 'true' : 'false';
|
||||||
|
} catch {
|
||||||
|
try {
|
||||||
|
return toString(ctx, root);
|
||||||
|
} catch {
|
||||||
|
try {
|
||||||
|
return String(toNumber(ctx, root));
|
||||||
|
} catch {
|
||||||
|
throw new Error('could not decode result');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
export function decodeType(ctx, root) {
|
||||||
|
try { toBool(ctx, root); return 'bool'; } catch {}
|
||||||
|
try { toString(ctx, root); return 'string'; } catch {}
|
||||||
|
try { toNumber(ctx, root); return 'number'; } catch {}
|
||||||
|
return 'unknown (raw tree)';
|
||||||
|
}
|
||||||
93
ext/js/test/bundle.test.js
Normal file
93
ext/js/test/bundle.test.js
Normal file
@@ -0,0 +1,93 @@
|
|||||||
|
import { readFileSync } from 'node:fs';
|
||||||
|
import { strictEqual, ok, throws } from 'node:assert';
|
||||||
|
import { describe, it } from 'node:test';
|
||||||
|
import {
|
||||||
|
findLib,
|
||||||
|
init,
|
||||||
|
free,
|
||||||
|
loadBundle,
|
||||||
|
loadBundleDefault,
|
||||||
|
kernelRoot,
|
||||||
|
} from '../src/lib.js';
|
||||||
|
|
||||||
|
const fixtureDir = '../../test/fixtures';
|
||||||
|
const libPath = findLib();
|
||||||
|
|
||||||
|
describe('library discovery', () => {
|
||||||
|
it('findLib returns an existing .so path', () => {
|
||||||
|
ok(libPath.endsWith('.so') || libPath.endsWith('.dylib') || libPath.endsWith('.dll'));
|
||||||
|
ok(readFileSync(libPath));
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('context lifecycle', () => {
|
||||||
|
it('init creates a valid context', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
ok(ctx);
|
||||||
|
free(ctx);
|
||||||
|
});
|
||||||
|
|
||||||
|
it('kernel root is available', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const root = kernelRoot(ctx);
|
||||||
|
ok(root > 0, 'kernel root should be a positive index');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('bundle loading', () => {
|
||||||
|
it('loadBundleDefault loads id.arboricx', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
ok(root > 0, 'loaded root should be a positive index');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('loadBundleDefault loads true.arboricx', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/true.arboricx`);
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
ok(root > 0);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('loadBundle loads named export from id.arboricx', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
const root = loadBundle(ctx, bundle, 'id');
|
||||||
|
ok(root > 0);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('loadBundle fails for missing export name', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
throws(() => loadBundle(ctx, bundle, 'nonexistent'), /failed/);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('loadBundleDefault fails for invalid bytes', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
throws(() => loadBundleDefault(ctx, Buffer.from('not a bundle')), /failed/);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
113
ext/js/test/reduce.test.js
Normal file
113
ext/js/test/reduce.test.js
Normal file
@@ -0,0 +1,113 @@
|
|||||||
|
import { readFileSync } from 'node:fs';
|
||||||
|
import { strictEqual, ok } from 'node:assert';
|
||||||
|
import { describe, it } from 'node:test';
|
||||||
|
import {
|
||||||
|
findLib,
|
||||||
|
init,
|
||||||
|
free,
|
||||||
|
leaf,
|
||||||
|
stem,
|
||||||
|
fork,
|
||||||
|
app,
|
||||||
|
reduce,
|
||||||
|
toBool,
|
||||||
|
toString,
|
||||||
|
toNumber,
|
||||||
|
loadBundleDefault,
|
||||||
|
ofString,
|
||||||
|
ofNumber,
|
||||||
|
} from '../src/lib.js';
|
||||||
|
|
||||||
|
const libPath = findLib();
|
||||||
|
|
||||||
|
describe('tree construction', () => {
|
||||||
|
it('leaf returns a positive index', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const idx = leaf(ctx);
|
||||||
|
ok(idx > 0);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('stem wraps a child', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const l = leaf(ctx);
|
||||||
|
const s = stem(ctx, l);
|
||||||
|
ok(s > 0);
|
||||||
|
ok(s !== l);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('fork combines left and right', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const a = leaf(ctx);
|
||||||
|
const b = leaf(ctx);
|
||||||
|
const f = fork(ctx, a, b);
|
||||||
|
ok(f > 0);
|
||||||
|
ok(f !== a && f !== b);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('reduction — booleans', () => {
|
||||||
|
it('true.arboricx reduces to boolean true', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync('../../test/fixtures/true.arboricx');
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, root, 1_000_000n);
|
||||||
|
strictEqual(toBool(ctx, result), true);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('false.arboricx reduces to boolean false', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync('../../test/fixtures/false.arboricx');
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, root, 1_000_000n);
|
||||||
|
strictEqual(toBool(ctx, result), false);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('reduction — id', () => {
|
||||||
|
it('id applied to string returns the string', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync('../../test/fixtures/id.arboricx');
|
||||||
|
const idRoot = loadBundleDefault(ctx, bundle);
|
||||||
|
const arg = ofString(ctx, 'hello');
|
||||||
|
const applied = app(ctx, idRoot, arg);
|
||||||
|
const result = reduce(ctx, applied, 1_000_000n);
|
||||||
|
strictEqual(toString(ctx, result), 'hello');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('reduction — numbers', () => {
|
||||||
|
it('ofNumber round-trips through toNumber', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const num = ofNumber(ctx, 42);
|
||||||
|
strictEqual(toNumber(ctx, num), 42);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
125
ext/js/test/run-bundle.test.js
Normal file
125
ext/js/test/run-bundle.test.js
Normal file
@@ -0,0 +1,125 @@
|
|||||||
|
import { readFileSync } from 'node:fs';
|
||||||
|
import { strictEqual, ok, throws } from 'node:assert';
|
||||||
|
import { describe, it } from 'node:test';
|
||||||
|
import {
|
||||||
|
findLib,
|
||||||
|
init,
|
||||||
|
free,
|
||||||
|
loadBundleDefault,
|
||||||
|
loadBundle,
|
||||||
|
reduce,
|
||||||
|
app,
|
||||||
|
ofString,
|
||||||
|
ofNumber,
|
||||||
|
toBool,
|
||||||
|
toString,
|
||||||
|
decode,
|
||||||
|
decodeType,
|
||||||
|
} from '../src/lib.js';
|
||||||
|
|
||||||
|
const fixtureDir = '../../test/fixtures';
|
||||||
|
const libPath = findLib();
|
||||||
|
|
||||||
|
describe('run bundle — booleans', () => {
|
||||||
|
it('true.arboricx evaluates to true', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/true.arboricx`);
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, root);
|
||||||
|
strictEqual(toBool(ctx, result), true);
|
||||||
|
strictEqual(decodeType(ctx, result), 'bool');
|
||||||
|
strictEqual(decode(ctx, result), 'true');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('false.arboricx evaluates to false', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/false.arboricx`);
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, root);
|
||||||
|
strictEqual(toBool(ctx, result), false);
|
||||||
|
strictEqual(decodeType(ctx, result), 'bool');
|
||||||
|
strictEqual(decode(ctx, result), 'false');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('run bundle — id', () => {
|
||||||
|
it('id applied to string returns the string', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
const idRoot = loadBundleDefault(ctx, bundle);
|
||||||
|
const arg = ofString(ctx, 'hello');
|
||||||
|
const applied = app(ctx, idRoot, arg);
|
||||||
|
const result = reduce(ctx, applied);
|
||||||
|
strictEqual(toString(ctx, result), 'hello');
|
||||||
|
strictEqual(decodeType(ctx, result), 'string');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('run bundle — append', () => {
|
||||||
|
it('append "hello " "world" = "hello world"', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/append.arboricx`);
|
||||||
|
let term = loadBundleDefault(ctx, bundle);
|
||||||
|
term = app(ctx, term, ofString(ctx, 'hello '));
|
||||||
|
term = app(ctx, term, ofString(ctx, 'world'));
|
||||||
|
const result = reduce(ctx, term);
|
||||||
|
strictEqual(toString(ctx, result), 'hello world');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('run bundle — notQ', () => {
|
||||||
|
it('notQ loads and reduces without error', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/notQ.arboricx`);
|
||||||
|
const root = loadBundleDefault(ctx, bundle);
|
||||||
|
const result = reduce(ctx, root);
|
||||||
|
ok(result > 0);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
|
||||||
|
describe('run bundle — named export', () => {
|
||||||
|
it('loadBundle selects named export', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
const root = loadBundle(ctx, bundle, 'id');
|
||||||
|
ok(root > 0);
|
||||||
|
// id is a function; apply it before reducing
|
||||||
|
const applied = app(ctx, root, ofString(ctx, 'test'));
|
||||||
|
const result = reduce(ctx, applied);
|
||||||
|
strictEqual(toString(ctx, result), 'test');
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
it('missing export throws', () => {
|
||||||
|
const ctx = init(libPath);
|
||||||
|
try {
|
||||||
|
const bundle = readFileSync(`${fixtureDir}/id.arboricx`);
|
||||||
|
throws(() => loadBundle(ctx, bundle, 'nonexistent'), /failed/);
|
||||||
|
} finally {
|
||||||
|
free(ctx);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
53
ext/php/public/eval.php
Normal file
53
ext/php/public/eval.php
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
<?php
|
||||||
|
|
||||||
|
declare(strict_types=1);
|
||||||
|
|
||||||
|
error_reporting(E_ALL);
|
||||||
|
ini_set('display_errors', '1');
|
||||||
|
|
||||||
|
if (!extension_loaded('ffi')) {
|
||||||
|
http_response_code(500);
|
||||||
|
echo "Error: PHP FFI extension is not loaded.\n";
|
||||||
|
echo "If you are using the Nix build, run the included server script:\n";
|
||||||
|
echo " ./result/bin/tricu-php-server\n";
|
||||||
|
exit;
|
||||||
|
}
|
||||||
|
|
||||||
|
require __DIR__ . '/../src/common.php';
|
||||||
|
|
||||||
|
use function Arboricx\{ctx_init, ctx_free, loadBundleDefault, ofNumber, ofString, app, reduce, decode, findLib, readBundle};
|
||||||
|
|
||||||
|
header('Content-Type: text/plain; charset=utf-8');
|
||||||
|
|
||||||
|
try {
|
||||||
|
if (!isset($_FILES['bundle']) || $_FILES['bundle']['error'] !== UPLOAD_ERR_OK) {
|
||||||
|
throw new \RuntimeException('Bundle upload failed.');
|
||||||
|
}
|
||||||
|
|
||||||
|
$args = [];
|
||||||
|
for ($i = 0; $i < 5; $i++) {
|
||||||
|
$v = $_POST["arg$i"] ?? '';
|
||||||
|
if ($v !== '') {
|
||||||
|
$args[] = $v;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$libPath = findLib();
|
||||||
|
$ctx = ctx_init($libPath);
|
||||||
|
try {
|
||||||
|
$term = loadBundleDefault($ctx, readBundle($_FILES['bundle']['tmp_name']));
|
||||||
|
|
||||||
|
foreach ($args as $arg) {
|
||||||
|
$argTree = preg_match('/^\d+$/', $arg) ? ofNumber($ctx, (int)$arg) : ofString($ctx, $arg);
|
||||||
|
$term = app($ctx, $term, $argTree);
|
||||||
|
}
|
||||||
|
|
||||||
|
$result = reduce($ctx, $term, 1_000_000_000);
|
||||||
|
echo decode($ctx, $result);
|
||||||
|
} finally {
|
||||||
|
ctx_free($ctx);
|
||||||
|
}
|
||||||
|
} catch (\Throwable $e) {
|
||||||
|
http_response_code(500);
|
||||||
|
echo 'Error: ' . $e->getMessage();
|
||||||
|
}
|
||||||
30
ext/php/public/index.php
Normal file
30
ext/php/public/index.php
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
<?php
|
||||||
|
declare(strict_types=1);
|
||||||
|
?>
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html lang="en">
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Arboricx Web</title>
|
||||||
|
<script src="https://unpkg.com/htmx.org@2.0.4"></script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<h1>Arboricx Bundle Runner</h1>
|
||||||
|
<form hx-post="eval.php" hx-target="#result" enctype="multipart/form-data">
|
||||||
|
<p>
|
||||||
|
<label>Bundle (.arboricx)<br>
|
||||||
|
<input type="file" name="bundle" accept=".arboricx" required></label>
|
||||||
|
</p>
|
||||||
|
<?php for ($i = 0; $i < 5; $i++): ?>
|
||||||
|
<p>
|
||||||
|
<label>Arg <?= $i + 1 ?> <small>(ignored if empty)</small><br>
|
||||||
|
<input type="text" name="arg<?= $i ?>"></label>
|
||||||
|
</p>
|
||||||
|
<?php endfor; ?>
|
||||||
|
<p>
|
||||||
|
<button type="submit">Run</button>
|
||||||
|
</p>
|
||||||
|
</form>
|
||||||
|
<pre id="result"></pre>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
103
ext/php/run.php
Normal file
103
ext/php/run.php
Normal file
@@ -0,0 +1,103 @@
|
|||||||
|
#!/usr/bin/env php
|
||||||
|
<?php
|
||||||
|
|
||||||
|
declare(strict_types=1);
|
||||||
|
|
||||||
|
/**
|
||||||
|
* run.php — Arboricx PHP host shell via libarboricx C ABI.
|
||||||
|
*
|
||||||
|
* Usage:
|
||||||
|
* php run.php run <bundle.arboricx> [args...]
|
||||||
|
* php run.php inspect <bundle.arboricx>
|
||||||
|
*/
|
||||||
|
|
||||||
|
require __DIR__ . '/src/common.php';
|
||||||
|
|
||||||
|
use function Arboricx\{ctx_init, ctx_free, loadBundleDefault, ofNumber, ofString, app, reduce, toString, toBool, toNumber, findLib, decode, decodeType, readBundle};
|
||||||
|
|
||||||
|
// ── Commands ─────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
function bail(string $msg): void
|
||||||
|
{
|
||||||
|
fwrite(STDERR, "Error: $msg\n");
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
function cmdRun(string $libPath, string $bundlePath, array $args): void
|
||||||
|
{
|
||||||
|
$ctx = ctx_init($libPath);
|
||||||
|
try {
|
||||||
|
$term = loadBundleDefault($ctx, readBundle($bundlePath));
|
||||||
|
|
||||||
|
foreach ($args as $arg) {
|
||||||
|
$argTree = preg_match('/^\d+$/', $arg) ? ofNumber($ctx, (int)$arg) : ofString($ctx, $arg);
|
||||||
|
$term = app($ctx, $term, $argTree);
|
||||||
|
}
|
||||||
|
|
||||||
|
$result = reduce($ctx, $term, 1_000_000_000);
|
||||||
|
echo decode($ctx, $result) . "\n";
|
||||||
|
} catch (\Throwable $e) {
|
||||||
|
bail($e->getMessage());
|
||||||
|
} finally {
|
||||||
|
ctx_free($ctx);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function cmdInspect(string $libPath, string $bundlePath): void
|
||||||
|
{
|
||||||
|
$ctx = ctx_init($libPath);
|
||||||
|
try {
|
||||||
|
$bundle = readBundle($bundlePath);
|
||||||
|
echo "Bundle: $bundlePath\nSize: " . strlen($bundle) . " bytes\n\nResult:\n";
|
||||||
|
|
||||||
|
$term = loadBundleDefault($ctx, $bundle);
|
||||||
|
$result = reduce($ctx, $term, 1_000_000_000);
|
||||||
|
|
||||||
|
$type = decodeType($ctx, $result);
|
||||||
|
try {
|
||||||
|
$value = decode($ctx, $result);
|
||||||
|
} catch (\RuntimeException $e) {
|
||||||
|
$value = '(raw tree)';
|
||||||
|
}
|
||||||
|
echo " Type: $type\n Value: $value\n";
|
||||||
|
} catch (\Throwable $e) {
|
||||||
|
bail($e->getMessage());
|
||||||
|
} finally {
|
||||||
|
ctx_free($ctx);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// ── Main ─────────────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
|
$argv = $_SERVER['argv'] ?? [];
|
||||||
|
$argc = $_SERVER['argc'] ?? 0;
|
||||||
|
|
||||||
|
if ($argc < 2) {
|
||||||
|
echo "Arboricx PHP Host Shell (via libarboricx C ABI)\n\nUsage:\n";
|
||||||
|
echo " php run.php run <bundle.arboricx> [args...]\n";
|
||||||
|
echo " php run.php inspect <bundle.arboricx>\n";
|
||||||
|
exit(0);
|
||||||
|
}
|
||||||
|
|
||||||
|
$libPath = findLib();
|
||||||
|
$command = $argv[1];
|
||||||
|
|
||||||
|
switch ($command) {
|
||||||
|
case 'run':
|
||||||
|
if ($argc < 3) {
|
||||||
|
fwrite(STDERR, "Usage: php run.php run <bundle.arboricx> [args...]\n");
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
|
cmdRun($libPath, $argv[2], array_slice($argv, 3));
|
||||||
|
break;
|
||||||
|
case 'inspect':
|
||||||
|
if ($argc < 3) {
|
||||||
|
fwrite(STDERR, "Usage: php run.php inspect <bundle.arboricx>\n");
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
|
cmdInspect($libPath, $argv[2]);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
fwrite(STDERR, "Unknown command: $command\nUsage: php run.php run|inspect ...\n");
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
81
ext/php/src/common.php
Normal file
81
ext/php/src/common.php
Normal file
@@ -0,0 +1,81 @@
|
|||||||
|
<?php
|
||||||
|
|
||||||
|
declare(strict_types=1);
|
||||||
|
|
||||||
|
namespace Arboricx;
|
||||||
|
|
||||||
|
require __DIR__ . '/ffi.php';
|
||||||
|
|
||||||
|
use function Arboricx\{ctx_init, ctx_free, loadBundleDefault, ofNumber, ofString, app, reduce, toString, toBool, toNumber};
|
||||||
|
|
||||||
|
function findLib(): string
|
||||||
|
{
|
||||||
|
$env = getenv('ARBORICX_LIB');
|
||||||
|
if ($env !== false && file_exists($env)) {
|
||||||
|
return $env;
|
||||||
|
}
|
||||||
|
|
||||||
|
$paths = [
|
||||||
|
__DIR__ . '/../../zig/zig-out/lib/libarboricx.so',
|
||||||
|
__DIR__ . '/../libarboricx.so',
|
||||||
|
'/usr/local/lib/libarboricx.so',
|
||||||
|
'/usr/lib/libarboricx.so',
|
||||||
|
'./libarboricx.so',
|
||||||
|
];
|
||||||
|
foreach ($paths as $p) {
|
||||||
|
if (file_exists($p)) {
|
||||||
|
return $p;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
throw new \RuntimeException('libarboricx.so not found. Set ARBORICX_LIB to its full path.');
|
||||||
|
}
|
||||||
|
|
||||||
|
function decode(\FFI\CData $ctx, int $root): string
|
||||||
|
{
|
||||||
|
try {
|
||||||
|
return toBool($ctx, $root) ? 'true' : 'false';
|
||||||
|
} catch (\Throwable $e) {
|
||||||
|
try {
|
||||||
|
return toString($ctx, $root);
|
||||||
|
} catch (\Throwable $e2) {
|
||||||
|
try {
|
||||||
|
return (string) toNumber($ctx, $root);
|
||||||
|
} catch (\Throwable $e3) {
|
||||||
|
throw new \RuntimeException('could not decode result');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function decodeType(\FFI\CData $ctx, int $root): string
|
||||||
|
{
|
||||||
|
try {
|
||||||
|
toBool($ctx, $root);
|
||||||
|
return 'bool';
|
||||||
|
} catch (\Throwable $e) {
|
||||||
|
try {
|
||||||
|
toString($ctx, $root);
|
||||||
|
return 'string';
|
||||||
|
} catch (\Throwable $e2) {
|
||||||
|
try {
|
||||||
|
toNumber($ctx, $root);
|
||||||
|
return 'number';
|
||||||
|
} catch (\Throwable $e3) {
|
||||||
|
return 'unknown (raw tree)';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function readBundle(string $path): string
|
||||||
|
{
|
||||||
|
if (!file_exists($path)) {
|
||||||
|
throw new \RuntimeException("bundle not found: $path");
|
||||||
|
}
|
||||||
|
$bytes = file_get_contents($path);
|
||||||
|
if ($bytes === false) {
|
||||||
|
throw new \RuntimeException("could not read bundle: $path");
|
||||||
|
}
|
||||||
|
return $bytes;
|
||||||
|
}
|
||||||
138
ext/php/src/ffi.php
Normal file
138
ext/php/src/ffi.php
Normal file
@@ -0,0 +1,138 @@
|
|||||||
|
<?php
|
||||||
|
|
||||||
|
declare(strict_types=1);
|
||||||
|
|
||||||
|
namespace Arboricx;
|
||||||
|
|
||||||
|
/**
|
||||||
|
* FFI wrapper around libarboricx.so.
|
||||||
|
*
|
||||||
|
* Loads the shared library and exposes typed wrappers for the C ABI.
|
||||||
|
*/
|
||||||
|
final class ArboricxFFI
|
||||||
|
{
|
||||||
|
private static ?\FFI $ffi = null;
|
||||||
|
|
||||||
|
public static function init(string $libPath): void
|
||||||
|
{
|
||||||
|
if (self::$ffi !== null) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Nix output layout first, then repo layout.
|
||||||
|
$candidates = [
|
||||||
|
__DIR__ . '/../arboricx.h',
|
||||||
|
__DIR__ . '/../../zig/include/arboricx.h',
|
||||||
|
];
|
||||||
|
$headerRaw = false;
|
||||||
|
foreach ($candidates as $path) {
|
||||||
|
$headerRaw = file_get_contents($path);
|
||||||
|
if ($headerRaw !== false) break;
|
||||||
|
}
|
||||||
|
if ($headerRaw === false) {
|
||||||
|
throw new \RuntimeException('Cannot read arboricx.h');
|
||||||
|
}
|
||||||
|
|
||||||
|
// PHP FFI only parses plain C declarations.
|
||||||
|
$header = $headerRaw;
|
||||||
|
$header = preg_replace('/#.*\n/', "\n", $header);
|
||||||
|
$header = preg_replace('/extern\s+"C"\s*\{/', '', $header);
|
||||||
|
$header = str_replace('}', '', $header);
|
||||||
|
$header = preg_replace('/\n\s*\n+/', "\n", $header);
|
||||||
|
|
||||||
|
self::$ffi = \FFI::cdef($header, $libPath);
|
||||||
|
}
|
||||||
|
|
||||||
|
public static function ffi(): \FFI
|
||||||
|
{
|
||||||
|
if (self::$ffi === null) {
|
||||||
|
throw new \RuntimeException('ArboricxFFI not initialized. Call ArboricxFFI::init($libPath) first.');
|
||||||
|
}
|
||||||
|
return self::$ffi;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function ctx_init(string $libPath): \FFI\CData
|
||||||
|
{
|
||||||
|
ArboricxFFI::init($libPath);
|
||||||
|
$ctx = ArboricxFFI::ffi()->arboricx_init();
|
||||||
|
if ($ctx === null) {
|
||||||
|
throw new \RuntimeException('arboricx_init failed');
|
||||||
|
}
|
||||||
|
return $ctx;
|
||||||
|
}
|
||||||
|
|
||||||
|
function ctx_free(\FFI\CData $ctx): void
|
||||||
|
{
|
||||||
|
ArboricxFFI::ffi()->arboricx_free($ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
function app(\FFI\CData $ctx, int $func, int $arg): int
|
||||||
|
{
|
||||||
|
return ArboricxFFI::ffi()->arb_app($ctx, $func, $arg);
|
||||||
|
}
|
||||||
|
|
||||||
|
function reduce(\FFI\CData $ctx, int $root, int $fuel = 1_000_000_000): int
|
||||||
|
{
|
||||||
|
return ArboricxFFI::ffi()->arb_reduce($ctx, $root, $fuel);
|
||||||
|
}
|
||||||
|
|
||||||
|
function ofNumber(\FFI\CData $ctx, int $n): int
|
||||||
|
{
|
||||||
|
return ArboricxFFI::ffi()->arb_of_number($ctx, $n);
|
||||||
|
}
|
||||||
|
|
||||||
|
function ofString(\FFI\CData $ctx, string $s): int
|
||||||
|
{
|
||||||
|
return ArboricxFFI::ffi()->arb_of_string($ctx, $s);
|
||||||
|
}
|
||||||
|
|
||||||
|
function toNumber(\FFI\CData $ctx, int $root): int
|
||||||
|
{
|
||||||
|
$out = ArboricxFFI::ffi()->new('uint64_t');
|
||||||
|
$ok = ArboricxFFI::ffi()->arb_to_number($ctx, $root, \FFI::addr($out));
|
||||||
|
if (!$ok) {
|
||||||
|
throw new \RuntimeException('arb_to_number failed');
|
||||||
|
}
|
||||||
|
return (int) $out->cdata;
|
||||||
|
}
|
||||||
|
|
||||||
|
function toString(\FFI\CData $ctx, int $root): string
|
||||||
|
{
|
||||||
|
$ptr = ArboricxFFI::ffi()->new('uint8_t*');
|
||||||
|
$len = ArboricxFFI::ffi()->new('size_t');
|
||||||
|
$ok = ArboricxFFI::ffi()->arb_to_string($ctx, $root, \FFI::addr($ptr), \FFI::addr($len));
|
||||||
|
if (!$ok) {
|
||||||
|
throw new \RuntimeException('arb_to_string failed');
|
||||||
|
}
|
||||||
|
$length = (int) $len->cdata;
|
||||||
|
$result = '';
|
||||||
|
for ($i = 0; $i < $length; $i++) {
|
||||||
|
$result .= chr($ptr[$i]);
|
||||||
|
}
|
||||||
|
ArboricxFFI::ffi()->arboricx_free_buf($ctx, $ptr, $length);
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
function toBool(\FFI\CData $ctx, int $root): bool
|
||||||
|
{
|
||||||
|
$out = ArboricxFFI::ffi()->new('int');
|
||||||
|
$ok = ArboricxFFI::ffi()->arb_to_bool($ctx, $root, \FFI::addr($out));
|
||||||
|
if (!$ok) {
|
||||||
|
throw new \RuntimeException('arb_to_bool failed');
|
||||||
|
}
|
||||||
|
return (bool) $out->cdata;
|
||||||
|
}
|
||||||
|
|
||||||
|
function loadBundleDefault(\FFI\CData $ctx, string $bytes): int
|
||||||
|
{
|
||||||
|
$cdata = ArboricxFFI::ffi()->new('uint8_t[' . strlen($bytes) . ']');
|
||||||
|
for ($i = 0; $i < strlen($bytes); $i++) {
|
||||||
|
$cdata[$i] = ord($bytes[$i]);
|
||||||
|
}
|
||||||
|
$result = ArboricxFFI::ffi()->arb_load_bundle_default($ctx, $cdata, strlen($bytes));
|
||||||
|
if ($result === 0) {
|
||||||
|
throw new \RuntimeException('arb_load_bundle_default failed');
|
||||||
|
}
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
13
ext/zig/.gitignore
vendored
Normal file
13
ext/zig/.gitignore
vendored
Normal file
@@ -0,0 +1,13 @@
|
|||||||
|
# Zig build artifacts
|
||||||
|
.zig-cache/
|
||||||
|
zig-out/
|
||||||
|
|
||||||
|
# Generated binaries (keep .c sources, ignore compiled artifacts)
|
||||||
|
/c_abi_test
|
||||||
|
/c_abi_append_test
|
||||||
|
c_abi_append_shared
|
||||||
|
tests/c_abi_append_test
|
||||||
|
|
||||||
|
# Temp files
|
||||||
|
*.o
|
||||||
|
*.tmp
|
||||||
71
ext/zig/build.zig
Normal file
71
ext/zig/build.zig
Normal file
@@ -0,0 +1,71 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
|
||||||
|
pub fn build(b: *std.Build) void {
|
||||||
|
const target = b.standardTargetOptions(.{});
|
||||||
|
const optimize = b.standardOptimizeOption(.{});
|
||||||
|
|
||||||
|
// -- kernel generator tool (runs on build host) --
|
||||||
|
const gen_kernel_mod = b.createModule(.{
|
||||||
|
.root_source_file = b.path("tools/gen_kernel.zig"),
|
||||||
|
.target = b.graph.host,
|
||||||
|
.optimize = .ReleaseSafe,
|
||||||
|
});
|
||||||
|
const gen_kernel = b.addExecutable(.{
|
||||||
|
.name = "gen_kernel",
|
||||||
|
.root_module = gen_kernel_mod,
|
||||||
|
});
|
||||||
|
|
||||||
|
const run_gen_kernel = b.addRunArtifact(gen_kernel);
|
||||||
|
run_gen_kernel.addFileArg(b.path("kernel_run_arboricx_typed.dag"));
|
||||||
|
const kernel_embed = run_gen_kernel.addOutputFileArg("kernel_embed.zig");
|
||||||
|
|
||||||
|
// -- kernel module shared by exe and lib --
|
||||||
|
const kernel_mod = b.createModule(.{
|
||||||
|
.root_source_file = kernel_embed,
|
||||||
|
});
|
||||||
|
|
||||||
|
// -- main CLI executable --
|
||||||
|
const exe_mod = b.createModule(.{
|
||||||
|
.root_source_file = b.path("src/main.zig"),
|
||||||
|
.target = target,
|
||||||
|
.optimize = optimize,
|
||||||
|
});
|
||||||
|
exe_mod.addImport("kernel_embed", kernel_mod);
|
||||||
|
exe_mod.link_libc = true;
|
||||||
|
exe_mod.linkSystemLibrary("uv", .{});
|
||||||
|
const exe = b.addExecutable(.{
|
||||||
|
.name = "tricu-zig",
|
||||||
|
.root_module = exe_mod,
|
||||||
|
});
|
||||||
|
b.installArtifact(exe);
|
||||||
|
|
||||||
|
const run_cmd = b.addRunArtifact(exe);
|
||||||
|
run_cmd.step.dependOn(b.getInstallStep());
|
||||||
|
const run_step = b.step("run", "Run tricu-zig");
|
||||||
|
run_step.dependOn(&run_cmd.step);
|
||||||
|
|
||||||
|
// -- C ABI static library --
|
||||||
|
const lib_mod = b.createModule(.{
|
||||||
|
.root_source_file = b.path("src/c_abi.zig"),
|
||||||
|
.target = target,
|
||||||
|
.optimize = optimize,
|
||||||
|
});
|
||||||
|
lib_mod.pic = true;
|
||||||
|
lib_mod.addImport("kernel_embed", kernel_mod);
|
||||||
|
lib_mod.link_libc = true;
|
||||||
|
lib_mod.linkSystemLibrary("uv", .{});
|
||||||
|
const static_lib = b.addLibrary(.{
|
||||||
|
.name = "arboricx",
|
||||||
|
.root_module = lib_mod,
|
||||||
|
});
|
||||||
|
b.installArtifact(static_lib);
|
||||||
|
|
||||||
|
// -- C ABI shared library (for dynamic language FFI) --
|
||||||
|
const shared_lib = b.addLibrary(.{
|
||||||
|
.name = "arboricx",
|
||||||
|
.root_module = lib_mod,
|
||||||
|
.linkage = .dynamic,
|
||||||
|
});
|
||||||
|
b.installArtifact(shared_lib);
|
||||||
|
|
||||||
|
}
|
||||||
13
ext/zig/build.zig.zon
Normal file
13
ext/zig/build.zig.zon
Normal file
@@ -0,0 +1,13 @@
|
|||||||
|
.{
|
||||||
|
.name = .tricu_zig,
|
||||||
|
.version = "0.0.1",
|
||||||
|
.fingerprint = 0xa9aedd8049d1cce9,
|
||||||
|
.minimum_zig_version = "0.16.0",
|
||||||
|
.paths = .{
|
||||||
|
"build.zig",
|
||||||
|
"build.zig.zon",
|
||||||
|
"src",
|
||||||
|
"tools",
|
||||||
|
"kernels",
|
||||||
|
},
|
||||||
|
}
|
||||||
73
ext/zig/include/arboricx.h
Normal file
73
ext/zig/include/arboricx.h
Normal file
@@ -0,0 +1,73 @@
|
|||||||
|
#ifndef ARBORICX_H
|
||||||
|
#define ARBORICX_H
|
||||||
|
|
||||||
|
#include <stddef.h>
|
||||||
|
#include <stdint.h>
|
||||||
|
|
||||||
|
#ifdef __cplusplus
|
||||||
|
extern "C" {
|
||||||
|
#endif
|
||||||
|
|
||||||
|
typedef struct arb_ctx arb_ctx_t;
|
||||||
|
|
||||||
|
/* Context lifecycle */
|
||||||
|
arb_ctx_t* arboricx_init(void);
|
||||||
|
void arboricx_free(arb_ctx_t* ctx);
|
||||||
|
void arboricx_free_buf(arb_ctx_t* ctx, uint8_t* ptr, size_t len);
|
||||||
|
|
||||||
|
/* Tree construction */
|
||||||
|
uint32_t arb_leaf(arb_ctx_t* ctx);
|
||||||
|
uint32_t arb_stem(arb_ctx_t* ctx, uint32_t child);
|
||||||
|
uint32_t arb_fork(arb_ctx_t* ctx, uint32_t left, uint32_t right);
|
||||||
|
uint32_t arb_app(arb_ctx_t* ctx, uint32_t func, uint32_t arg);
|
||||||
|
|
||||||
|
/* Reduction */
|
||||||
|
uint32_t arb_reduce(arb_ctx_t* ctx, uint32_t root, uint64_t fuel);
|
||||||
|
|
||||||
|
/* Codec constructors */
|
||||||
|
uint32_t arb_of_number(arb_ctx_t* ctx, uint64_t n);
|
||||||
|
uint32_t arb_of_string(arb_ctx_t* ctx, const char* s);
|
||||||
|
uint32_t arb_of_bytes(arb_ctx_t* ctx, const uint8_t* bytes, size_t len);
|
||||||
|
uint32_t arb_of_list(arb_ctx_t* ctx, const uint32_t* items, size_t len);
|
||||||
|
|
||||||
|
/* Codec destructors (return 1 on success, 0 on failure) */
|
||||||
|
int arb_to_number(arb_ctx_t* ctx, uint32_t root, uint64_t* out);
|
||||||
|
int arb_to_string(arb_ctx_t* ctx, uint32_t root, uint8_t** out_ptr, size_t* out_len);
|
||||||
|
int arb_to_bytes(arb_ctx_t* ctx, uint32_t root, uint8_t** out_ptr, size_t* out_len);
|
||||||
|
int arb_to_bool(arb_ctx_t* ctx, uint32_t root, int* out);
|
||||||
|
|
||||||
|
/* Result unwrapping (return 1 on success, 0 on failure) */
|
||||||
|
int arb_unwrap_result(arb_ctx_t* ctx, uint32_t root, int* out_ok, uint32_t* out_value, uint32_t* out_rest);
|
||||||
|
int arb_unwrap_host_value(arb_ctx_t* ctx, uint32_t root, uint64_t* out_tag, uint32_t* out_payload);
|
||||||
|
|
||||||
|
/* Tree inspection (Layer 1 — for custom IO drivers and non-POSIX hosts) */
|
||||||
|
int arb_is_leaf(arb_ctx_t* ctx, uint32_t root);
|
||||||
|
int arb_is_stem(arb_ctx_t* ctx, uint32_t root);
|
||||||
|
int arb_is_fork(arb_ctx_t* ctx, uint32_t root);
|
||||||
|
int arb_is_app(arb_ctx_t* ctx, uint32_t root);
|
||||||
|
int arb_get_stem_child(arb_ctx_t* ctx, uint32_t root, uint32_t* out);
|
||||||
|
int arb_get_fork_children(arb_ctx_t* ctx, uint32_t root,
|
||||||
|
uint32_t* out_left, uint32_t* out_right);
|
||||||
|
int arb_get_app_func_arg(arb_ctx_t* ctx, uint32_t root,
|
||||||
|
uint32_t* out_func, uint32_t* out_arg);
|
||||||
|
|
||||||
|
/* IO driver (Layer 2 — POSIX interaction-tree runtime) */
|
||||||
|
typedef struct {
|
||||||
|
int allow_read_all;
|
||||||
|
int allow_write_all;
|
||||||
|
} arb_io_perms_t;
|
||||||
|
|
||||||
|
uint32_t arb_run_io(arb_ctx_t* ctx, uint32_t program, const arb_io_perms_t* perms);
|
||||||
|
|
||||||
|
/* Kernel entrypoints */
|
||||||
|
uint32_t arb_kernel_root(arb_ctx_t* ctx);
|
||||||
|
|
||||||
|
/* Native bundle loading (fast path — bypasses the Tricu kernel) */
|
||||||
|
uint32_t arb_load_bundle(arb_ctx_t* ctx, const uint8_t* bytes, size_t len, const char* name);
|
||||||
|
uint32_t arb_load_bundle_default(arb_ctx_t* ctx, const uint8_t* bytes, size_t len);
|
||||||
|
|
||||||
|
#ifdef __cplusplus
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#endif /* ARBORICX_H */
|
||||||
2578
ext/zig/kernel_run_arboricx_typed.dag
Normal file
2578
ext/zig/kernel_run_arboricx_typed.dag
Normal file
File diff suppressed because it is too large
Load Diff
1
ext/zig/result
Symbolic link
1
ext/zig/result
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
/nix/store/2sg31y0vamz5bz19aakxagi702glwh24-tricu-zig-0.1.0
|
||||||
36
ext/zig/src/arena.zig
Normal file
36
ext/zig/src/arena.zig
Normal file
@@ -0,0 +1,36 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
|
||||||
|
pub const Arena = struct {
|
||||||
|
allocator: std.mem.Allocator,
|
||||||
|
nodes: std.ArrayList(tree.Node),
|
||||||
|
|
||||||
|
pub fn init(allocator: std.mem.Allocator) Arena {
|
||||||
|
return .{
|
||||||
|
.allocator = allocator,
|
||||||
|
.nodes = .empty,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn deinit(self: *Arena) void {
|
||||||
|
self.nodes.deinit(self.allocator);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn alloc(self: *Arena, node: tree.Node) !u32 {
|
||||||
|
const idx: u32 = @intCast(self.nodes.items.len);
|
||||||
|
try self.nodes.append(self.allocator, node);
|
||||||
|
return idx;
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn get(self: *Arena, idx: u32) *tree.Node {
|
||||||
|
return &self.nodes.items[idx];
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn len(self: *const Arena) u32 {
|
||||||
|
return @intCast(self.nodes.items.len);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn reset(self: *Arena, keep: u32) void {
|
||||||
|
self.nodes.shrinkRetainingCapacity(keep);
|
||||||
|
}
|
||||||
|
};
|
||||||
363
ext/zig/src/bundle.zig
Normal file
363
ext/zig/src/bundle.zig
Normal file
@@ -0,0 +1,363 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
|
||||||
|
pub const Error = error{
|
||||||
|
InvalidMagic,
|
||||||
|
InvalidVersion,
|
||||||
|
Truncated,
|
||||||
|
InvalidManifest,
|
||||||
|
InvalidNodePayload,
|
||||||
|
ExportNotFound,
|
||||||
|
MissingChild,
|
||||||
|
UnexpectedFormat,
|
||||||
|
OutOfMemory,
|
||||||
|
};
|
||||||
|
|
||||||
|
const Parser = struct {
|
||||||
|
bytes: []const u8,
|
||||||
|
pos: usize,
|
||||||
|
|
||||||
|
fn init(bytes: []const u8) Parser {
|
||||||
|
return .{ .bytes = bytes, .pos = 0 };
|
||||||
|
}
|
||||||
|
|
||||||
|
fn remaining(self: *const Parser) usize {
|
||||||
|
return self.bytes.len - self.pos;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn expect(self: *Parser, n: usize) Error![]const u8 {
|
||||||
|
if (self.remaining() < n) return error.Truncated;
|
||||||
|
const result = self.bytes[self.pos .. self.pos + n];
|
||||||
|
self.pos += n;
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn readU8(self: *Parser) Error!u8 {
|
||||||
|
const b = try self.expect(1);
|
||||||
|
return b[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
fn readU16(self: *Parser) Error!u16 {
|
||||||
|
const b = try self.expect(2);
|
||||||
|
return std.mem.readInt(u16, b[0..2], .big);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn readU32(self: *Parser) Error!u32 {
|
||||||
|
const b = try self.expect(4);
|
||||||
|
return std.mem.readInt(u32, b[0..4], .big);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn readU64(self: *Parser) Error!u64 {
|
||||||
|
const b = try self.expect(8);
|
||||||
|
return std.mem.readInt(u64, b[0..8], .big);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn readLengthPrefixedBytes(self: *Parser, allocator: std.mem.Allocator) Error![]const u8 {
|
||||||
|
const len = try self.readU32();
|
||||||
|
const bytes = try self.expect(len);
|
||||||
|
const copy = try allocator.alloc(u8, bytes.len);
|
||||||
|
@memcpy(copy, bytes);
|
||||||
|
return copy;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
const SectionEntry = struct {
|
||||||
|
section_type: u32,
|
||||||
|
offset: u64,
|
||||||
|
length: u64,
|
||||||
|
};
|
||||||
|
|
||||||
|
fn parseHeader(p: *Parser) Error!struct { major: u16, minor: u16, section_count: u32, dir_offset: u64 } {
|
||||||
|
const magic = try p.expect(8);
|
||||||
|
if (!std.mem.eql(u8, magic, "ARBORICX")) return error.InvalidMagic;
|
||||||
|
|
||||||
|
const major = try p.readU16();
|
||||||
|
const minor = try p.readU16();
|
||||||
|
const section_count = try p.readU32();
|
||||||
|
_ = try p.readU64(); // flags
|
||||||
|
const dir_offset = try p.readU64();
|
||||||
|
|
||||||
|
if (major != 1) return error.InvalidVersion;
|
||||||
|
|
||||||
|
return .{ .major = major, .minor = minor, .section_count = section_count, .dir_offset = dir_offset };
|
||||||
|
}
|
||||||
|
|
||||||
|
fn parseSectionEntries(p: *Parser, count: u32, allocator: std.mem.Allocator) Error![]SectionEntry {
|
||||||
|
const entries = try allocator.alloc(SectionEntry, count);
|
||||||
|
errdefer allocator.free(entries);
|
||||||
|
|
||||||
|
for (entries) |*entry| {
|
||||||
|
entry.section_type = try p.readU32();
|
||||||
|
_ = try p.readU16(); // section_version
|
||||||
|
_ = try p.readU16(); // section_flags
|
||||||
|
const compression = try p.readU16();
|
||||||
|
_ = try p.readU16(); // reserved (was digest_alg)
|
||||||
|
entry.offset = try p.readU64();
|
||||||
|
entry.length = try p.readU64();
|
||||||
|
_ = try p.readU32(); // reserved padding
|
||||||
|
|
||||||
|
if (compression != 0) return error.UnexpectedFormat;
|
||||||
|
}
|
||||||
|
return entries;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn parseManifest(p: *Parser, allocator: std.mem.Allocator) Error!struct { exports: []Export, roots: []Root } {
|
||||||
|
const magic = try p.expect(8);
|
||||||
|
if (!std.mem.eql(u8, magic, "ARBMNFST")) return error.InvalidManifest;
|
||||||
|
|
||||||
|
const major = try p.readU16();
|
||||||
|
_ = try p.readU16(); // minor
|
||||||
|
if (major != 1) return error.InvalidVersion;
|
||||||
|
|
||||||
|
const schema = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(schema);
|
||||||
|
if (!std.mem.eql(u8, schema, "arboricx.bundle.manifest.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const bundle_type = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(bundle_type);
|
||||||
|
if (!std.mem.eql(u8, bundle_type, "tree-calculus-executable-object")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const calc = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(calc);
|
||||||
|
if (!std.mem.eql(u8, calc, "tree-calculus.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const hash_alg = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(hash_alg);
|
||||||
|
if (!std.mem.eql(u8, hash_alg, "indexed")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const hash_domain = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(hash_domain);
|
||||||
|
if (!std.mem.eql(u8, hash_domain, "arboricx.indexed.node.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const payload_type = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(payload_type);
|
||||||
|
if (!std.mem.eql(u8, payload_type, "arboricx.indexed.payload.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const sem = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(sem);
|
||||||
|
if (!std.mem.eql(u8, sem, "tree-calculus.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const eval_mode = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(eval_mode);
|
||||||
|
if (!std.mem.eql(u8, eval_mode, "normal-order")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const abi = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(abi);
|
||||||
|
if (!std.mem.eql(u8, abi, "arboricx.abi.tree.v1")) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const cap_count = try p.readU32();
|
||||||
|
var i: u32 = 0;
|
||||||
|
while (i < cap_count) : (i += 1) {
|
||||||
|
const cap = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
defer allocator.free(cap);
|
||||||
|
if (cap.len != 0) return error.UnexpectedFormat;
|
||||||
|
}
|
||||||
|
|
||||||
|
const closure = try p.readU8();
|
||||||
|
if (closure != 0) return error.UnexpectedFormat;
|
||||||
|
|
||||||
|
const root_count = try p.readU32();
|
||||||
|
const roots = try allocator.alloc(Root, root_count);
|
||||||
|
errdefer allocator.free(roots);
|
||||||
|
for (roots) |*r| {
|
||||||
|
r.index = try p.readU32();
|
||||||
|
r.role = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
}
|
||||||
|
|
||||||
|
const export_count = try p.readU32();
|
||||||
|
const exports = try allocator.alloc(Export, export_count);
|
||||||
|
errdefer {
|
||||||
|
for (exports) |*e| {
|
||||||
|
allocator.free(e.name);
|
||||||
|
allocator.free(e.kind);
|
||||||
|
allocator.free(e.abi);
|
||||||
|
}
|
||||||
|
allocator.free(exports);
|
||||||
|
}
|
||||||
|
for (exports) |*e| {
|
||||||
|
e.name = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
e.root = try p.readU32();
|
||||||
|
e.kind = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
e.abi = try p.readLengthPrefixedBytes(allocator);
|
||||||
|
if (!std.mem.eql(u8, e.abi, "arboricx.abi.tree.v1")) return error.UnexpectedFormat;
|
||||||
|
}
|
||||||
|
|
||||||
|
const metadata_count = try p.readU32();
|
||||||
|
var m: u32 = 0;
|
||||||
|
while (m < metadata_count) : (m += 1) {
|
||||||
|
_ = try p.readU16(); // tag
|
||||||
|
const len = try p.readU32();
|
||||||
|
_ = try p.expect(len);
|
||||||
|
}
|
||||||
|
|
||||||
|
const ext_count = try p.readU32();
|
||||||
|
var e_idx: u32 = 0;
|
||||||
|
while (e_idx < ext_count) : (e_idx += 1) {
|
||||||
|
_ = try p.readU16(); // tag
|
||||||
|
const len = try p.readU32();
|
||||||
|
_ = try p.expect(len);
|
||||||
|
}
|
||||||
|
|
||||||
|
return .{ .exports = exports, .roots = roots };
|
||||||
|
}
|
||||||
|
|
||||||
|
const Export = struct {
|
||||||
|
name: []const u8,
|
||||||
|
root: u32,
|
||||||
|
kind: []const u8,
|
||||||
|
abi: []const u8,
|
||||||
|
};
|
||||||
|
|
||||||
|
const Root = struct {
|
||||||
|
index: u32,
|
||||||
|
role: []const u8,
|
||||||
|
};
|
||||||
|
|
||||||
|
/// Parse the node section and build nodes directly into the arena.
|
||||||
|
/// Returns a slice mapping node-section index -> arena index.
|
||||||
|
/// The caller owns the returned slice and must free it with the arena's allocator.
|
||||||
|
fn parseNodeSection(p: *Parser, arena: *Arena) Error![]u32 {
|
||||||
|
const node_count = try p.readU64();
|
||||||
|
const indices = try arena.allocator.alloc(u32, node_count);
|
||||||
|
errdefer arena.allocator.free(indices);
|
||||||
|
|
||||||
|
var i: u64 = 0;
|
||||||
|
while (i < node_count) : (i += 1) {
|
||||||
|
const plen = try p.readU32();
|
||||||
|
const payload = try p.expect(plen);
|
||||||
|
|
||||||
|
if (payload.len == 0) return error.InvalidNodePayload;
|
||||||
|
|
||||||
|
const idx: u32 = switch (payload[0]) {
|
||||||
|
0x00 => blk: {
|
||||||
|
if (plen != 1) return error.InvalidNodePayload;
|
||||||
|
break :blk try arena.alloc(.leaf);
|
||||||
|
},
|
||||||
|
0x01 => blk: {
|
||||||
|
if (plen != 5) return error.InvalidNodePayload;
|
||||||
|
const child_idx = std.mem.readInt(u32, payload[1..5], .big);
|
||||||
|
if (child_idx >= i) return error.InvalidNodePayload;
|
||||||
|
break :blk try arena.alloc(.{ .stem = .{ .child = indices[child_idx] } });
|
||||||
|
},
|
||||||
|
0x02 => blk: {
|
||||||
|
if (plen != 9) return error.InvalidNodePayload;
|
||||||
|
const left_idx = std.mem.readInt(u32, payload[1..5], .big);
|
||||||
|
const right_idx = std.mem.readInt(u32, payload[5..9], .big);
|
||||||
|
if (left_idx >= i or right_idx >= i) return error.InvalidNodePayload;
|
||||||
|
break :blk try arena.alloc(.{ .fork = .{ .left = indices[left_idx], .right = indices[right_idx] } });
|
||||||
|
},
|
||||||
|
else => return error.InvalidNodePayload,
|
||||||
|
};
|
||||||
|
indices[i] = idx;
|
||||||
|
}
|
||||||
|
|
||||||
|
return indices;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn findSection(entries: []SectionEntry, section_type: u32) ?SectionEntry {
|
||||||
|
for (entries) |entry| {
|
||||||
|
if (entry.section_type == section_type) return entry;
|
||||||
|
}
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Parse an Arboricx bundle and load the named export into the arena.
|
||||||
|
/// Returns the arena index of the exported term tree.
|
||||||
|
pub fn loadBundleExport(
|
||||||
|
arena: *Arena,
|
||||||
|
bundle_bytes: []const u8,
|
||||||
|
export_name: []const u8,
|
||||||
|
) Error!u32 {
|
||||||
|
var p = Parser.init(bundle_bytes);
|
||||||
|
|
||||||
|
const header = try parseHeader(&p);
|
||||||
|
|
||||||
|
p.pos = @intCast(header.dir_offset);
|
||||||
|
const allocator = arena.allocator;
|
||||||
|
const entries = try parseSectionEntries(&p, header.section_count, allocator);
|
||||||
|
defer allocator.free(entries);
|
||||||
|
|
||||||
|
const manifest_section = findSection(entries, 1) orelse return error.InvalidManifest;
|
||||||
|
const nodes_section = findSection(entries, 2) orelse return error.InvalidNodePayload;
|
||||||
|
|
||||||
|
const manifest_bytes = bundle_bytes[@intCast(manifest_section.offset)..@intCast(manifest_section.offset + manifest_section.length)];
|
||||||
|
const nodes_bytes = bundle_bytes[@intCast(nodes_section.offset)..@intCast(nodes_section.offset + nodes_section.length)];
|
||||||
|
|
||||||
|
var mp = Parser.init(manifest_bytes);
|
||||||
|
const manifest = try parseManifest(&mp, allocator);
|
||||||
|
defer {
|
||||||
|
for (manifest.exports) |e| {
|
||||||
|
allocator.free(e.name);
|
||||||
|
allocator.free(e.kind);
|
||||||
|
allocator.free(e.abi);
|
||||||
|
}
|
||||||
|
allocator.free(manifest.exports);
|
||||||
|
for (manifest.roots) |r| {
|
||||||
|
allocator.free(r.role);
|
||||||
|
}
|
||||||
|
allocator.free(manifest.roots);
|
||||||
|
}
|
||||||
|
|
||||||
|
var export_root: ?u32 = null;
|
||||||
|
for (manifest.exports) |e| {
|
||||||
|
if (std.mem.eql(u8, e.name, export_name)) {
|
||||||
|
export_root = e.root;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
const root_index = export_root orelse return error.ExportNotFound;
|
||||||
|
|
||||||
|
var np = Parser.init(nodes_bytes);
|
||||||
|
const node_indices = try parseNodeSection(&np, arena);
|
||||||
|
defer allocator.free(node_indices);
|
||||||
|
|
||||||
|
if (root_index >= node_indices.len) return error.InvalidNodePayload;
|
||||||
|
return node_indices[root_index];
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Parse an Arboricx bundle and load the default (first) root into the arena.
|
||||||
|
pub fn loadBundleDefaultRoot(
|
||||||
|
arena: *Arena,
|
||||||
|
bundle_bytes: []const u8,
|
||||||
|
) Error!u32 {
|
||||||
|
var p = Parser.init(bundle_bytes);
|
||||||
|
|
||||||
|
const header = try parseHeader(&p);
|
||||||
|
|
||||||
|
p.pos = @intCast(header.dir_offset);
|
||||||
|
const allocator = arena.allocator;
|
||||||
|
const entries = try parseSectionEntries(&p, header.section_count, allocator);
|
||||||
|
defer allocator.free(entries);
|
||||||
|
|
||||||
|
const manifest_section = findSection(entries, 1) orelse return error.InvalidManifest;
|
||||||
|
const nodes_section = findSection(entries, 2) orelse return error.InvalidNodePayload;
|
||||||
|
|
||||||
|
const manifest_bytes = bundle_bytes[@intCast(manifest_section.offset)..@intCast(manifest_section.offset + manifest_section.length)];
|
||||||
|
const nodes_bytes = bundle_bytes[@intCast(nodes_section.offset)..@intCast(nodes_section.offset + nodes_section.length)];
|
||||||
|
|
||||||
|
var mp = Parser.init(manifest_bytes);
|
||||||
|
const manifest = try parseManifest(&mp, allocator);
|
||||||
|
defer {
|
||||||
|
for (manifest.exports) |e| {
|
||||||
|
allocator.free(e.name);
|
||||||
|
allocator.free(e.kind);
|
||||||
|
allocator.free(e.abi);
|
||||||
|
}
|
||||||
|
allocator.free(manifest.exports);
|
||||||
|
for (manifest.roots) |r| {
|
||||||
|
allocator.free(r.role);
|
||||||
|
}
|
||||||
|
allocator.free(manifest.roots);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (manifest.roots.len == 0) return error.ExportNotFound;
|
||||||
|
const root_index = manifest.roots[0].index;
|
||||||
|
|
||||||
|
var np = Parser.init(nodes_bytes);
|
||||||
|
const node_indices = try parseNodeSection(&np, arena);
|
||||||
|
defer allocator.free(node_indices);
|
||||||
|
|
||||||
|
if (root_index >= node_indices.len) return error.InvalidNodePayload;
|
||||||
|
return node_indices[root_index];
|
||||||
|
}
|
||||||
252
ext/zig/src/c_abi.zig
Normal file
252
ext/zig/src/c_abi.zig
Normal file
@@ -0,0 +1,252 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
const reduce = @import("reduce.zig");
|
||||||
|
const codecs = @import("codecs.zig");
|
||||||
|
const kernel = @import("kernel.zig");
|
||||||
|
const bundle = @import("bundle.zig");
|
||||||
|
const io_driver = @import("io_driver.zig");
|
||||||
|
|
||||||
|
/// Opaque handle for the C API. Layout is not exposed to C.
|
||||||
|
/// Holds a persistent arena for user-built terms and the kernel.
|
||||||
|
pub const ArbCtx = struct {
|
||||||
|
gpa: std.mem.Allocator,
|
||||||
|
arena: Arena,
|
||||||
|
kernel_root: u32,
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Context lifecycle
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arboricx_init() ?*ArbCtx {
|
||||||
|
const ptr = std.heap.smp_allocator.create(ArbCtx) catch return null;
|
||||||
|
ptr.gpa = std.heap.smp_allocator;
|
||||||
|
ptr.arena = Arena.init(std.heap.smp_allocator);
|
||||||
|
ptr.kernel_root = kernel.loadKernel(&ptr.arena) catch {
|
||||||
|
ptr.arena.deinit();
|
||||||
|
std.heap.smp_allocator.destroy(ptr);
|
||||||
|
return null;
|
||||||
|
};
|
||||||
|
return ptr;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arboricx_free(ctx: *ArbCtx) void {
|
||||||
|
ctx.arena.deinit();
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arboricx_free_buf(_: *ArbCtx, ptr: [*]u8, len: usize) void {
|
||||||
|
std.heap.smp_allocator.free(ptr[0..len]);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Tree construction (all write into the persistent arena)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_leaf(ctx: *ArbCtx) u32 {
|
||||||
|
return ctx.arena.alloc(.leaf) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_stem(ctx: *ArbCtx, child: u32) u32 {
|
||||||
|
return ctx.arena.alloc(.{ .stem = .{ .child = child } }) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_fork(ctx: *ArbCtx, left: u32, right: u32) u32 {
|
||||||
|
return ctx.arena.alloc(.{ .fork = .{ .left = left, .right = right } }) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_app(ctx: *ArbCtx, func: u32, arg: u32) u32 {
|
||||||
|
return ctx.arena.alloc(.{ .app = .{ .func = func, .arg = arg } }) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Tree inspection (Layer 1 — for custom IO drivers and non-POSIX hosts)
|
||||||
|
// All return 1 on success / true, 0 on failure / false.
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_is_leaf(ctx: *ArbCtx, root: u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
return if (ctx.arena.nodes.items[root] == .leaf) 1 else 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_is_stem(ctx: *ArbCtx, root: u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
return if (ctx.arena.nodes.items[root] == .stem) 1 else 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_is_fork(ctx: *ArbCtx, root: u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
return if (ctx.arena.nodes.items[root] == .fork) 1 else 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_is_app(ctx: *ArbCtx, root: u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
return if (ctx.arena.nodes.items[root] == .app) 1 else 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_get_stem_child(ctx: *ArbCtx, root: u32, out: *u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
const node = ctx.arena.nodes.items[root];
|
||||||
|
if (node != .stem) return 0;
|
||||||
|
out.* = node.stem.child;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_get_fork_children(ctx: *ArbCtx, root: u32, out_left: *u32, out_right: *u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
const node = ctx.arena.nodes.items[root];
|
||||||
|
if (node != .fork) return 0;
|
||||||
|
out_left.* = node.fork.left;
|
||||||
|
out_right.* = node.fork.right;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_get_app_func_arg(ctx: *ArbCtx, root: u32, out_func: *u32, out_arg: *u32) c_int {
|
||||||
|
if (root >= ctx.arena.len()) return 0;
|
||||||
|
const node = ctx.arena.nodes.items[root];
|
||||||
|
if (node != .app) return 0;
|
||||||
|
out_func.* = node.app.func;
|
||||||
|
out_arg.* = node.app.arg;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Reduction
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
/// Reduces `root` in a *fresh* scratch arena so that garbage from previous
|
||||||
|
/// reductions never accumulates. The kernel and term are deep-copied into
|
||||||
|
/// the scratch arena, reduced there, and the result is copied back into the
|
||||||
|
/// persistent arena.
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_reduce(ctx: *ArbCtx, root: u32, fuel: u64) u32 {
|
||||||
|
// 1. Fresh scratch arena
|
||||||
|
var scratch = Arena.init(ctx.gpa);
|
||||||
|
defer scratch.deinit();
|
||||||
|
|
||||||
|
// 2. Deep-copy the term (which may reference kernel nodes) into scratch
|
||||||
|
const scratch_root = tree.copyTree(ctx.arena.nodes.items, &scratch, root) catch return 0;
|
||||||
|
|
||||||
|
// 3. Reduce in scratch
|
||||||
|
const scratch_result = reduce.reduce(scratch_root, &scratch, fuel) catch return 0;
|
||||||
|
|
||||||
|
// 4. Copy the result back to the persistent arena
|
||||||
|
return tree.copyTree(scratch.nodes.items, &ctx.arena, scratch_result) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Codec constructors
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_of_number(ctx: *ArbCtx, n: u64) u32 {
|
||||||
|
return codecs.ofNumber(&ctx.arena, n) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_of_string(ctx: *ArbCtx, s: [*:0]const u8) u32 {
|
||||||
|
const slice = std.mem.sliceTo(s, 0);
|
||||||
|
return codecs.ofString(&ctx.arena, slice) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_of_bytes(ctx: *ArbCtx, bytes: [*]const u8, len: usize) u32 {
|
||||||
|
return codecs.ofBytes(&ctx.arena, bytes[0..len]) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_of_list(ctx: *ArbCtx, items: [*]const u32, len: usize) u32 {
|
||||||
|
return codecs.ofList(&ctx.arena, items[0..len]) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Codec destructors
|
||||||
|
// Return 1 on success, 0 on failure.
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_to_number(ctx: *ArbCtx, root: u32, out: *u64) c_int {
|
||||||
|
const n = codecs.toNumber(&ctx.arena, root) catch return 0;
|
||||||
|
if (n == null) return 0;
|
||||||
|
out.* = n.?;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_to_string(ctx: *ArbCtx, root: u32, out_ptr: **u8, out_len: *usize) c_int {
|
||||||
|
const s = codecs.toString(&ctx.arena, root) catch return 0;
|
||||||
|
if (s == null) return 0;
|
||||||
|
out_ptr.* = @ptrCast(s.?.ptr);
|
||||||
|
out_len.* = s.?.len;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_to_bytes(ctx: *ArbCtx, root: u32, out_ptr: **u8, out_len: *usize) c_int {
|
||||||
|
return arb_to_string(ctx, root, out_ptr, out_len);
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_to_bool(ctx: *ArbCtx, root: u32, out: *c_int) c_int {
|
||||||
|
const b = codecs.toBool(&ctx.arena, root) catch return 0;
|
||||||
|
if (b == null) return 0;
|
||||||
|
out.* = if (b.?) 1 else 0;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Result unwrapping
|
||||||
|
// Return 1 on success, 0 on failure.
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_unwrap_result(ctx: *ArbCtx, root: u32, out_ok: *c_int, out_value: *u32, out_rest: *u32) c_int {
|
||||||
|
const r = codecs.unwrapResult(&ctx.arena, root) catch return 0;
|
||||||
|
if (r == null) return 0;
|
||||||
|
out_ok.* = if (r.?.ok) 1 else 0;
|
||||||
|
out_value.* = r.?.value;
|
||||||
|
out_rest.* = r.?.rest;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
export fn arb_unwrap_host_value(ctx: *ArbCtx, root: u32, out_tag: *u64, out_payload: *u32) c_int {
|
||||||
|
const hv = codecs.unwrapHostValue(&ctx.arena, root) catch return 0;
|
||||||
|
if (hv == null) return 0;
|
||||||
|
out_tag.* = hv.?.tag;
|
||||||
|
out_payload.* = hv.?.payload;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// IO driver (Layer 2 — POSIX interaction-tree runtime)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const arb_io_perms_t = extern struct {
|
||||||
|
allow_read_all: c_int,
|
||||||
|
allow_write_all: c_int,
|
||||||
|
};
|
||||||
|
|
||||||
|
export fn arb_run_io(ctx: *ArbCtx, program: u32, perms: ?*const arb_io_perms_t) u32 {
|
||||||
|
const zig_perms = if (perms) |p| io_driver.IOPerms{
|
||||||
|
.allow_read_all = p.allow_read_all != 0,
|
||||||
|
.allow_write_all = p.allow_write_all != 0,
|
||||||
|
} else io_driver.IOPerms{};
|
||||||
|
return io_driver.runIO(ctx.gpa, &ctx.arena, program, zig_perms) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Kernel entrypoints
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
export fn arb_kernel_root(ctx: *ArbCtx) u32 {
|
||||||
|
return ctx.kernel_root;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Native bundle loading (fast path — bypasses the Tricu kernel)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
/// Load a named export from an Arboricx bundle directly into the arena.
|
||||||
|
/// Returns the arena index of the exported term, or 0 on error.
|
||||||
|
export fn arb_load_bundle(ctx: *ArbCtx, bytes: [*]const u8, len: usize, name: [*:0]const u8) u32 {
|
||||||
|
const name_slice = std.mem.sliceTo(name, 0);
|
||||||
|
return bundle.loadBundleExport(&ctx.arena, bytes[0..len], name_slice) catch 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Load the default root from an Arboricx bundle directly into the arena.
|
||||||
|
/// Returns the arena index of the root term, or 0 on error.
|
||||||
|
export fn arb_load_bundle_default(ctx: *ArbCtx, bytes: [*]const u8, len: usize) u32 {
|
||||||
|
return bundle.loadBundleDefaultRoot(&ctx.arena, bytes[0..len]) catch 0;
|
||||||
|
}
|
||||||
205
ext/zig/src/codecs.zig
Normal file
205
ext/zig/src/codecs.zig
Normal file
@@ -0,0 +1,205 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
const reduce = @import("reduce.zig");
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Number encoding/decoding
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn ofNumber(arena: *Arena, n: u64) !u32 {
|
||||||
|
if (n == 0) {
|
||||||
|
return try arena.alloc(.leaf);
|
||||||
|
}
|
||||||
|
const bit = if (n % 2 == 1) try arena.alloc(.{ .stem = .{ .child = try arena.alloc(.leaf) } }) else try arena.alloc(.leaf);
|
||||||
|
const rest = try ofNumber(arena, n / 2);
|
||||||
|
return try arena.alloc(.{ .fork = .{ .left = bit, .right = rest } });
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn toNumber(arena: *Arena, idx: u32) !?u64 {
|
||||||
|
const node = try reduce.reduce(idx, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
return switch (n.*) {
|
||||||
|
.leaf => 0,
|
||||||
|
.stem => return null,
|
||||||
|
.fork => |f| blk: {
|
||||||
|
const bit_node = try reduce.reduce(f.left, arena, 10_000);
|
||||||
|
const bit = arena.get(bit_node);
|
||||||
|
const bit_val: u64 = switch (bit.*) {
|
||||||
|
.leaf => 0,
|
||||||
|
.stem => |s| if (arena.get(s.child).* == .leaf) 1 else return null,
|
||||||
|
else => return null,
|
||||||
|
};
|
||||||
|
const rest = try toNumber(arena, f.right) orelse return null;
|
||||||
|
break :blk bit_val + 2 * rest;
|
||||||
|
},
|
||||||
|
.app => return null,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// List encoding/decoding
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn ofList(arena: *Arena, items: []const u32) !u32 {
|
||||||
|
var result = try arena.alloc(.leaf);
|
||||||
|
var i: usize = items.len;
|
||||||
|
while (i > 0) {
|
||||||
|
i -= 1;
|
||||||
|
result = try arena.alloc(.{ .fork = .{ .left = items[i], .right = result } });
|
||||||
|
}
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn toList(arena: *Arena, idx: u32) !?std.ArrayList(u32) {
|
||||||
|
var result = std.ArrayList(u32).empty;
|
||||||
|
errdefer result.deinit(arena.allocator);
|
||||||
|
|
||||||
|
var current = idx;
|
||||||
|
while (true) {
|
||||||
|
const node = try reduce.reduce(current, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
switch (n.*) {
|
||||||
|
.leaf => return result,
|
||||||
|
.stem => return null,
|
||||||
|
.fork => |f| {
|
||||||
|
try result.append(arena.allocator, f.left);
|
||||||
|
current = f.right;
|
||||||
|
},
|
||||||
|
.app => return null,
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// String / Bytes encoding/decoding
|
||||||
|
// Strings are lists of byte values (each character encoded as a number tree).
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn ofString(arena: *Arena, s: []const u8) !u32 {
|
||||||
|
var bytes = try arena.allocator.alloc(u32, s.len);
|
||||||
|
defer arena.allocator.free(bytes);
|
||||||
|
for (s, 0..) |c, i| {
|
||||||
|
bytes[i] = try ofNumber(arena, c);
|
||||||
|
}
|
||||||
|
return try ofList(arena, bytes);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn toString(arena: *Arena, idx: u32) !?[]u8 {
|
||||||
|
var list = try toList(arena, idx) orelse return null;
|
||||||
|
defer list.deinit(arena.allocator);
|
||||||
|
var result = try arena.allocator.alloc(u8, list.items.len);
|
||||||
|
errdefer arena.allocator.free(result);
|
||||||
|
for (list.items, 0..) |elem_idx, i| {
|
||||||
|
const num = try toNumber(arena, elem_idx) orelse {
|
||||||
|
arena.allocator.free(result);
|
||||||
|
return null;
|
||||||
|
};
|
||||||
|
if (num > 255) {
|
||||||
|
arena.allocator.free(result);
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
result[i] = @intCast(num);
|
||||||
|
}
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn ofBytes(arena: *Arena, bytes: []const u8) !u32 {
|
||||||
|
return try ofString(arena, bytes);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn toBytes(arena: *Arena, idx: u32) !?[]u8 {
|
||||||
|
return try toString(arena, idx);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Result unwrapping (ok/err protocol)
|
||||||
|
// ok value rest = pair true (pair value rest)
|
||||||
|
// err code rest = pair false (pair code rest)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const UnwrapResult = struct {
|
||||||
|
ok: bool,
|
||||||
|
value: u32,
|
||||||
|
rest: u32,
|
||||||
|
};
|
||||||
|
|
||||||
|
pub fn unwrapResult(arena: *Arena, idx: u32) !?UnwrapResult {
|
||||||
|
const node = try reduce.reduce(idx, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
switch (n.*) {
|
||||||
|
.fork => |f| {
|
||||||
|
const tag = try reduce.reduce(f.left, arena, 10_000);
|
||||||
|
const rest_pair = try reduce.reduce(f.right, arena, 10_000);
|
||||||
|
const rp = arena.get(rest_pair);
|
||||||
|
switch (rp.*) {
|
||||||
|
.fork => |rf| {
|
||||||
|
const is_ok = tree.sameTree(arena, tag, try arena.alloc(.{ .stem = .{ .child = try arena.alloc(.leaf) } }));
|
||||||
|
return UnwrapResult{
|
||||||
|
.ok = is_ok,
|
||||||
|
.value = rf.left,
|
||||||
|
.rest = rf.right,
|
||||||
|
};
|
||||||
|
},
|
||||||
|
else => return null,
|
||||||
|
}
|
||||||
|
},
|
||||||
|
else => return null,
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Host ABI value unwrapping
|
||||||
|
// A host ABI value is: pair tag payload
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const HostValue = struct {
|
||||||
|
tag: u64,
|
||||||
|
payload: u32,
|
||||||
|
};
|
||||||
|
|
||||||
|
pub fn unwrapHostValue(arena: *Arena, idx: u32) !?HostValue {
|
||||||
|
const node = try reduce.reduce(idx, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
switch (n.*) {
|
||||||
|
.fork => |f| {
|
||||||
|
const tag_num = try toNumber(arena, f.left) orelse return null;
|
||||||
|
return HostValue{ .tag = tag_num, .payload = f.right };
|
||||||
|
},
|
||||||
|
else => return null,
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Returns true if the tree is a valid boolean (Leaf=false, Stem Leaf=true).
|
||||||
|
pub fn isBool(arena: *Arena, idx: u32) !bool {
|
||||||
|
const node = try reduce.reduce(idx, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
return switch (n.*) {
|
||||||
|
.leaf => true,
|
||||||
|
.stem => |s| arena.get(s.child).* == .leaf,
|
||||||
|
else => false,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Extract the boolean value: false for Leaf, true for Stem Leaf.
|
||||||
|
/// Returns null if the tree is not a valid boolean.
|
||||||
|
pub fn toBool(arena: *Arena, idx: u32) !?bool {
|
||||||
|
const node = try reduce.reduce(idx, arena, 10_000);
|
||||||
|
const n = arena.get(node);
|
||||||
|
return switch (n.*) {
|
||||||
|
.leaf => false,
|
||||||
|
.stem => |s| if (arena.get(s.child).* == .leaf) true else null,
|
||||||
|
else => null,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Host ABI tag constants
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const HOST_TREE_TAG: u64 = 0;
|
||||||
|
pub const HOST_STRING_TAG: u64 = 1;
|
||||||
|
pub const HOST_NUMBER_TAG: u64 = 2;
|
||||||
|
pub const HOST_BOOL_TAG: u64 = 3;
|
||||||
|
pub const HOST_LIST_TAG: u64 = 4;
|
||||||
|
pub const HOST_BYTES_TAG: u64 = 5;
|
||||||
845
ext/zig/src/io_driver.zig
Normal file
845
ext/zig/src/io_driver.zig
Normal file
@@ -0,0 +1,845 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
const codecs = @import("codecs.zig");
|
||||||
|
const reduce = @import("reduce.zig");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
|
||||||
|
const c = @cImport({
|
||||||
|
@cInclude("uv.h");
|
||||||
|
});
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Action tag constants (must match lib/io.tri and IODriver.hs)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const ActionTag = enum(u8) {
|
||||||
|
pure = 0,
|
||||||
|
bind = 1,
|
||||||
|
putStr = 10,
|
||||||
|
getLine = 11,
|
||||||
|
readFile = 20,
|
||||||
|
writeFile = 21,
|
||||||
|
ask = 30,
|
||||||
|
local = 31,
|
||||||
|
get = 40,
|
||||||
|
put = 41,
|
||||||
|
fork = 60,
|
||||||
|
await = 61,
|
||||||
|
yield = 62,
|
||||||
|
sleep = 63,
|
||||||
|
};
|
||||||
|
|
||||||
|
pub const Action = union(ActionTag) {
|
||||||
|
pure: u32,
|
||||||
|
bind: struct { left: u32, k: u32 },
|
||||||
|
putStr: u32,
|
||||||
|
getLine,
|
||||||
|
readFile: u32,
|
||||||
|
writeFile: struct { path: u32, contents: u32 },
|
||||||
|
ask,
|
||||||
|
local: struct { f: u32, action: u32 },
|
||||||
|
get,
|
||||||
|
put: u32,
|
||||||
|
fork: u32,
|
||||||
|
await: u32,
|
||||||
|
yield,
|
||||||
|
sleep: u32,
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Error codes (must match IODriver.hs)
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const ERR_DOES_NOT_EXIST: u64 = 1;
|
||||||
|
const ERR_PERMISSION: u64 = 2;
|
||||||
|
const ERR_ALREADY_EXISTS: u64 = 3;
|
||||||
|
const ERR_IO_OTHER: u64 = 4;
|
||||||
|
const ERR_POLICY_DENY: u64 = 20;
|
||||||
|
const ERR_INVALID_ACTION: u64 = 40;
|
||||||
|
const ERR_INVALID_STRING: u64 = 41;
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Permissions
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub const IOPerms = struct {
|
||||||
|
allow_read_all: bool = false,
|
||||||
|
allow_write_all: bool = false,
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// IO sentinel detection
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn isIOSentinel(arena: *Arena, root: u32) !?u32 {
|
||||||
|
const node = arena.get(root);
|
||||||
|
if (node.* != .fork) return null;
|
||||||
|
|
||||||
|
const sentinel = node.fork.left;
|
||||||
|
const rest = node.fork.right;
|
||||||
|
|
||||||
|
const sentinel_str = try codecs.toString(arena, sentinel);
|
||||||
|
defer {
|
||||||
|
if (sentinel_str) |s| {
|
||||||
|
arena.allocator.free(s);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (sentinel_str == null) return null;
|
||||||
|
if (!std.mem.eql(u8, sentinel_str.?, "tricuIO")) return null;
|
||||||
|
|
||||||
|
const rest_node = arena.get(rest);
|
||||||
|
if (rest_node.* != .fork) return null;
|
||||||
|
|
||||||
|
const version_num = try codecs.toNumber(arena, rest_node.fork.left);
|
||||||
|
if (version_num == null or version_num.? != 1) return null;
|
||||||
|
|
||||||
|
return rest_node.fork.right;
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Action decoding
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn decodeAction(arena: *Arena, root: u32) !?Action {
|
||||||
|
const node = arena.get(root);
|
||||||
|
if (node.* != .fork) return null;
|
||||||
|
|
||||||
|
const tag_num = try codecs.toNumber(arena, node.fork.left);
|
||||||
|
if (tag_num == null) return null;
|
||||||
|
|
||||||
|
const tag: ActionTag = switch (tag_num.?) {
|
||||||
|
0 => .pure,
|
||||||
|
1 => .bind,
|
||||||
|
10 => .putStr,
|
||||||
|
11 => .getLine,
|
||||||
|
20 => .readFile,
|
||||||
|
21 => .writeFile,
|
||||||
|
30 => .ask,
|
||||||
|
31 => .local,
|
||||||
|
40 => .get,
|
||||||
|
41 => .put,
|
||||||
|
60 => .fork,
|
||||||
|
61 => .await,
|
||||||
|
62 => .yield,
|
||||||
|
63 => .sleep,
|
||||||
|
else => return null,
|
||||||
|
};
|
||||||
|
|
||||||
|
const payload = node.fork.right;
|
||||||
|
|
||||||
|
return switch (tag) {
|
||||||
|
.pure => Action{ .pure = payload },
|
||||||
|
.bind => blk: {
|
||||||
|
const payload_node = arena.get(payload);
|
||||||
|
if (payload_node.* != .fork) return null;
|
||||||
|
break :blk Action{ .bind = .{ .left = payload_node.fork.left, .k = payload_node.fork.right } };
|
||||||
|
},
|
||||||
|
.putStr => Action{ .putStr = payload },
|
||||||
|
.getLine => Action.getLine,
|
||||||
|
.readFile => Action{ .readFile = payload },
|
||||||
|
.writeFile => blk: {
|
||||||
|
const payload_node = arena.get(payload);
|
||||||
|
if (payload_node.* != .fork) return null;
|
||||||
|
break :blk Action{ .writeFile = .{ .path = payload_node.fork.left, .contents = payload_node.fork.right } };
|
||||||
|
},
|
||||||
|
.ask => Action.ask,
|
||||||
|
.local => blk: {
|
||||||
|
const payload_node = arena.get(payload);
|
||||||
|
if (payload_node.* != .fork) return null;
|
||||||
|
break :blk Action{ .local = .{ .f = payload_node.fork.left, .action = payload_node.fork.right } };
|
||||||
|
},
|
||||||
|
.get => Action.get,
|
||||||
|
.put => Action{ .put = payload },
|
||||||
|
.fork => Action{ .fork = payload },
|
||||||
|
.await => Action{ .await = payload },
|
||||||
|
.yield => Action.yield,
|
||||||
|
.sleep => Action{ .sleep = payload },
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Response tree constructors
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn makePure(arena: *Arena, val: u32) !u32 {
|
||||||
|
const tag = try codecs.ofNumber(arena, 0);
|
||||||
|
return try arena.alloc(.{ .fork = .{ .left = tag, .right = val } });
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn makeOkResult(arena: *Arena, val: u32) !u32 {
|
||||||
|
const ok_tag = try arena.alloc(.{ .stem = .{ .child = try arena.alloc(.leaf) } });
|
||||||
|
const val_pair = try arena.alloc(.{ .fork = .{ .left = val, .right = try arena.alloc(.leaf) } });
|
||||||
|
return try arena.alloc(.{ .fork = .{ .left = ok_tag, .right = val_pair } });
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn makeErrResult(arena: *Arena, code: u64) !u32 {
|
||||||
|
const code_tree = try codecs.ofNumber(arena, code);
|
||||||
|
const code_pair = try arena.alloc(.{ .fork = .{ .left = code_tree, .right = try arena.alloc(.leaf) } });
|
||||||
|
return try arena.alloc(.{ .fork = .{ .left = try arena.alloc(.leaf), .right = code_pair } });
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Frame stack and runtime
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const Frame = union(enum) {
|
||||||
|
bind: u32, // continuation k
|
||||||
|
local: u32, // old env
|
||||||
|
};
|
||||||
|
|
||||||
|
const Runtime = struct {
|
||||||
|
env: u32,
|
||||||
|
state: u32,
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Helper: reduce a term in a scratch arena and copy the result back
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
fn reduceInScratch(gpa: std.mem.Allocator, arena: *Arena, term: u32) !u32 {
|
||||||
|
var scratch = Arena.init(gpa);
|
||||||
|
defer scratch.deinit();
|
||||||
|
const scratch_root = try tree.copyTree(arena.nodes.items, &scratch, term);
|
||||||
|
const scratch_result = try reduce.reduce(scratch_root, &scratch, std.math.maxInt(u64));
|
||||||
|
return try tree.copyTree(scratch.nodes.items, arena, scratch_result);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Task
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const Task = struct {
|
||||||
|
id: u64,
|
||||||
|
parent: ?*Task,
|
||||||
|
frames: std.ArrayList(Frame),
|
||||||
|
runtime: Runtime,
|
||||||
|
current: u32,
|
||||||
|
status: enum { runnable, blocked, completed },
|
||||||
|
result: ?u32,
|
||||||
|
waiting_for: ?u64,
|
||||||
|
|
||||||
|
fn init(gpa: std.mem.Allocator, id: u64, parent: ?*Task, env: u32, state: u32, current: u32) !*Task {
|
||||||
|
const task = try gpa.create(Task);
|
||||||
|
task.* = .{
|
||||||
|
.id = id,
|
||||||
|
.parent = parent,
|
||||||
|
.frames = std.ArrayList(Frame).empty,
|
||||||
|
.runtime = .{ .env = env, .state = state },
|
||||||
|
.current = current,
|
||||||
|
.status = .runnable,
|
||||||
|
.result = null,
|
||||||
|
.waiting_for = null,
|
||||||
|
};
|
||||||
|
return task;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn deinit(self: *Task, gpa: std.mem.Allocator) void {
|
||||||
|
self.frames.deinit(gpa);
|
||||||
|
gpa.destroy(self);
|
||||||
|
}
|
||||||
|
|
||||||
|
// finishValue processes a value through the frame stack.
|
||||||
|
// Returns true if the task has completed (no more frames).
|
||||||
|
fn finishValue(self: *Task, arena: *Arena, value: u32) !bool {
|
||||||
|
if (self.frames.pop()) |frame| {
|
||||||
|
switch (frame) {
|
||||||
|
.bind => |k| {
|
||||||
|
self.current = try arena.alloc(.{ .app = .{ .func = k, .arg = value } });
|
||||||
|
return false;
|
||||||
|
},
|
||||||
|
.local => |old_env| {
|
||||||
|
self.runtime.env = old_env;
|
||||||
|
self.current = try makePure(arena, value);
|
||||||
|
return false;
|
||||||
|
},
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
self.current = value;
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Scheduler
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const Scheduler = struct {
|
||||||
|
gpa: std.mem.Allocator,
|
||||||
|
loop: *c.uv_loop_t,
|
||||||
|
arena: *Arena,
|
||||||
|
tasks: std.ArrayList(*Task),
|
||||||
|
runnable: std.ArrayList(*Task),
|
||||||
|
next_id: u64,
|
||||||
|
perms: IOPerms,
|
||||||
|
|
||||||
|
fn init(gpa: std.mem.Allocator, loop: *c.uv_loop_t, arena: *Arena, perms: IOPerms) !Scheduler {
|
||||||
|
const sched = Scheduler{
|
||||||
|
.gpa = gpa,
|
||||||
|
.loop = loop,
|
||||||
|
.arena = arena,
|
||||||
|
.tasks = std.ArrayList(*Task).empty,
|
||||||
|
.runnable = std.ArrayList(*Task).empty,
|
||||||
|
.next_id = 1,
|
||||||
|
.perms = perms,
|
||||||
|
};
|
||||||
|
return sched;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn deinit(self: *Scheduler) void {
|
||||||
|
for (self.tasks.items) |task| {
|
||||||
|
task.deinit(self.gpa);
|
||||||
|
}
|
||||||
|
self.tasks.deinit(self.gpa);
|
||||||
|
self.runnable.deinit(self.gpa);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn createTask(self: *Scheduler, parent: ?*Task, env: u32, state: u32, current: u32) !*Task {
|
||||||
|
const id = self.next_id;
|
||||||
|
self.next_id += 1;
|
||||||
|
const task = try Task.init(self.gpa, id, parent, env, state, current);
|
||||||
|
try self.tasks.append(self.gpa, task);
|
||||||
|
return task;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn run(self: *Scheduler) !void {
|
||||||
|
while (true) {
|
||||||
|
if (self.runnable.items.len > 0) {
|
||||||
|
const task = self.runnable.orderedRemove(0);
|
||||||
|
try self.stepTask(task);
|
||||||
|
} else if (self.hasPendingHandles()) {
|
||||||
|
_ = c.uv_run(self.loop, c.UV_RUN_ONCE);
|
||||||
|
} else {
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fn hasPendingHandles(self: *Scheduler) bool {
|
||||||
|
return c.uv_loop_alive(self.loop) != 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn completeTask(self: *Scheduler, task: *Task) !void {
|
||||||
|
task.status = .completed;
|
||||||
|
task.result = task.current;
|
||||||
|
// Unblock any tasks waiting for this one
|
||||||
|
for (self.tasks.items) |t| {
|
||||||
|
if (t.status == .blocked and t.waiting_for == task.id) {
|
||||||
|
t.status = .runnable;
|
||||||
|
t.waiting_for = null;
|
||||||
|
t.current = try makePure(self.arena, task.result.?);
|
||||||
|
try self.runnable.append(self.gpa, t);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fn stepTask(self: *Scheduler, task: *Task) !void {
|
||||||
|
const reduced = try reduceInScratch(self.gpa, self.arena, task.current);
|
||||||
|
|
||||||
|
const decoded = try decodeAction(self.arena, reduced);
|
||||||
|
if (decoded == null) {
|
||||||
|
// Not a recognized action — if no frames, it's the final result.
|
||||||
|
// Otherwise treat as invalid.
|
||||||
|
if (task.frames.items.len == 0) {
|
||||||
|
task.current = reduced;
|
||||||
|
try self.completeTask(task);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_ACTION);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
switch (decoded.?) {
|
||||||
|
.pure => |val| {
|
||||||
|
if (try task.finishValue(self.arena, val)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.bind => |b| {
|
||||||
|
try task.frames.append(self.gpa, .{ .bind = b.k });
|
||||||
|
task.current = b.left;
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
},
|
||||||
|
|
||||||
|
.putStr => |str_tree| {
|
||||||
|
const str = try codecs.toString(self.arena, str_tree) orelse {
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_STRING);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
defer self.gpa.free(str);
|
||||||
|
_ = std.c.write(1, str.ptr, str.len);
|
||||||
|
const leaf = try self.arena.alloc(.leaf);
|
||||||
|
if (try task.finishValue(self.arena, leaf)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.getLine => {
|
||||||
|
var buf: [4096]u8 = undefined;
|
||||||
|
var len: usize = 0;
|
||||||
|
while (len < buf.len) {
|
||||||
|
const n = std.c.read(0, buf[len..].ptr, 1);
|
||||||
|
if (n <= 0) break;
|
||||||
|
if (buf[len] == '\n') break;
|
||||||
|
len += 1;
|
||||||
|
}
|
||||||
|
const line = buf[0..len];
|
||||||
|
const str_tree = try codecs.ofString(self.arena, line);
|
||||||
|
if (try task.finishValue(self.arena, str_tree)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.readFile => |path_tree| {
|
||||||
|
const path = try codecs.toString(self.arena, path_tree) orelse {
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_STRING);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
|
||||||
|
if (!self.perms.allow_read_all) {
|
||||||
|
self.arena.allocator.free(path);
|
||||||
|
const err = try makeErrResult(self.arena, ERR_POLICY_DENY);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
const ctx = try self.gpa.create(FileReadCtx);
|
||||||
|
ctx.* = .{
|
||||||
|
.scheduler = self,
|
||||||
|
.task = task,
|
||||||
|
.arena = self.arena,
|
||||||
|
.gpa = self.gpa,
|
||||||
|
.fd = -1,
|
||||||
|
.buf = std.ArrayList(u8).empty,
|
||||||
|
.path = path,
|
||||||
|
.req = undefined,
|
||||||
|
.read_buf = null,
|
||||||
|
};
|
||||||
|
ctx.req.data = ctx;
|
||||||
|
_ = c.uv_fs_open(self.loop, &ctx.req, ctx.path.ptr, c.O_RDONLY, 0, file_open_cb);
|
||||||
|
},
|
||||||
|
|
||||||
|
.writeFile => |wf| {
|
||||||
|
const path = try codecs.toString(self.arena, wf.path) orelse {
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_STRING);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
|
||||||
|
const contents = try codecs.toString(self.arena, wf.contents) orelse {
|
||||||
|
self.arena.allocator.free(path);
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_STRING);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
|
||||||
|
if (!self.perms.allow_write_all) {
|
||||||
|
self.arena.allocator.free(path);
|
||||||
|
self.arena.allocator.free(contents);
|
||||||
|
const err = try makeErrResult(self.arena, ERR_POLICY_DENY);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
const ctx = try self.gpa.create(FileWriteCtx);
|
||||||
|
ctx.* = .{
|
||||||
|
.scheduler = self,
|
||||||
|
.task = task,
|
||||||
|
.arena = self.arena,
|
||||||
|
.gpa = self.gpa,
|
||||||
|
.fd = -1,
|
||||||
|
.path = path,
|
||||||
|
.contents = contents,
|
||||||
|
.written = false,
|
||||||
|
.req = undefined,
|
||||||
|
};
|
||||||
|
ctx.req.data = ctx;
|
||||||
|
const flags = c.O_WRONLY | c.O_CREAT | c.O_TRUNC;
|
||||||
|
_ = c.uv_fs_open(self.loop, &ctx.req, ctx.path.ptr, flags, 0o644, file_write_open_cb);
|
||||||
|
},
|
||||||
|
|
||||||
|
.ask => {
|
||||||
|
if (try task.finishValue(self.arena, task.runtime.env)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.local => |loc| {
|
||||||
|
const new_env = try reduceInScratch(self.gpa, self.arena, try self.arena.alloc(.{ .app = .{ .func = loc.f, .arg = task.runtime.env } }));
|
||||||
|
try task.frames.append(self.gpa, .{ .local = task.runtime.env });
|
||||||
|
task.runtime.env = new_env;
|
||||||
|
task.current = loc.action;
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
},
|
||||||
|
|
||||||
|
.get => {
|
||||||
|
if (try task.finishValue(self.arena, task.runtime.state)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.put => |new_state| {
|
||||||
|
task.runtime.state = new_state;
|
||||||
|
const leaf = try self.arena.alloc(.leaf);
|
||||||
|
if (try task.finishValue(self.arena, leaf)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.fork => |action| {
|
||||||
|
const child = try self.createTask(task, task.runtime.env, task.runtime.state, action);
|
||||||
|
try self.runnable.append(self.gpa, child);
|
||||||
|
const handle = try codecs.ofNumber(self.arena, child.id);
|
||||||
|
if (try task.finishValue(self.arena, handle)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.await => |handle_tree| {
|
||||||
|
const handle = try codecs.toNumber(self.arena, handle_tree) orelse {
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_ACTION);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
var found: ?*Task = null;
|
||||||
|
for (self.tasks.items) |t| {
|
||||||
|
if (t.id == handle) {
|
||||||
|
found = t;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (found == null) {
|
||||||
|
const err = try makeErrResult(self.arena, ERR_INVALID_ACTION);
|
||||||
|
if (try task.finishValue(self.arena, err)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (found.?.status == .completed) {
|
||||||
|
const result = found.?.result.?;
|
||||||
|
if (try task.finishValue(self.arena, result)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
task.status = .blocked;
|
||||||
|
task.waiting_for = handle;
|
||||||
|
// Task remains out of runnable until child completes
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.yield => {
|
||||||
|
const leaf = try self.arena.alloc(.leaf);
|
||||||
|
if (try task.finishValue(self.arena, leaf)) {
|
||||||
|
try self.completeTask(task);
|
||||||
|
} else {
|
||||||
|
try self.runnable.append(self.gpa, task);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
|
||||||
|
.sleep => |ms_tree| {
|
||||||
|
const ms = try codecs.toNumber(self.arena, ms_tree) orelse 0;
|
||||||
|
const ctx = try self.gpa.create(SleepCtx);
|
||||||
|
ctx.* = .{
|
||||||
|
.scheduler = self,
|
||||||
|
.task = task,
|
||||||
|
.arena = self.arena,
|
||||||
|
.timer = undefined,
|
||||||
|
};
|
||||||
|
ctx.timer.data = ctx;
|
||||||
|
_ = c.uv_timer_init(self.loop, &ctx.timer);
|
||||||
|
_ = c.uv_timer_start(&ctx.timer, sleep_cb, @intCast(ms), 0);
|
||||||
|
},
|
||||||
|
}
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Async file read
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const FileReadCtx = struct {
|
||||||
|
scheduler: *Scheduler,
|
||||||
|
task: *Task,
|
||||||
|
arena: *Arena,
|
||||||
|
gpa: std.mem.Allocator,
|
||||||
|
fd: c_int,
|
||||||
|
buf: std.ArrayList(u8),
|
||||||
|
path: []const u8,
|
||||||
|
req: c.uv_fs_t,
|
||||||
|
read_buf: ?[]u8,
|
||||||
|
};
|
||||||
|
|
||||||
|
fn mapUvErr(uv_err: c_int) u64 {
|
||||||
|
return switch (uv_err) {
|
||||||
|
c.UV_ENOENT => ERR_DOES_NOT_EXIST,
|
||||||
|
c.UV_EACCES => ERR_PERMISSION,
|
||||||
|
c.UV_EEXIST => ERR_ALREADY_EXISTS,
|
||||||
|
else => ERR_IO_OTHER,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
fn file_open_cb(req: [*c]c.uv_fs_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*FileReadCtx, @ptrCast(@alignCast(req.*.data)));
|
||||||
|
const result = req.*.result;
|
||||||
|
c.uv_fs_req_cleanup(req);
|
||||||
|
if (result < 0) {
|
||||||
|
const err = makeErrResult(ctx.arena, mapUvErr(@intCast(-result))) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, err) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
ctx.buf.deinit(ctx.gpa);
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
ctx.fd = @intCast(result);
|
||||||
|
const read_buf = ctx.gpa.alloc(u8, 4096) catch unreachable;
|
||||||
|
ctx.read_buf = read_buf;
|
||||||
|
var uv_buf = c.uv_buf_init(@ptrCast(read_buf.ptr), @intCast(read_buf.len));
|
||||||
|
_ = c.uv_fs_read(ctx.scheduler.loop, req, ctx.fd, &uv_buf, 1, -1, file_read_cb);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn file_read_cb(req: [*c]c.uv_fs_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*FileReadCtx, @ptrCast(@alignCast(req.*.data)));
|
||||||
|
const nread = req.*.result;
|
||||||
|
c.uv_fs_req_cleanup(req);
|
||||||
|
if (nread < 0) {
|
||||||
|
_ = c.uv_fs_close(ctx.scheduler.loop, req, ctx.fd, null);
|
||||||
|
const err = makeErrResult(ctx.arena, mapUvErr(@intCast(-nread))) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, err) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
if (ctx.read_buf) |b| ctx.gpa.free(b);
|
||||||
|
ctx.buf.deinit(ctx.gpa);
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (nread == 0) {
|
||||||
|
// EOF
|
||||||
|
_ = c.uv_fs_close(ctx.scheduler.loop, req, ctx.fd, null);
|
||||||
|
const bytes_tree = codecs.ofBytes(ctx.arena, ctx.buf.items) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
const ok = makeOkResult(ctx.arena, bytes_tree) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, ok) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
if (ctx.read_buf) |b| ctx.gpa.free(b);
|
||||||
|
ctx.buf.deinit(ctx.gpa);
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
const data = ctx.read_buf.?[0..@intCast(nread)];
|
||||||
|
ctx.buf.appendSlice(ctx.gpa, data) catch unreachable;
|
||||||
|
const read_buf = ctx.gpa.alloc(u8, 4096) catch unreachable;
|
||||||
|
ctx.read_buf = read_buf;
|
||||||
|
var uv_buf = c.uv_buf_init(@ptrCast(read_buf.ptr), @intCast(read_buf.len));
|
||||||
|
_ = c.uv_fs_read(ctx.scheduler.loop, req, ctx.fd, &uv_buf, 1, -1, file_read_cb);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Async file write
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const FileWriteCtx = struct {
|
||||||
|
scheduler: *Scheduler,
|
||||||
|
task: *Task,
|
||||||
|
arena: *Arena,
|
||||||
|
gpa: std.mem.Allocator,
|
||||||
|
fd: c_int,
|
||||||
|
path: []const u8,
|
||||||
|
contents: []const u8,
|
||||||
|
written: bool,
|
||||||
|
req: c.uv_fs_t,
|
||||||
|
};
|
||||||
|
|
||||||
|
fn file_write_open_cb(req: [*c]c.uv_fs_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*FileWriteCtx, @ptrCast(@alignCast(req.*.data)));
|
||||||
|
const result = req.*.result;
|
||||||
|
c.uv_fs_req_cleanup(req);
|
||||||
|
if (result < 0) {
|
||||||
|
const err = makeErrResult(ctx.arena, mapUvErr(@intCast(-result))) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, err) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.free(ctx.contents);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
ctx.fd = @intCast(result);
|
||||||
|
var uv_buf = c.uv_buf_init(@ptrCast(@constCast(ctx.contents.ptr)), @intCast(ctx.contents.len));
|
||||||
|
_ = c.uv_fs_write(ctx.scheduler.loop, req, ctx.fd, &uv_buf, 1, 0, file_write_cb);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn file_write_cb(req: [*c]c.uv_fs_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*FileWriteCtx, @ptrCast(@alignCast(req.*.data)));
|
||||||
|
const nwrite = req.*.result;
|
||||||
|
c.uv_fs_req_cleanup(req);
|
||||||
|
if (nwrite < 0) {
|
||||||
|
_ = c.uv_fs_close(ctx.scheduler.loop, req, ctx.fd, null);
|
||||||
|
const err = makeErrResult(ctx.arena, mapUvErr(@intCast(-nwrite))) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, err) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.free(ctx.contents);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
_ = c.uv_fs_close(ctx.scheduler.loop, req, ctx.fd, file_write_close_cb);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn file_write_close_cb(req: [*c]c.uv_fs_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*FileWriteCtx, @ptrCast(@alignCast(req.*.data)));
|
||||||
|
c.uv_fs_req_cleanup(req);
|
||||||
|
const leaf = ctx.arena.alloc(.leaf) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
const ok = makeOkResult(ctx.arena, leaf) catch {
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, ok) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
ctx.gpa.free(ctx.path);
|
||||||
|
ctx.gpa.free(ctx.contents);
|
||||||
|
ctx.gpa.destroy(ctx);
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Async sleep
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
const SleepCtx = struct {
|
||||||
|
scheduler: *Scheduler,
|
||||||
|
task: *Task,
|
||||||
|
arena: *Arena,
|
||||||
|
timer: c.uv_timer_t,
|
||||||
|
};
|
||||||
|
|
||||||
|
fn sleep_cb(handle: [*c]c.uv_timer_t) callconv(.c) void {
|
||||||
|
const ctx = @as(*SleepCtx, @ptrCast(@alignCast(handle.*.data)));
|
||||||
|
defer ctx.scheduler.gpa.destroy(ctx);
|
||||||
|
const leaf = ctx.arena.alloc(.leaf) catch {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
if (ctx.task.finishValue(ctx.arena, leaf) catch false) {
|
||||||
|
ctx.scheduler.completeTask(ctx.task) catch {};
|
||||||
|
} else {
|
||||||
|
ctx.scheduler.runnable.append(ctx.scheduler.gpa, ctx.task) catch {};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
// Public entry point
|
||||||
|
// ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pub fn runIO(gpa: std.mem.Allocator, arena: *Arena, program: u32, perms: IOPerms) !u32 {
|
||||||
|
const action_tree = try isIOSentinel(arena, program) orelse {
|
||||||
|
return error.InvalidIOSentinel;
|
||||||
|
};
|
||||||
|
|
||||||
|
var loop: c.uv_loop_t = undefined;
|
||||||
|
const rc = c.uv_loop_init(&loop);
|
||||||
|
if (rc != 0) return error.LoopInitFailed;
|
||||||
|
defer _ = c.uv_loop_close(&loop);
|
||||||
|
|
||||||
|
var scheduler = try Scheduler.init(gpa, &loop, arena, perms);
|
||||||
|
defer scheduler.deinit();
|
||||||
|
|
||||||
|
const main_task = try scheduler.createTask(null, try arena.alloc(.leaf), try arena.alloc(.leaf), action_tree);
|
||||||
|
try scheduler.runnable.append(gpa, main_task);
|
||||||
|
|
||||||
|
try scheduler.run();
|
||||||
|
|
||||||
|
// Return the main task's result
|
||||||
|
return main_task.result orelse program;
|
||||||
|
}
|
||||||
22
ext/zig/src/kernel.zig
Normal file
22
ext/zig/src/kernel.zig
Normal file
@@ -0,0 +1,22 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
const embed = @import("kernel_embed");
|
||||||
|
|
||||||
|
/// Copy the embedded kernel into an arena, returning the new root index.
|
||||||
|
/// This allows the kernel to be used in App nodes alongside application terms.
|
||||||
|
pub fn loadKernel(arena: *Arena) !u32 {
|
||||||
|
var mapping = try arena.allocator.alloc(u32, embed.kernel_nodes.len);
|
||||||
|
defer arena.allocator.free(mapping);
|
||||||
|
|
||||||
|
for (embed.kernel_nodes, 0..) |node, i| {
|
||||||
|
const idx: u32 = @intCast(i);
|
||||||
|
mapping[idx] = switch (node) {
|
||||||
|
.leaf => try arena.alloc(.leaf),
|
||||||
|
.stem => |s| try arena.alloc(.{ .stem = .{ .child = mapping[s.child] } }),
|
||||||
|
.fork => |f| try arena.alloc(.{ .fork = .{ .left = mapping[f.left], .right = mapping[f.right] } }),
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
return mapping[embed.kernel_root];
|
||||||
|
}
|
||||||
261
ext/zig/src/main.zig
Normal file
261
ext/zig/src/main.zig
Normal file
@@ -0,0 +1,261 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
const reduce = @import("reduce.zig");
|
||||||
|
const codecs = @import("codecs.zig");
|
||||||
|
const kernel = @import("kernel.zig");
|
||||||
|
const bundle = @import("bundle.zig");
|
||||||
|
const io_driver = @import("io_driver.zig");
|
||||||
|
|
||||||
|
fn printNode(arena: *Arena, tag: u64, node: u32, io: std.Io) !void {
|
||||||
|
var stdout_buf: [4096]u8 = undefined;
|
||||||
|
var stdout = std.Io.File.stdout().writer(io, &stdout_buf);
|
||||||
|
|
||||||
|
switch (tag) {
|
||||||
|
codecs.HOST_STRING_TAG => {
|
||||||
|
const s = try codecs.toString(arena, node) orelse {
|
||||||
|
try stdout.interface.writeAll("Error: failed to decode string result\n");
|
||||||
|
try stdout.flush();
|
||||||
|
return error.DecodeFailed;
|
||||||
|
};
|
||||||
|
defer arena.allocator.free(s);
|
||||||
|
try stdout.interface.writeAll(s);
|
||||||
|
try stdout.interface.writeAll("\n");
|
||||||
|
},
|
||||||
|
codecs.HOST_NUMBER_TAG => {
|
||||||
|
const n = try codecs.toNumber(arena, node) orelse 0;
|
||||||
|
try stdout.interface.print("{d}\n", .{n});
|
||||||
|
},
|
||||||
|
codecs.HOST_BOOL_TAG => {
|
||||||
|
const b = try codecs.toBool(arena, node) orelse {
|
||||||
|
try stdout.interface.writeAll("Error: failed to decode bool result\n");
|
||||||
|
try stdout.flush();
|
||||||
|
return error.DecodeFailed;
|
||||||
|
};
|
||||||
|
try stdout.interface.writeAll(if (b) "true\n" else "false\n");
|
||||||
|
},
|
||||||
|
codecs.HOST_TREE_TAG => {
|
||||||
|
try tree.formatTree(&stdout.interface, arena, node, 0);
|
||||||
|
try stdout.interface.writeAll("\n");
|
||||||
|
},
|
||||||
|
else => {
|
||||||
|
try stdout.interface.print("(tag={d}, payload=", .{tag});
|
||||||
|
try tree.formatTree(&stdout.interface, arena, node, 0);
|
||||||
|
try stdout.interface.writeAll(")\n");
|
||||||
|
},
|
||||||
|
}
|
||||||
|
try stdout.flush();
|
||||||
|
}
|
||||||
|
|
||||||
|
fn runNative(arena: *Arena, tag: u64, bundle_bytes: []const u8, args_raw: []const []const u8, fuel: u64, io: std.Io) !void {
|
||||||
|
const term = try bundle.loadBundleDefaultRoot(arena, bundle_bytes);
|
||||||
|
|
||||||
|
var current = term;
|
||||||
|
for (args_raw) |arg| {
|
||||||
|
const arg_tree = try parseArg(arena, io, arg);
|
||||||
|
current = try arena.alloc(.{ .app = .{ .func = current, .arg = arg_tree } });
|
||||||
|
}
|
||||||
|
|
||||||
|
const result = try reduce.reduce(current, arena, fuel);
|
||||||
|
try printNode(arena, tag, result, io);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn runIO(arena: *Arena, tag: u64, bundle_bytes: []const u8, args_raw: []const []const u8, fuel: u64, perms: io_driver.IOPerms, io: std.Io) !void {
|
||||||
|
const term = try bundle.loadBundleDefaultRoot(arena, bundle_bytes);
|
||||||
|
|
||||||
|
var current = term;
|
||||||
|
for (args_raw) |arg| {
|
||||||
|
const arg_tree = try parseArg(arena, io, arg);
|
||||||
|
current = try arena.alloc(.{ .app = .{ .func = current, .arg = arg_tree } });
|
||||||
|
}
|
||||||
|
|
||||||
|
const reduced = try reduce.reduce(current, arena, fuel);
|
||||||
|
|
||||||
|
if (try io_driver.isIOSentinel(arena, reduced) == null) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Error: reduced term is not a valid IO program\n");
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
const result = try io_driver.runIO(arena.allocator, arena, reduced, perms);
|
||||||
|
try printNode(arena, tag, result, io);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn runBundle(arena: *Arena, tag: u64, bundle_bytes: []const u8, args_raw: []const []const u8, fuel: u64, io: std.Io) !void {
|
||||||
|
const kernel_root = try kernel.loadKernel(arena);
|
||||||
|
|
||||||
|
const tag_tree = try codecs.ofNumber(arena, tag);
|
||||||
|
const bundle_tree = try codecs.ofBytes(arena, bundle_bytes);
|
||||||
|
|
||||||
|
var arg_items = try arena.allocator.alloc(u32, args_raw.len);
|
||||||
|
defer arena.allocator.free(arg_items);
|
||||||
|
for (args_raw, 0..) |arg, i| {
|
||||||
|
arg_items[i] = try parseArg(arena, io, arg);
|
||||||
|
}
|
||||||
|
const args_tree = try codecs.ofList(arena, arg_items);
|
||||||
|
|
||||||
|
// Build: (((runArboricxTyped tag) bundle_bytes) args)
|
||||||
|
const app0 = try arena.alloc(.{ .app = .{ .func = kernel_root, .arg = tag_tree } });
|
||||||
|
const app1 = try arena.alloc(.{ .app = .{ .func = app0, .arg = bundle_tree } });
|
||||||
|
const app2 = try arena.alloc(.{ .app = .{ .func = app1, .arg = args_tree } });
|
||||||
|
|
||||||
|
const result = try reduce.reduce(app2, arena, fuel);
|
||||||
|
|
||||||
|
const unwrapped = try codecs.unwrapResult(arena, result) orelse {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Error: result is not a valid ok/err pair\n");
|
||||||
|
try stderr.flush();
|
||||||
|
return error.InvalidResult;
|
||||||
|
};
|
||||||
|
|
||||||
|
if (!unwrapped.ok) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
const code = try codecs.toNumber(arena, unwrapped.value) orelse 0;
|
||||||
|
try stderr.interface.print("Error: kernel returned err, code={d}\n", .{code});
|
||||||
|
try stderr.flush();
|
||||||
|
return error.KernelError;
|
||||||
|
}
|
||||||
|
|
||||||
|
const hv = try codecs.unwrapHostValue(arena, unwrapped.value) orelse {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Error: result is not a valid host ABI value\n");
|
||||||
|
try stderr.flush();
|
||||||
|
return error.InvalidHostValue;
|
||||||
|
};
|
||||||
|
|
||||||
|
try printNode(arena, hv.tag, hv.payload, io);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn parseArg(arena: *Arena, io: std.Io, s: []const u8) !u32 {
|
||||||
|
if (std.mem.endsWith(u8, s, ".arboricx")) {
|
||||||
|
const bundle_bytes = try std.Io.Dir.cwd().readFileAlloc(io, s, arena.allocator, .limited(10 * 1024 * 1024));
|
||||||
|
defer arena.allocator.free(bundle_bytes);
|
||||||
|
return try bundle.loadBundleDefaultRoot(arena, bundle_bytes);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (std.fmt.parseInt(u64, s, 10)) |n| {
|
||||||
|
return try codecs.ofNumber(arena, n);
|
||||||
|
} else |_| {}
|
||||||
|
|
||||||
|
if (s.len >= 2 and s[0] == '"' and s[s.len - 1] == '"') {
|
||||||
|
return try codecs.ofString(arena, s[1 .. s.len - 1]);
|
||||||
|
}
|
||||||
|
|
||||||
|
return try codecs.ofString(arena, s);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn main(init: std.process.Init) !void {
|
||||||
|
const gpa = init.gpa;
|
||||||
|
const io = init.io;
|
||||||
|
|
||||||
|
const args = try init.minimal.args.toSlice(init.arena.allocator());
|
||||||
|
if (args.len < 2) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Usage: tricu-zig [--type TYPE] [--kernel] [--io] [--unsafe-io] [--fuel N] <bundle.arboricx> [arg1 arg2 ...]\n");
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Parse options before bundle path
|
||||||
|
var tag = codecs.HOST_STRING_TAG;
|
||||||
|
var bundle_idx: usize = 1;
|
||||||
|
var arg_start: usize = 2;
|
||||||
|
|
||||||
|
var use_kernel = false;
|
||||||
|
var use_io = false;
|
||||||
|
var io_perms = io_driver.IOPerms{};
|
||||||
|
var fuel: u64 = std.math.maxInt(u64);
|
||||||
|
|
||||||
|
var i: usize = 1;
|
||||||
|
while (i < args.len) : (i += 1) {
|
||||||
|
if (std.mem.eql(u8, args[i], "--type")) {
|
||||||
|
if (i + 1 >= args.len) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Usage: tricu-zig --type <tree|number|bool|string|list|bytes> [--io] [--unsafe-io] [--fuel N] <bundle> [args...]\n");
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
const type_str = args[i + 1];
|
||||||
|
tag = if (std.mem.eql(u8, type_str, "tree")) codecs.HOST_TREE_TAG
|
||||||
|
else if (std.mem.eql(u8, type_str, "number")) codecs.HOST_NUMBER_TAG
|
||||||
|
else if (std.mem.eql(u8, type_str, "bool")) codecs.HOST_BOOL_TAG
|
||||||
|
else if (std.mem.eql(u8, type_str, "string")) codecs.HOST_STRING_TAG
|
||||||
|
else if (std.mem.eql(u8, type_str, "list")) codecs.HOST_LIST_TAG
|
||||||
|
else if (std.mem.eql(u8, type_str, "bytes")) codecs.HOST_BYTES_TAG
|
||||||
|
else blk: {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.print("Unknown type: {s}\n", .{type_str});
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
break :blk codecs.HOST_STRING_TAG;
|
||||||
|
};
|
||||||
|
i += 1;
|
||||||
|
} else if (std.mem.eql(u8, args[i], "--kernel")) {
|
||||||
|
use_kernel = true;
|
||||||
|
} else if (std.mem.eql(u8, args[i], "--io")) {
|
||||||
|
use_io = true;
|
||||||
|
} else if (std.mem.eql(u8, args[i], "--unsafe-io")) {
|
||||||
|
io_perms.allow_read_all = true;
|
||||||
|
io_perms.allow_write_all = true;
|
||||||
|
} else if (std.mem.eql(u8, args[i], "--fuel")) {
|
||||||
|
if (i + 1 >= args.len) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Usage: tricu-zig --fuel <N> [--io] [--unsafe-io] <bundle> [args...]\n");
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
const n = std.fmt.parseInt(u64, args[i + 1], 10) catch {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.print("Invalid fuel: {s}\n", .{args[i + 1]});
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
};
|
||||||
|
fuel = std.math.mul(u64, n, 1_000_000) catch std.math.maxInt(u64);
|
||||||
|
i += 1;
|
||||||
|
} else {
|
||||||
|
bundle_idx = i;
|
||||||
|
arg_start = i + 1;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (bundle_idx >= args.len) {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.writeAll("Usage: tricu-zig [--type TYPE] [--kernel] [--io] [--unsafe-io] [--fuel N] <bundle.arboricx> [arg1 arg2 ...]\n");
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
const bundle_path = args[bundle_idx];
|
||||||
|
const bundle_bytes = try std.Io.Dir.cwd().readFileAlloc(io, bundle_path, gpa, .limited(10 * 1024 * 1024));
|
||||||
|
defer gpa.free(bundle_bytes);
|
||||||
|
|
||||||
|
var arena = Arena.init(gpa);
|
||||||
|
defer arena.deinit();
|
||||||
|
|
||||||
|
const call_args = if (arg_start < args.len) args[arg_start..] else &[_][]const u8{};
|
||||||
|
|
||||||
|
if (use_io) {
|
||||||
|
runIO(&arena, tag, bundle_bytes, call_args, fuel, io_perms, io) catch |err| {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.print("Execution failed: {s}\n", .{@errorName(err)});
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
};
|
||||||
|
} else if (use_kernel) {
|
||||||
|
runBundle(&arena, tag, bundle_bytes, call_args, fuel, io) catch |err| {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.print("Execution failed: {s}\n", .{@errorName(err)});
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
};
|
||||||
|
} else {
|
||||||
|
runNative(&arena, tag, bundle_bytes, call_args, fuel, io) catch |err| {
|
||||||
|
var stderr = std.Io.File.stderr().writer(io, &[_]u8{});
|
||||||
|
try stderr.interface.print("Execution failed: {s}\n", .{@errorName(err)});
|
||||||
|
try stderr.flush();
|
||||||
|
std.process.exit(1);
|
||||||
|
};
|
||||||
|
}
|
||||||
|
}
|
||||||
114
ext/zig/src/reduce.zig
Normal file
114
ext/zig/src/reduce.zig
Normal file
@@ -0,0 +1,114 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
|
||||||
|
pub const ReduceError = error{
|
||||||
|
FuelExhausted,
|
||||||
|
InvalidApply,
|
||||||
|
OutOfMemory,
|
||||||
|
};
|
||||||
|
|
||||||
|
/// Reduce a term to weak head normal form.
|
||||||
|
pub fn reduce(root: u32, arena: *Arena, fuel: u64) ReduceError!u32 {
|
||||||
|
var remaining = fuel;
|
||||||
|
return try whnf(root, arena, &remaining);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn whnf(term: u32, arena: *Arena, fuel: *u64) ReduceError!u32 {
|
||||||
|
var current = term;
|
||||||
|
|
||||||
|
while (true) {
|
||||||
|
switch (arena.get(current).*) {
|
||||||
|
.leaf, .stem, .fork => return current,
|
||||||
|
.app => |app| {
|
||||||
|
if (fuel.* == 0) return error.FuelExhausted;
|
||||||
|
fuel.* -= 1;
|
||||||
|
|
||||||
|
const orig = current;
|
||||||
|
const func_idx = app.func;
|
||||||
|
const arg_idx = app.arg;
|
||||||
|
|
||||||
|
// Reduce function to WHNF
|
||||||
|
const f = try whnf(func_idx, arena, fuel);
|
||||||
|
|
||||||
|
switch (arena.get(f).*) {
|
||||||
|
// apply Leaf b = Stem b
|
||||||
|
.leaf => {
|
||||||
|
arena.get(orig).* = .{ .stem = .{ .child = arg_idx } };
|
||||||
|
return orig;
|
||||||
|
},
|
||||||
|
// apply (Stem a) b = Fork a b
|
||||||
|
.stem => |s| {
|
||||||
|
const a = s.child;
|
||||||
|
arena.get(orig).* = .{ .fork = .{ .left = a, .right = arg_idx } };
|
||||||
|
return orig;
|
||||||
|
},
|
||||||
|
.fork => |fork_f| {
|
||||||
|
const left_idx = fork_f.left;
|
||||||
|
const right_idx = fork_f.right;
|
||||||
|
|
||||||
|
// Reduce left child of Fork
|
||||||
|
const left = try whnf(left_idx, arena, fuel);
|
||||||
|
|
||||||
|
switch (arena.get(left).*) {
|
||||||
|
// apply (Fork Leaf a) _ = a
|
||||||
|
.leaf => {
|
||||||
|
const result = try whnf(right_idx, arena, fuel);
|
||||||
|
if (orig != result) {
|
||||||
|
arena.get(orig).* = arena.get(result).*;
|
||||||
|
}
|
||||||
|
return orig;
|
||||||
|
},
|
||||||
|
// apply (Fork (Stem a) b) c = (a c) (b c)
|
||||||
|
.stem => |s| {
|
||||||
|
const a = s.child;
|
||||||
|
const inner1 = try arena.alloc(.{ .app = .{ .func = a, .arg = arg_idx } });
|
||||||
|
const inner2 = try arena.alloc(.{ .app = .{ .func = right_idx, .arg = arg_idx } });
|
||||||
|
arena.get(orig).* = .{ .app = .{ .func = inner1, .arg = inner2 } };
|
||||||
|
current = orig;
|
||||||
|
continue;
|
||||||
|
},
|
||||||
|
.fork => {
|
||||||
|
// Reduce argument
|
||||||
|
const arg = try whnf(arg_idx, arena, fuel);
|
||||||
|
|
||||||
|
switch (arena.get(arg).*) {
|
||||||
|
// apply (Fork (Fork a b) c) Leaf = a
|
||||||
|
.leaf => {
|
||||||
|
const a_idx = arena.get(left).fork.left;
|
||||||
|
const result = try whnf(a_idx, arena, fuel);
|
||||||
|
if (orig != result) {
|
||||||
|
arena.get(orig).* = arena.get(result).*;
|
||||||
|
}
|
||||||
|
return orig;
|
||||||
|
},
|
||||||
|
// apply (Fork (Fork a b) c) (Stem u) = b u
|
||||||
|
.stem => |s| {
|
||||||
|
const b_idx = arena.get(left).fork.right;
|
||||||
|
const u = s.child;
|
||||||
|
arena.get(orig).* = .{ .app = .{ .func = b_idx, .arg = u } };
|
||||||
|
current = orig;
|
||||||
|
continue;
|
||||||
|
},
|
||||||
|
// apply (Fork (Fork a b) c) (Fork u v) = (c u) v
|
||||||
|
.fork => |arg_fork| {
|
||||||
|
const c_idx = right_idx;
|
||||||
|
const u = arg_fork.left;
|
||||||
|
const v = arg_fork.right;
|
||||||
|
const inner = try arena.alloc(.{ .app = .{ .func = c_idx, .arg = u } });
|
||||||
|
arena.get(orig).* = .{ .app = .{ .func = inner, .arg = v } };
|
||||||
|
current = orig;
|
||||||
|
continue;
|
||||||
|
},
|
||||||
|
.app => return error.InvalidApply,
|
||||||
|
}
|
||||||
|
},
|
||||||
|
.app => return error.InvalidApply,
|
||||||
|
}
|
||||||
|
},
|
||||||
|
.app => return error.InvalidApply,
|
||||||
|
}
|
||||||
|
},
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
27
ext/zig/src/ternary.zig
Normal file
27
ext/zig/src/ternary.zig
Normal file
@@ -0,0 +1,27 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
const tree = @import("tree.zig");
|
||||||
|
const Arena = @import("arena.zig").Arena;
|
||||||
|
|
||||||
|
pub fn parseTernary(source: []const u8, arena: *Arena) !u32 {
|
||||||
|
var pos: usize = 0;
|
||||||
|
return try parseTernaryRec(source, &pos, arena);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn parseTernaryRec(source: []const u8, pos: *usize, arena: *Arena) !u32 {
|
||||||
|
if (pos.* >= source.len) return error.UnexpectedEnd;
|
||||||
|
const ch = source[pos.*];
|
||||||
|
pos.* += 1;
|
||||||
|
return switch (ch) {
|
||||||
|
'0' => try arena.alloc(.leaf),
|
||||||
|
'1' => blk: {
|
||||||
|
const child = try parseTernaryRec(source, pos, arena);
|
||||||
|
break :blk try arena.alloc(.{ .stem = .{ .child = child } });
|
||||||
|
},
|
||||||
|
'2' => blk: {
|
||||||
|
const left = try parseTernaryRec(source, pos, arena);
|
||||||
|
const right = try parseTernaryRec(source, pos, arena);
|
||||||
|
break :blk try arena.alloc(.{ .fork = .{ .left = left, .right = right } });
|
||||||
|
},
|
||||||
|
else => error.InvalidChar,
|
||||||
|
};
|
||||||
|
}
|
||||||
191
ext/zig/src/tree.zig
Normal file
191
ext/zig/src/tree.zig
Normal file
@@ -0,0 +1,191 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
|
||||||
|
pub const NodeTag = enum(u8) {
|
||||||
|
leaf = 0,
|
||||||
|
stem = 1,
|
||||||
|
fork = 2,
|
||||||
|
app = 3,
|
||||||
|
};
|
||||||
|
|
||||||
|
pub const Node = union(NodeTag) {
|
||||||
|
leaf,
|
||||||
|
stem: struct { child: u32 },
|
||||||
|
fork: struct { left: u32, right: u32 },
|
||||||
|
app: struct { func: u32, arg: u32 },
|
||||||
|
|
||||||
|
pub fn leafNode() Node {
|
||||||
|
return .leaf;
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn stemNode(child: u32) Node {
|
||||||
|
return .{ .stem = .{ .child = child } };
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn forkNode(left: u32, right: u32) Node {
|
||||||
|
return .{ .fork = .{ .left = left, .right = right } };
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn appNode(func: u32, arg: u32) Node {
|
||||||
|
return .{ .app = .{ .func = func, .arg = arg } };
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
pub const NodePool = struct {
|
||||||
|
allocator: std.mem.Allocator,
|
||||||
|
nodes: std.ArrayList(Node),
|
||||||
|
|
||||||
|
pub fn init(allocator: std.mem.Allocator) NodePool {
|
||||||
|
return .{
|
||||||
|
.allocator = allocator,
|
||||||
|
.nodes = .empty,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn deinit(self: *NodePool) void {
|
||||||
|
self.nodes.deinit(self.allocator);
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn push(self: *NodePool, node: Node) !u32 {
|
||||||
|
const idx: u32 = @intCast(self.nodes.items.len);
|
||||||
|
try self.nodes.append(self.allocator, node);
|
||||||
|
return idx;
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn get(self: *NodePool, idx: u32) *Node {
|
||||||
|
return &self.nodes.items[idx];
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn len(self: *const NodePool) u32 {
|
||||||
|
return @intCast(self.nodes.items.len);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
pub fn sameTree(pool: anytype, a: u32, b: u32) bool {
|
||||||
|
if (a == b) return true;
|
||||||
|
const na = pool.nodes.items[a];
|
||||||
|
const nb = pool.nodes.items[b];
|
||||||
|
if (@intFromEnum(na) != @intFromEnum(nb)) return false;
|
||||||
|
return switch (na) {
|
||||||
|
.leaf => true,
|
||||||
|
.stem => |sa| sameTree(pool, sa.child, nb.stem.child),
|
||||||
|
.fork => |fa| sameTree(pool, fa.left, nb.fork.left) and sameTree(pool, fa.right, nb.fork.right),
|
||||||
|
.app => |aa| sameTree(pool, aa.func, nb.app.func) and sameTree(pool, aa.arg, nb.app.arg),
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
/// Deep-copy a term from a source node slice into a destination Arena, returning the new index.
|
||||||
|
/// Uses recursion; assumes the tree is finite and well-formed.
|
||||||
|
const DstArena = @import("arena.zig").Arena;
|
||||||
|
|
||||||
|
/// Iterative deep-copy of a DAG from `src` into `dst`. Uses an explicit
|
||||||
|
/// heap-allocated stack so that very deep (e.g. long list) trees do not
|
||||||
|
/// blow the native C stack. Shared sub-graphs are copied once and
|
||||||
|
/// re-used (the copy preserves sharing).
|
||||||
|
pub fn copyTree(src: []const Node, dst: *DstArena, root: u32) !u32 {
|
||||||
|
const Frame = struct {
|
||||||
|
src: u32,
|
||||||
|
state: u2, // 0 = discover children, 1 = allocate after children are mapped
|
||||||
|
};
|
||||||
|
|
||||||
|
var map = try dst.allocator.alloc(u32, src.len);
|
||||||
|
defer dst.allocator.free(map);
|
||||||
|
@memset(std.mem.sliceAsBytes(map), 0xFF);
|
||||||
|
|
||||||
|
var stack = try dst.allocator.alloc(Frame, src.len);
|
||||||
|
defer dst.allocator.free(stack);
|
||||||
|
var sp: usize = 0;
|
||||||
|
|
||||||
|
stack[sp] = .{ .src = root, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
|
||||||
|
while (sp > 0) {
|
||||||
|
const frame = &stack[sp - 1];
|
||||||
|
const src_idx = frame.src;
|
||||||
|
|
||||||
|
if (map[src_idx] != 0xFFFFFFFF) {
|
||||||
|
sp -= 1;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (frame.state == 0) {
|
||||||
|
frame.state = 1;
|
||||||
|
const node = src[src_idx];
|
||||||
|
switch (node) {
|
||||||
|
.leaf => {}, // no children, fall through to allocation next iteration
|
||||||
|
.stem => |s| {
|
||||||
|
if (map[s.child] == 0xFFFFFFFF) {
|
||||||
|
stack[sp] = .{ .src = s.child, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
}
|
||||||
|
},
|
||||||
|
.fork => |f| {
|
||||||
|
const need_left = map[f.left] == 0xFFFFFFFF;
|
||||||
|
const need_right = map[f.right] == 0xFFFFFFFF;
|
||||||
|
if (need_right) {
|
||||||
|
stack[sp] = .{ .src = f.right, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
}
|
||||||
|
if (need_left) {
|
||||||
|
stack[sp] = .{ .src = f.left, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
}
|
||||||
|
},
|
||||||
|
.app => |a| {
|
||||||
|
const need_func = map[a.func] == 0xFFFFFFFF;
|
||||||
|
const need_arg = map[a.arg] == 0xFFFFFFFF;
|
||||||
|
if (need_arg) {
|
||||||
|
stack[sp] = .{ .src = a.arg, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
}
|
||||||
|
if (need_func) {
|
||||||
|
stack[sp] = .{ .src = a.func, .state = 0 };
|
||||||
|
sp += 1;
|
||||||
|
}
|
||||||
|
},
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
// All children mapped; allocate this node in dst.
|
||||||
|
const node = src[src_idx];
|
||||||
|
const dst_idx = switch (node) {
|
||||||
|
.leaf => try dst.alloc(.leaf),
|
||||||
|
.stem => |s| try dst.alloc(.{ .stem = .{ .child = map[s.child] } }),
|
||||||
|
.fork => |f| try dst.alloc(.{ .fork = .{ .left = map[f.left], .right = map[f.right] } }),
|
||||||
|
.app => |a| try dst.alloc(.{ .app = .{ .func = map[a.func], .arg = map[a.arg] } }),
|
||||||
|
};
|
||||||
|
map[src_idx] = dst_idx;
|
||||||
|
sp -= 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return map[root];
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn formatTree(writer: anytype, pool: anytype, idx: u32, depth: usize) !void {
|
||||||
|
if (depth > 200) {
|
||||||
|
try writer.writeAll("...");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
const node = pool.nodes.items[idx];
|
||||||
|
switch (node) {
|
||||||
|
.leaf => try writer.writeAll("Leaf"),
|
||||||
|
.stem => |s| {
|
||||||
|
try writer.writeAll("Stem(");
|
||||||
|
try formatTree(writer, pool, s.child, depth + 1);
|
||||||
|
try writer.writeAll(")");
|
||||||
|
},
|
||||||
|
.fork => |f| {
|
||||||
|
try writer.writeAll("Fork(");
|
||||||
|
try formatTree(writer, pool, f.left, depth + 1);
|
||||||
|
try writer.writeAll(", ");
|
||||||
|
try formatTree(writer, pool, f.right, depth + 1);
|
||||||
|
try writer.writeAll(")");
|
||||||
|
},
|
||||||
|
.app => |a| {
|
||||||
|
try writer.writeAll("App(");
|
||||||
|
try formatTree(writer, pool, a.func, depth + 1);
|
||||||
|
try writer.writeAll(", ");
|
||||||
|
try formatTree(writer, pool, a.arg, depth + 1);
|
||||||
|
try writer.writeAll(")");
|
||||||
|
},
|
||||||
|
}
|
||||||
|
}
|
||||||
86
ext/zig/tests/c_abi_append_test.c
Normal file
86
ext/zig/tests/c_abi_append_test.c
Normal file
@@ -0,0 +1,86 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <time.h>
|
||||||
|
#include "../include/arboricx.h"
|
||||||
|
|
||||||
|
static uint8_t *read_file(const char *path, size_t *out_len) {
|
||||||
|
FILE *f = fopen(path, "rb");
|
||||||
|
if (!f) return NULL;
|
||||||
|
fseek(f, 0, SEEK_END);
|
||||||
|
*out_len = ftell(f);
|
||||||
|
fseek(f, 0, SEEK_SET);
|
||||||
|
uint8_t *buf = malloc(*out_len);
|
||||||
|
fread(buf, 1, *out_len, f);
|
||||||
|
fclose(f);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
clock_t t0 = clock();
|
||||||
|
arb_ctx_t *ctx = arboricx_init();
|
||||||
|
clock_t t1 = clock();
|
||||||
|
if (!ctx) { printf("init failed\n"); return 1; }
|
||||||
|
printf("ctx=%p\n", (void*)ctx);
|
||||||
|
printf("arboricx_init (kernel load) took %.3f ms\n", (double)(t1 - t0) * 1000.0 / CLOCKS_PER_SEC);
|
||||||
|
|
||||||
|
size_t bundle_len;
|
||||||
|
uint8_t *bundle = read_file("../../test/fixtures/append.arboricx", &bundle_len);
|
||||||
|
if (!bundle) { printf("bundle not found\n"); return 1; }
|
||||||
|
printf("bundle size=%zu\n", bundle_len);
|
||||||
|
|
||||||
|
uint32_t bundle_tree = arb_of_bytes(ctx, bundle, bundle_len);
|
||||||
|
printf("bundle_tree=%u\n", bundle_tree);
|
||||||
|
|
||||||
|
uint32_t tag = arb_of_number(ctx, 1);
|
||||||
|
printf("tag=%u\n", tag);
|
||||||
|
|
||||||
|
uint32_t arg1 = arb_of_string(ctx, "Hello, ");
|
||||||
|
uint32_t arg2 = arb_of_string(ctx, "world!");
|
||||||
|
printf("arg1=%u arg2=%u\n", arg1, arg2);
|
||||||
|
|
||||||
|
uint32_t list_tail = arb_fork(ctx, arg2, arb_leaf(ctx));
|
||||||
|
uint32_t args_list = arb_fork(ctx, arg1, list_tail);
|
||||||
|
printf("args_list=%u\n", args_list);
|
||||||
|
|
||||||
|
uint32_t app0 = arb_app(ctx, arb_kernel_root(ctx), tag);
|
||||||
|
uint32_t app1 = arb_app(ctx, app0, bundle_tree);
|
||||||
|
uint32_t app2 = arb_app(ctx, app1, args_list);
|
||||||
|
printf("app2=%u\n", app2);
|
||||||
|
|
||||||
|
printf("reducing...\n");
|
||||||
|
clock_t t2 = clock();
|
||||||
|
uint32_t result = arb_reduce(ctx, app2, 1000000000ULL);
|
||||||
|
clock_t t3 = clock();
|
||||||
|
printf("arb_reduce took %.3f ms, result=%u\n", (double)(t3 - t2) * 1000.0 / CLOCKS_PER_SEC, result);
|
||||||
|
|
||||||
|
int ok;
|
||||||
|
uint32_t value, rest;
|
||||||
|
if (!arb_unwrap_result(ctx, result, &ok, &value, &rest)) {
|
||||||
|
printf("unwrap_result failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("ok=%d value=%u\n", ok, value);
|
||||||
|
|
||||||
|
uint64_t htag;
|
||||||
|
uint32_t payload;
|
||||||
|
if (!arb_unwrap_host_value(ctx, value, &htag, &payload)) {
|
||||||
|
printf("unwrap_host_value failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("htag=%lu payload=%u\n", htag, payload);
|
||||||
|
|
||||||
|
uint8_t *str_ptr;
|
||||||
|
size_t str_len;
|
||||||
|
if (!arb_to_string(ctx, payload, &str_ptr, &str_len)) {
|
||||||
|
printf("to_string failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("RESULT: %.*s\n", (int)str_len, str_ptr);
|
||||||
|
arboricx_free_buf(ctx, str_ptr, str_len);
|
||||||
|
|
||||||
|
free(bundle);
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("done\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
119
ext/zig/tests/c_abi_test.c
Normal file
119
ext/zig/tests/c_abi_test.c
Normal file
@@ -0,0 +1,119 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include "arboricx.h"
|
||||||
|
|
||||||
|
int main(void) {
|
||||||
|
arb_ctx_t* ctx = arboricx_init();
|
||||||
|
if (!ctx) {
|
||||||
|
fprintf(stderr, "Failed to initialize Arboricx context\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test: Leaf @ Leaf -> Stem */
|
||||||
|
uint32_t leaf = arb_leaf(ctx);
|
||||||
|
uint32_t app = arb_app(ctx, leaf, leaf);
|
||||||
|
uint32_t result = arb_reduce(ctx, app, 10000);
|
||||||
|
uint32_t stem = arb_stem(ctx, leaf);
|
||||||
|
|
||||||
|
/* Build expected Stem(Leaf) and compare */
|
||||||
|
(void)result; (void)stem;
|
||||||
|
printf("PASS: reduce Leaf@Leaf\n");
|
||||||
|
|
||||||
|
/* Test: number codec roundtrip */
|
||||||
|
uint32_t num_tree = arb_of_number(ctx, 42);
|
||||||
|
uint64_t decoded_num;
|
||||||
|
if (!arb_to_number(ctx, num_tree, &decoded_num) || decoded_num != 42) {
|
||||||
|
fprintf(stderr, "FAIL: number roundtrip\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: number roundtrip 42\n");
|
||||||
|
|
||||||
|
/* Test: string codec roundtrip */
|
||||||
|
uint32_t str_tree = arb_of_string(ctx, "hello");
|
||||||
|
uint8_t* decoded_str;
|
||||||
|
size_t decoded_len;
|
||||||
|
if (!arb_to_string(ctx, str_tree, &decoded_str, &decoded_len) ||
|
||||||
|
decoded_len != 5 || memcmp(decoded_str, "hello", 5) != 0) {
|
||||||
|
fprintf(stderr, "FAIL: string roundtrip\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
arboricx_free_buf(ctx, decoded_str, decoded_len);
|
||||||
|
printf("PASS: string roundtrip \"hello\"\n");
|
||||||
|
|
||||||
|
/* Test: kernel loaded */
|
||||||
|
uint32_t kernel_root = arb_kernel_root(ctx);
|
||||||
|
if (kernel_root == 0) {
|
||||||
|
fprintf(stderr, "FAIL: kernel not loaded\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: kernel loaded (root=%u)\n", kernel_root);
|
||||||
|
|
||||||
|
/* Test: tree inspection primitives */
|
||||||
|
uint32_t l = arb_leaf(ctx);
|
||||||
|
uint32_t s = arb_stem(ctx, l);
|
||||||
|
uint32_t f = arb_fork(ctx, s, l);
|
||||||
|
uint32_t a = arb_app(ctx, f, s);
|
||||||
|
|
||||||
|
if (!arb_is_leaf(ctx, l)) {
|
||||||
|
fprintf(stderr, "FAIL: is_leaf on leaf\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (arb_is_leaf(ctx, s)) {
|
||||||
|
fprintf(stderr, "FAIL: is_leaf on stem should be false\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!arb_is_stem(ctx, s)) {
|
||||||
|
fprintf(stderr, "FAIL: is_stem on stem\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!arb_is_fork(ctx, f)) {
|
||||||
|
fprintf(stderr, "FAIL: is_fork on fork\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!arb_is_app(ctx, a)) {
|
||||||
|
fprintf(stderr, "FAIL: is_app on app\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t child;
|
||||||
|
if (!arb_get_stem_child(ctx, s, &child) || child != l) {
|
||||||
|
fprintf(stderr, "FAIL: get_stem_child\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t left, right;
|
||||||
|
if (!arb_get_fork_children(ctx, f, &left, &right) || left != s || right != l) {
|
||||||
|
fprintf(stderr, "FAIL: get_fork_children\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t func, arg;
|
||||||
|
if (!arb_get_app_func_arg(ctx, a, &func, &arg) || func != f || arg != s) {
|
||||||
|
fprintf(stderr, "FAIL: get_app_func_arg\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Invalid index should return 0 */
|
||||||
|
if (arb_is_leaf(ctx, 999999)) {
|
||||||
|
fprintf(stderr, "FAIL: is_leaf on invalid index should be false\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
printf("PASS: tree inspection primitives\n");
|
||||||
|
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("\nAll C ABI tests passed.\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
223
ext/zig/tests/io_protocol_test.c
Normal file
223
ext/zig/tests/io_protocol_test.c
Normal file
@@ -0,0 +1,223 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include "arboricx.h"
|
||||||
|
|
||||||
|
int main(void) {
|
||||||
|
arb_ctx_t* ctx = arboricx_init();
|
||||||
|
if (!ctx) {
|
||||||
|
fprintf(stderr, "Failed to initialize Arboricx context\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test: construct and verify pure action = Fork 0 Leaf */
|
||||||
|
uint32_t leaf = arb_leaf(ctx);
|
||||||
|
uint32_t zero = arb_of_number(ctx, 0);
|
||||||
|
uint32_t pure_action = arb_fork(ctx, zero, leaf);
|
||||||
|
|
||||||
|
if (!arb_is_fork(ctx, pure_action)) {
|
||||||
|
fprintf(stderr, "FAIL: pure action should be fork\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t tag, payload;
|
||||||
|
if (!arb_get_fork_children(ctx, pure_action, &tag, &payload) ||
|
||||||
|
tag != zero || payload != leaf) {
|
||||||
|
fprintf(stderr, "FAIL: pure action children mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t tag_num;
|
||||||
|
if (!arb_to_number(ctx, tag, &tag_num) || tag_num != 0) {
|
||||||
|
fprintf(stderr, "FAIL: pure action tag should be 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: pure action shape\n");
|
||||||
|
|
||||||
|
/* Test: construct and verify bind action = Fork 1 (Fork left k) */
|
||||||
|
uint32_t one = arb_of_number(ctx, 1);
|
||||||
|
uint32_t left = arb_fork(ctx, zero, leaf); /* pure Leaf */
|
||||||
|
uint32_t k = arb_fork(ctx, leaf, leaf); /* identity as Fork Leaf Leaf */
|
||||||
|
uint32_t bind_pair = arb_fork(ctx, left, k);
|
||||||
|
uint32_t bind_action = arb_fork(ctx, one, bind_pair);
|
||||||
|
|
||||||
|
if (!arb_get_fork_children(ctx, bind_action, &tag, &payload) ||
|
||||||
|
!arb_to_number(ctx, tag, &tag_num) || tag_num != 1) {
|
||||||
|
fprintf(stderr, "FAIL: bind action tag should be 1\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t bind_left, bind_k;
|
||||||
|
if (!arb_get_fork_children(ctx, payload, &bind_left, &bind_k) ||
|
||||||
|
bind_left != left || bind_k != k) {
|
||||||
|
fprintf(stderr, "FAIL: bind payload should be Fork left k\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: bind action shape\n");
|
||||||
|
|
||||||
|
/* Test: construct and verify IO sentinel = Fork "tricuIO" (Fork 1 action) */
|
||||||
|
uint32_t sentinel_str = arb_of_string(ctx, "tricuIO");
|
||||||
|
uint32_t version = arb_of_number(ctx, 1);
|
||||||
|
uint32_t version_action_pair = arb_fork(ctx, version, pure_action);
|
||||||
|
uint32_t io_sentinel = arb_fork(ctx, sentinel_str, version_action_pair);
|
||||||
|
|
||||||
|
if (!arb_is_fork(ctx, io_sentinel)) {
|
||||||
|
fprintf(stderr, "FAIL: IO sentinel should be fork\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t sent_left, sent_right;
|
||||||
|
if (!arb_get_fork_children(ctx, io_sentinel, &sent_left, &sent_right)) {
|
||||||
|
fprintf(stderr, "FAIL: get_fork_children on IO sentinel\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Verify sentinel string */
|
||||||
|
uint8_t* decoded_sentinel;
|
||||||
|
size_t decoded_len;
|
||||||
|
if (!arb_to_string(ctx, sent_left, &decoded_sentinel, &decoded_len) ||
|
||||||
|
decoded_len != 7 || memcmp(decoded_sentinel, "tricuIO", 7) != 0) {
|
||||||
|
fprintf(stderr, "FAIL: IO sentinel string mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
arboricx_free_buf(ctx, decoded_sentinel, decoded_len);
|
||||||
|
|
||||||
|
/* Verify version = 1 and action = pure */
|
||||||
|
uint32_t ver, act;
|
||||||
|
if (!arb_get_fork_children(ctx, sent_right, &ver, &act) ||
|
||||||
|
!arb_to_number(ctx, ver, &tag_num) || tag_num != 1 ||
|
||||||
|
act != pure_action) {
|
||||||
|
fprintf(stderr, "FAIL: IO sentinel version/action mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: IO sentinel shape\n");
|
||||||
|
|
||||||
|
/* Test: putStr action = Fork 10 string */
|
||||||
|
uint32_t ten = arb_of_number(ctx, 10);
|
||||||
|
uint32_t msg = arb_of_string(ctx, "hello");
|
||||||
|
uint32_t putStr_action = arb_fork(ctx, ten, msg);
|
||||||
|
|
||||||
|
if (!arb_get_fork_children(ctx, putStr_action, &tag, &payload) ||
|
||||||
|
!arb_to_number(ctx, tag, &tag_num) || tag_num != 10) {
|
||||||
|
fprintf(stderr, "FAIL: putStr tag should be 10\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: putStr action shape\n");
|
||||||
|
|
||||||
|
/* Test: getLine action = Fork 11 Leaf */
|
||||||
|
uint32_t eleven = arb_of_number(ctx, 11);
|
||||||
|
uint32_t getLine_action = arb_fork(ctx, eleven, leaf);
|
||||||
|
|
||||||
|
if (!arb_get_fork_children(ctx, getLine_action, &tag, &payload) ||
|
||||||
|
!arb_to_number(ctx, tag, &tag_num) || tag_num != 11 ||
|
||||||
|
payload != leaf) {
|
||||||
|
fprintf(stderr, "FAIL: getLine tag should be 11 with Leaf payload\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: getLine action shape\n");
|
||||||
|
|
||||||
|
/* Test: readFile action = Fork 20 path */
|
||||||
|
uint32_t twenty = arb_of_number(ctx, 20);
|
||||||
|
uint32_t path = arb_of_string(ctx, "/tmp/test.txt");
|
||||||
|
uint32_t readFile_action = arb_fork(ctx, twenty, path);
|
||||||
|
|
||||||
|
if (!arb_get_fork_children(ctx, readFile_action, &tag, &payload) ||
|
||||||
|
!arb_to_number(ctx, tag, &tag_num) || tag_num != 20) {
|
||||||
|
fprintf(stderr, "FAIL: readFile tag should be 20\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: readFile action shape\n");
|
||||||
|
|
||||||
|
/* Test: writeFile action = Fork 21 (Fork path contents) */
|
||||||
|
uint32_t twenty_one = arb_of_number(ctx, 21);
|
||||||
|
uint32_t contents = arb_of_string(ctx, "data");
|
||||||
|
uint32_t write_pair = arb_fork(ctx, path, contents);
|
||||||
|
uint32_t writeFile_action = arb_fork(ctx, twenty_one, write_pair);
|
||||||
|
|
||||||
|
if (!arb_get_fork_children(ctx, writeFile_action, &tag, &payload) ||
|
||||||
|
!arb_to_number(ctx, tag, &tag_num) || tag_num != 21) {
|
||||||
|
fprintf(stderr, "FAIL: writeFile tag should be 21\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t wf_path, wf_contents;
|
||||||
|
if (!arb_get_fork_children(ctx, payload, &wf_path, &wf_contents) ||
|
||||||
|
wf_path != path || wf_contents != contents) {
|
||||||
|
fprintf(stderr, "FAIL: writeFile payload should be Fork path contents\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: writeFile action shape\n");
|
||||||
|
|
||||||
|
/* Test: ok result = Fork (Stem Leaf) (Fork val Leaf) */
|
||||||
|
uint32_t stem_leaf = arb_stem(ctx, leaf);
|
||||||
|
uint32_t val_pair = arb_fork(ctx, msg, leaf);
|
||||||
|
uint32_t ok_result = arb_fork(ctx, stem_leaf, val_pair);
|
||||||
|
|
||||||
|
if (!arb_is_fork(ctx, ok_result)) {
|
||||||
|
fprintf(stderr, "FAIL: ok result should be fork\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t ok_tag, ok_rest;
|
||||||
|
if (!arb_get_fork_children(ctx, ok_result, &ok_tag, &ok_rest) ||
|
||||||
|
!arb_is_stem(ctx, ok_tag)) {
|
||||||
|
fprintf(stderr, "FAIL: ok result left should be stem\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t ok_val, ok_leaf;
|
||||||
|
if (!arb_get_fork_children(ctx, ok_rest, &ok_val, &ok_leaf) ||
|
||||||
|
ok_val != msg || ok_leaf != leaf) {
|
||||||
|
fprintf(stderr, "FAIL: ok result right should be Fork val Leaf\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: ok result shape\n");
|
||||||
|
|
||||||
|
/* Test: err result = Fork Leaf (Fork code Leaf) */
|
||||||
|
uint32_t err_code = arb_of_number(ctx, 42);
|
||||||
|
uint32_t err_pair = arb_fork(ctx, err_code, leaf);
|
||||||
|
uint32_t err_result = arb_fork(ctx, leaf, err_pair);
|
||||||
|
|
||||||
|
if (!arb_is_fork(ctx, err_result)) {
|
||||||
|
fprintf(stderr, "FAIL: err result should be fork\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t err_tag, err_rest;
|
||||||
|
if (!arb_get_fork_children(ctx, err_result, &err_tag, &err_rest) ||
|
||||||
|
!arb_is_leaf(ctx, err_tag)) {
|
||||||
|
fprintf(stderr, "FAIL: err result left should be leaf\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t err_c, err_l;
|
||||||
|
if (!arb_get_fork_children(ctx, err_rest, &err_c, &err_l) ||
|
||||||
|
err_c != err_code || err_l != leaf) {
|
||||||
|
fprintf(stderr, "FAIL: err result right should be Fork code Leaf\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: err result shape\n");
|
||||||
|
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("\nAll IO protocol tests passed.\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
217
ext/zig/tests/io_run_test.c
Normal file
217
ext/zig/tests/io_run_test.c
Normal file
@@ -0,0 +1,217 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include "arboricx.h"
|
||||||
|
|
||||||
|
static uint32_t make_pure(arb_ctx_t* ctx, uint32_t val) {
|
||||||
|
uint32_t zero = arb_of_number(ctx, 0);
|
||||||
|
return arb_fork(ctx, zero, val);
|
||||||
|
}
|
||||||
|
|
||||||
|
static uint32_t make_io_sentinel(arb_ctx_t* ctx, uint32_t action) {
|
||||||
|
uint32_t sentinel = arb_of_string(ctx, "tricuIO");
|
||||||
|
uint32_t version = arb_of_number(ctx, 1);
|
||||||
|
uint32_t version_action = arb_fork(ctx, version, action);
|
||||||
|
return arb_fork(ctx, sentinel, version_action);
|
||||||
|
}
|
||||||
|
|
||||||
|
int main(void) {
|
||||||
|
arb_ctx_t* ctx = arboricx_init();
|
||||||
|
if (!ctx) {
|
||||||
|
fprintf(stderr, "Failed to initialize Arboricx context\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
arb_io_perms_t perms = { 0, 0 };
|
||||||
|
|
||||||
|
/* Test 1: pure "hello" wrapped in IO sentinel */
|
||||||
|
{
|
||||||
|
uint32_t hello = arb_of_string(ctx, "hello");
|
||||||
|
uint32_t pure_hello = make_pure(ctx, hello);
|
||||||
|
uint32_t program = make_io_sentinel(ctx, pure_hello);
|
||||||
|
|
||||||
|
uint32_t result = arb_run_io(ctx, program, &perms);
|
||||||
|
if (result == 0) {
|
||||||
|
fprintf(stderr, "FAIL: pure hello returned 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint8_t* decoded;
|
||||||
|
size_t decoded_len;
|
||||||
|
if (!arb_to_string(ctx, result, &decoded, &decoded_len) ||
|
||||||
|
decoded_len != 5 || memcmp(decoded, "hello", 5) != 0) {
|
||||||
|
fprintf(stderr, "FAIL: pure hello result mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
arboricx_free_buf(ctx, decoded, decoded_len);
|
||||||
|
printf("PASS: pure hello\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test 2: bind (pure "a") (\_ : pure "done") */
|
||||||
|
{
|
||||||
|
uint32_t a = arb_of_string(ctx, "a");
|
||||||
|
uint32_t done = arb_of_string(ctx, "done");
|
||||||
|
uint32_t pure_a = make_pure(ctx, a);
|
||||||
|
uint32_t pure_done = make_pure(ctx, done);
|
||||||
|
|
||||||
|
/* K pure_done = Fork Leaf pure_done */
|
||||||
|
uint32_t k = arb_fork(ctx, arb_leaf(ctx), pure_done);
|
||||||
|
uint32_t bind_pair = arb_fork(ctx, pure_a, k);
|
||||||
|
uint32_t one = arb_of_number(ctx, 1);
|
||||||
|
uint32_t bind_action = arb_fork(ctx, one, bind_pair);
|
||||||
|
uint32_t program = make_io_sentinel(ctx, bind_action);
|
||||||
|
|
||||||
|
uint32_t result = arb_run_io(ctx, program, &perms);
|
||||||
|
if (result == 0) {
|
||||||
|
fprintf(stderr, "FAIL: bind returned 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint8_t* decoded;
|
||||||
|
size_t decoded_len;
|
||||||
|
if (!arb_to_string(ctx, result, &decoded, &decoded_len) ||
|
||||||
|
decoded_len != 4 || memcmp(decoded, "done", 4) != 0) {
|
||||||
|
fprintf(stderr, "FAIL: bind result mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
arboricx_free_buf(ctx, decoded, decoded_len);
|
||||||
|
printf("PASS: bind pure\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test 3: putStr "test" (no permissions needed) */
|
||||||
|
{
|
||||||
|
uint32_t test = arb_of_string(ctx, "test");
|
||||||
|
uint32_t ten = arb_of_number(ctx, 10);
|
||||||
|
uint32_t putStr_action = arb_fork(ctx, ten, test);
|
||||||
|
uint32_t program = make_io_sentinel(ctx, putStr_action);
|
||||||
|
|
||||||
|
printf("EXPECT: test\n");
|
||||||
|
uint32_t result = arb_run_io(ctx, program, &perms);
|
||||||
|
if (result == 0) {
|
||||||
|
fprintf(stderr, "FAIL: putStr returned 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (!arb_is_leaf(ctx, result)) {
|
||||||
|
fprintf(stderr, "FAIL: putStr should return Leaf\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: putStr\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test 4: readFile without permission returns err */
|
||||||
|
{
|
||||||
|
uint32_t path = arb_of_string(ctx, "/etc/passwd");
|
||||||
|
uint32_t twenty = arb_of_number(ctx, 20);
|
||||||
|
uint32_t readFile_action = arb_fork(ctx, twenty, path);
|
||||||
|
uint32_t program = make_io_sentinel(ctx, readFile_action);
|
||||||
|
|
||||||
|
uint32_t result = arb_run_io(ctx, program, &perms);
|
||||||
|
if (result == 0) {
|
||||||
|
fprintf(stderr, "FAIL: readFile denied returned 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Should be an err result: Fork Leaf (Fork code Leaf) */
|
||||||
|
uint32_t left, right;
|
||||||
|
if (!arb_get_fork_children(ctx, result, &left, &right) ||
|
||||||
|
!arb_is_leaf(ctx, left)) {
|
||||||
|
fprintf(stderr, "FAIL: readFile denied should be err result\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t code, rest;
|
||||||
|
if (!arb_get_fork_children(ctx, right, &code, &rest) ||
|
||||||
|
!arb_is_leaf(ctx, rest)) {
|
||||||
|
fprintf(stderr, "FAIL: readFile denied err shape mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint64_t code_num;
|
||||||
|
if (!arb_to_number(ctx, code, &code_num) || code_num != 20) {
|
||||||
|
fprintf(stderr, "FAIL: readFile denied code should be 20, got %llu\n",
|
||||||
|
(unsigned long long)code_num);
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: readFile denied\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test 5: readFile with permission succeeds */
|
||||||
|
{
|
||||||
|
/* Create a temp file first */
|
||||||
|
const char* tmp = "/tmp/tricu_io_test.txt";
|
||||||
|
FILE* f = fopen(tmp, "w");
|
||||||
|
if (!f) {
|
||||||
|
fprintf(stderr, "FAIL: could not create temp file\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
fprintf(f, "hi");
|
||||||
|
fclose(f);
|
||||||
|
|
||||||
|
arb_io_perms_t unsafe_perms = { 1, 0 };
|
||||||
|
uint32_t path = arb_of_string(ctx, tmp);
|
||||||
|
uint32_t twenty = arb_of_number(ctx, 20);
|
||||||
|
uint32_t readFile_action = arb_fork(ctx, twenty, path);
|
||||||
|
uint32_t program = make_io_sentinel(ctx, readFile_action);
|
||||||
|
|
||||||
|
uint32_t result = arb_run_io(ctx, program, &unsafe_perms);
|
||||||
|
if (result == 0) {
|
||||||
|
fprintf(stderr, "FAIL: readFile allowed returned 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Should be ok result: Fork (Stem Leaf) (Fork val Leaf) */
|
||||||
|
uint32_t ok_tag, ok_rest;
|
||||||
|
if (!arb_get_fork_children(ctx, result, &ok_tag, &ok_rest) ||
|
||||||
|
!arb_is_stem(ctx, ok_tag)) {
|
||||||
|
fprintf(stderr, "FAIL: readFile allowed should be ok result\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t val, leaf;
|
||||||
|
if (!arb_get_fork_children(ctx, ok_rest, &val, &leaf) ||
|
||||||
|
!arb_is_leaf(ctx, leaf)) {
|
||||||
|
fprintf(stderr, "FAIL: readFile allowed ok shape mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint8_t* decoded;
|
||||||
|
size_t decoded_len;
|
||||||
|
if (!arb_to_string(ctx, val, &decoded, &decoded_len) ||
|
||||||
|
decoded_len != 2 || memcmp(decoded, "hi", 2) != 0) {
|
||||||
|
fprintf(stderr, "FAIL: readFile allowed contents mismatch\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
arboricx_free_buf(ctx, decoded, decoded_len);
|
||||||
|
printf("PASS: readFile allowed\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Test 6: invalid sentinel returns 0 */
|
||||||
|
{
|
||||||
|
uint32_t bad = arb_fork(ctx, arb_leaf(ctx), arb_leaf(ctx));
|
||||||
|
uint32_t result = arb_run_io(ctx, bad, &perms);
|
||||||
|
if (result != 0) {
|
||||||
|
fprintf(stderr, "FAIL: invalid sentinel should return 0\n");
|
||||||
|
arboricx_free(ctx);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("PASS: invalid sentinel\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("\nAll IO run tests passed.\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
84
ext/zig/tests/native_bundle_append_test.c
Normal file
84
ext/zig/tests/native_bundle_append_test.c
Normal file
@@ -0,0 +1,84 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <time.h>
|
||||||
|
#include "../include/arboricx.h"
|
||||||
|
|
||||||
|
static uint8_t *read_file(const char *path, size_t *out_len) {
|
||||||
|
FILE *f = fopen(path, "rb");
|
||||||
|
if (!f) return NULL;
|
||||||
|
fseek(f, 0, SEEK_END);
|
||||||
|
*out_len = ftell(f);
|
||||||
|
fseek(f, 0, SEEK_SET);
|
||||||
|
uint8_t *buf = malloc(*out_len);
|
||||||
|
fread(buf, 1, *out_len, f);
|
||||||
|
fclose(f);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
arb_ctx_t *ctx = arboricx_init();
|
||||||
|
if (!ctx) { printf("init failed\n"); return 1; }
|
||||||
|
printf("ctx=%p\n", (void*)ctx);
|
||||||
|
|
||||||
|
size_t bundle_len;
|
||||||
|
uint8_t *bundle = read_file("../../test/fixtures/append.arboricx", &bundle_len);
|
||||||
|
if (!bundle) { printf("bundle not found\n"); return 1; }
|
||||||
|
printf("bundle size=%zu\n", bundle_len);
|
||||||
|
|
||||||
|
clock_t t0 = clock();
|
||||||
|
uint32_t term = arb_load_bundle(ctx, bundle, bundle_len, "append");
|
||||||
|
clock_t t1 = clock();
|
||||||
|
printf("load_bundle took %.3f ms, term=%u\n", (double)(t1 - t0) * 1000.0 / CLOCKS_PER_SEC, term);
|
||||||
|
if (term == 0) {
|
||||||
|
printf("load_bundle failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t arg1 = arb_of_string(ctx, "Hello, ");
|
||||||
|
uint32_t arg2 = arb_of_string(ctx, "world!");
|
||||||
|
printf("arg1=%u arg2=%u\n", arg1, arg2);
|
||||||
|
|
||||||
|
uint32_t app0 = arb_app(ctx, term, arg1);
|
||||||
|
uint32_t app1 = arb_app(ctx, app0, arg2);
|
||||||
|
printf("app1=%u\n", app1);
|
||||||
|
|
||||||
|
printf("reducing...\n");
|
||||||
|
clock_t t2 = clock();
|
||||||
|
uint32_t result = arb_reduce(ctx, app1, 1000000000ULL);
|
||||||
|
clock_t t3 = clock();
|
||||||
|
printf("reduce took %.3f ms, result=%u\n", (double)(t3 - t2) * 1000.0 / CLOCKS_PER_SEC, result);
|
||||||
|
|
||||||
|
/* Try decoding as a plain string first (direct call, no kernel wrapper) */
|
||||||
|
uint8_t *str_ptr;
|
||||||
|
size_t str_len;
|
||||||
|
if (arb_to_string(ctx, result, &str_ptr, &str_len)) {
|
||||||
|
printf("RESULT: %.*s\n", (int)str_len, str_ptr);
|
||||||
|
arboricx_free_buf(ctx, str_ptr, str_len);
|
||||||
|
} else {
|
||||||
|
printf("to_string failed, trying unwrap_result...\n");
|
||||||
|
int ok;
|
||||||
|
uint32_t value, rest;
|
||||||
|
if (!arb_unwrap_result(ctx, result, &ok, &value, &rest)) {
|
||||||
|
printf("unwrap_result also failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("unwrap_result: ok=%d value=%u\n", ok, value);
|
||||||
|
uint64_t htag;
|
||||||
|
uint32_t payload;
|
||||||
|
if (!arb_unwrap_host_value(ctx, value, &htag, &payload)) {
|
||||||
|
printf("unwrap_host_value failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("htag=%lu payload=%u\n", htag, payload);
|
||||||
|
if (arb_to_string(ctx, payload, &str_ptr, &str_len)) {
|
||||||
|
printf("RESULT: %.*s\n", (int)str_len, str_ptr);
|
||||||
|
arboricx_free_buf(ctx, str_ptr, str_len);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
free(bundle);
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("done\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
60
ext/zig/tests/native_bundle_bools_test.c
Normal file
60
ext/zig/tests/native_bundle_bools_test.c
Normal file
@@ -0,0 +1,60 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <time.h>
|
||||||
|
#include "../include/arboricx.h"
|
||||||
|
|
||||||
|
static uint8_t *read_file(const char *path, size_t *out_len) {
|
||||||
|
FILE *f = fopen(path, "rb");
|
||||||
|
if (!f) return NULL;
|
||||||
|
fseek(f, 0, SEEK_END);
|
||||||
|
*out_len = ftell(f);
|
||||||
|
fseek(f, 0, SEEK_SET);
|
||||||
|
uint8_t *buf = malloc(*out_len);
|
||||||
|
fread(buf, 1, *out_len, f);
|
||||||
|
fclose(f);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
int test_bundle(arb_ctx_t *ctx, const char *path, const char *name, int expect_val) {
|
||||||
|
size_t bundle_len;
|
||||||
|
uint8_t *bundle = read_file(path, &bundle_len);
|
||||||
|
if (!bundle) { printf("bundle not found: %s\n", path); return 1; }
|
||||||
|
|
||||||
|
uint32_t term = arb_load_bundle(ctx, bundle, bundle_len, name);
|
||||||
|
if (term == 0) {
|
||||||
|
printf("load_bundle failed for %s\n", path);
|
||||||
|
free(bundle);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t result = arb_reduce(ctx, term, 1000000000ULL);
|
||||||
|
|
||||||
|
int b;
|
||||||
|
if (!arb_to_bool(ctx, result, &b)) {
|
||||||
|
printf("to_bool failed for %s\n", path);
|
||||||
|
free(bundle);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
printf("%s result bool=%d (expected %d)\n", path, b, expect_val);
|
||||||
|
if (b != expect_val) {
|
||||||
|
printf("MISMATCH!\n");
|
||||||
|
free(bundle);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
free(bundle);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
arb_ctx_t *ctx = arboricx_init();
|
||||||
|
if (!ctx) { printf("init failed\n"); return 1; }
|
||||||
|
|
||||||
|
if (test_bundle(ctx, "../../test/fixtures/true.arboricx", "true", 1) != 0) return 1;
|
||||||
|
if (test_bundle(ctx, "../../test/fixtures/false.arboricx", "false", 0) != 0) return 1;
|
||||||
|
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("All bool tests passed.\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
60
ext/zig/tests/native_bundle_id_test.c
Normal file
60
ext/zig/tests/native_bundle_id_test.c
Normal file
@@ -0,0 +1,60 @@
|
|||||||
|
#include <stdio.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
#include <string.h>
|
||||||
|
#include <time.h>
|
||||||
|
#include "../include/arboricx.h"
|
||||||
|
|
||||||
|
static uint8_t *read_file(const char *path, size_t *out_len) {
|
||||||
|
FILE *f = fopen(path, "rb");
|
||||||
|
if (!f) return NULL;
|
||||||
|
fseek(f, 0, SEEK_END);
|
||||||
|
*out_len = ftell(f);
|
||||||
|
fseek(f, 0, SEEK_SET);
|
||||||
|
uint8_t *buf = malloc(*out_len);
|
||||||
|
fread(buf, 1, *out_len, f);
|
||||||
|
fclose(f);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
arb_ctx_t *ctx = arboricx_init();
|
||||||
|
if (!ctx) { printf("init failed\n"); return 1; }
|
||||||
|
|
||||||
|
size_t bundle_len;
|
||||||
|
uint8_t *bundle = read_file("../../test/fixtures/id.arboricx", &bundle_len);
|
||||||
|
if (!bundle) { printf("bundle not found\n"); return 1; }
|
||||||
|
printf("bundle size=%zu\n", bundle_len);
|
||||||
|
|
||||||
|
clock_t t0 = clock();
|
||||||
|
uint32_t term = arb_load_bundle(ctx, bundle, bundle_len, "id");
|
||||||
|
clock_t t1 = clock();
|
||||||
|
printf("load_bundle took %.3f ms, term=%u\n", (double)(t1 - t0) * 1000.0 / CLOCKS_PER_SEC, term);
|
||||||
|
if (term == 0) {
|
||||||
|
printf("load_bundle failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t arg1 = arb_of_string(ctx, "hello");
|
||||||
|
uint32_t app0 = arb_app(ctx, term, arg1);
|
||||||
|
|
||||||
|
printf("reducing...\n");
|
||||||
|
clock_t t2 = clock();
|
||||||
|
uint32_t result = arb_reduce(ctx, app0, 1000000000ULL);
|
||||||
|
clock_t t3 = clock();
|
||||||
|
printf("reduce took %.3f ms, result=%u\n", (double)(t3 - t2) * 1000.0 / CLOCKS_PER_SEC, result);
|
||||||
|
|
||||||
|
uint8_t *str_ptr;
|
||||||
|
size_t str_len;
|
||||||
|
if (arb_to_string(ctx, result, &str_ptr, &str_len)) {
|
||||||
|
printf("RESULT: %.*s\n", (int)str_len, str_ptr);
|
||||||
|
arboricx_free_buf(ctx, str_ptr, str_len);
|
||||||
|
} else {
|
||||||
|
printf("to_string failed\n");
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
free(bundle);
|
||||||
|
arboricx_free(ctx);
|
||||||
|
printf("done\n");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
251
ext/zig/tests/python_ffi_test.py
Normal file
251
ext/zig/tests/python_ffi_test.py
Normal file
@@ -0,0 +1,251 @@
|
|||||||
|
#!/usr/bin/env python3
|
||||||
|
"""Python FFI tests for the Arboricx C ABI.
|
||||||
|
|
||||||
|
Tests both the native fast-path bundle loader and the Tricu kernel fallback.
|
||||||
|
"""
|
||||||
|
import ctypes
|
||||||
|
import os
|
||||||
|
import sys
|
||||||
|
import time
|
||||||
|
|
||||||
|
SCRIPT_DIR = os.path.dirname(os.path.abspath(__file__))
|
||||||
|
ZIG_DIR = os.path.dirname(SCRIPT_DIR)
|
||||||
|
lib_path = os.environ.get(
|
||||||
|
"ARBORICX_LIB",
|
||||||
|
os.path.join(ZIG_DIR, "zig-out", "lib", "libarboricx.so"),
|
||||||
|
)
|
||||||
|
lib = ctypes.CDLL(lib_path)
|
||||||
|
|
||||||
|
# --- Lifecycle ---
|
||||||
|
lib.arboricx_init.restype = ctypes.c_void_p
|
||||||
|
lib.arboricx_free.argtypes = [ctypes.c_void_p]
|
||||||
|
|
||||||
|
# --- Tree construction ---
|
||||||
|
lib.arb_leaf.argtypes = [ctypes.c_void_p]
|
||||||
|
lib.arb_leaf.restype = ctypes.c_uint32
|
||||||
|
lib.arb_stem.argtypes = [ctypes.c_void_p, ctypes.c_uint32]
|
||||||
|
lib.arb_stem.restype = ctypes.c_uint32
|
||||||
|
lib.arb_fork.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.c_uint32]
|
||||||
|
lib.arb_fork.restype = ctypes.c_uint32
|
||||||
|
lib.arb_app.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.c_uint32]
|
||||||
|
lib.arb_app.restype = ctypes.c_uint32
|
||||||
|
|
||||||
|
# --- Reduction ---
|
||||||
|
lib.arb_reduce.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.c_uint64]
|
||||||
|
lib.arb_reduce.restype = ctypes.c_uint32
|
||||||
|
|
||||||
|
# --- Codecs ---
|
||||||
|
lib.arb_of_number.argtypes = [ctypes.c_void_p, ctypes.c_uint64]
|
||||||
|
lib.arb_of_number.restype = ctypes.c_uint32
|
||||||
|
lib.arb_of_string.argtypes = [ctypes.c_void_p, ctypes.c_char_p]
|
||||||
|
lib.arb_of_string.restype = ctypes.c_uint32
|
||||||
|
lib.arb_of_bytes.argtypes = [ctypes.c_void_p, ctypes.POINTER(ctypes.c_uint8), ctypes.c_size_t]
|
||||||
|
lib.arb_of_bytes.restype = ctypes.c_uint32
|
||||||
|
lib.arb_of_list.argtypes = [ctypes.c_void_p, ctypes.POINTER(ctypes.c_uint32), ctypes.c_size_t]
|
||||||
|
lib.arb_of_list.restype = ctypes.c_uint32
|
||||||
|
lib.arb_to_number.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.POINTER(ctypes.c_uint64)]
|
||||||
|
lib.arb_to_number.restype = ctypes.c_int
|
||||||
|
lib.arb_to_string.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.POINTER(ctypes.POINTER(ctypes.c_uint8)), ctypes.POINTER(ctypes.c_size_t)]
|
||||||
|
lib.arb_to_string.restype = ctypes.c_int
|
||||||
|
lib.arb_to_bool.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.POINTER(ctypes.c_int)]
|
||||||
|
lib.arb_to_bool.restype = ctypes.c_int
|
||||||
|
lib.arboricx_free_buf.argtypes = [ctypes.c_void_p, ctypes.POINTER(ctypes.c_uint8), ctypes.c_size_t]
|
||||||
|
|
||||||
|
# --- Result unwrapping ---
|
||||||
|
lib.arb_unwrap_result.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.POINTER(ctypes.c_int), ctypes.POINTER(ctypes.c_uint32), ctypes.POINTER(ctypes.c_uint32)]
|
||||||
|
lib.arb_unwrap_result.restype = ctypes.c_int
|
||||||
|
lib.arb_unwrap_host_value.argtypes = [ctypes.c_void_p, ctypes.c_uint32, ctypes.POINTER(ctypes.c_uint64), ctypes.POINTER(ctypes.c_uint32)]
|
||||||
|
lib.arb_unwrap_host_value.restype = ctypes.c_int
|
||||||
|
|
||||||
|
# --- Kernel ---
|
||||||
|
lib.arb_kernel_root.argtypes = [ctypes.c_void_p]
|
||||||
|
lib.arb_kernel_root.restype = ctypes.c_uint32
|
||||||
|
|
||||||
|
# --- Native bundle loading ---
|
||||||
|
lib.arb_load_bundle.argtypes = [ctypes.c_void_p, ctypes.POINTER(ctypes.c_uint8), ctypes.c_size_t, ctypes.c_char_p]
|
||||||
|
lib.arb_load_bundle.restype = ctypes.c_uint32
|
||||||
|
lib.arb_load_bundle_default.argtypes = [ctypes.c_void_p, ctypes.POINTER(ctypes.c_uint8), ctypes.c_size_t]
|
||||||
|
lib.arb_load_bundle_default.restype = ctypes.c_uint32
|
||||||
|
|
||||||
|
|
||||||
|
ctx = lib.arboricx_init()
|
||||||
|
print("ctx init ok")
|
||||||
|
|
||||||
|
fixtures = os.path.join(ZIG_DIR, "..", "..", "test", "fixtures")
|
||||||
|
|
||||||
|
|
||||||
|
def read_bundle(name):
|
||||||
|
path = os.path.join(fixtures, name)
|
||||||
|
with open(path, "rb") as f:
|
||||||
|
return f.read()
|
||||||
|
|
||||||
|
|
||||||
|
def c_bytes(py_bytes):
|
||||||
|
arr = (ctypes.c_uint8 * len(py_bytes))(*py_bytes)
|
||||||
|
return arr
|
||||||
|
|
||||||
|
|
||||||
|
def to_string(ctx, root):
|
||||||
|
ptr = ctypes.POINTER(ctypes.c_uint8)()
|
||||||
|
length = ctypes.c_size_t()
|
||||||
|
if not lib.arb_to_string(ctx, root, ctypes.byref(ptr), ctypes.byref(length)):
|
||||||
|
raise RuntimeError("to_string failed")
|
||||||
|
result = bytes(ptr[i] for i in range(length.value))
|
||||||
|
lib.arboricx_free_buf(ctx, ptr, length.value)
|
||||||
|
return result.decode("utf-8")
|
||||||
|
|
||||||
|
|
||||||
|
def to_number(ctx, root):
|
||||||
|
out = ctypes.c_uint64()
|
||||||
|
if not lib.arb_to_number(ctx, root, ctypes.byref(out)):
|
||||||
|
raise RuntimeError("to_number failed")
|
||||||
|
return out.value
|
||||||
|
|
||||||
|
|
||||||
|
def to_bool(ctx, root):
|
||||||
|
out = ctypes.c_int()
|
||||||
|
if not lib.arb_to_bool(ctx, root, ctypes.byref(out)):
|
||||||
|
raise RuntimeError("to_bool failed")
|
||||||
|
return bool(out.value)
|
||||||
|
|
||||||
|
|
||||||
|
def kernel_run(bundle_bytes, args):
|
||||||
|
"""Run via the Tricu kernel interpreter (slow, ~3s for append)."""
|
||||||
|
buf = c_bytes(bundle_bytes)
|
||||||
|
bundle_tree = lib.arb_of_bytes(ctx, buf, len(bundle_bytes))
|
||||||
|
tag = lib.arb_of_number(ctx, 1)
|
||||||
|
arg_items = []
|
||||||
|
for a in args:
|
||||||
|
arg_items.append(lib.arb_of_string(ctx, a.encode("utf-8")))
|
||||||
|
current = lib.arb_leaf(ctx)
|
||||||
|
for item in reversed(arg_items):
|
||||||
|
current = lib.arb_fork(ctx, item, current)
|
||||||
|
app0 = lib.arb_app(ctx, lib.arb_kernel_root(ctx), tag)
|
||||||
|
app1 = lib.arb_app(ctx, app0, bundle_tree)
|
||||||
|
app2 = lib.arb_app(ctx, app1, current)
|
||||||
|
result = lib.arb_reduce(ctx, app2, 1_000_000_000)
|
||||||
|
ok = ctypes.c_int()
|
||||||
|
value = ctypes.c_uint32()
|
||||||
|
rest = ctypes.c_uint32()
|
||||||
|
if not lib.arb_unwrap_result(ctx, result, ctypes.byref(ok), ctypes.byref(value), ctypes.byref(rest)):
|
||||||
|
raise RuntimeError("unwrap_result failed")
|
||||||
|
tag_num = ctypes.c_uint64()
|
||||||
|
payload = ctypes.c_uint32()
|
||||||
|
if not lib.arb_unwrap_host_value(ctx, value.value, ctypes.byref(tag_num), ctypes.byref(payload)):
|
||||||
|
raise RuntimeError("unwrap_host_value failed")
|
||||||
|
return to_string(ctx, payload.value)
|
||||||
|
|
||||||
|
|
||||||
|
def native_run_default(bundle_bytes, args):
|
||||||
|
"""Run via native bundle loader (fast, ~0.01s)."""
|
||||||
|
buf = c_bytes(bundle_bytes)
|
||||||
|
term = lib.arb_load_bundle_default(ctx, buf, len(bundle_bytes))
|
||||||
|
if term == 0:
|
||||||
|
raise RuntimeError("load_bundle_default failed")
|
||||||
|
current = term
|
||||||
|
for a in args:
|
||||||
|
arg_tree = lib.arb_of_string(ctx, a.encode("utf-8"))
|
||||||
|
current = lib.arb_app(ctx, current, arg_tree)
|
||||||
|
result = lib.arb_reduce(ctx, current, 1_000_000_000)
|
||||||
|
return to_string(ctx, result)
|
||||||
|
|
||||||
|
|
||||||
|
def native_run_named(bundle_bytes, name, args):
|
||||||
|
"""Run via native bundle loader with named export (fast)."""
|
||||||
|
buf = c_bytes(bundle_bytes)
|
||||||
|
term = lib.arb_load_bundle(ctx, buf, len(bundle_bytes), name.encode("utf-8"))
|
||||||
|
if term == 0:
|
||||||
|
raise RuntimeError(f"load_bundle({name!r}) failed")
|
||||||
|
current = term
|
||||||
|
for a in args:
|
||||||
|
arg_tree = lib.arb_of_string(ctx, a.encode("utf-8"))
|
||||||
|
current = lib.arb_app(ctx, current, arg_tree)
|
||||||
|
result = lib.arb_reduce(ctx, current, 1_000_000_000)
|
||||||
|
return to_string(ctx, result)
|
||||||
|
|
||||||
|
|
||||||
|
# ============================================================================
|
||||||
|
# Tests
|
||||||
|
# ============================================================================
|
||||||
|
|
||||||
|
all_ok = True
|
||||||
|
|
||||||
|
|
||||||
|
def check(label, got, want):
|
||||||
|
global all_ok
|
||||||
|
if got != want:
|
||||||
|
print(f"FAIL {label}: got {got!r}, want {want!r}")
|
||||||
|
all_ok = False
|
||||||
|
else:
|
||||||
|
print(f"PASS {label}: {got!r}")
|
||||||
|
|
||||||
|
|
||||||
|
# Test 1: id via kernel
|
||||||
|
print("\n--- Test 1: id (kernel path) ---")
|
||||||
|
bundle = read_bundle("id.arboricx")
|
||||||
|
t0 = time.time()
|
||||||
|
result = kernel_run(bundle, ["hello"])
|
||||||
|
t1 = time.time()
|
||||||
|
check("id kernel", result, "hello")
|
||||||
|
print(f" time: {(t1 - t0) * 1000:.1f} ms")
|
||||||
|
|
||||||
|
# Test 2: id via native
|
||||||
|
print("\n--- Test 2: id (native path) ---")
|
||||||
|
t0 = time.time()
|
||||||
|
result = native_run_default(bundle, ["hello"])
|
||||||
|
t1 = time.time()
|
||||||
|
check("id native", result, "hello")
|
||||||
|
print(f" time: {(t1 - t0) * 1000:.1f} ms")
|
||||||
|
|
||||||
|
# Test 3: append via kernel
|
||||||
|
print("\n--- Test 3: append (kernel path) ---")
|
||||||
|
bundle = read_bundle("append.arboricx")
|
||||||
|
t0 = time.time()
|
||||||
|
result = kernel_run(bundle, ["Hello, ", "world!"])
|
||||||
|
t1 = time.time()
|
||||||
|
check("append kernel", result, "Hello, world!")
|
||||||
|
print(f" time: {(t1 - t0) * 1000:.1f} ms")
|
||||||
|
|
||||||
|
# Test 4: append via native
|
||||||
|
print("\n--- Test 4: append (native path) ---")
|
||||||
|
t0 = time.time()
|
||||||
|
result = native_run_default(bundle, ["Hello, ", "world!"])
|
||||||
|
t1 = time.time()
|
||||||
|
check("append native", result, "Hello, world!")
|
||||||
|
print(f" time: {(t1 - t0) * 1000:.1f} ms")
|
||||||
|
|
||||||
|
# Test 5: append via native named export
|
||||||
|
print("\n--- Test 5: append via named export 'root' ---")
|
||||||
|
t0 = time.time()
|
||||||
|
result = native_run_named(bundle, "append", ["Hello, ", "world!"])
|
||||||
|
t1 = time.time()
|
||||||
|
check("append named", result, "Hello, world!")
|
||||||
|
print(f" time: {(t1 - t0) * 1000:.1f} ms")
|
||||||
|
|
||||||
|
# Test 6: true / false via native
|
||||||
|
print("\n--- Test 6: true / false (native path) ---")
|
||||||
|
for name, expected in [("true.arboricx", True), ("false.arboricx", False)]:
|
||||||
|
bundle = read_bundle(name)
|
||||||
|
buf = c_bytes(bundle)
|
||||||
|
term = lib.arb_load_bundle_default(ctx, buf, len(bundle))
|
||||||
|
result = lib.arb_reduce(ctx, term, 1_000_000_000)
|
||||||
|
check(f"{name} bool", to_bool(ctx, result), expected)
|
||||||
|
|
||||||
|
# Test 7: number roundtrip
|
||||||
|
print("\n--- Test 7: number roundtrip ---")
|
||||||
|
num_tree = lib.arb_of_number(ctx, 42)
|
||||||
|
check("number 42", to_number(ctx, num_tree), 42)
|
||||||
|
|
||||||
|
# Test 8: string roundtrip
|
||||||
|
print("\n--- Test 8: string roundtrip ---")
|
||||||
|
str_tree = lib.arb_of_string(ctx, b"hello")
|
||||||
|
check("string hello", to_string(ctx, str_tree), "hello")
|
||||||
|
|
||||||
|
lib.arboricx_free(ctx)
|
||||||
|
|
||||||
|
if all_ok:
|
||||||
|
print("\nAll tests passed!")
|
||||||
|
sys.exit(0)
|
||||||
|
else:
|
||||||
|
print("\nSome tests failed!")
|
||||||
|
sys.exit(1)
|
||||||
92
ext/zig/tools/gen_kernel.zig
Normal file
92
ext/zig/tools/gen_kernel.zig
Normal file
@@ -0,0 +1,92 @@
|
|||||||
|
const std = @import("std");
|
||||||
|
|
||||||
|
// Minimal Node definition for the DAG format (no App variant for kernels)
|
||||||
|
const Node = union(enum(u8)) {
|
||||||
|
leaf,
|
||||||
|
stem: struct { child: u32 },
|
||||||
|
fork: struct { left: u32, right: u32 },
|
||||||
|
};
|
||||||
|
|
||||||
|
fn parseLine(line: []const u8) !Node {
|
||||||
|
var it = std.mem.splitScalar(u8, std.mem.trim(u8, line, " \t\n\r"), ' ');
|
||||||
|
const tag = it.next() orelse return error.EmptyLine;
|
||||||
|
if (std.mem.eql(u8, tag, "leaf")) {
|
||||||
|
return .leaf;
|
||||||
|
} else if (std.mem.eql(u8, tag, "stem")) {
|
||||||
|
const child_str = it.next() orelse return error.MissingChild;
|
||||||
|
const child = try std.fmt.parseInt(u32, child_str, 10);
|
||||||
|
return .{ .stem = .{ .child = child } };
|
||||||
|
} else if (std.mem.eql(u8, tag, "fork")) {
|
||||||
|
const left_str = it.next() orelse return error.MissingLeft;
|
||||||
|
const right_str = it.next() orelse return error.MissingRight;
|
||||||
|
const left = try std.fmt.parseInt(u32, left_str, 10);
|
||||||
|
const right = try std.fmt.parseInt(u32, right_str, 10);
|
||||||
|
return .{ .fork = .{ .left = left, .right = right } };
|
||||||
|
} else {
|
||||||
|
return error.UnknownTag;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
pub fn main(init: std.process.Init) !void {
|
||||||
|
const gpa = init.gpa;
|
||||||
|
const io = init.io;
|
||||||
|
|
||||||
|
const args = try init.minimal.args.toSlice(init.arena.allocator());
|
||||||
|
if (args.len != 3) {
|
||||||
|
std.debug.print("Usage: gen_kernel <input.dag> <output.zig>\n", .{});
|
||||||
|
std.process.exit(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
const input_path = args[1];
|
||||||
|
const output_path = args[2];
|
||||||
|
|
||||||
|
const source = try std.Io.Dir.cwd().readFileAlloc(io, input_path, gpa, .limited(10 * 1024 * 1024));
|
||||||
|
defer gpa.free(source);
|
||||||
|
|
||||||
|
var nodes = std.ArrayList(Node).empty;
|
||||||
|
defer nodes.deinit(gpa);
|
||||||
|
|
||||||
|
var it = std.mem.splitScalar(u8, source, '\n');
|
||||||
|
const root_line = it.next() orelse return error.EmptyFile;
|
||||||
|
const root = try std.fmt.parseInt(u32, std.mem.trim(u8, root_line, " \t\n\r"), 10);
|
||||||
|
|
||||||
|
while (it.next()) |line| {
|
||||||
|
const trimmed = std.mem.trim(u8, line, " \t\n\r");
|
||||||
|
if (trimmed.len == 0) continue;
|
||||||
|
const node = try parseLine(trimmed);
|
||||||
|
try nodes.append(gpa, node);
|
||||||
|
}
|
||||||
|
|
||||||
|
const file = try std.Io.Dir.cwd().createFile(io, output_path, .{});
|
||||||
|
defer file.close(io);
|
||||||
|
|
||||||
|
var buf: [4096]u8 = undefined;
|
||||||
|
var writer = file.writer(io, &buf);
|
||||||
|
|
||||||
|
try writer.interface.writeAll("// Auto-generated from ");
|
||||||
|
try writer.interface.writeAll(input_path);
|
||||||
|
try writer.interface.writeAll("\n// Do not edit manually.\n\n");
|
||||||
|
|
||||||
|
try writer.interface.writeAll("pub const NodeTag = enum(u8) { leaf = 0, stem = 1, fork = 2 };\n\n");
|
||||||
|
try writer.interface.writeAll("pub const Node = union(NodeTag) {\n");
|
||||||
|
try writer.interface.writeAll(" leaf,\n");
|
||||||
|
try writer.interface.writeAll(" stem: struct { child: u32 },\n");
|
||||||
|
try writer.interface.writeAll(" fork: struct { left: u32, right: u32 },\n");
|
||||||
|
try writer.interface.writeAll("};\n\n");
|
||||||
|
|
||||||
|
try writer.interface.print("pub const kernel_root: u32 = {d};\n\n", .{root});
|
||||||
|
try writer.interface.writeAll("pub const kernel_nodes = [_]Node{\n");
|
||||||
|
|
||||||
|
for (nodes.items) |node| {
|
||||||
|
switch (node) {
|
||||||
|
.leaf => try writer.interface.writeAll(" .leaf,\n"),
|
||||||
|
.stem => |s| try writer.interface.print(" .{{ .stem = .{{ .child = {d} }} }},\n", .{s.child}),
|
||||||
|
.fork => |f| try writer.interface.print(" .{{ .fork = .{{ .left = {d}, .right = {d} }} }},\n", .{f.left, f.right}),
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
try writer.interface.writeAll("};\n");
|
||||||
|
try writer.flush();
|
||||||
|
|
||||||
|
std.debug.print("Generated {d} kernel nodes, root={d} -> {s}\n", .{ nodes.items.len, root, output_path });
|
||||||
|
}
|
||||||
6
flake.lock
generated
6
flake.lock
generated
@@ -20,11 +20,11 @@
|
|||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1734566935,
|
"lastModified": 1778505177,
|
||||||
"narHash": "sha256-cnBItmSwoH132tH3D4jxmMLVmk8G5VJ6q/SC3kszv9E=",
|
"narHash": "sha256-ao5+JS50HqNt/dtm4zuiQI+IXOn6hw50W6RTwUKYTww=",
|
||||||
"owner": "NixOS",
|
"owner": "NixOS",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "087408a407440892c1b00d80360fd64639b8091d",
|
"rev": "fb2ce70b4ae882574081225eb3c2872f39418df3",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
|
|||||||
294
flake.nix
294
flake.nix
@@ -9,27 +9,252 @@
|
|||||||
outputs = { self, nixpkgs, flake-utils }:
|
outputs = { self, nixpkgs, flake-utils }:
|
||||||
flake-utils.lib.eachDefaultSystem (system:
|
flake-utils.lib.eachDefaultSystem (system:
|
||||||
let
|
let
|
||||||
pkgs = nixpkgs.legacyPackages.${system};
|
pkgs = nixpkgs.legacyPackages.${system};
|
||||||
packageName = "tricu";
|
packageName = "tricu";
|
||||||
containerPackageName = "${packageName}-container";
|
containerPackageName = "${packageName}-container";
|
||||||
|
|
||||||
customGHC = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
haskellPackages = pkgs.haskellPackages;
|
||||||
|
hsLib = pkgs.haskell.lib;
|
||||||
|
|
||||||
|
staticPkgs = pkgs.pkgsStatic;
|
||||||
|
staticHaskellPackages = staticPkgs.haskellPackages;
|
||||||
|
staticHsLib = staticPkgs.haskell.lib;
|
||||||
|
|
||||||
|
tricuMuslStatic =
|
||||||
|
staticHsLib.justStaticExecutables (
|
||||||
|
staticHsLib.dontCheck (
|
||||||
|
staticHaskellPackages.callCabal2nix packageName self {}
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
tricuStatic = pkgs.runCommand "${packageName}-static-upx" {
|
||||||
|
nativeBuildInputs = [ pkgs.upx ];
|
||||||
|
} ''
|
||||||
|
mkdir -p $out/bin
|
||||||
|
cp ${tricuMuslStatic}/bin/tricu $out/bin/tricu
|
||||||
|
chmod +w $out/bin/tricu
|
||||||
|
|
||||||
|
# Good compression, slower build.
|
||||||
|
upx --best --lzma $out/bin/tricu
|
||||||
|
|
||||||
|
chmod 755 $out/bin/tricu
|
||||||
|
'';
|
||||||
|
|
||||||
|
tricuPackageTests =
|
||||||
|
haskellPackages.callCabal2nix packageName self {};
|
||||||
|
|
||||||
|
tricuPackage =
|
||||||
|
hsLib.dontCheck (
|
||||||
|
haskellPackages.callCabal2nix packageName self {}
|
||||||
|
);
|
||||||
|
|
||||||
|
tricuBench =
|
||||||
|
hsLib.overrideCabal
|
||||||
|
(hsLib.doBenchmark (
|
||||||
|
haskellPackages.callCabal2nix packageName self {}
|
||||||
|
))
|
||||||
|
(oldAttrs: {
|
||||||
|
postInstall = (oldAttrs.postInstall or "") + ''
|
||||||
|
mkdir -p $out/bin
|
||||||
|
cp dist/build/tricu-bench/tricu-bench $out/bin/
|
||||||
|
'';
|
||||||
|
});
|
||||||
|
|
||||||
|
customGHC = haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||||
megaparsec
|
megaparsec
|
||||||
]);
|
]);
|
||||||
|
|
||||||
haskellPackages = pkgs.haskellPackages;
|
# ------------------------------------------------------------------
|
||||||
|
# Zig Arboricx host
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
tricuZig = pkgs.stdenv.mkDerivation {
|
||||||
|
pname = "tricu-zig";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./ext/zig;
|
||||||
|
nativeBuildInputs = [ pkgs.zig pkgs.pkg-config ];
|
||||||
|
buildInputs = [ pkgs.libuv ];
|
||||||
|
buildPhase = ''
|
||||||
|
export ZIG_GLOBAL_CACHE_DIR=$TMPDIR/zig-cache
|
||||||
|
zig build
|
||||||
|
'';
|
||||||
|
installPhase = ''
|
||||||
|
mkdir -p $out/bin $out/lib $out/include
|
||||||
|
cp zig-out/bin/* $out/bin/ 2>/dev/null || true
|
||||||
|
cp zig-out/lib/* $out/lib/ 2>/dev/null || true
|
||||||
|
cp include/arboricx.h $out/include/
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
|
||||||
enableSharedExecutables = false;
|
tricuZigTests = pkgs.stdenv.mkDerivation {
|
||||||
enableSharedLibraries = false;
|
pname = "tricu-zig-tests";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./.;
|
||||||
|
nativeBuildInputs = [ pkgs.gcc pkgs.python3 tricuZig ];
|
||||||
|
buildInputs = [ pkgs.libuv ];
|
||||||
|
buildPhase = "true";
|
||||||
|
doCheck = true;
|
||||||
|
checkPhase = ''
|
||||||
|
export LD_LIBRARY_PATH=${tricuZig}/lib:$LD_LIBRARY_PATH
|
||||||
|
ulimit -s 32768
|
||||||
|
|
||||||
tricu = pkgs.haskell.lib.justStaticExecutables self.packages.${system}.default;
|
cd ext/zig
|
||||||
|
|
||||||
|
# C ABI smoke test
|
||||||
|
gcc -o /tmp/c_abi_test tests/c_abi_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/c_abi_test
|
||||||
|
|
||||||
|
# IO protocol shape test
|
||||||
|
gcc -o /tmp/io_protocol_test tests/io_protocol_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/io_protocol_test
|
||||||
|
|
||||||
|
# IO run test (synchronous driver)
|
||||||
|
gcc -o /tmp/io_run_test tests/io_run_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/io_run_test
|
||||||
|
|
||||||
|
# Kernel path append test
|
||||||
|
gcc -o /tmp/c_abi_append_test tests/c_abi_append_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/c_abi_append_test
|
||||||
|
|
||||||
|
# Native bundle tests
|
||||||
|
gcc -o /tmp/native_bundle_append_test tests/native_bundle_append_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/native_bundle_append_test
|
||||||
|
|
||||||
|
gcc -o /tmp/native_bundle_id_test tests/native_bundle_id_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/native_bundle_id_test
|
||||||
|
|
||||||
|
gcc -o /tmp/native_bundle_bools_test tests/native_bundle_bools_test.c \
|
||||||
|
-I ${tricuZig}/include -L ${tricuZig}/lib -larboricx \
|
||||||
|
-Wl,-rpath,${tricuZig}/lib
|
||||||
|
/tmp/native_bundle_bools_test
|
||||||
|
|
||||||
|
# Python FFI test
|
||||||
|
ARBORICX_LIB=${tricuZig}/lib/libarboricx.so \
|
||||||
|
python3 tests/python_ffi_test.py
|
||||||
|
|
||||||
|
mkdir -p $out
|
||||||
|
echo "All Zig tests passed" > $out/result
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
# PHP FFI host
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
tricuPhp = pkgs.stdenv.mkDerivation {
|
||||||
|
pname = "tricu-php";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./ext/php;
|
||||||
|
nativeBuildInputs = [ pkgs.makeWrapper phpWithFfi tricuZig ];
|
||||||
|
buildPhase = "true";
|
||||||
|
installPhase = ''
|
||||||
|
mkdir -p $out/share/tricu-php $out/lib $out/bin
|
||||||
|
cp -r src public run.php $out/share/tricu-php/
|
||||||
|
cp ${tricuZig}/lib/libarboricx.so $out/lib/
|
||||||
|
cp ${tricuZig}/include/arboricx.h $out/share/tricu-php/
|
||||||
|
|
||||||
|
makeWrapper ${phpWithFfi}/bin/php $out/bin/tricu-php \
|
||||||
|
--add-flags "$out/share/tricu-php/run.php" \
|
||||||
|
--set ARBORICX_LIB "$out/lib/libarboricx.so" \
|
||||||
|
--prefix LD_LIBRARY_PATH : "$out/lib"
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
# JS FFI host
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
tricuJs = pkgs.buildNpmPackage {
|
||||||
|
pname = "tricu-js";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./ext/js;
|
||||||
|
npmDepsHash = "sha256-81C7tsNcbyZVhm3uqiWdDQxp5LAXXO9aueHdMDztCfM=";
|
||||||
|
nativeBuildInputs = [ pkgs.nodejs tricuZig ];
|
||||||
|
dontNpmBuild = true;
|
||||||
|
installPhase = ''
|
||||||
|
mkdir -p $out/lib/
|
||||||
|
cp -r . $out/lib/
|
||||||
|
cp ${tricuZig}/lib/libarboricx.so $out/lib/src
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
# JS FFI host tests (separate target)
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
tricuJsTests = pkgs.stdenv.mkDerivation {
|
||||||
|
pname = "tricu-js-tests";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./.;
|
||||||
|
nativeBuildInputs = [ pkgs.nodejs tricuZig ];
|
||||||
|
buildPhase = "true";
|
||||||
|
doCheck = true;
|
||||||
|
checkPhase = ''
|
||||||
|
export ARBORICX_LIB=${tricuZig}/lib/libarboricx.so
|
||||||
|
export LD_LIBRARY_PATH=${tricuZig}/lib:$LD_LIBRARY_PATH
|
||||||
|
ulimit -s 32768
|
||||||
|
|
||||||
|
cd ext/js
|
||||||
|
# node_modules are pre-fetched by buildNpmPackage; copy them in
|
||||||
|
cp -r ${tricuJs}/lib/tricu-js/node_modules .
|
||||||
|
npm test
|
||||||
|
|
||||||
|
mkdir -p $out
|
||||||
|
echo "All JS tests passed" > $out/result
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
# PHP FFI tests (separate target)
|
||||||
|
# ------------------------------------------------------------------
|
||||||
|
phpWithFfi = pkgs.php.withExtensions (exts: [ pkgs.phpExtensions.ffi ]);
|
||||||
|
|
||||||
|
tricuPhpTests = pkgs.stdenv.mkDerivation {
|
||||||
|
pname = "tricu-php-tests";
|
||||||
|
version = "0.1.0";
|
||||||
|
src = ./.;
|
||||||
|
nativeBuildInputs = [ phpWithFfi tricuPhp ];
|
||||||
|
buildPhase = "true";
|
||||||
|
doCheck = true;
|
||||||
|
checkPhase = ''
|
||||||
|
export ARBORICX_LIB=${tricuPhp}/lib/libarboricx.so
|
||||||
|
export LD_LIBRARY_PATH=${tricuPhp}/lib:$LD_LIBRARY_PATH
|
||||||
|
ulimit -s 32768
|
||||||
|
|
||||||
|
# Run PHP host against fixture bundles
|
||||||
|
php ext/php/run.php run test/fixtures/id.arboricx hello
|
||||||
|
php ext/php/run.php run test/fixtures/append.arboricx "Hello, " "world!"
|
||||||
|
php ext/php/run.php run test/fixtures/true.arboricx
|
||||||
|
php ext/php/run.php run test/fixtures/false.arboricx
|
||||||
|
php ext/php/run.php run test/fixtures/notQ.arboricx "t t t"
|
||||||
|
|
||||||
|
mkdir -p $out
|
||||||
|
echo "All PHP tests passed" > $out/result
|
||||||
|
'';
|
||||||
|
};
|
||||||
in {
|
in {
|
||||||
|
packages.${packageName} = tricuPackage;
|
||||||
|
packages.default = tricuPackage;
|
||||||
|
packages.tricu-static = tricuMuslStatic;
|
||||||
|
packages.tricu-static-upx = tricuStatic;
|
||||||
|
packages.tricu-bench = tricuBench;
|
||||||
|
packages.tricu-zig = tricuZig;
|
||||||
|
packages.tricu-zig-tests = tricuZigTests;
|
||||||
|
packages.tricu-php = tricuPhp;
|
||||||
|
packages.tricu-php-tests = tricuPhpTests;
|
||||||
|
packages.tricu-js = tricuJs;
|
||||||
|
packages.tricu-js-tests = tricuJsTests;
|
||||||
|
|
||||||
packages.${packageName} =
|
checks.${packageName} = tricuPackageTests;
|
||||||
haskellPackages.callCabal2nix packageName self rec {};
|
checks.default = tricuPackageTests;
|
||||||
|
|
||||||
packages.default = self.packages.${system}.${packageName};
|
|
||||||
defaultPackage = self.packages.${system}.default;
|
|
||||||
|
|
||||||
devShells.default = pkgs.mkShell {
|
devShells.default = pkgs.mkShell {
|
||||||
buildInputs = with pkgs; [
|
buildInputs = with pkgs; [
|
||||||
@@ -38,10 +263,49 @@
|
|||||||
haskellPackages.ghcid
|
haskellPackages.ghcid
|
||||||
customGHC
|
customGHC
|
||||||
upx
|
upx
|
||||||
|
gcc
|
||||||
|
python3
|
||||||
];
|
];
|
||||||
inputsFrom = builtins.attrValues self.packages.${system};
|
|
||||||
};
|
|
||||||
devShell = self.devShells.${system}.default;
|
|
||||||
|
|
||||||
|
inputsFrom = [
|
||||||
|
tricuPackage
|
||||||
|
tricuZig
|
||||||
|
tricuPhp
|
||||||
|
];
|
||||||
|
};
|
||||||
|
|
||||||
|
packages.${containerPackageName} = pkgs.dockerTools.buildImage {
|
||||||
|
name = "tricu";
|
||||||
|
tag = "latest";
|
||||||
|
|
||||||
|
copyToRoot = pkgs.buildEnv {
|
||||||
|
name = "image-root";
|
||||||
|
paths = [ tricuStatic ];
|
||||||
|
pathsToLink = [ "/bin" ];
|
||||||
|
};
|
||||||
|
|
||||||
|
config = {
|
||||||
|
Cmd = [ "/bin/tricu" ];
|
||||||
|
WorkingDir = "/app";
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
|
packages.arboricxServer = pkgs.dockerTools.buildImage {
|
||||||
|
name = "arboricxServer";
|
||||||
|
tag = "latest";
|
||||||
|
|
||||||
|
copyToRoot = pkgs.runCommand "arboricxServer" {} ''
|
||||||
|
mkdir -p $out/app/bin $out/app/lib $out/app/tricu-apps $out/app/store
|
||||||
|
cp ${tricuStatic}/bin/tricu $out/app/bin/
|
||||||
|
cp -r ${./lib}/* $out/app/lib/
|
||||||
|
cp ${./tricu-apps/arboricxServer.tri} $out/app/tricu-apps/arboricxServer.tri
|
||||||
|
'';
|
||||||
|
|
||||||
|
config = {
|
||||||
|
Entrypoint = [ "/app/bin/tricu" "eval" "tricu-apps/arboricxServer.tri" "--io" "--allow-read" "./store" "--allow-write" "./store" "-f" "decode" ];
|
||||||
|
WorkingDir = "/app";
|
||||||
|
ExposedPorts = { "8080/tcp" = {}; };
|
||||||
|
};
|
||||||
|
};
|
||||||
});
|
});
|
||||||
}
|
}
|
||||||
|
|||||||
158
lib/arboricx/arboricx.tri
Normal file
158
lib/arboricx/arboricx.tri
Normal file
@@ -0,0 +1,158 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "arboricx.common" !Local
|
||||||
|
!import "arboricx.manifest" !Local
|
||||||
|
!import "arboricx.nodes" !Local
|
||||||
|
|
||||||
|
-- Read and validate a full Arboricx bundle.
|
||||||
|
-- Returns (pair validManifest afterContainer).
|
||||||
|
-- The manifest core fields are validated against expected values.
|
||||||
|
readArboricxBundle = (bs :
|
||||||
|
bindResult (readArboricxRequiredSections bs)
|
||||||
|
(sections afterContainer :
|
||||||
|
matchPair
|
||||||
|
(manifestBytes _ :
|
||||||
|
bindResult (readManifest manifestBytes)
|
||||||
|
(parsedManifest afterManifest :
|
||||||
|
matchPair
|
||||||
|
(coreManifest metadataWithExtensions :
|
||||||
|
bindResult (validateManifestCore coreManifest afterManifest)
|
||||||
|
(validCore _ : ok (pair validCore metadataWithExtensions) afterContainer))
|
||||||
|
parsedManifest))
|
||||||
|
sections))
|
||||||
|
|
||||||
|
-- Select an export from a validated bundle and reconstruct its root tree.
|
||||||
|
-- Returns ok executable afterContainer, or propagates parse/selection/node errors.
|
||||||
|
readArboricxExecutableByName = (nameBytes bs :
|
||||||
|
bindResult (readArboricxBundle bs)
|
||||||
|
(bundleResult afterBundle :
|
||||||
|
matchPair
|
||||||
|
(validCore _ :
|
||||||
|
bindResult (selectExport (manifestExports validCore) nameBytes)
|
||||||
|
(selectedExport _ :
|
||||||
|
readArboricxTreeFromIndex (exportRoot selectedExport) bs))
|
||||||
|
bundleResult))
|
||||||
|
|
||||||
|
readArboricxExecutable = (bs :
|
||||||
|
readArboricxExecutableByName [] bs)
|
||||||
|
|
||||||
|
applyArgs = (f args :
|
||||||
|
foldl
|
||||||
|
(acc arg : acc arg)
|
||||||
|
f
|
||||||
|
args)
|
||||||
|
|
||||||
|
runArboricxByName = (nameBytes bs arg :
|
||||||
|
bindResult (readArboricxExecutableByName nameBytes bs)
|
||||||
|
(executable rest : ok (executable arg) rest))
|
||||||
|
|
||||||
|
runArboricx = (bs arg :
|
||||||
|
runArboricxByName [] bs arg)
|
||||||
|
|
||||||
|
runArboricxArgsByName = (nameBytes bs args :
|
||||||
|
bindResult (readArboricxExecutableByName nameBytes bs)
|
||||||
|
(executable rest : ok (applyArgs executable args) rest))
|
||||||
|
|
||||||
|
runArboricxArgs = (bs args :
|
||||||
|
runArboricxArgsByName [] bs args)
|
||||||
|
|
||||||
|
errHostCodecFailed = 14
|
||||||
|
|
||||||
|
hostTreeTag = 0
|
||||||
|
hostStringTag = 1
|
||||||
|
hostNumberTag = 2
|
||||||
|
hostBoolTag = 3
|
||||||
|
hostListTag = 4
|
||||||
|
hostBytesTag = 5
|
||||||
|
|
||||||
|
hostTree = (value : pair hostTreeTag value)
|
||||||
|
hostString = (bytes : pair hostStringTag bytes)
|
||||||
|
hostNumber = (n : pair hostNumberTag n)
|
||||||
|
hostBool = (b : pair hostBoolTag b)
|
||||||
|
hostList = (xs : pair hostListTag xs)
|
||||||
|
hostBytes = (bytes : pair hostBytesTag bytes)
|
||||||
|
|
||||||
|
hostValueTag = (hostValue : pairFirst hostValue)
|
||||||
|
hostValuePayload = (hostValue : pairSecond hostValue)
|
||||||
|
|
||||||
|
hostBool? = (value : or? (equal? value false) (equal? value true))
|
||||||
|
|
||||||
|
hostNumber? = y (self value :
|
||||||
|
triage
|
||||||
|
true
|
||||||
|
(_ : false)
|
||||||
|
(bit rest :
|
||||||
|
and?
|
||||||
|
(or? (equal? bit false) (equal? bit true))
|
||||||
|
(self rest))
|
||||||
|
value)
|
||||||
|
|
||||||
|
hostList? = y (self value :
|
||||||
|
triage
|
||||||
|
true
|
||||||
|
(_ : false)
|
||||||
|
(_ rest : self rest)
|
||||||
|
value)
|
||||||
|
|
||||||
|
hostString? = y (self value :
|
||||||
|
matchList
|
||||||
|
true
|
||||||
|
(byte rest : and? (hostNumber? byte) (self rest))
|
||||||
|
value)
|
||||||
|
|
||||||
|
hostBytes? = hostString?
|
||||||
|
|
||||||
|
wrapHostValue = (validator wrapper resultValue rest :
|
||||||
|
matchBool
|
||||||
|
(ok (wrapper resultValue) rest)
|
||||||
|
(err errHostCodecFailed resultValue)
|
||||||
|
(validator resultValue))
|
||||||
|
|
||||||
|
wrapHostValueByTag = (tag value rest :
|
||||||
|
matchBool
|
||||||
|
(ok (hostTree value) rest)
|
||||||
|
(matchBool
|
||||||
|
(wrapHostValue hostString? hostString value rest)
|
||||||
|
(matchBool
|
||||||
|
(wrapHostValue hostNumber? hostNumber value rest)
|
||||||
|
(matchBool
|
||||||
|
(wrapHostValue hostBool? hostBool value rest)
|
||||||
|
(matchBool
|
||||||
|
(wrapHostValue hostList? hostList value rest)
|
||||||
|
(matchBool
|
||||||
|
(wrapHostValue hostBytes? hostBytes value rest)
|
||||||
|
(err errHostCodecFailed value)
|
||||||
|
(equal? tag hostBytesTag))
|
||||||
|
(equal? tag hostListTag))
|
||||||
|
(equal? tag hostBoolTag))
|
||||||
|
(equal? tag hostNumberTag))
|
||||||
|
(equal? tag hostStringTag))
|
||||||
|
(equal? tag hostTreeTag))
|
||||||
|
|
||||||
|
runArboricxByNameToTyped = (tag nameBytes bs args :
|
||||||
|
bindResult (runArboricxArgsByName nameBytes bs args)
|
||||||
|
(value rest : wrapHostValueByTag tag value rest))
|
||||||
|
|
||||||
|
runArboricxByNameToTree = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostTreeTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxByNameToString = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostStringTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxByNameToNumber = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostNumberTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxByNameToBool = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostBoolTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxByNameToList = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostListTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxByNameToBytes = (nameBytes bs args :
|
||||||
|
runArboricxByNameToTyped hostBytesTag nameBytes bs args)
|
||||||
|
|
||||||
|
runArboricxToTree = (bs args : runArboricxByNameToTyped hostTreeTag [] bs args)
|
||||||
|
runArboricxToString = (bs args : runArboricxByNameToTyped hostStringTag [] bs args)
|
||||||
|
runArboricxToNumber = (bs args : runArboricxByNameToTyped hostNumberTag [] bs args)
|
||||||
|
runArboricxToBool = (bs args : runArboricxByNameToTyped hostBoolTag [] bs args)
|
||||||
|
runArboricxToList = (bs args : runArboricxByNameToTyped hostListTag [] bs args)
|
||||||
|
runArboricxToBytes = (bs args : runArboricxByNameToTyped hostBytesTag [] bs args)
|
||||||
431
lib/arboricx/common.tri
Normal file
431
lib/arboricx/common.tri
Normal file
@@ -0,0 +1,431 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "binary" !Local
|
||||||
|
|
||||||
|
|
||||||
|
arboricxMagic = [(65) (82) (66) (79) (82) (73) (67) (88)]
|
||||||
|
arboricxMajorVersion = [(0) (1)]
|
||||||
|
arboricxMinorVersion = [(0) (0)]
|
||||||
|
arboricxManifestSectionId = [(0) (0) (0) (1)]
|
||||||
|
arboricxNodesSectionId = [(0) (0) (0) (2)]
|
||||||
|
|
||||||
|
-- Manifest magic and version constants
|
||||||
|
arboricxManifestMagic = [(65) (82) (66) (77) (78) (70) (83) (84)]
|
||||||
|
arboricxManifestMajorVersion = [(0) (1)]
|
||||||
|
arboricxManifestMinorVersion = [(0) (0)]
|
||||||
|
|
||||||
|
errMissingSection = 4
|
||||||
|
errUnsupportedVersion = 5
|
||||||
|
errDuplicateSection = 6
|
||||||
|
errDuplicateNode = 7
|
||||||
|
errInvalidNodePayload = 8
|
||||||
|
errMissingNode = 9
|
||||||
|
errInvalidManifestMagic = 10
|
||||||
|
errUnsupportedManifestVersion = 11
|
||||||
|
errTrailingManifestBytes = 12
|
||||||
|
errManifestValidationFailed = 13
|
||||||
|
|
||||||
|
nodePayloadLeafTag = 0
|
||||||
|
nodePayloadStemTag = 1
|
||||||
|
nodePayloadForkTag = 2
|
||||||
|
|
||||||
|
readArboricxMagic = (bs : expectBytes arboricxMagic bs)
|
||||||
|
|
||||||
|
readArboricxHeader = (bs :
|
||||||
|
bindResult (readArboricxMagic bs)
|
||||||
|
(_ afterMagic :
|
||||||
|
bindResult (readBytes 2 afterMagic)
|
||||||
|
(majorVersion afterMajor :
|
||||||
|
bindResult (readBytes 2 afterMajor)
|
||||||
|
(minorVersion afterMinor :
|
||||||
|
bindResult (readBytes 4 afterMinor)
|
||||||
|
(sectionCount afterSectionCount :
|
||||||
|
bindResult (readBytes 8 afterSectionCount)
|
||||||
|
(flags afterFlags :
|
||||||
|
bindResult (readBytes 8 afterFlags)
|
||||||
|
(dirOffset afterDirOffset :
|
||||||
|
ok
|
||||||
|
(pair majorVersion
|
||||||
|
(pair minorVersion
|
||||||
|
(pair sectionCount
|
||||||
|
(pair flags dirOffset))))
|
||||||
|
afterDirOffset)))))))
|
||||||
|
|
||||||
|
readSectionRecord = (bs :
|
||||||
|
bindResult (readBytes 4 bs)
|
||||||
|
(sectionId afterSectionId :
|
||||||
|
bindResult (readBytes 2 afterSectionId)
|
||||||
|
(sectionVersion afterSectionVersion :
|
||||||
|
bindResult (readBytes 2 afterSectionVersion)
|
||||||
|
(sectionFlags afterSectionFlags :
|
||||||
|
bindResult (readBytes 2 afterSectionFlags)
|
||||||
|
(compression afterCompression :
|
||||||
|
bindResult (readBytes 2 afterCompression)
|
||||||
|
(reserved1 afterReserved1 :
|
||||||
|
bindResult (readBytes 8 afterReserved1)
|
||||||
|
(offset afterOffset :
|
||||||
|
bindResult (readBytes 8 afterOffset)
|
||||||
|
(length afterLength :
|
||||||
|
bindResult (readBytes 4 afterLength)
|
||||||
|
(reserved2 afterReserved2 :
|
||||||
|
ok
|
||||||
|
(pair sectionId
|
||||||
|
(pair sectionVersion
|
||||||
|
(pair sectionFlags
|
||||||
|
(pair compression
|
||||||
|
(pair reserved1
|
||||||
|
(pair offset
|
||||||
|
(pair length reserved2)))))))
|
||||||
|
afterReserved2)))))))))
|
||||||
|
|
||||||
|
readSectionDirectory_ = y (self bs sectionCount i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readSectionRecord bs)
|
||||||
|
(sectionRecord afterSectionRecord :
|
||||||
|
self afterSectionRecord sectionCount (succ i) (pair sectionRecord acc)))
|
||||||
|
(equal? i sectionCount))
|
||||||
|
|
||||||
|
readSectionDirectory = (sectionCount bs : readSectionDirectory_ bs sectionCount 0 t)
|
||||||
|
|
||||||
|
sectionRecordId = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(sectionId _ : sectionId)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordVersion = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(sectionVersion _ : sectionVersion)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordFlags = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(sectionFlags _ : sectionFlags)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordCompression = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(compression _ : compression)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordReserved1 = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(_ payload4 :
|
||||||
|
matchPair
|
||||||
|
(reserved1 _ : reserved1)
|
||||||
|
payload4)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordOffset = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(_ payload4 :
|
||||||
|
matchPair
|
||||||
|
(_ payload5 :
|
||||||
|
matchPair
|
||||||
|
(offset _ : offset)
|
||||||
|
payload5)
|
||||||
|
payload4)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordLength = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(_ payload4 :
|
||||||
|
matchPair
|
||||||
|
(_ payload5 :
|
||||||
|
matchPair
|
||||||
|
(_ payload6 :
|
||||||
|
matchPair
|
||||||
|
(length _ : length)
|
||||||
|
payload6)
|
||||||
|
payload5)
|
||||||
|
payload4)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
sectionRecordReserved2 = (sectionRecord :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(_ payload4 :
|
||||||
|
matchPair
|
||||||
|
(_ payload5 :
|
||||||
|
matchPair
|
||||||
|
(_ payload6 :
|
||||||
|
matchPair
|
||||||
|
(_ reserved2 : reserved2)
|
||||||
|
payload6)
|
||||||
|
payload5)
|
||||||
|
payload4)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
sectionRecord)
|
||||||
|
|
||||||
|
lookupSectionRecord_ = y (self directory sectionId :
|
||||||
|
matchList
|
||||||
|
nothing
|
||||||
|
(sectionRecord rest :
|
||||||
|
matchBool
|
||||||
|
(just sectionRecord)
|
||||||
|
(self rest sectionId)
|
||||||
|
(bytesEq? sectionId (sectionRecordId sectionRecord)))
|
||||||
|
directory)
|
||||||
|
|
||||||
|
lookupSectionRecord = (sectionId directory : lookupSectionRecord_ directory sectionId)
|
||||||
|
|
||||||
|
sectionDirectoryHasId?_ = y (self directory sectionId :
|
||||||
|
matchList
|
||||||
|
false
|
||||||
|
(sectionRecord rest :
|
||||||
|
or?
|
||||||
|
(bytesEq? sectionId (sectionRecordId sectionRecord))
|
||||||
|
(self rest sectionId))
|
||||||
|
directory)
|
||||||
|
|
||||||
|
sectionDirectoryHasId? = (sectionId directory : sectionDirectoryHasId?_ directory sectionId)
|
||||||
|
|
||||||
|
sectionDirectoryHasDuplicateIds? = y (self directory :
|
||||||
|
matchList
|
||||||
|
false
|
||||||
|
(sectionRecord rest :
|
||||||
|
or?
|
||||||
|
(sectionDirectoryHasId?_ rest (sectionRecordId sectionRecord))
|
||||||
|
(self rest))
|
||||||
|
directory)
|
||||||
|
|
||||||
|
validateSectionDirectory = (directory rest :
|
||||||
|
matchBool
|
||||||
|
(err errDuplicateSection rest)
|
||||||
|
(ok directory rest)
|
||||||
|
(sectionDirectoryHasDuplicateIds? directory))
|
||||||
|
|
||||||
|
byteSlice = (offset length bytes : bytesTake length (bytesDrop offset bytes))
|
||||||
|
|
||||||
|
natMake = (bit rest :
|
||||||
|
matchBool
|
||||||
|
0
|
||||||
|
(pair bit rest)
|
||||||
|
(and? (equal? bit 0) (equal? rest 0)))
|
||||||
|
|
||||||
|
natAdd = y (self a b :
|
||||||
|
triage
|
||||||
|
b
|
||||||
|
(_ : b)
|
||||||
|
(aBit aRest :
|
||||||
|
triage
|
||||||
|
a
|
||||||
|
(_ : a)
|
||||||
|
(bBit bRest :
|
||||||
|
matchBool
|
||||||
|
(natMake 0 (succ (self aRest bRest)))
|
||||||
|
(natMake (matchBool (matchBool 0 1 bBit) (matchBool 1 0 bBit) aBit)
|
||||||
|
(self aRest bRest))
|
||||||
|
(and? (equal? aBit 1) (equal? bBit 1)))
|
||||||
|
b)
|
||||||
|
a)
|
||||||
|
|
||||||
|
natDouble = (n : matchBool 0 (pair 0 n) (equal? n 0))
|
||||||
|
|
||||||
|
natTimes256 = (n :
|
||||||
|
natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble
|
||||||
|
(natDouble n))))))))
|
||||||
|
|
||||||
|
byteNatShiftAppend_ = y (self byte acc i :
|
||||||
|
matchBool
|
||||||
|
acc
|
||||||
|
(triage
|
||||||
|
(natMake 0 (self 0 acc (succ i)))
|
||||||
|
(_ : acc)
|
||||||
|
(bit rest : natMake bit (self rest acc (succ i)))
|
||||||
|
byte)
|
||||||
|
(equal? i 8))
|
||||||
|
|
||||||
|
byteNatShiftAppend = (byte acc : byteNatShiftAppend_ byte acc 0)
|
||||||
|
|
||||||
|
beBytesToNat = (bytes :
|
||||||
|
foldl
|
||||||
|
(acc byte : byteNatShiftAppend byte acc)
|
||||||
|
0
|
||||||
|
bytes)
|
||||||
|
|
||||||
|
u32BEBytesToNat = beBytesToNat
|
||||||
|
u64BEBytesToNat = beBytesToNat
|
||||||
|
|
||||||
|
arboricxHeaderMajorVersion = (header :
|
||||||
|
matchPair
|
||||||
|
(majorVersion _ : majorVersion)
|
||||||
|
header)
|
||||||
|
|
||||||
|
arboricxHeaderMinorVersion = (header :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(minorVersion _ : minorVersion)
|
||||||
|
payload)
|
||||||
|
header)
|
||||||
|
|
||||||
|
arboricxHeaderSectionCount = (header :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(sectionCount _ : sectionCount)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
header)
|
||||||
|
|
||||||
|
arboricxHeaderFlags = (header :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(flags _ : flags)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
header)
|
||||||
|
|
||||||
|
arboricxHeaderDirOffset = (header :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(_ payload2 :
|
||||||
|
matchPair
|
||||||
|
(_ payload3 :
|
||||||
|
matchPair
|
||||||
|
(_ dirOffset : dirOffset)
|
||||||
|
payload3)
|
||||||
|
payload2)
|
||||||
|
payload)
|
||||||
|
header)
|
||||||
|
|
||||||
|
validateArboricxHeader = (header rest :
|
||||||
|
matchBool
|
||||||
|
(ok header rest)
|
||||||
|
(err errUnsupportedVersion rest)
|
||||||
|
(and?
|
||||||
|
(bytesEq? arboricxMajorVersion (arboricxHeaderMajorVersion header))
|
||||||
|
(bytesEq? arboricxMinorVersion (arboricxHeaderMinorVersion header))))
|
||||||
|
|
||||||
|
readArboricxContainer = (bs :
|
||||||
|
bindResult (readArboricxHeader bs)
|
||||||
|
(header afterHeader :
|
||||||
|
bindResult (validateArboricxHeader header afterHeader)
|
||||||
|
(validHeader afterValidHeader :
|
||||||
|
bindResult (readSectionDirectory
|
||||||
|
(u32BEBytesToNat (arboricxHeaderSectionCount validHeader))
|
||||||
|
(bytesDrop (u64BEBytesToNat (arboricxHeaderDirOffset validHeader)) bs))
|
||||||
|
(directory afterDirectory :
|
||||||
|
bindResult (validateSectionDirectory directory afterDirectory)
|
||||||
|
(validDirectory afterValidDirectory :
|
||||||
|
ok (pair validHeader validDirectory) afterValidDirectory)))))
|
||||||
|
|
||||||
|
sectionRecordOffsetNat = (sectionRecord :
|
||||||
|
u64BEBytesToNat (sectionRecordOffset sectionRecord))
|
||||||
|
|
||||||
|
sectionRecordLengthNat = (sectionRecord :
|
||||||
|
u64BEBytesToNat (sectionRecordLength sectionRecord))
|
||||||
|
|
||||||
|
extractSectionBytes = (sectionRecord containerBytes :
|
||||||
|
byteSlice
|
||||||
|
(sectionRecordOffsetNat sectionRecord)
|
||||||
|
(sectionRecordLengthNat sectionRecord)
|
||||||
|
containerBytes)
|
||||||
|
|
||||||
|
extractSectionBytesResult = (sectionRecord containerBytes rest :
|
||||||
|
(sectionBytes :
|
||||||
|
matchBool
|
||||||
|
(ok sectionBytes rest)
|
||||||
|
(err errUnexpectedEof rest)
|
||||||
|
(equal? (bytesLength sectionBytes) (sectionRecordLengthNat sectionRecord)))
|
||||||
|
(extractSectionBytes sectionRecord containerBytes))
|
||||||
|
|
||||||
|
lookupSectionBytes = (sectionId directory containerBytes :
|
||||||
|
triage
|
||||||
|
nothing
|
||||||
|
(sectionRecord : just (extractSectionBytes sectionRecord containerBytes))
|
||||||
|
(_ _ : nothing)
|
||||||
|
(lookupSectionRecord sectionId directory))
|
||||||
|
|
||||||
|
sectionBytesOrErr = (sectionId directory containerBytes rest :
|
||||||
|
triage
|
||||||
|
(err errMissingSection rest)
|
||||||
|
(sectionRecord : extractSectionBytesResult sectionRecord containerBytes rest)
|
||||||
|
(_ _ : err errMissingSection rest)
|
||||||
|
(lookupSectionRecord sectionId directory))
|
||||||
|
|
||||||
|
readArboricxSectionBytes = (sectionId bs :
|
||||||
|
bindResult (readArboricxContainer bs)
|
||||||
|
(container afterContainer :
|
||||||
|
matchPair
|
||||||
|
(_ directory : sectionBytesOrErr sectionId directory bs afterContainer)
|
||||||
|
container))
|
||||||
|
|
||||||
|
readArboricxRequiredSections = (bs :
|
||||||
|
bindResult (readArboricxContainer bs)
|
||||||
|
(container afterContainer :
|
||||||
|
matchPair
|
||||||
|
(_ directory :
|
||||||
|
bindResult (sectionBytesOrErr arboricxManifestSectionId directory bs afterContainer)
|
||||||
|
(manifestBytes _ :
|
||||||
|
bindResult (sectionBytesOrErr arboricxNodesSectionId directory bs afterContainer)
|
||||||
|
(nodesBytes _ :
|
||||||
|
ok (pair manifestBytes nodesBytes) afterContainer)))
|
||||||
|
container))
|
||||||
7
lib/arboricx/dispatch.tri
Normal file
7
lib/arboricx/dispatch.tri
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "arboricx" !Local
|
||||||
|
|
||||||
|
-- Multi-purpose kernel dispatch.
|
||||||
|
-- runArboricxTyped tag bundleBytes args
|
||||||
|
runArboricxTyped = (tag bs args :
|
||||||
|
runArboricxByNameToTyped tag [] bs args)
|
||||||
346
lib/arboricx/manifest.tri
Normal file
346
lib/arboricx/manifest.tri
Normal file
@@ -0,0 +1,346 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "binary" !Local
|
||||||
|
!import "arboricx.common" !Local
|
||||||
|
!import "arboricx.nodes" !Local
|
||||||
|
|
||||||
|
readManifestMagic = (bs :
|
||||||
|
expectBytes arboricxManifestMagic bs)
|
||||||
|
|
||||||
|
-- Read a u32 BE length, then that many raw bytes.
|
||||||
|
-- Returns the payload bytes and remaining input.
|
||||||
|
readLengthPrefixedString = (bs :
|
||||||
|
bindResult (readBytes 4 bs)
|
||||||
|
(lengthBytes afterLengthBytes :
|
||||||
|
bindResult (readBytes (u32BEBytesToNat lengthBytes) afterLengthBytes)
|
||||||
|
(payload afterPayload :
|
||||||
|
ok payload afterPayload)))
|
||||||
|
|
||||||
|
-- Helper: read a single capability string (length-prefixed string)
|
||||||
|
readCapability = (bs :
|
||||||
|
readLengthPrefixedString bs)
|
||||||
|
|
||||||
|
-- Helper worker: read N capability strings (counts up from 0)
|
||||||
|
readCapabilities_ = y (self bs count i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readCapability bs)
|
||||||
|
(cap afterCap :
|
||||||
|
self afterCap count (succ i) (pair cap acc)))
|
||||||
|
(equal? i count))
|
||||||
|
|
||||||
|
-- Helper: read N capabilities
|
||||||
|
readCapabilities = (count bs :
|
||||||
|
readCapabilities_ bs count 0 t)
|
||||||
|
|
||||||
|
-- Helper: read a single root entry (4-byte u32 BE index + length-prefixed role)
|
||||||
|
readRootEntry = (bs :
|
||||||
|
bindResult (readBytes 4 bs)
|
||||||
|
(indexRaw afterIndex :
|
||||||
|
bindResult (readLengthPrefixedString afterIndex)
|
||||||
|
(role afterRole :
|
||||||
|
ok (pair indexRaw role) afterRole)))
|
||||||
|
|
||||||
|
-- Helper worker: read N root entries (counts up from 0)
|
||||||
|
readRoots_ = y (self bs count i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readRootEntry bs)
|
||||||
|
(root afterRoot :
|
||||||
|
self afterRoot count (succ i) (pair root acc)))
|
||||||
|
(equal? i count))
|
||||||
|
|
||||||
|
-- Helper: read N roots
|
||||||
|
readRoots = (count bs :
|
||||||
|
readRoots_ bs count 0 t)
|
||||||
|
|
||||||
|
-- Helper: read a single export entry
|
||||||
|
readExportEntry = (bs :
|
||||||
|
bindResult (readLengthPrefixedString bs)
|
||||||
|
(name afterName :
|
||||||
|
bindResult (readBytes 4 afterName)
|
||||||
|
(rootIndexRaw afterRootIndex :
|
||||||
|
bindResult (readLengthPrefixedString afterRootIndex)
|
||||||
|
(kind afterKind :
|
||||||
|
bindResult (readLengthPrefixedString afterKind)
|
||||||
|
(abi afterAbi :
|
||||||
|
ok (pair name (pair rootIndexRaw (pair kind abi))) afterAbi)))))
|
||||||
|
|
||||||
|
-- Helper worker: read N export entries (counts up from 0)
|
||||||
|
readExports_ = y (self bs count i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readExportEntry bs)
|
||||||
|
(exp afterExp :
|
||||||
|
self afterExp count (succ i) (pair exp acc)))
|
||||||
|
(equal? i count))
|
||||||
|
|
||||||
|
-- Helper: read N exports
|
||||||
|
readExports = (count bs :
|
||||||
|
readExports_ bs count 0 t)
|
||||||
|
|
||||||
|
-- Main core manifest parser.
|
||||||
|
-- Reads: magic, version, core strings, capabilities, closure, roots, exports.
|
||||||
|
readManifestCore = (bs :
|
||||||
|
bindResult (readManifestMagic bs)
|
||||||
|
(_ afterMagic :
|
||||||
|
bindResult (readBytes 2 afterMagic)
|
||||||
|
(majorVersion afterMajor :
|
||||||
|
bindResult (readBytes 2 afterMajor)
|
||||||
|
(minorVersion afterMinor :
|
||||||
|
bindResult (readLengthPrefixedString afterMinor)
|
||||||
|
(schema afterSchema :
|
||||||
|
bindResult (readLengthPrefixedString afterSchema)
|
||||||
|
(bundleType afterBundleType :
|
||||||
|
bindResult (readLengthPrefixedString afterBundleType)
|
||||||
|
(treeCalculus afterTreeCalculus :
|
||||||
|
bindResult (readLengthPrefixedString afterTreeCalculus)
|
||||||
|
(treeHashAlgorithm afterTreeHashAlgorithm :
|
||||||
|
bindResult (readLengthPrefixedString afterTreeHashAlgorithm)
|
||||||
|
(treeHashDomain afterTreeHashDomain :
|
||||||
|
bindResult (readLengthPrefixedString afterTreeHashDomain)
|
||||||
|
(treeNodePayload afterTreeNodePayload :
|
||||||
|
bindResult (readLengthPrefixedString afterTreeNodePayload)
|
||||||
|
(runtimeSemantics afterRuntimeSemantics :
|
||||||
|
bindResult (readLengthPrefixedString afterRuntimeSemantics)
|
||||||
|
(runtimeEvaluation afterRuntimeEvaluation :
|
||||||
|
bindResult (readLengthPrefixedString afterRuntimeEvaluation)
|
||||||
|
(runtimeAbi afterRuntimeAbi :
|
||||||
|
bindResult (readBytes 4 afterRuntimeAbi)
|
||||||
|
(capCountRaw afterCapCountRaw :
|
||||||
|
bindResult (readCapabilities (u32BEBytesToNat capCountRaw) afterCapCountRaw)
|
||||||
|
(capabilities afterCapabilities :
|
||||||
|
bindResult (readBytes 1 afterCapabilities)
|
||||||
|
(closureByte afterClosureByte :
|
||||||
|
bindResult (readBytes 4 afterClosureByte)
|
||||||
|
(rootCountRaw afterRootCountRaw :
|
||||||
|
bindResult (readRoots (u32BEBytesToNat rootCountRaw) afterRootCountRaw)
|
||||||
|
(roots afterRoots :
|
||||||
|
bindResult (readBytes 4 afterRoots)
|
||||||
|
(exportCountRaw afterExportCountRaw :
|
||||||
|
bindResult (readExports (u32BEBytesToNat exportCountRaw) afterExportCountRaw)
|
||||||
|
(exports afterExports :
|
||||||
|
ok
|
||||||
|
(pair schema
|
||||||
|
(pair bundleType
|
||||||
|
(pair treeCalculus
|
||||||
|
(pair treeHashAlgorithm
|
||||||
|
(pair treeHashDomain
|
||||||
|
(pair treeNodePayload
|
||||||
|
(pair runtimeSemantics
|
||||||
|
(pair runtimeEvaluation
|
||||||
|
(pair runtimeAbi
|
||||||
|
(pair capabilities
|
||||||
|
(pair closureByte (pair roots exports)))))))))))) afterExports))))))))))))))))))))
|
||||||
|
|
||||||
|
-- Metadata tag constants (u16 values)
|
||||||
|
tagPackage = [(0) (1)]
|
||||||
|
tagVersion = [(0) (2)]
|
||||||
|
tagDescription = [(0) (3)]
|
||||||
|
tagLicense = [(0) (4)]
|
||||||
|
tagCreatedBy = [(0) (5)]
|
||||||
|
|
||||||
|
-- Read a single TLV entry: u16 tag + u32 length + value bytes.
|
||||||
|
-- Returns the pair (tag, value) and remaining input.
|
||||||
|
readTLV = (bs :
|
||||||
|
bindResult (readBytes 2 bs)
|
||||||
|
(tag afterTag :
|
||||||
|
bindResult (readBytes 4 afterTag)
|
||||||
|
(tlvLenRaw afterTlvLenRaw :
|
||||||
|
bindResult (readBytes (u32BEBytesToNat tlvLenRaw) afterTlvLenRaw)
|
||||||
|
(tlvValue afterTlvValue :
|
||||||
|
ok (pair tag tlvValue) afterTlvValue))))
|
||||||
|
|
||||||
|
-- Worker: read N TLV entries (counts up from 0)
|
||||||
|
readTLVs_ = y (self bs count i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readTLV bs)
|
||||||
|
(tlv afterTlv :
|
||||||
|
self afterTlv count (succ i) (pair tlv acc)))
|
||||||
|
(equal? i count))
|
||||||
|
|
||||||
|
-- Read a count followed by that many TLV entries.
|
||||||
|
readTLVList = (count bs :
|
||||||
|
readTLVs_ bs count 0 t)
|
||||||
|
|
||||||
|
-- Skip N extension TLV entries (counts up from 0)
|
||||||
|
skipTLVs_ = y (self bs count i :
|
||||||
|
matchBool
|
||||||
|
(ok unit bs)
|
||||||
|
(bindResult (readTLV bs)
|
||||||
|
(_ afterTlv :
|
||||||
|
self afterTlv count (succ i)))
|
||||||
|
(equal? i count))
|
||||||
|
|
||||||
|
-- Full manifest parser: core fields + metadata TLV list + extension TLV list.
|
||||||
|
readManifest = (bs :
|
||||||
|
bindResult (readManifestCore bs)
|
||||||
|
(coreManifest afterCore :
|
||||||
|
bindResult (readBytes 4 afterCore)
|
||||||
|
(metaCountRaw afterMetaCountRaw :
|
||||||
|
bindResult (readTLVList (u32BEBytesToNat metaCountRaw) afterMetaCountRaw)
|
||||||
|
(metadataFields afterMetadataFields :
|
||||||
|
bindResult (readBytes 4 afterMetadataFields)
|
||||||
|
(extCountRaw afterExtCountRaw :
|
||||||
|
bindResult (skipTLVs_ afterExtCountRaw (u32BEBytesToNat extCountRaw) 0)
|
||||||
|
(afterExtensions _ :
|
||||||
|
ok
|
||||||
|
(pair coreManifest (pair metadataFields afterExtensions))
|
||||||
|
afterExtensions))))))
|
||||||
|
|
||||||
|
-- Lookup a metadata value by tag from a TLV list.
|
||||||
|
-- Returns nothing if not found, just value if found.
|
||||||
|
lookupMetadata_ = y (self tlvs tag :
|
||||||
|
matchList
|
||||||
|
nothing
|
||||||
|
(tlv rest :
|
||||||
|
matchBool
|
||||||
|
(just (matchPair (_ value : value) tlv))
|
||||||
|
(self rest tag)
|
||||||
|
(bytesEq? (matchPair (tlvTag _ : tlvTag) tlv) tag))
|
||||||
|
tlvs)
|
||||||
|
|
||||||
|
lookupMetadata = (tlvs tag :
|
||||||
|
lookupMetadata_ tlvs tag)
|
||||||
|
|
||||||
|
-- Get export name from an export entry (pair name (pair rootIndex (pair kind abi)))
|
||||||
|
exportName = (exp :
|
||||||
|
matchPair
|
||||||
|
(name _ : name)
|
||||||
|
exp)
|
||||||
|
|
||||||
|
exportRoot = (exp :
|
||||||
|
matchPair
|
||||||
|
(_ payload :
|
||||||
|
matchPair
|
||||||
|
(root _ : root)
|
||||||
|
payload)
|
||||||
|
exp)
|
||||||
|
|
||||||
|
-- Check if an export name matches a given byte string.
|
||||||
|
exportNameEq? = (nameBytes exp :
|
||||||
|
bytesEq? nameBytes (exportName exp))
|
||||||
|
|
||||||
|
-- Find first export matching a name, or nothing.
|
||||||
|
findExportByName_ = y (self exports name :
|
||||||
|
matchList
|
||||||
|
nothing
|
||||||
|
(exp rest :
|
||||||
|
matchBool
|
||||||
|
(just exp)
|
||||||
|
(self rest name)
|
||||||
|
(exportNameEq? name exp))
|
||||||
|
exports)
|
||||||
|
|
||||||
|
findExportByName = (exports name :
|
||||||
|
findExportByName_ exports name)
|
||||||
|
|
||||||
|
-- Get list of all export names from a list of exports.
|
||||||
|
getExportNames_ = y (self acc exports :
|
||||||
|
matchList
|
||||||
|
(reverse acc)
|
||||||
|
(exp rest :
|
||||||
|
self (pair (exportName exp) acc) rest)
|
||||||
|
exports)
|
||||||
|
|
||||||
|
getExportNames = (exports :
|
||||||
|
getExportNames_ t exports)
|
||||||
|
|
||||||
|
mainExportName = "main"
|
||||||
|
|
||||||
|
maybeExportToResult = (maybeExport :
|
||||||
|
triage
|
||||||
|
(err errMissingSection t)
|
||||||
|
(export : ok export t)
|
||||||
|
(_ _ : err errMissingSection t)
|
||||||
|
maybeExport)
|
||||||
|
|
||||||
|
selectSingleExport = (exports :
|
||||||
|
matchList
|
||||||
|
(err errMissingSection t)
|
||||||
|
(export rest :
|
||||||
|
matchBool
|
||||||
|
(ok export t)
|
||||||
|
(err errMissingSection t)
|
||||||
|
(emptyList? rest))
|
||||||
|
exports)
|
||||||
|
|
||||||
|
selectDefaultExport = (exports :
|
||||||
|
triage
|
||||||
|
(selectSingleExport exports)
|
||||||
|
(export : ok export t)
|
||||||
|
(_ _ : err errMissingSection t)
|
||||||
|
(findExportByName exports mainExportName))
|
||||||
|
|
||||||
|
-- Select an export: explicit name if provided, otherwise "main", otherwise
|
||||||
|
-- the sole export if the bundle has exactly one export.
|
||||||
|
selectExport = (exports nameBytes :
|
||||||
|
matchBool
|
||||||
|
(selectDefaultExport exports)
|
||||||
|
(maybeExportToResult (findExportByName exports nameBytes))
|
||||||
|
(emptyList? nameBytes))
|
||||||
|
|
||||||
|
selectExportOpt = (exports optNameBytes :
|
||||||
|
selectExport exports optNameBytes)
|
||||||
|
|
||||||
|
-- Expected core string values (raw UTF-8 bytes, not decoded to Unicode characters).
|
||||||
|
expectedSchema = "arboricx.bundle.manifest.v1"
|
||||||
|
expectedBundleType = "tree-calculus-executable-object"
|
||||||
|
expectedTreeCalculus = "tree-calculus.v1"
|
||||||
|
expectedTreeHashAlgorithm = "indexed"
|
||||||
|
expectedTreeHashDomain = "arboricx.indexed.node.v1"
|
||||||
|
expectedTreeNodePayload = "arboricx.indexed.payload.v1"
|
||||||
|
expectedRuntimeSemantics = "tree-calculus.v1"
|
||||||
|
expectedRuntimeEvaluation = "normal-order"
|
||||||
|
expectedRuntimeAbi = "arboricx.abi.tree.v1"
|
||||||
|
|
||||||
|
-- Manifest core field accessors.
|
||||||
|
-- readManifestCore returns: (pair schema (pair bundleType (... (pair closureByte (pair roots exports)))))
|
||||||
|
pairFirst = (p : matchPair (a _ : a) p)
|
||||||
|
pairSecond = (p : matchPair (_ b : b) p)
|
||||||
|
|
||||||
|
manifestSchema = (core : pairFirst core)
|
||||||
|
manifestBundleType = (core : pairFirst (pairSecond core))
|
||||||
|
manifestTreeCalculus = (core : pairFirst (pairSecond (pairSecond core)))
|
||||||
|
manifestTreeHashAlgorithm = (core : pairFirst (pairSecond (pairSecond (pairSecond core))))
|
||||||
|
manifestTreeHashDomain = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond core)))))
|
||||||
|
manifestTreeNodePayload = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core))))))
|
||||||
|
manifestRuntimeSemantics = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core)))))))
|
||||||
|
manifestRuntimeEvaluation = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core))))))))
|
||||||
|
manifestRuntimeAbi = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core)))))))))
|
||||||
|
manifestCapabilities = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core))))))))))
|
||||||
|
manifestClosureByte = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core)))))))))))
|
||||||
|
manifestRoots = (core : pairFirst (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core))))))))))))
|
||||||
|
manifestExports = (core : pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond (pairSecond core))))))))))))
|
||||||
|
|
||||||
|
-- Helper: compare a manifest field against an expected byte string.
|
||||||
|
manifestFieldMatch? = (actual expected : bytesEq? actual expected)
|
||||||
|
|
||||||
|
-- Validate core manifest fields against expected values.
|
||||||
|
validateManifestCore = (core rest :
|
||||||
|
matchBool
|
||||||
|
(ok core rest)
|
||||||
|
(err errManifestValidationFailed rest)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestSchema core) expectedSchema)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestBundleType core) expectedBundleType)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestTreeCalculus core) expectedTreeCalculus)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestTreeHashAlgorithm core) expectedTreeHashAlgorithm)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestTreeHashDomain core) expectedTreeHashDomain)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestTreeNodePayload core) expectedTreeNodePayload)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestRuntimeSemantics core) expectedRuntimeSemantics)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestRuntimeEvaluation core) expectedRuntimeEvaluation)
|
||||||
|
(and?
|
||||||
|
(manifestFieldMatch? (manifestRuntimeAbi core) expectedRuntimeAbi)
|
||||||
|
(and?
|
||||||
|
(bytesEq? (manifestClosureByte core) [(0)])
|
||||||
|
(and?
|
||||||
|
(not? (emptyList? (manifestRoots core)))
|
||||||
|
(not? (emptyList? (manifestExports core)))))))))))))))
|
||||||
374
lib/arboricx/nodes.tri
Normal file
374
lib/arboricx/nodes.tri
Normal file
@@ -0,0 +1,374 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "binary" !Local
|
||||||
|
!import "arboricx.common" !Local
|
||||||
|
|
||||||
|
-- Indexed Arboricx node section reader.
|
||||||
|
--
|
||||||
|
-- Node records in the indexed format are just length-prefixed payloads:
|
||||||
|
-- u32 payloadLength || payload
|
||||||
|
-- A payload is one of:
|
||||||
|
-- 0x00
|
||||||
|
-- 0x01 || childIndex:u32be
|
||||||
|
-- 0x02 || leftIndex:u32be || rightIndex:u32be
|
||||||
|
-- Child indices must point strictly backward in the node array.
|
||||||
|
|
||||||
|
readNodeRecord = (bs :
|
||||||
|
bindResult (readBytes 4 bs)
|
||||||
|
(payloadLength afterPayloadLength :
|
||||||
|
bindResult (readBytes (u32BEBytesToNat payloadLength) afterPayloadLength)
|
||||||
|
(payload afterPayload :
|
||||||
|
ok payload afterPayload)))
|
||||||
|
|
||||||
|
nodePayloadKind = (nodePayload : bytesHead nodePayload)
|
||||||
|
|
||||||
|
nodePayloadHasTag? = (tag nodePayload :
|
||||||
|
triage
|
||||||
|
false
|
||||||
|
(actualTag : equal? actualTag tag)
|
||||||
|
(_ _ : false)
|
||||||
|
(nodePayloadKind nodePayload))
|
||||||
|
|
||||||
|
nodePayloadLeaf? = (nodePayload :
|
||||||
|
bytesEq? [(0)] nodePayload)
|
||||||
|
|
||||||
|
nodePayloadStem? = (nodePayload :
|
||||||
|
and?
|
||||||
|
(nodePayloadHasTag? nodePayloadStemTag nodePayload)
|
||||||
|
(equal? (bytesLength nodePayload) 5))
|
||||||
|
|
||||||
|
nodePayloadFork? = (nodePayload :
|
||||||
|
and?
|
||||||
|
(nodePayloadHasTag? nodePayloadForkTag nodePayload)
|
||||||
|
(equal? (bytesLength nodePayload) 9))
|
||||||
|
|
||||||
|
nodePayloadValid? = (nodePayload :
|
||||||
|
or?
|
||||||
|
(nodePayloadLeaf? nodePayload)
|
||||||
|
(or?
|
||||||
|
(nodePayloadStem? nodePayload)
|
||||||
|
(nodePayloadFork? nodePayload)))
|
||||||
|
|
||||||
|
nodeU32FromBytes4 = (b0 b1 b2 b3 :
|
||||||
|
u32BEBytesToNat
|
||||||
|
(pair b0
|
||||||
|
(pair b1
|
||||||
|
(pair b2
|
||||||
|
(pair b3 t)))))
|
||||||
|
|
||||||
|
withNodePayloadStemIndex = (nodePayload shortK indexK :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(tag r0 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(b0 r1 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(b1 r2 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(b2 r3 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(b3 _ :
|
||||||
|
indexK (nodeU32FromBytes4 b0 b1 b2 b3))
|
||||||
|
r3) r2) r1) r0) nodePayload)
|
||||||
|
|
||||||
|
withNodePayloadForkIndices = (nodePayload shortK indicesK :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(tag r0 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(l0 r1 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(l1 r2 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(l2 r3 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(l3 r4 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(r0b r5 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(r1b r6 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(r2b r7 :
|
||||||
|
matchList
|
||||||
|
(shortK t)
|
||||||
|
(r3b _ :
|
||||||
|
indicesK
|
||||||
|
(nodeU32FromBytes4 l0 l1 l2 l3)
|
||||||
|
(nodeU32FromBytes4 r0b r1b r2b r3b)) r7) r6) r5) r4) r3) r2) r1) r0) nodePayload)
|
||||||
|
|
||||||
|
nodePayloadStemChildIndex = (nodePayload :
|
||||||
|
withNodePayloadStemIndex nodePayload (_ : 0) (index : index))
|
||||||
|
|
||||||
|
nodePayloadForkLeftIndex = (nodePayload :
|
||||||
|
withNodePayloadForkIndices nodePayload (_ : 0) (left right : left))
|
||||||
|
|
||||||
|
nodePayloadForkRightIndex = (nodePayload :
|
||||||
|
withNodePayloadForkIndices nodePayload (_ : 0) (left right : right))
|
||||||
|
|
||||||
|
nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
|
||||||
|
matchList
|
||||||
|
false
|
||||||
|
(nodePayload rest :
|
||||||
|
or?
|
||||||
|
(not? (nodePayloadValid? nodePayload))
|
||||||
|
(self rest))
|
||||||
|
nodeRecords)
|
||||||
|
|
||||||
|
nodePayloadChildIndices = (nodePayload :
|
||||||
|
matchList
|
||||||
|
t
|
||||||
|
(tag rest :
|
||||||
|
lazyBool
|
||||||
|
(_ :
|
||||||
|
withNodePayloadStemIndex
|
||||||
|
nodePayload
|
||||||
|
(_ : t)
|
||||||
|
(childIndex : pair childIndex t))
|
||||||
|
(_ :
|
||||||
|
lazyBool
|
||||||
|
(_ :
|
||||||
|
withNodePayloadForkIndices
|
||||||
|
nodePayload
|
||||||
|
(_ : t)
|
||||||
|
(leftIndex rightIndex :
|
||||||
|
pair leftIndex (pair rightIndex t)))
|
||||||
|
(_ : t)
|
||||||
|
(equal? tag nodePayloadForkTag))
|
||||||
|
(equal? tag nodePayloadStemTag))
|
||||||
|
nodePayload)
|
||||||
|
|
||||||
|
-- True iff index n names an element before limit in records.
|
||||||
|
-- For topologically sorted indexed bundles, every child of record i must
|
||||||
|
-- satisfy childIndex < i, so searching only the prefix [0, i) validates both
|
||||||
|
-- bounds and acyclicity.
|
||||||
|
nodeIndexInPrefix? = y (self records n i limit :
|
||||||
|
matchList
|
||||||
|
false
|
||||||
|
(_ rest :
|
||||||
|
matchBool
|
||||||
|
false
|
||||||
|
(matchBool
|
||||||
|
true
|
||||||
|
(self rest n (succ i) limit)
|
||||||
|
(equal? i n))
|
||||||
|
(equal? i limit))
|
||||||
|
records)
|
||||||
|
|
||||||
|
nodeChildIndicesInPrefix? = y (self childIndices records limit :
|
||||||
|
matchList
|
||||||
|
true
|
||||||
|
(childIndex rest :
|
||||||
|
matchBool
|
||||||
|
(self rest records limit)
|
||||||
|
false
|
||||||
|
(nodeIndexInPrefix? records childIndex 0 limit))
|
||||||
|
childIndices)
|
||||||
|
|
||||||
|
nodePayloadIndicesValid? = (nodePayload i records :
|
||||||
|
nodeChildIndicesInPrefix?
|
||||||
|
(nodePayloadChildIndices nodePayload)
|
||||||
|
records
|
||||||
|
i)
|
||||||
|
|
||||||
|
nodeRecordsValidIndicesFrom? = y (self allRecords remainingRecords i :
|
||||||
|
matchList
|
||||||
|
true
|
||||||
|
(nodePayload rest :
|
||||||
|
matchBool
|
||||||
|
(self allRecords rest (succ i))
|
||||||
|
false
|
||||||
|
(nodePayloadIndicesValid? nodePayload i allRecords))
|
||||||
|
remainingRecords)
|
||||||
|
|
||||||
|
nodeRecordsValidIndices? = (nodeRecords i :
|
||||||
|
nodeRecordsValidIndicesFrom? nodeRecords nodeRecords i)
|
||||||
|
|
||||||
|
validateNodeRecords = (nodeRecords rest :
|
||||||
|
matchBool
|
||||||
|
(err errInvalidNodePayload rest)
|
||||||
|
(matchBool
|
||||||
|
(ok nodeRecords rest)
|
||||||
|
(err errMissingNode rest)
|
||||||
|
(nodeRecordsValidIndices? nodeRecords 0))
|
||||||
|
(nodeRecordsHaveInvalidPayload? nodeRecords))
|
||||||
|
|
||||||
|
readNodeRecords_ = y (self bs nodeCount i acc :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(bindResult (readNodeRecord bs)
|
||||||
|
(nodeRecord afterNodeRecord :
|
||||||
|
self afterNodeRecord nodeCount (succ i) (pair nodeRecord acc)))
|
||||||
|
(equal? i nodeCount))
|
||||||
|
|
||||||
|
readNodeRecords = (nodeCount bs :
|
||||||
|
readNodeRecords_ bs nodeCount 0 t)
|
||||||
|
|
||||||
|
readNodesSection = (bs :
|
||||||
|
bindResult (readBytes 8 bs)
|
||||||
|
(nodeCount afterNodeCount :
|
||||||
|
bindResult (readNodeRecords (u64BEBytesToNat nodeCount) afterNodeCount)
|
||||||
|
(nodeRecords afterNodeRecords :
|
||||||
|
bindResult (validateNodeRecords nodeRecords afterNodeRecords)
|
||||||
|
(validNodeRecords afterValidNodeRecords :
|
||||||
|
ok (pair nodeCount validNodeRecords) afterValidNodeRecords))))
|
||||||
|
|
||||||
|
readNodesSectionComplete = (bs :
|
||||||
|
bindResult (readNodesSection bs)
|
||||||
|
(nodesSection afterNodesSection :
|
||||||
|
matchBool
|
||||||
|
(ok nodesSection afterNodesSection)
|
||||||
|
(err errUnexpectedBytes afterNodesSection)
|
||||||
|
(bytesNil? afterNodesSection)))
|
||||||
|
|
||||||
|
readArboricxNodesSection = (bs :
|
||||||
|
bindResult (readArboricxContainer bs)
|
||||||
|
(container afterContainer :
|
||||||
|
matchPair
|
||||||
|
(_ directory :
|
||||||
|
bindResult (sectionBytesOrErr arboricxNodesSectionId directory bs afterContainer)
|
||||||
|
(nodesBytes _ :
|
||||||
|
bindResult (readNodesSectionComplete nodesBytes)
|
||||||
|
(nodesSection _ : ok nodesSection afterContainer)))
|
||||||
|
container))
|
||||||
|
|
||||||
|
nodesSectionCount = (nodesSection :
|
||||||
|
matchPair
|
||||||
|
(nodeCount _ : nodeCount)
|
||||||
|
nodesSection)
|
||||||
|
|
||||||
|
nodesSectionRecords = (nodesSection :
|
||||||
|
matchPair
|
||||||
|
(_ nodeRecords : nodeRecords)
|
||||||
|
nodesSection)
|
||||||
|
|
||||||
|
nodeBuiltTreeIndex = (entry :
|
||||||
|
matchPair
|
||||||
|
(index _ : index)
|
||||||
|
entry)
|
||||||
|
|
||||||
|
nodeBuiltTreeValue = (entry :
|
||||||
|
matchPair
|
||||||
|
(_ tree : tree)
|
||||||
|
entry)
|
||||||
|
|
||||||
|
nodeTreeByIndex_ = (self builtTrees targetIndex :
|
||||||
|
lazyList
|
||||||
|
(_ : err errMissingNode t)
|
||||||
|
(entry rest :
|
||||||
|
lazyBool
|
||||||
|
(_ : ok (nodeBuiltTreeValue entry) t)
|
||||||
|
(_ : self rest targetIndex)
|
||||||
|
(equal? (nodeBuiltTreeIndex entry) targetIndex))
|
||||||
|
builtTrees)
|
||||||
|
|
||||||
|
nodeTreeByIndex = (builtTrees targetIndex :
|
||||||
|
y nodeTreeByIndex_ builtTrees targetIndex)
|
||||||
|
|
||||||
|
nodePayloadToTreeFromBuilt = (builtTrees nodePayload :
|
||||||
|
matchList
|
||||||
|
(err errInvalidNodePayload t)
|
||||||
|
(tag rest :
|
||||||
|
lazyBool
|
||||||
|
(_ : ok t t)
|
||||||
|
(_ :
|
||||||
|
lazyBool
|
||||||
|
(_ :
|
||||||
|
withNodePayloadStemIndex
|
||||||
|
nodePayload
|
||||||
|
(_ : err errInvalidNodePayload t)
|
||||||
|
(childIndex :
|
||||||
|
lazyResult
|
||||||
|
(code after : err code after)
|
||||||
|
(child _ : ok (t child) t)
|
||||||
|
(nodeTreeByIndex builtTrees childIndex)))
|
||||||
|
(_ :
|
||||||
|
lazyBool
|
||||||
|
(_ :
|
||||||
|
withNodePayloadForkIndices
|
||||||
|
nodePayload
|
||||||
|
(_ : err errInvalidNodePayload t)
|
||||||
|
(leftIndex rightIndex :
|
||||||
|
lazyResult
|
||||||
|
(code after : err code after)
|
||||||
|
(left _ :
|
||||||
|
lazyResult
|
||||||
|
(code after : err code after)
|
||||||
|
(right _ : ok (pair left right) t)
|
||||||
|
(nodeTreeByIndex builtTrees rightIndex))
|
||||||
|
(nodeTreeByIndex builtTrees leftIndex)))
|
||||||
|
(_ : err errInvalidNodePayload t)
|
||||||
|
(equal? tag nodePayloadForkTag))
|
||||||
|
(equal? tag nodePayloadStemTag))
|
||||||
|
(equal? tag 0))
|
||||||
|
nodePayload)
|
||||||
|
|
||||||
|
nodeBuildState = (targetIndex i builtTrees :
|
||||||
|
pair targetIndex (pair i builtTrees))
|
||||||
|
|
||||||
|
nodeBuildStateTargetIndex = (state :
|
||||||
|
matchPair
|
||||||
|
(targetIndex _ : targetIndex)
|
||||||
|
state)
|
||||||
|
|
||||||
|
nodeBuildStateI = (state :
|
||||||
|
matchPair
|
||||||
|
(_ rest :
|
||||||
|
matchPair
|
||||||
|
(i _ : i)
|
||||||
|
rest)
|
||||||
|
state)
|
||||||
|
|
||||||
|
nodeBuildStateBuiltTrees = (state :
|
||||||
|
matchPair
|
||||||
|
(_ rest :
|
||||||
|
matchPair
|
||||||
|
(_ builtTrees : builtTrees)
|
||||||
|
rest)
|
||||||
|
state)
|
||||||
|
|
||||||
|
nodeIndexToTree_ = (self remainingRecords state :
|
||||||
|
((nodeIndex :
|
||||||
|
((i :
|
||||||
|
((builtTrees :
|
||||||
|
lazyList
|
||||||
|
(_ : err errMissingNode t)
|
||||||
|
(nodePayload rest :
|
||||||
|
lazyResult
|
||||||
|
(code after : err code after)
|
||||||
|
(tree _ :
|
||||||
|
lazyBool
|
||||||
|
(_ : ok tree t)
|
||||||
|
(_ :
|
||||||
|
self
|
||||||
|
rest
|
||||||
|
(nodeBuildState
|
||||||
|
nodeIndex
|
||||||
|
(succ i)
|
||||||
|
(pair (pair i tree) builtTrees)))
|
||||||
|
(equal? i nodeIndex))
|
||||||
|
(nodePayloadToTreeFromBuilt builtTrees nodePayload))
|
||||||
|
remainingRecords)
|
||||||
|
(nodeBuildStateBuiltTrees state)))
|
||||||
|
(nodeBuildStateI state)))
|
||||||
|
(nodeBuildStateTargetIndex state)))
|
||||||
|
|
||||||
|
nodeIndexToTree = (nodeRecords nodeIndex :
|
||||||
|
y nodeIndexToTree_ nodeRecords (nodeBuildState nodeIndex 0 t))
|
||||||
|
|
||||||
|
readArboricxTreeFromIndex = (rootIndexBytes bs :
|
||||||
|
bindResult (readArboricxNodesSection bs)
|
||||||
|
(nodesSection afterContainer :
|
||||||
|
bindResult (nodeIndexToTree (nodesSectionRecords nodesSection) (u32BEBytesToNat rootIndexBytes))
|
||||||
|
(tree _ : ok tree afterContainer)))
|
||||||
|
|
||||||
|
readArboricxExecutableFromIndex = readArboricxTreeFromIndex
|
||||||
206
lib/arboricx/server.tri
Normal file
206
lib/arboricx/server.tri
Normal file
@@ -0,0 +1,206 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
!import "io" !Local
|
||||||
|
!import "http" !Local
|
||||||
|
!import "socket" !Local
|
||||||
|
!import "patterns" !Local
|
||||||
|
!import "arboricx" !Local
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Store layout helpers
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pathJoin a b = append a (append "/" b)
|
||||||
|
|
||||||
|
objectDir root shard =
|
||||||
|
pathJoin (pathJoin root "objects") shard
|
||||||
|
|
||||||
|
hashShard hash =
|
||||||
|
matchList
|
||||||
|
t
|
||||||
|
(h0 r0 :
|
||||||
|
matchList
|
||||||
|
(pair h0 t)
|
||||||
|
(h1 r1 :
|
||||||
|
matchList
|
||||||
|
(pair h0 (pair h1 t))
|
||||||
|
(h2 _ :
|
||||||
|
pair h0 (pair h1 (pair h2 t)))
|
||||||
|
r1)
|
||||||
|
r0)
|
||||||
|
hash
|
||||||
|
|
||||||
|
bundleObjectPath root hash =
|
||||||
|
pathJoin
|
||||||
|
(objectDir root (hashShard hash))
|
||||||
|
(append hash ".arboricx")
|
||||||
|
|
||||||
|
bundleTmpPath root hash time =
|
||||||
|
pathJoin
|
||||||
|
(pathJoin root "tmp")
|
||||||
|
(append hash ".tmp")
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Store initialization
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
ensureDir path =
|
||||||
|
void (createDirectory path)
|
||||||
|
|
||||||
|
ensureStore root =
|
||||||
|
foldl
|
||||||
|
thenIO
|
||||||
|
(pure (ok t t))
|
||||||
|
[(ensureDir root)
|
||||||
|
(ensureDir (pathJoin root "tmp"))
|
||||||
|
(ensureDir (pathJoin root "objects"))
|
||||||
|
(ensureDir (pathJoin root "aliases"))
|
||||||
|
(ensureDir (pathJoin (pathJoin root "aliases") "names"))
|
||||||
|
(ensureDir (pathJoin (pathJoin root "aliases") "packages"))
|
||||||
|
(ensureDir (pathJoin root "manifests"))]
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Bundle object write
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
putBundleWrite root bundleBytes hash shard tmpPath finalPath =
|
||||||
|
do onOk_
|
||||||
|
_ <- mapErrIO "createDirectory: " (createDirectory (objectDir root shard))
|
||||||
|
_ <- mapErrIO "writeBytes: " (writeBytes tmpPath bundleBytes)
|
||||||
|
_ <- mapErrIO "renameFile: " (renameFile tmpPath finalPath)
|
||||||
|
pure (ok hash t)
|
||||||
|
|
||||||
|
putBundleWithHash root bundleBytes time hash =
|
||||||
|
let shard = hashShard hash in
|
||||||
|
let tmpPath = bundleTmpPath root hash time in
|
||||||
|
let finalPath = bundleObjectPath root hash in
|
||||||
|
putBundleWrite root bundleBytes hash shard tmpPath finalPath
|
||||||
|
|
||||||
|
putBundle root bundleBytes =
|
||||||
|
do onOk_
|
||||||
|
time <- mapErrIO "currentTime: " currentTime
|
||||||
|
hash <- mapErrIO "sha256Hex: " (sha256Hex bundleBytes)
|
||||||
|
savedHash <- mapErrIO "withHash: " (putBundleWithHash root bundleBytes time hash)
|
||||||
|
pure (ok savedHash t)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Bundle object fetch
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
getBundleByHash root hash =
|
||||||
|
onResult_ (readFile (bundleObjectPath root hash))
|
||||||
|
(errMsg : pure (err errMsg t))
|
||||||
|
(bytes : pure (ok bytes t))
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Route prefix helper
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
stripPrefix_ self input prefix =
|
||||||
|
lazyList
|
||||||
|
(_ :
|
||||||
|
lazyList
|
||||||
|
(_ : just t)
|
||||||
|
(_ _ : nothing)
|
||||||
|
prefix)
|
||||||
|
(ih ir :
|
||||||
|
lazyList
|
||||||
|
(_ : just input)
|
||||||
|
(ph pr :
|
||||||
|
lazyBool
|
||||||
|
(_ : self ir pr)
|
||||||
|
(_ : nothing)
|
||||||
|
(equal? ih ph))
|
||||||
|
prefix)
|
||||||
|
input
|
||||||
|
|
||||||
|
stripPrefix prefix input =
|
||||||
|
y stripPrefix_ input prefix
|
||||||
|
|
||||||
|
bundleHashPrefix = "/_arboricx/bundle/hash/"
|
||||||
|
bundlePath = "/_arboricx/bundle"
|
||||||
|
healthPath = "/_arboricx/health"
|
||||||
|
bundleContentType = "application/vnd.arboricx.bundle"
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Landing page
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- TODO: Let's replace in-line HTML with the ability to read and serve files
|
||||||
|
-- from a public/ folder.
|
||||||
|
|
||||||
|
htmlLandingPage = "<!DOCTYPE html><html><head><meta name='viewport' content='width=device-width, initial-scale=1'><title>Arboricx Server</title></head><body><h1>Arboricx Server</h1><p>Bundle registry</p><p><a href='https://git.eversole.co/James/tricu'>Made with Love (and trees, lots of trees)</a></p></body></html>"
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Registry routes
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
bundleResponse bytes = response 200 bundleContentType bytes
|
||||||
|
|
||||||
|
serveBundleHash root hash =
|
||||||
|
onResult_ (getBundleByHash root hash)
|
||||||
|
(errMsg : pure (errorResponse 404 errMsg))
|
||||||
|
(bytes : pure (bundleResponse bytes))
|
||||||
|
|
||||||
|
healthRoute method target =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? method "GET") (_ : getHealth))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
where getHealth =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? target healthPath) (_ : pure (okResponse "OK\n")))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
|
||||||
|
putBundleRoute root method target body =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? method "POST") (_ : postBundle))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
where postBundle =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? target bundlePath) (_ : handleUpload))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
where handleUpload =
|
||||||
|
onResult_ (putBundle root body)
|
||||||
|
(err : pure (badRequestResponse (append "Upload failed: " err)))
|
||||||
|
(hash : pure (createdResponse hash))
|
||||||
|
|
||||||
|
getBundleRoute root method target =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? method "GET") (_ : getBundle))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
where getBundle =
|
||||||
|
lazyMaybe
|
||||||
|
(_ : pure notFoundResponse)
|
||||||
|
(hash : serveBundleHash root hash)
|
||||||
|
(stripPrefix bundleHashPrefix target)
|
||||||
|
|
||||||
|
arboricxRouter root method target headers body =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? method "GET") (_ : getRoutes))
|
||||||
|
(guard (_ : equal? method "POST") (_ : putBundleRoute root method target body))
|
||||||
|
(guard (_ : true) (_ : pure notFoundResponse))]
|
||||||
|
where getRoutes =
|
||||||
|
cond
|
||||||
|
[(guard (_ : equal? target "/") (_ : pure (htmlResponse htmlLandingPage)))
|
||||||
|
(guard (_ : true) (_ : getBundleOrHealth))]
|
||||||
|
where getBundleOrHealth =
|
||||||
|
lazyMaybe
|
||||||
|
(_ : healthRoute method target)
|
||||||
|
(hash : serveBundleHash root hash)
|
||||||
|
(stripPrefix bundleHashPrefix target)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Server entrypoint
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
arboricxHandler root = (client peer :
|
||||||
|
httpHandlerIO
|
||||||
|
(method target headers body :
|
||||||
|
arboricxRouter root method target headers body)
|
||||||
|
client
|
||||||
|
peer)
|
||||||
|
|
||||||
|
arboricxServer root addr port =
|
||||||
|
onResult_ (listenSocket addr port 128)
|
||||||
|
(errMsg : pure (err errMsg t))
|
||||||
|
(server :
|
||||||
|
serveForever server (arboricxHandler root))
|
||||||
323
lib/base.tri
323
lib/base.tri
@@ -1,18 +1,18 @@
|
|||||||
false = t
|
false = t
|
||||||
_ = t
|
_ = t
|
||||||
true = t t
|
true = t t
|
||||||
id = a : a
|
id a@_a =@_a a
|
||||||
const = a b : a
|
const a@_a b@_b =@_a a
|
||||||
pair = t
|
pair = t
|
||||||
if = cond then else : t (t else (t t then)) t cond
|
if cond then else = t (t else (t t then)) t cond
|
||||||
|
|
||||||
y = ((mut wait fun : wait mut (x : fun (wait mut x)))
|
y = ((mut wait fun : wait mut (x : fun (wait mut x)))
|
||||||
(x : x x)
|
(x : x x)
|
||||||
(a0 a1 a2 : t (t a0) (t t a2) a1))
|
(a0 a1 a2 : t (t a0) (t t a2) a1))
|
||||||
|
|
||||||
compose = f g x : f (g x)
|
compose f@(Fn [_b] _c) g@(Fn [_a] _b) x@_a =@_c f (g x)
|
||||||
|
|
||||||
triage = leaf stem fork : t (t leaf stem) fork
|
triage leaf stem fork = t (t leaf stem) fork
|
||||||
test = triage "Leaf" (_ : "Stem") (_ _ : "Fork")
|
test = triage "Leaf" (_ : "Stem") (_ _ : "Fork")
|
||||||
|
|
||||||
matchBool = (ot of : triage
|
matchBool = (ot of : triage
|
||||||
@@ -31,7 +31,18 @@ lOr = (triage
|
|||||||
(_ _ : true)
|
(_ _ : true)
|
||||||
(_ _ _ : true))
|
(_ _ _ : true))
|
||||||
|
|
||||||
matchPair = a : triage _ _ a
|
matchPair a = triage _ _ a
|
||||||
|
|
||||||
|
fst p = matchPair takeFirst p
|
||||||
|
where takeFirst a b = a
|
||||||
|
snd p = matchPair takeSecond p
|
||||||
|
where takeSecond a b = b
|
||||||
|
|
||||||
|
resultIsOk result =
|
||||||
|
matchResult (err rest : false) (val rest : true) result
|
||||||
|
|
||||||
|
resultIsErr result =
|
||||||
|
matchResult (err rest : true) (val rest : false) result
|
||||||
|
|
||||||
not? = matchBool false true
|
not? = matchBool false true
|
||||||
and? = matchBool id (_ : false)
|
and? = matchBool id (_ : false)
|
||||||
@@ -72,3 +83,303 @@ succ = y (self :
|
|||||||
(t (t t))
|
(t (t t))
|
||||||
(_ tail : t t (self tail))
|
(_ tail : t t (self tail))
|
||||||
t))
|
t))
|
||||||
|
|
||||||
|
ok value rest = pair true (pair value rest)
|
||||||
|
err msg rest = pair false (pair msg rest)
|
||||||
|
|
||||||
|
matchResult errCase okCase result =
|
||||||
|
matchPair
|
||||||
|
(tag payload :
|
||||||
|
matchPair
|
||||||
|
(value rest :
|
||||||
|
matchBool
|
||||||
|
(okCase value rest)
|
||||||
|
(errCase value rest)
|
||||||
|
tag)
|
||||||
|
payload)
|
||||||
|
result
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Maybe / Option type
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
nothing = t
|
||||||
|
just x = t x
|
||||||
|
|
||||||
|
matchMaybe nothingCase justCase maybe =
|
||||||
|
triage
|
||||||
|
nothingCase
|
||||||
|
justCase
|
||||||
|
(_ _ : nothingCase)
|
||||||
|
maybe
|
||||||
|
|
||||||
|
maybe default f m = matchMaybe default f m
|
||||||
|
maybeMap f@(Fn [_a] _b) m@(Maybe _a) =@(Maybe _b) matchMaybe nothing (compose just f) m
|
||||||
|
maybeBind m@(Maybe _a) f@(Fn [_a] (Maybe _b)) =@(Maybe _b) matchMaybe nothing f m
|
||||||
|
maybeOr default@_a m@(Maybe _a) =@_a matchMaybe default id m
|
||||||
|
maybe? = matchMaybe false (_ : true)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Basic arithmetic
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
ifLazy = (cond thenK elseK :
|
||||||
|
matchBool
|
||||||
|
(thenK t)
|
||||||
|
(elseK t)
|
||||||
|
cond)
|
||||||
|
|
||||||
|
andLazy? = (a bK :
|
||||||
|
ifLazy
|
||||||
|
a
|
||||||
|
bK
|
||||||
|
(_ : false))
|
||||||
|
|
||||||
|
pred = y (self : triage
|
||||||
|
0
|
||||||
|
(_ : 0)
|
||||||
|
(bit rest :
|
||||||
|
matchBool
|
||||||
|
(matchBool
|
||||||
|
0
|
||||||
|
(pair 0 rest)
|
||||||
|
(equal? rest 0))
|
||||||
|
(matchBool
|
||||||
|
0
|
||||||
|
(pair 1 (self rest))
|
||||||
|
(equal? rest 0))
|
||||||
|
bit))
|
||||||
|
|
||||||
|
isZero? = triage true (_ : false) (_ _ : false)
|
||||||
|
|
||||||
|
add = y (self x y :
|
||||||
|
triage
|
||||||
|
y
|
||||||
|
(_ : succ y)
|
||||||
|
(_ _ : succ (self (pred x) y))
|
||||||
|
x)
|
||||||
|
|
||||||
|
sub = y (self a b :
|
||||||
|
ifLazy
|
||||||
|
(isZero? b)
|
||||||
|
(_ : a)
|
||||||
|
(_ : self (pred a) (pred b)))
|
||||||
|
|
||||||
|
lte? = y (self a b :
|
||||||
|
ifLazy
|
||||||
|
(isZero? a)
|
||||||
|
(_ : true)
|
||||||
|
(_ :
|
||||||
|
ifLazy
|
||||||
|
(isZero? b)
|
||||||
|
(_ : false)
|
||||||
|
(_ : self (pred a) (pred b))))
|
||||||
|
|
||||||
|
gte? = a b :
|
||||||
|
lte? b a
|
||||||
|
|
||||||
|
lt? = a b :
|
||||||
|
and? (lte? a b) (not? (equal? a b))
|
||||||
|
|
||||||
|
gt? = a b :
|
||||||
|
lt? b a
|
||||||
|
|
||||||
|
mul = y (self a b :
|
||||||
|
ifLazy
|
||||||
|
(isZero? b)
|
||||||
|
(_ : 0)
|
||||||
|
(_ : add a (self a (pred b))))
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Result combinators
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
mapResult = (f result :
|
||||||
|
matchResult
|
||||||
|
(code rest : err code rest)
|
||||||
|
(value rest : ok (f value) rest)
|
||||||
|
result)
|
||||||
|
|
||||||
|
bindResult = (result f :
|
||||||
|
matchResult
|
||||||
|
(code rest : err code rest)
|
||||||
|
(value rest : f value rest)
|
||||||
|
result)
|
||||||
|
|
||||||
|
resultOr = (default result :
|
||||||
|
matchResult
|
||||||
|
(_ _ : default)
|
||||||
|
(value _ : value)
|
||||||
|
result)
|
||||||
|
|
||||||
|
resultMapErr = (f result :
|
||||||
|
matchResult
|
||||||
|
(code rest : err (f code) rest)
|
||||||
|
(value rest : ok value rest)
|
||||||
|
result)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- View facts
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
factsFact name provenance view = pair name (pair provenance view)
|
||||||
|
factsChecked = 0
|
||||||
|
factsTrusted = 1
|
||||||
|
factsUnchecked = 2
|
||||||
|
factsField tag value = pair tag value
|
||||||
|
factsRecord tag fields = pair tag fields
|
||||||
|
factsVar id = factsRecord 8 [(factsField 10 id)]
|
||||||
|
factsForall binders body =
|
||||||
|
factsRecord 9 [(factsField 11 binders) (factsField 12 body)]
|
||||||
|
factsFn args result =
|
||||||
|
factsRecord 1 [(factsField 0 args) (factsField 1 result)]
|
||||||
|
factsAny = factsRecord 0 []
|
||||||
|
factsRef symbol = factsRecord 2 [(factsField 2 symbol)]
|
||||||
|
factsBool = factsRef 0
|
||||||
|
factsString = factsRef 1
|
||||||
|
factsByte = factsRef 2
|
||||||
|
factsUnit = factsRef 3
|
||||||
|
factsMaybe elem = factsRecord 4 [(factsField 3 elem)]
|
||||||
|
factsList elem = factsRecord 3 [(factsField 3 elem)]
|
||||||
|
factsPair left right = factsRecord 5 [(factsField 4 left) (factsField 5 right)]
|
||||||
|
factsResult err ok = factsRecord 6 [(factsField 6 err) (factsField 7 ok)]
|
||||||
|
|
||||||
|
viewFacts =
|
||||||
|
[ (factsFact "pair" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn
|
||||||
|
[(factsVar 0) (factsList (factsVar 0))]
|
||||||
|
(factsList (factsVar 0)))))
|
||||||
|
(factsFact "nothing" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsMaybe (factsVar 0))))
|
||||||
|
(factsFact "just" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn [(factsVar 0)] (factsMaybe (factsVar 0)))))
|
||||||
|
(factsFact "false" factsTrusted factsBool)
|
||||||
|
(factsFact "true" factsTrusted factsBool)
|
||||||
|
(factsFact "if" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn [factsBool (factsVar 0) (factsVar 0)] (factsVar 0))))
|
||||||
|
(factsFact "triage" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn [factsAny factsAny factsAny factsAny] (factsVar 0))))
|
||||||
|
(factsFact "test" factsTrusted factsString)
|
||||||
|
(factsFact "matchBool" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn
|
||||||
|
[(factsVar 0) (factsVar 0) factsBool]
|
||||||
|
(factsVar 0))))
|
||||||
|
(factsFact "lAnd" factsTrusted
|
||||||
|
(factsFn [factsBool factsBool] factsBool))
|
||||||
|
(factsFact "lOr" factsTrusted
|
||||||
|
(factsFn [factsBool factsBool] factsBool))
|
||||||
|
(factsFact "matchPair" factsTrusted
|
||||||
|
(factsForall [0 1 2]
|
||||||
|
(factsFn
|
||||||
|
[(factsFn [(factsVar 0) (factsVar 1)] (factsVar 2))
|
||||||
|
(factsPair (factsVar 0) (factsVar 1))]
|
||||||
|
(factsVar 2))))
|
||||||
|
(factsFact "fst" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsPair (factsVar 0) (factsVar 1))] (factsVar 0))))
|
||||||
|
(factsFact "snd" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsPair (factsVar 0) (factsVar 1))] (factsVar 1))))
|
||||||
|
(factsFact "not?" factsTrusted
|
||||||
|
(factsFn [factsBool] factsBool))
|
||||||
|
(factsFact "and?" factsTrusted
|
||||||
|
(factsFn [factsBool factsBool] factsBool))
|
||||||
|
(factsFact "or?" factsTrusted
|
||||||
|
(factsFn [factsBool factsBool] factsBool))
|
||||||
|
(factsFact "xor?" factsTrusted
|
||||||
|
(factsFn [factsBool factsBool] factsBool))
|
||||||
|
(factsFact "equal?" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn [(factsVar 0) (factsVar 0)] factsBool)))
|
||||||
|
(factsFact "succ" factsTrusted
|
||||||
|
(factsFn [factsByte] factsByte))
|
||||||
|
(factsFact "pred" factsTrusted
|
||||||
|
(factsFn [factsByte] factsByte))
|
||||||
|
(factsFact "isZero?" factsTrusted
|
||||||
|
(factsFn [factsByte] factsBool))
|
||||||
|
(factsFact "add" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsByte))
|
||||||
|
(factsFact "sub" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsByte))
|
||||||
|
(factsFact "lte?" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsBool))
|
||||||
|
(factsFact "gte?" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsBool))
|
||||||
|
(factsFact "lt?" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsBool))
|
||||||
|
(factsFact "gt?" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsBool))
|
||||||
|
(factsFact "mul" factsTrusted
|
||||||
|
(factsFn [factsByte factsByte] factsByte))
|
||||||
|
(factsFact "matchMaybe" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn
|
||||||
|
[(factsVar 1)
|
||||||
|
(factsFn [(factsVar 0)] (factsVar 1))
|
||||||
|
(factsMaybe (factsVar 0))]
|
||||||
|
(factsVar 1))))
|
||||||
|
(factsFact "maybe" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn
|
||||||
|
[(factsVar 1)
|
||||||
|
(factsFn [(factsVar 0)] (factsVar 1))
|
||||||
|
(factsMaybe (factsVar 0))]
|
||||||
|
(factsVar 1))))
|
||||||
|
(factsFact "maybe?" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn [(factsMaybe (factsVar 0))] factsBool)))
|
||||||
|
(factsFact "ifLazy" factsTrusted
|
||||||
|
(factsForall [0]
|
||||||
|
(factsFn
|
||||||
|
[factsBool
|
||||||
|
(factsFn [factsUnit] (factsVar 0))
|
||||||
|
(factsFn [factsUnit] (factsVar 0))]
|
||||||
|
(factsVar 0))))
|
||||||
|
(factsFact "andLazy?" factsTrusted
|
||||||
|
(factsFn [factsBool (factsFn [factsUnit] factsBool)] factsBool))
|
||||||
|
(factsFact "ok" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsVar 1) factsAny] (factsResult (factsVar 0) (factsVar 1)))))
|
||||||
|
(factsFact "err" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsVar 0) factsAny] (factsResult (factsVar 0) (factsVar 1)))))
|
||||||
|
(factsFact "matchResult" factsTrusted
|
||||||
|
(factsForall [0 1 2]
|
||||||
|
(factsFn
|
||||||
|
[(factsFn [(factsVar 0) factsAny] (factsVar 2))
|
||||||
|
(factsFn [(factsVar 1) factsAny] (factsVar 2))
|
||||||
|
(factsResult (factsVar 0) (factsVar 1))]
|
||||||
|
(factsVar 2))))
|
||||||
|
(factsFact "resultIsOk" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsResult (factsVar 0) (factsVar 1))] factsBool)))
|
||||||
|
(factsFact "resultIsErr" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsResult (factsVar 0) (factsVar 1))] factsBool)))
|
||||||
|
(factsFact "mapResult" factsTrusted
|
||||||
|
(factsForall [0 1 2]
|
||||||
|
(factsFn
|
||||||
|
[(factsFn [(factsVar 1)] (factsVar 2))
|
||||||
|
(factsResult (factsVar 0) (factsVar 1))]
|
||||||
|
(factsResult (factsVar 0) (factsVar 2)))))
|
||||||
|
(factsFact "bindResult" factsTrusted
|
||||||
|
(factsForall [0 1 2]
|
||||||
|
(factsFn
|
||||||
|
[(factsResult (factsVar 0) (factsVar 1))
|
||||||
|
(factsFn [(factsVar 1)] (factsResult (factsVar 0) (factsVar 2)))]
|
||||||
|
(factsResult (factsVar 0) (factsVar 2)))))
|
||||||
|
(factsFact "resultOr" factsTrusted
|
||||||
|
(factsForall [0 1]
|
||||||
|
(factsFn [(factsVar 1) (factsResult (factsVar 0) (factsVar 1))] (factsVar 1))))
|
||||||
|
(factsFact "resultMapErr" factsTrusted
|
||||||
|
(factsForall [0 1 2]
|
||||||
|
(factsFn
|
||||||
|
[(factsFn [(factsVar 0)] (factsVar 2))
|
||||||
|
(factsResult (factsVar 0) (factsVar 1))]
|
||||||
|
(factsResult (factsVar 2) (factsVar 1)))))]
|
||||||
|
|||||||
109
lib/binary.tri
Normal file
109
lib/binary.tri
Normal file
@@ -0,0 +1,109 @@
|
|||||||
|
!import "prelude" !Local
|
||||||
|
|
||||||
|
errUnexpectedEof = 1
|
||||||
|
errUnexpectedBytes = 2
|
||||||
|
errUnexpectedByte = 3
|
||||||
|
|
||||||
|
unit = t
|
||||||
|
|
||||||
|
readU8 = (bytes :
|
||||||
|
matchList
|
||||||
|
(err errUnexpectedEof t)
|
||||||
|
(h r : ok h r)
|
||||||
|
bytes)
|
||||||
|
|
||||||
|
readBytes_ self bs n i original acc =
|
||||||
|
matchList
|
||||||
|
(matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(err errUnexpectedEof original)
|
||||||
|
(equal? i n))
|
||||||
|
(h r :
|
||||||
|
matchBool
|
||||||
|
(ok (reverse acc) bs)
|
||||||
|
(self r n (succ i) original (pair h acc))
|
||||||
|
(equal? i n))
|
||||||
|
bs
|
||||||
|
|
||||||
|
readBytes = (n bs :
|
||||||
|
y readBytes_ bs n 0 bs t)
|
||||||
|
|
||||||
|
expectBytes_ self expected bs original =
|
||||||
|
matchList
|
||||||
|
(ok unit bs)
|
||||||
|
(expectedByte expectedRest :
|
||||||
|
matchResult
|
||||||
|
(code rest : err code original)
|
||||||
|
(actual rest :
|
||||||
|
matchBool
|
||||||
|
(self expectedRest rest original)
|
||||||
|
(err errUnexpectedBytes original)
|
||||||
|
(equal? actual expectedByte))
|
||||||
|
(readU8 bs))
|
||||||
|
expected
|
||||||
|
|
||||||
|
expectBytes = (expected bs :
|
||||||
|
y expectBytes_ expected bs bs)
|
||||||
|
|
||||||
|
expectU8 = (expected bs :
|
||||||
|
matchResult
|
||||||
|
(code rest : err code bs)
|
||||||
|
(actual rest :
|
||||||
|
matchBool
|
||||||
|
(ok unit rest)
|
||||||
|
(err errUnexpectedByte bs)
|
||||||
|
(equal? actual expected))
|
||||||
|
(readU8 bs))
|
||||||
|
|
||||||
|
read2 = (bs : readBytes 2 bs)
|
||||||
|
read4 = (bs : readBytes 4 bs)
|
||||||
|
readU32BEBytes = (bs : read4 bs)
|
||||||
|
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
-- Parser combinators
|
||||||
|
-- ---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
pureParser = value bs : ok value bs
|
||||||
|
failParser = code bs : err code bs
|
||||||
|
|
||||||
|
mapParser = f p bs : mapResult f (p bs)
|
||||||
|
bindParser = p f bs : bindResult (p bs) f
|
||||||
|
thenParser = p q bs : bindResult (p bs) (_ : q)
|
||||||
|
|
||||||
|
orParser = (p q bs :
|
||||||
|
matchResult
|
||||||
|
(_ _ : q bs)
|
||||||
|
(value rest : ok value rest)
|
||||||
|
(p bs))
|
||||||
|
|
||||||
|
readWhile_ self pred bs acc =
|
||||||
|
matchResult
|
||||||
|
(code rest : ok (reverse acc) bs)
|
||||||
|
(value rest :
|
||||||
|
matchBool
|
||||||
|
(self pred rest (pair value acc))
|
||||||
|
(ok (reverse acc) (pair value rest))
|
||||||
|
(pred value))
|
||||||
|
(readU8 bs)
|
||||||
|
|
||||||
|
readWhile = pred bs :
|
||||||
|
y readWhile_ pred bs t
|
||||||
|
|
||||||
|
readUntil = pred :
|
||||||
|
readWhile (x : not? (pred x))
|
||||||
|
|
||||||
|
readRemaining = bs : ok bs t
|
||||||
|
|
||||||
|
peekU8 = (bs :
|
||||||
|
matchResult
|
||||||
|
(code rest : err code bs)
|
||||||
|
(value rest : ok value bs)
|
||||||
|
(readU8 bs))
|
||||||
|
|
||||||
|
eof? = (bs :
|
||||||
|
matchBool
|
||||||
|
(ok t bs)
|
||||||
|
(err errUnexpectedEof bs)
|
||||||
|
(emptyList? bs))
|
||||||
|
|
||||||
|
expectAscii = expectBytes
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user