Useful but limited polymorphism

Sorry for squashing all of this but 🤷

.gitea/workflows/test-and-build.yml

@@ -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

AGENTS.md

@@ -2,70 +2,25 @@
 
 > For AI agents and contributors working in this repository.
 
-## 0. Test Driven Development
-
-Write and discuss tests with the user before working on implementation code. Do not modify existing tests without explicit permission.
-
-## 1. Build & Test
+## Build & Test
 
 ```bash
-# Haskell tests (default check)
+# Tests
 nix flake check
 
-# Zig build
-nix build .#tricu-zig
-
-# Zig tests (separate target — not part of nix flake check)
-nix build .#tricu-zig-tests
-
-# Full build
+# Build tricu executable
 nix build .#
 ```
 
-### ⚠️ Never call `cabal` directly
+### Never call `cabal` directly
 
 > **Rule of thumb:** if it builds, links, or tests, it goes through `nix`.
 
-## 2. Project Overview
+## Project Overview
 
-**tricu** (pronounced "tree-shoe") is a programming-language experiment written in Haskell. It implements [Triage Calculus](https://olydis.medium.com/a-visual-introduction-to-tree-calculus-2f4a34ceffc2), an extension of Barry Jay's Tree Calculus, with lambda-abstraction sugar that gets eliminated back to pure tree calculus terms.
+**tricu** (pronounced "tree-shoe") is a programming-language experiment written primarily in Haskell.
 
-### Core types (in `src/Research.hs`)
-
-| Type | Description |
-|------|-------------|
-| `T = Leaf \| Stem T \| Fork T T` | Tree Calculus term (the runtime value) |
-| `TricuAST` | Parsed AST with `SDef`, `SApp`, `SLambda`, etc. |
-| `LToken` | Lexer tokens |
-| `Node` / `MerkleHash` | Content-addressed Merkle DAG nodes |
-
-### Source modules (Haskell)
-
-| Module | Purpose |
-|--------|---------|
-| `Main.hs` | CLI entry point (`cmdargs`), three modes: `repl`, `eval`, `decode` |
-| `Eval.hs` | Interpreter: `evalTricu`, `result`, `evalSingle` |
-| `Parser.hs` | Megaparsec parser → `TricuAST` |
-| `Lexer.hs` | Megaparsec lexer → `LToken` |
-| `FileEval.hs` | File loading, module imports, `!import` |
-| `REPL.hs` | Interactive Read-Eval-Print Loop (haskeline) |
-| `Research.hs` | Core types, `apply` reduction, booleans, marshalling (`ofString`, `ofNumber`), output formatters (`toAscii`, `toTernaryString`, `decodeResult`) |
-| `ContentStore.hs` | SQLite-backed term persistence |
-| `Wire.hs` | Arboricx portable wire format — encode/decode/import/export of Merkle-DAG bundle blobs |
-
-### Multi-language Arboricx ecosystem
-
-Arboricx is the portable executable-object format used by tricu. The project now includes native parsing and execution in multiple languages:
-
-| Language | Location | Capabilities |
-|----------|----------|--------------|
-| **Haskell** | `src/Wire.hs`, `src/Research.hs` | Reference implementation — bundle encode/decode, content store, full Tree Calculus reduction |
-| **tricu (self-hosted)** | `kernel_run_arboricx_typed.dag` | A self-hosting Arboricx parser/executor written in tricu itself. Used as a kernel inside the Zig host for maximum portability ("cool but useless" — ~3s for `append`) |
-| **Zig** | `ext/zig/` | **Production host** — native bundle parser, WHNF reducer, C ABI (`libarboricx.so` / `.a`), CLI (`tricu-zig`), Python FFI support |
-| **JavaScript (Node)** | `ext/js/` | Native bundle parser, manifest decoder, Merkle DAG verifier, Tree Calculus reducer, CLI runner |
-| **PHP** | `ext/php/` | FFI wrapper around `libarboricx.so`, CLI runner |
-
-All hosts share the same bundle format and Merkle hashing scheme.
+Core types are in `src/Research.hs`.
 
 ### File extensions
 
@@ -74,8 +29,6 @@ All hosts share the same bundle format and Merkle hashing scheme.
 - `.arboricx` - Portable executable bundle
 - `.dag` - Serialized kernel DAG (used by `gen_kernel.zig` at build time)
 
-## 3. Test Suite
-
 ### Haskell tests
 
 Tests live in `test/Spec.hs` and use **Tasty** + **HUnit**.
@@ -84,42 +37,7 @@ Tests live in `test/Spec.hs` and use **Tasty** + **HUnit**.
 nix flake check
 ```
 
-### Test groups
-
-| Group | What it covers |
-|-------|----------------|
-| `lexer` | Megaparsec lexer - identifiers, keywords, strings, escapes, invalid tokens |
-| `parser` | Parser - defs, lambda, applications, lists, comments, parentheses |
-| `simpleEvaluation` | Core `apply` reduction rules, variable substitution, immutability |
-| `lambdas` | Lambda elimination, SKI calculus, higher-order functions, currying, shadowing, free vars |
-| `providedLibraries` | `lib/list.tri` - triage, booleans, list ops (`head`, `tail`, `map`, `emptyList?`, `append`, `equal?`) |
-| `fileEval` | Loading `.tri` files, multi-file context, decode |
-| `modules` | `!import`, cyclic deps, namespacing, multi-level imports, unresolved vars, local namespaces |
-| `demos` | `demos/*.tri` - structural equality, `toSource`, `size`, level-order traversal |
-| `decoding` | `decodeResult` - Leaf, numbers, strings, lists, mixed |
-| `elimLambdaSingle` | Lambda elimination: eta reduction, SDef binding, semantics preservation |
-| `stressElimLambda` | Lambda elimination stress test: 200 vars, 800-body curried lambda |
-
-### Zig tests
-
-Run separately via:
-
-```bash
-nix build .#tricu-zig-tests
-```
-
-These are **not** included in `nix flake check`. The test derivation compiles and runs:
-
-| Test | What it covers |
-|------|----------------|
-| `c_abi_test.c` | Smoke tests — leaf, stem, fork, app, reduce, number/string roundtrip, kernel root |
-| `c_abi_append_test.c` | Kernel path — `append.arboricx` with string arguments via Tricu kernel |
-| `native_bundle_append_test.c` | Native fast path — `append.arboricx` loaded natively, applied, reduced |
-| `native_bundle_id_test.c` | Native fast path — `id.arboricx` |
-| `native_bundle_bools_test.c` | Native fast path — `true.arboricx` / `false.arboricx` |
-| `python_ffi_test.py` | Python ctypes FFI — tests both kernel and native paths for `id` and `append` |
-
-## 4. tricu Language Quick Reference
+## tricu Language Quick Reference
 
 ```
 t                      → Leaf (the base term)
@@ -136,242 +54,4 @@ head (map f xs)        → From lib/list.tri
 ```
 
 CRITICAL:
-
-When working with recursion in `tricu` files:
-
-1. Put consumed data first in recursive workers.
-2. Let data shape drive recursion.
-3. Do not let counters unroll over abstract input.
-
-## 5. Output Formats
-
-The `eval` command accepts `--form` (shorthand `-t`):
-
-| Format | Value | Description |
-|--------|-------|-------------|
-| `tree` | `TreeCalculus` | Simple `t` form (default) |
-| `fsl` | `FSL` | Full show representation |
-| `ast` | `AST` | Parsed AST representation |
-| `ternary` | `Ternary` | Ternary string encoding |
-| `ascii` | `Ascii` | ASCII-art tree diagram |
-| `decode` | `Decode` | Human-readable (strings, numbers, lists) |
-
-## 6. Content Addressing
-
-Each `T` term is content-addressed via a Merkle DAG:
-
-```
-NLeaf       → 0x00
-NStem(h)    → 0x01 || h (32 bytes)
-NFork(l,r)  → 0x02 || l (32 bytes) || r (32 bytes)
-
-hash = SHA256("arboricx.merkle.node.v1" <> 0x00 <> serialized_node)
-```
-
-This is stored in SQLite via `ContentStore.hs`. Hash suffixes on identifiers (e.g., `foo_abc123...`) are validated: 16–64 hex characters (SHA256).
-
-## 7. Arboricx Portable Bundles (`.arboricx`)
-
-Portable executable bundles are generated via `Wire.hs`. See `docs/arboricx-bundle-format.md` for the full binary format spec.
-
-```bash
-# Export a bundle from the content store
-./result/bin/tricu export -o myterm.arboricx myterm
-
-# Run a bundle (requires TRICU_DB_PATH)
-./result/bin/tricu import -f lib/list.tri
-TRICU_DB_PATH=/tmp/tricu.db ./result/bin/tricu export -o list_ops.arboricx append
-```
-
-## 8. Zig Arboricx Host (`ext/zig/`)
-
-The Zig host is a fast implementation for running Arboricx bundles. It provides a native bundle parser and arena-based evaluator.
-
-### Modules
-
-| File | Role |
-|------|------|
-| `src/main.zig` | CLI entrypoint — default native path, `--kernel` fallback |
-| `src/bundle.zig` | Native Arboricx bundle parser — verifies digests, hashes, loads DAG into arena |
-| `src/c_abi.zig` | C FFI exports — `arboricx_init`, tree constructors, codecs, reduction, bundle loading |
-| `src/reduce.zig` | WHNF reducer (Tree Calculus `apply` rules) |
-| `src/arena.zig` | Node arena (`ArrayListUnmanaged`) |
-| `src/tree.zig` | `Node` union + iterative `copyTree` |
-| `src/codecs.zig` | Number/string/list/bytes encoding + result unwrapping |
-| `src/kernel.zig` | Embeds DAG kernel into arena (fallback path only) |
-| `src/ternary.zig` | Ternary string parser for Tree Calculus terms |
-| `tools/gen_kernel.zig` | Build-time tool: converts `.dag` → `kernel_embed.zig` |
-| `include/arboricx.h` | C header for `libarboricx` |
-
-### C ABI
-
-Key functions:
-
-```c
-arb_ctx_t* arboricx_init(void);
-uint32_t arb_load_bundle(arb_ctx_t*, const uint8_t* bytes, size_t len, const char* name);
-uint32_t arb_load_bundle_default(arb_ctx_t*, const uint8_t* bytes, size_t len);
-uint32_t arb_reduce(arb_ctx_t*, uint32_t root, uint64_t fuel);
-```
-
-`arb_reduce` evaluates in a **fresh scratch arena** so garbage never accumulates.
-
-### Stack size requirement
-
-Tree Calculus reduction is deeply recursive. Assume a segfault is a memory limitation until proven otherwise.
-
-```bash
-ulimit -s 32768   # 32 MB
-```
-
-### Performance comparison
-
-| Fixture | Native path | Kernel path (`--kernel`) |
-|---------|-------------|--------------------------|
-| `append "hello " "world"` | **~0.007 s** | ~3.4 s |
-| `id "hello"` | **~0.005 s** | ~0.38 s |
-
-The kernel path is kept as a "cool but useless" fallback — the DAG is tiny (~30 KB) so the cost is negligible.
-
-## 9. Nix Flake Outputs
-
-| Output | Description |
-|--------|-------------|
-| `packages.default` / `packages.tricu` | Haskell tricu package |
-| `packages.tricu-zig` | Zig CLI + `libarboricx.a` + `libarboricx.so` + `arboricx.h` |
-| `packages.tricu-zig-tests` | **Separate test target** — C ABI + native bundle + Python FFI tests |
-| `packages.tricu-php` | PHP source + `libarboricx.so` + `tricu-php` wrapper script |
-| `packages.tricu-php-tests` | **Separate test target** — PHP FFI tests against fixture bundles |
-| `packages.tricu-container` | Docker image |
-| `checks.default` / `checks.tricu` | Haskell test suite via Tasty/HUnit |
-
-`tricu-zig-tests` is deliberately **not** in `checks` so `nix flake check` remains fast.
-
-## 10. Directory Layout
-
-```
-tricu/
-├── flake.nix           # Nix flake: packages, tests, devShell
-├── tricu.cabal         # Cabal package (used via callCabal2nix)
-├── AGENTS.md           # This file
-├── src/                # Haskell modules
-│   ├── Main.hs
-│   ├── Eval.hs
-│   ├── Parser.hs
-│   ├── Lexer.hs
-│   ├── FileEval.hs
-│   ├── REPL.hs
-│   ├── Research.hs
-│   ├── ContentStore.hs
-│   └── Wire.hs
-├── test/
-│   ├── Spec.hs         # Tasty + HUnit tests
-│   ├── *.tri           # tricu test programs
-│   ├── *.arboricx      # Arboricx bundle fixtures
-│   └── local-ns/       # Module namespace test files
-├── lib/
-│   ├── base.tri
-│   ├── list.tri
-│   └── patterns.tri
-├── demos/
-│   ├── equality.tri
-│   ├── size.tri
-│   ├── toSource.tri
-│   ├── levelOrderTraversal.tri
-│   └── patternMatching.tri
-├── ext/                # Multi-language Arboricx hosts
-│   ├── js/             # Node.js bundle parser + reducer
-│   │   ├── src/
-│   │   │   ├── bundle.js
-│   │   │   ├── manifest.js
-│   │   │   ├── merkle.js
-│   │   │   ├── tree.js
-│   │   │   ├── codecs.js
-│   │   │   └── cli.js
-│   │   └── test/
-│   ├── php/            # PHP FFI host for libarboricx.so
-│   │   ├── src/
-│   │   │   └── ffi.php
-│   │   └── run.php
-│   └── zig/            # Zig production host
-│       ├── build.zig
-│       ├── build.zig.zon
-│       ├── kernel_run_arboricx_typed.dag
-│       ├── include/arboricx.h
-│       ├── src/
-│       │   ├── main.zig
-│       │   ├── bundle.zig
-│       │   ├── c_abi.zig
-│       │   ├── codecs.zig
-│       │   ├── kernel.zig
-│       │   ├── reduce.zig
-│       │   ├── arena.zig
-│       │   ├── tree.zig
-│       │   └── ternary.zig
-│       ├── tests/
-│       │   ├── c_abi_test.c
-│       │   ├── c_abi_append_test.c
-│       │   ├── native_bundle_append_test.c
-│       │   ├── native_bundle_id_test.c
-│       │   ├── native_bundle_bools_test.c
-│       │   └── python_ffi_test.py
-│       └── tools/
-│           └── gen_kernel.zig
-└── docs/
-    └── arboricx-bundle-format.md
-```
-
-## 11. Content Store Workflow (Custom DB)
-
-The content store location is controlled by the `TRICU_DB_PATH` environment variable. When set, `eval` mode automatically loads all stored terms into the initial environment, so you can call any previously imported/evaluated term by name.
-
-```bash
-# Use a local DB
-export TRICU_DB_PATH=/tmp/tricu-local.db
-
-# Import terms from the standard library
-./result/bin/tricu import -f lib/list.tri
-
-# Now use them in eval mode
-echo "not? (t t)" | ./result/bin/tricu eval -t decode
-# Output: t
-
-echo "not? (t t t)" | ./result/bin/tricu eval -t decode
-# Output: Stem Leaf
-
-echo "equal? (t t) (t t t)" | ./result/bin/tricu eval -t decode
-# Output: t
-
-# Check what's in the store
-./result/bin/tricu
-t> !definitions
-```
-
-Without `TRICU_DB_PATH` set, `eval` uses only the terms defined in the input file(s).
-
-## 12. Development Tips
-
-- **REPL:** `nix run .#` starts the interactive tricu REPL.
-- **Evaluate files:** `nix run .# -- eval -f demos/equality.tri`
-- **Zig host:** `nix build .#tricu-zig` then `./result/bin/tricu-zig <bundle> [args...]`
-- **Zig tests:** `nix build .#tricu-zig-tests`
-- **GHC options:** `-threaded -rtsopts -with-rtsopts=-N` for parallel runtime. Use `-N` RTS flag for multi-core.
-- **Upx** is in the devShell for binary compression if needed.
-
-## 13. Viewing Haskell Dependency Docs from Nix
-
-When you need Haddock documentation for a Haskell dependency available in Nixpkgs, build the package's `doc` output directly with `^doc`.
-
-Example:
-
-Replace `megaparsec` with the dependency name you need:
-
-```sh
-nix build "nixpkgs#haskellPackages.${pkg}^doc"
-```
-
-View the available documentation files:
-
-```sh
-find ./result-doc -type f \( -name '*.html' -o -name '*.haddock' \) | sort
-```
+When working with `tricu` `.tri` files ***YOU MUST REVIEW notes/tricu-normalization-rules.md***

README.md

@@ -2,7 +2,7 @@
 
 ## Introduction
 
-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 will refer to this "family" of calculi as TC.
+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.
 
 tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
 
@@ -37,23 +37,6 @@ tricu > "(t (t (t t) (t t t)) (t t (t t t)))"
 tricu < -- or calculate its size (/demos/size.tri)
 tricu < size not?
 tricu > 12
-
-tricu < !help
-tricu version 1.1.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 to the content store
-  !watch       - Watch a file for changes, evaluate terms, and store them
-  !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
-  !export      - Export a term bundle to file (hash, file)
-  !bundleimport- Import a bundle file into the content store
 ```
 
 ## Installation and Use
@@ -69,4 +52,62 @@ You can easily build and run this project using [Nix](https://nixos.org/download
 
 ## Usage
 
-I'll update this once the CLI stabilizes more.
+### CLI
+
+Evaluate one or more files:
+
+```sh
+tricu eval program.tri
+tricu eval --format decode program.tri
+tricu eval --output result.txt program.tri
+```
+
+Unchecked eval parses annotation syntax, discards contract metadata, skips
+producer-side View Contract checks during workspace module auto-builds, and does
+not publish unchecked View refs. 
+
+```sh
+tricu eval --unchecked program.tri
+```
+
+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.

bench/Bench.hs

@@ -33,7 +33,7 @@ main = do
   !listLib        <- loadLib "lib/list.tri"
 
   -- Stress benchmark environment: Arboricx parser + size + toSource
-  !arboricxLib    <- loadLib "lib/arboricx-dispatch.tri"
+  !arboricxLib    <- loadLib "lib/arboricx/dispatch.tri"
   !sizeEnv        <- evaluateFileWithContext arboricxLib "demos/size.tri"
   !toSourceEnv    <- evaluateFileWithContext sizeEnv "demos/toSource.tri"
 

demos/equality.tri

@@ -1,5 +1,4 @@
-!import "../lib/base.tri" !Local
-!import "../lib/list.tri" !Local
+!import "prelude" !Local
 
 main = lambdaEqualsTC
 

demos/interactionTrees.tri

@@ -1,6 +1,5 @@
-!import "../lib/base.tri"      !Local
-!import "../lib/list.tri"      !Local
-!import "../lib/io.tri"        !Local
+!import "prelude"   !Local
+!import "io"        !Local
 
 -- Interaction Tree Effect Runtime
 --

demos/interactionTrees/arboricxServer.tri

@@ -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)))

demos/interactionTrees/echo-server.tri

@@ -1,46 +0,0 @@
-!import "../../lib/base.tri"   !Local
-!import "../../lib/io.tri"     !Local
-!import "../../lib/socket.tri" !Local
-
--- Preserve the host-driver Result shape on error, run okCase on success.
-onOk = action okCase :
-  bind action (result :
-    matchResult
-      (err rest : pure result)
-      okCase
-      result)
-
--- Convenience: print a string and continue.
-printLn = s : bind (putStr (append s "\n")) (_ : pure t)
-
--- Main accept+echo loop. Recursion via y.
-echoLoop = y (self server :
-  bind (accept server) (acceptResult :
-    matchResult
-      (err rest :
-        bind (printLn (append "accept error: " err)) (_ :
-          self server))
-      (accepted rest :
-        matchPair
-          (clientSock addr :
-            bind (printLn (append "client from " addr)) (_ :
-              bind (recv clientSock 4096) (msgResult :
-                matchResult
-                  (err rest :
-                    bind (closeSocket clientSock) (_ :
-                      self server))
-                  (msg rest :
-                    bind (send clientSock msg) (_ :
-                      bind (closeSocket clientSock) (_ :
-                        self server)))
-                  msgResult)))
-          accepted)
-      acceptResult))
-
-main = io (
-  onOk socket (server rest :
-    onOk (bindSocket server "127.0.0.1" 0) (_ rest :
-      onOk (listen server 5) (_ rest :
-        onOk (getSocketName server) (port rest :
-          bind (printLn (append "Echo server listening on port " (showNumber port))) (_ :
-            echoLoop server))))))

demos/interactionTrees/echoServer.tri

@@ -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))))))

demos/interactionTrees/environment.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Environment effects: ask and local.
 --   ask reads the current environment value.

demos/interactionTrees/forkAwait.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Basic fork and await.
 -- fork spawns a concurrent task and returns a handle.

demos/interactionTrees/getLineAsync.tri

@@ -12,7 +12,8 @@
 --   3. You see:
 --        Hello, <name>!
 
-!import "../lib/io.tri" !Local
+!import "prelude" !Local
+!import "io"      !Local
 
 main = io <|
   bind (fork getLine) (h :

demos/interactionTrees/greet.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Greet and return a pure value.
 -- putStrLn writes to stdout; pure lifts "done" into IO.

demos/interactionTrees/httpServer.tri

@@ -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)))))

demos/interactionTrees/safeRead.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!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.

demos/interactionTrees/shout.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!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.

demos/interactionTrees/state.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Mutable state via get and put.
 --   get reads the current state.

demos/interactionTrees/writeThenRead.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Write a file, then read it back.
 --   thenIO discards the writeFile Result and continues.

demos/interactionTrees/yield.tri

@@ -1,6 +1,6 @@
-!import "../../lib/base.tri" !Local
-!import "../../lib/list.tri" !Local
-!import "../../lib/io.tri"   !Local
+!import "base" !Local
+!import "list" !Local
+!import "io"   !Local
 
 -- Cooperative scheduling with yield.
 --   yield returns control to the scheduler so other tasks can run.

demos/levelOrderTraversal.tri

@@ -1,5 +1,4 @@
-!import "../lib/base.tri" Lib
-!import "../lib/list.tri" !Local
+!import "prelude" !Local
 
 main = exampleTwo
 -- Level Order Traversal of a labelled binary tree

demos/patternMatching.tri

@@ -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
 -- each sublist contains a boolean expression and a function to return if said

demos/runArboricxBundle.tri

@@ -1,7 +1,6 @@
-!import "../lib/base.tri"      !Local
-!import "../lib/list.tri"      !Local
-!import "../lib/io.tri"        !Local
-!import "../lib/arboricx.tri"  !Local
+!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

demos/size.tri

@@ -1,5 +1,4 @@
-!import "../lib/base.tri" !Local
-!import "../lib/list.tri" !Local
+!import "prelude" !Local
 
 main = size size
 

demos/toSource.tri

@@ -1,5 +1,4 @@
-!import "../lib/base.tri" !Local
-!import "../lib/list.tri" !Local
+!import "prelude" !Local
 
 main = toSource not?
 -- Thanks to intensionality, we can inspect the structure of a given value

demos/viewContracts.tri

@@ -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

demos/viewContracts/README.md

@@ -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
+```

demos/viewContracts/complete.tri

@@ -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)]

demos/viewContracts/diagnostic.tri

@@ -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)

demos/viewContracts/frontendEmission/README.md

@@ -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.

demos/viewContracts/frontendEmission/filter-wrong-predicate.emitted.tri

@@ -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)

demos/viewContracts/frontendEmission/map-success.emitted.tri

@@ -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)

demos/viewContracts/frontendEmission/map-wrong-list.emitted.tri

@@ -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)

demos/viewContracts/io-continuation.tri

@@ -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)))

demos/viewContracts/io.tri

@@ -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"))

demos/viewContracts/modules/README.md

@@ -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`.

demos/viewContracts/modules/failure.tri

@@ -0,0 +1,3 @@
+!import "vc.demo.util" Util
+
+foo x@Bool =@Bool Util.toString x

demos/viewContracts/modules/success.tri

@@ -0,0 +1,3 @@
+!import "vc.demo.util" Util
+
+foo x@Bool =@Bool Util.id x

demos/viewContracts/modules/tricu.workspace

@@ -0,0 +1 @@
+module vc.demo.util = util.tri

demos/viewContracts/modules/util.tri

@@ -0,0 +1,2 @@
+id x@Bool =@Bool x
+toString x@Bool =@String "ok"

demos/viewContracts/selfTests.tri

@@ -0,0 +1,3 @@
+!import "views.catalog" !Local
+
+main = viewCatalogSelfTests

demos/viewContracts/sourceSyntax/failure.tri

@@ -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"

demos/viewContracts/sourceSyntax/success.tri

@@ -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)

demos/viewContracts/stdlibContracts.tri

@@ -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)]

docs/content-store-and-module-format.md

@@ -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.

docs/guard-injection.md

@@ -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.

docs/module-system-design.md

@@ -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.

docs/self-hosted-arboricx-host.md

@@ -327,7 +327,7 @@ 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/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.

docs/view-contract-syntax.md

@@ -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.

docs/view-contracts.md

@@ -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.

flake.nix

@@ -16,7 +16,29 @@
         haskellPackages = pkgs.haskellPackages;
         hsLib = pkgs.haskell.lib;
 
-        tricuStatic = hsLib.justStaticExecutables self.packages.${system}.default;
+        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 {};
@@ -221,6 +243,8 @@
       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;
@@ -252,26 +276,35 @@
 
         packages.${containerPackageName} = pkgs.dockerTools.buildImage {
           name = "tricu";
+          tag = "latest";
 
           copyToRoot = pkgs.buildEnv {
             name = "image-root";
             paths = [ tricuStatic ];
             pathsToLink = [ "/bin" ];
           };
-          tag = "latest";
+
           config = {
-            Cmd = [
-              "/bin/tricu"
-              "server"
-              "-h" "0.0.0.0"
-              "-p" "8787"
-            ];
+            Cmd = [ "/bin/tricu" ];
             WorkingDir = "/app";
-            ExposedPorts = {
-              "8787/tcp" = {};
-            };
-            extraCommands = ''
-            '';
+          };
+        };
+
+        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" = {}; };
           };
         };
       });

lib/arboricx-nodes.tri

@@ -1,208 +0,0 @@
-!import "arboricx-common.tri" !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 : byteEq? 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)))
-
-nodePayloadStemChildIndex = (nodePayload :
-  u32BEBytesToNat (bytesTake 4 (bytesDrop 1 nodePayload)))
-
-nodePayloadForkLeftIndex = (nodePayload :
-  u32BEBytesToNat (bytesTake 4 (bytesDrop 1 nodePayload)))
-
-nodePayloadForkRightIndex = (nodePayload :
-  u32BEBytesToNat (bytesTake 4 (bytesDrop 5 nodePayload)))
-
-nodeRecordsHaveInvalidPayload? = y (self nodeRecords :
-  matchList
-    false
-    (nodePayload rest :
-      or?
-        (not? (nodePayloadValid? nodePayload))
-        (self rest))
-    nodeRecords)
-
-nodePayloadChildIndices = (nodePayload :
-  matchBool
-    t
-    (matchBool
-      (pair (nodePayloadStemChildIndex nodePayload) t)
-      (pair (nodePayloadForkLeftIndex nodePayload)
-        (pair (nodePayloadForkRightIndex nodePayload) t))
-      (nodePayloadStem? nodePayload))
-    (nodePayloadLeaf? 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 n records i limit :
-  matchBool
-    false
-    (matchList
-      false
-      (_ rest :
-        matchBool
-          true
-          (self n rest (succ i) limit)
-          (equal? i n))
-      records)
-    (equal? i limit))
-
-nodeChildIndicesInPrefix? = y (self childIndices records limit :
-  matchList
-    true
-    (childIndex rest :
-      matchBool
-        (self rest records limit)
-        false
-        (nodeIndexInPrefix? childIndex records 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)
-
-nodePayloadToTreeWith = (self nodeRecords nodePayload :
-  matchBool
-    (ok t t)
-    (matchBool
-      (bindResult (self (nodePayloadStemChildIndex nodePayload) nodeRecords)
-        (child _ : ok (t child) t))
-      (bindResult (self (nodePayloadForkLeftIndex nodePayload) nodeRecords)
-        (left _ :
-          bindResult (self (nodePayloadForkRightIndex nodePayload) nodeRecords)
-            (right _ : ok (pair left right) t)))
-      (nodePayloadStem? nodePayload))
-    (nodePayloadLeaf? nodePayload))
-
-nodeIndexToTree = y (self nodeIndex nodeRecords :
-  (nodePayload :
-    matchBool
-      (nodePayloadToTreeWith self nodeRecords nodePayload)
-      (err errMissingNode t)
-      (not? (equal? nodePayload t)))
-    (nth nodeIndex nodeRecords))
-
-readArboricxTreeFromIndex = (rootIndexBytes bs :
-  bindResult (readArboricxNodesSection bs)
-    (nodesSection afterContainer :
-      bindResult (nodeIndexToTree (u32BEBytesToNat rootIndexBytes) (nodesSectionRecords nodesSection))
-        (tree _ : ok tree afterContainer)))
-
-readArboricxExecutableFromIndex = readArboricxTreeFromIndex

lib/arboricx/arboricx.tri

@@ -1,4 +1,7 @@
-!import "arboricx-manifest.tri" !Local
+!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).

lib/arboricx/common.tri

@@ -1,7 +1,6 @@
-!import "base.tri" !Local
-!import "list.tri" !Local
-!import "bytes.tri" !Local
-!import "binary.tri" !Local
+!import "prelude" !Local
+!import "binary"  !Local
+
 
 arboricxMagic = [(65) (82) (66) (79) (82) (73) (67) (88)]
 arboricxMajorVersion = [(0) (1)]

lib/arboricx/dispatch.tri

@@ -1,4 +1,5 @@
-!import "arboricx.tri" !Local
+!import "prelude"  !Local
+!import "arboricx" !Local
 
 -- Multi-purpose kernel dispatch.
 -- runArboricxTyped tag bundleBytes args

lib/arboricx/manifest.tri

@@ -1,4 +1,7 @@
-!import "arboricx-nodes.tri" !Local
+!import "prelude"         !Local
+!import "binary"          !Local
+!import "arboricx.common" !Local
+!import "arboricx.nodes"  !Local
 
 readManifestMagic = (bs :
   expectBytes arboricxManifestMagic bs)

lib/arboricx/nodes.tri

@@ -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

lib/arboricx/server.tri

@@ -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))

lib/base.tri

@@ -1,18 +1,18 @@
 false = t
 _     = t
 true  = t t
-id    = a : a
-const = a b : a
+id a@_a =@_a a
+const a@_a b@_b =@_a a
 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)))
      (x : x x)
      (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")
 
 matchBool = (ot of : triage
@@ -31,7 +31,18 @@ lOr = (triage
   (_ _   : 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
 and? = matchBool id (_ : false)
@@ -73,10 +84,10 @@ succ = y (self :
       (_ tail : t t (self tail))
       t))
 
-ok = value rest : pair true (pair value rest)
-err = msg rest : pair false (pair msg rest)
+ok value rest = pair true (pair value rest)
+err msg rest = pair false (pair msg rest)
 
-matchResult = (errCase okCase result :
+matchResult errCase okCase result =
   matchPair
     (tag payload :
       matchPair
@@ -86,4 +97,289 @@ matchResult = (errCase okCase result :
             (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)))))]

lib/binary.tri

@@ -1,17 +1,18 @@
-!import "base.tri" !Local
-!import "list.tri" !Local
-!import "bytes.tri" !Local
+!import "prelude" !Local
 
 errUnexpectedEof = 1
 errUnexpectedBytes = 2
 errUnexpectedByte = 3
 
-readU8 = (bytes : matchList
-  (err errUnexpectedEof t)
-  (h r : ok h r)
-  bytes)
+unit = t
 
-readBytes_ = y (self bs n i original acc :
+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)
@@ -22,13 +23,12 @@ readBytes_ = y (self bs n i original acc :
         (ok (reverse acc) bs)
         (self r n (succ i) original (pair h acc))
         (equal? i n))
-    bs)
+    bs
 
-readBytes = (n bs : readBytes_ bs n 0 bs t)
+readBytes = (n bs :
+  y readBytes_ bs n 0 bs t)
 
-unit = t
-
-expectBytes_ = y (self expected bs original :
+expectBytes_ self expected bs original =
   matchList
     (ok unit bs)
     (expectedByte expectedRest :
@@ -38,11 +38,12 @@ expectBytes_ = y (self expected bs original :
           matchBool
             (self expectedRest rest original)
             (err errUnexpectedBytes original)
-            (byteEq? actual expectedByte))
+            (equal? actual expectedByte))
         (readU8 bs))
-    expected)
+    expected
 
-expectBytes = (expected bs : expectBytes_ expected bs bs)
+expectBytes = (expected bs :
+  y expectBytes_ expected bs bs)
 
 expectU8 = (expected bs :
   matchResult
@@ -51,22 +52,58 @@ expectU8 = (expected bs :
       matchBool
         (ok unit rest)
         (err errUnexpectedByte bs)
-        (byteEq? actual expected))
+        (equal? actual expected))
     (readU8 bs))
 
-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)
-
 read2 = (bs : readBytes 2 bs)
 read4 = (bs : readBytes 4 bs)
-readU16BEBytes = (bs : read2 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

lib/bytes.tri

@@ -1,51 +1,17 @@
-!import "base.tri" !Local
-!import "list.tri" !Local
-
-nothing = t
-just = x : t x
+!import "base" !Local
+!import "list" !Local
 
 bytesNil? = emptyList?
 
-bytesHead = matchList nothing (h _ : just h)
+bytesHead =
+  matchList nothing (h _ : just h)
 
-bytesTail = matchList nothing (_ r : just r)
+bytesTail =
+  matchList nothing (_ r : just r)
 
-byteEq? = equal?
 bytesLength = length
 bytesAppend = append
-
-bytesTake_ = y (self remaining n i :
-  matchList
-    t
-    (h r :
-      matchBool
-        t
-        (pair h (self r n (succ i)))
-        (equal? i n))
-    remaining)
-
-bytesTake = n bytes : bytesTake_ bytes n 0
-
-bytesDrop_ = y (self remaining n i :
-  matchList
-    t
-    (_ r :
-      matchBool
-        remaining
-        (self r n (succ i))
-        (equal? i n))
-    remaining)
-
-bytesDrop = n bytes : bytesDrop_ bytes n 0
-
-bytesSplitAt = n bytes : pair (bytesTake n bytes) (bytesDrop n bytes)
-
-bytesEq? = y (self xs ys :
-  matchList
-    (matchList true (_ _ : false) ys)
-    (xh xt :
-      matchList
-        false
-        (yh yt : and? (byteEq? xh yh) (self xt yt))
-        ys)
-    xs)
+bytesTake = take
+bytesDrop = drop
+bytesSplitAt = splitAt
+bytesEq? = equal?

lib/conversions.tri

@@ -1,22 +1,5 @@
-!import "base.tri" !Local
-!import "list.tri" !Local
-
-pred = y (self : triage
-  0
-  (_ : 0)
-  (bit rest :
-    matchBool
-      -- odd: 2n + 1 -> 2n
-      (matchBool
-        0
-        (pair 0 rest)
-        (equal? rest 0))
-      -- even: 2n -> 2n - 1
-      (matchBool
-        0
-        (pair 1 (self rest))
-        (equal? rest 0))
-      bit))
+!import "base" !Local
+!import "list" !Local
 
 incDecRev = y (self : matchList
   "1"

lib/http.tri

@@ -0,0 +1,849 @@
+!import "prelude"  !Local
+!import "io"       !Local
+!import "patterns" !Local
+!import "socket"   !Local
+
+-- ---------------------------------------------------------------------------
+--  Constants
+-- ---------------------------------------------------------------------------
+
+maxHeaderBytes = 65536
+maxBodyBytes = 1048576
+maxUriBytes = 8192
+
+crlf = pair 13 (pair 10 t)
+crlfcrlf = pair 13 (pair 10 (pair 13 (pair 10 t)))
+
+-- ---------------------------------------------------------------------------
+--  Small byte/list helpers
+-- ---------------------------------------------------------------------------
+
+chomp = (xs :
+  lazyList
+    (_ : t)
+    (h r :
+      lazyBool
+        (_ : reverse r)
+        (_ : xs)
+        (equal? h 13))
+    (reverse xs))
+
+-- ---------------------------------------------------------------------------
+--  Response construction
+-- ---------------------------------------------------------------------------
+
+statusPhrases =
+  [(pair 200 "OK")
+   (pair 201 "Created")
+   (pair 204 "No Content")
+   (pair 400 "Bad Request")
+   (pair 404 "Not Found")
+   (pair 405 "Method Not Allowed")
+   (pair 431 "Request Header Fields Too Large")
+   (pair 501 "Not Implemented")
+   (pair 505 "HTTP Version Not Supported")]
+
+lookupStatusPhrase_ self code phrases =
+  lazyList
+    (_ : "Internal Server Error")
+    (h r :
+      lazyBool
+        (_ : snd h)
+        (_ : self code r)
+        (equal? code (fst h)))
+    phrases
+
+statusPhrase = (code :
+  y lookupStatusPhrase_ code statusPhrases)
+
+statusLine = (code phrase :
+  append "HTTP/1.1 " (append (showNumber code) (append " " (append phrase "\r\n"))))
+
+headerLine = (key value :
+  append key (append ": " (append value "\r\n")))
+
+buildResponse = (status headers body :
+  append
+    (statusLine status (statusPhrase status))
+    (append
+      (foldl (acc h : append acc (headerLine (fst h) (snd h))) "" headers)
+      (append "\r\n" body)))
+
+response = (status contentType body :
+  buildResponse status
+    [(pair "Content-Type" contentType)
+     (pair "Content-Length" (showNumber (length body)))
+     (pair "Connection" "close")]
+    body)
+
+emptyResponse = (status :
+  buildResponse status
+    [(pair "Content-Length" "0")
+     (pair "Connection" "close")]
+    "")
+
+okResponse = (body :
+  response 200 "text/plain; charset=utf-8" body)
+
+textResponse = (body :
+  response 200 "text/plain; charset=utf-8" body)
+
+jsonResponse = (body :
+  response 200 "application/json" body)
+
+htmlResponse = (body :
+  response 200 "text/html; charset=utf-8" body)
+
+createdResponse = (body :
+  response 201 "text/plain; charset=utf-8" body)
+
+notFoundResponse = (
+  response 404 "text/plain; charset=utf-8" "Not found\n")
+
+badRequestResponse = (msg :
+  response 400 "text/plain; charset=utf-8" msg)
+
+errorResponse = (status msg :
+  response status "text/plain; charset=utf-8" msg)
+
+headerEndState state h =
+  lazyBool
+    (_ :
+      lazyBool
+        (_ : 3)
+        (_ : 1)
+        (equal? state 2))
+    (_ :
+      lazyBool
+        (_ :
+          lazyBool
+            (_ : 4)
+            (_ : 2)
+            (equal? state 3))
+        (_ : 0)
+        (boolAnd?
+          (equal? h 10)
+          (boolOr? (equal? state 1) (equal? state 3))))
+    (equal? h 13)
+
+headersOnly_ self bs state acc =
+  lazyList
+    (_ : reverse acc)
+    (h r :
+      let nextAcc = pair h acc in
+      let nextState = headerEndState state h in
+      lazyBool
+        (_ : reverse nextAcc)
+        (_ : self r nextState nextAcc)
+        (equal? nextState 4))
+    bs
+
+headersOnly = (response :
+  y headersOnly_ response 0 t)
+
+responseForMethod = (method resp :
+  lazyBool
+    (_ : headersOnly resp)
+    (_ : resp)
+    (equal? method "HEAD"))
+
+-- ---------------------------------------------------------------------------
+--  Header receive / framing
+-- ---------------------------------------------------------------------------
+
+recvUntilMax_ = (y (self sock pattern maxBytes acc accLen :
+  onResult_ (recv sock 1)
+    (err :
+      pure (err 400 acc))
+    (chunk :
+      lazyBool
+        (_ : pure (err 400 acc))
+        (_ :
+          let chunkLen = length chunk in
+          let nextLen = add accLen chunkLen in
+          let next = append acc chunk in
+          lazyBool
+            (_ :
+              lazyBool
+                (_ : pure (ok next t))
+                (_ : self sock pattern maxBytes next nextLen)
+                (contains? pattern next))
+            (_ : pure (err 431 next))
+            (lte? nextLen maxBytes))
+        (emptyList? chunk))))
+
+recvUntilMax = (sock pattern maxBytes :
+  recvUntilMax_ sock pattern maxBytes t 0)
+
+recvUntil = (sock pattern :
+  recvUntilMax sock pattern maxHeaderBytes)
+
+recvHeaders = (sock :
+  recvUntilMax sock crlfcrlf maxHeaderBytes)
+
+-- ---------------------------------------------------------------------------
+--  Request line parsing
+-- ---------------------------------------------------------------------------
+
+readLineBytes_ = (y (self bs acc :
+  lazyList
+    (_ : pair (reverse acc) t)
+    (h r :
+      lazyBool
+        (_ : pair (reverse acc) r)
+        (_ :
+          lazyBool
+            (_ : self r acc)
+            (_ : self r (pair h acc))
+            (equal? h 13))
+        (equal? h 10))
+    bs))
+
+readLineBytes = (bs :
+  ((result :
+    pair (chomp (fst result)) (snd result))
+   (readLineBytes_ bs t)))
+
+parseThreeWords_ = (y (self bs phase acc w1 w2 :
+  lazyList
+    (_ :
+      lazyBool
+        (_ : ok (pair w1 (pair w2 (reverse acc))) t)
+        (_ : err 400 "Bad Request\n")
+        (equal? phase 2))
+    (h r :
+      lazyBool
+        (_ :
+          lazyBool
+            (_ : self r 1 t (reverse acc) w2)
+            (_ :
+              lazyBool
+                (_ : self r 2 t w1 (reverse acc))
+                (_ : err 400 "Bad Request\n")
+                (equal? phase 1))
+            (equal? phase 0))
+        (_ : self r phase (pair h acc) w1 w2)
+        (equal? h 32))
+    bs))
+
+parseThreeWords = (bs :
+  parseThreeWords_ bs 0 t t t)
+
+parseRequestLine = (bs :
+  ((lineRest :
+    lazyResult
+      (code bad : err 400 "Bad Request\n")
+      (req ignored : ok req (snd lineRest))
+      (parseThreeWords (fst lineRest)))
+   (readLineBytes bs)))
+
+-- ---------------------------------------------------------------------------
+--  Header parsing
+-- ---------------------------------------------------------------------------
+
+
+-- ASCII byte helpers below are structural on the Tree Calculus numeral
+-- spine. Do not replace them with lte?/sub based checks: these names are
+-- normalized at import time under abstract byte inputs.
+boolNot? = (b :
+  matchBool false true b)
+
+boolOr? = (a b :
+  matchBool true b a)
+
+boolAnd? = (a b :
+  matchBool b false a)
+
+low5NonZero? = (b0 b1 b2 b3 b4 :
+  boolOr?
+    (bit1? b0)
+    (boolOr?
+      (bit1? b1)
+      (boolOr?
+        (bit1? b2)
+        (boolOr?
+          (bit1? b3)
+          (bit1? b4)))))
+
+low5TooHighForUpper? = (b0 b1 b2 b3 b4 :
+  boolAnd?
+    (bit1? b4)
+    (boolAnd?
+      (bit1? b3)
+      (boolOr?
+        (bit1? b2)
+        (boolAnd?
+          (bit1? b1)
+          (bit1? b0)))))
+
+upperLow5? = (b0 b1 b2 b3 b4 :
+  boolAnd?
+    (low5NonZero? b0 b1 b2 b3 b4)
+    (boolNot?
+      (low5TooHighForUpper? b0 b1 b2 b3 b4)))
+
+lowerAsciiBits = (b0 b1 b2 b3 b4 :
+  pair b0
+    (pair b1
+      (pair b2
+        (pair b3
+          (pair b4
+            (pair true
+              (pair true 0)))))))
+
+byte7BitsOr default c k =
+  let noStem _ = default in
+  let bit6 b0 b1 b2 b3 b4 b5 b6 r6 =
+    k b0 b1 b2 b3 b4 b5 b6 r6 in
+  let bit5 b0 b1 b2 b3 b4 b5 r5 =
+    triage default noStem (bit6 b0 b1 b2 b3 b4 b5) r5 in
+  let bit4 b0 b1 b2 b3 b4 r4 =
+    triage default noStem (bit5 b0 b1 b2 b3 b4) r4 in
+  let bit3 b0 b1 b2 b3 r3 =
+    triage default noStem (bit4 b0 b1 b2 b3) r3 in
+  let bit2 b0 b1 b2 r2 =
+    triage default noStem (bit3 b0 b1 b2) r2 in
+  let bit1 b0 b1 r1 =
+    triage default noStem (bit2 b0 b1) r1 in
+  let bit0 b0 r0 =
+    triage default noStem (bit1 b0) r0 in
+  triage default noStem bit0 c
+
+toLowerAsciiByte = (c :
+  byte7BitsOr c c (b0 b1 b2 b3 b4 b5 b6 rest :
+    lazyBool
+      (_ : lowerAsciiBits b0 b1 b2 b3 b4)
+      (_ : c)
+      (boolAnd?
+        (isZero? rest)
+        (boolAnd?
+          (bit1? b6)
+          (boolAnd?
+            (bit0? b5)
+            (upperLow5? b0 b1 b2 b3 b4))))))
+
+finishHeaderLine = (self r headers key value seenColon :
+  matchBool
+    (matchBool
+      (err 400 "Bad Request\n")
+      (ok (reverse headers) r)
+      seenColon)
+    (matchBool
+      (self r
+        (pair (pair (reverse key) (reverse value)) headers)
+        t
+        t
+        false
+        true)
+      (err 400 "Bad Request\n")
+      seenColon)
+    (emptyList? key))
+
+finishHeaderEOF = (headers key value seenColon :
+  matchBool
+    (ok (reverse headers) t)
+    (matchBool
+      (ok (reverse (pair (pair (reverse key) (reverse value)) headers)) t)
+      (err 400 "Bad Request\n")
+      seenColon)
+    (emptyList? key))
+
+parseHeaders_ = (self bs headers key value seenColon trimValue :
+  matchList
+    (finishHeaderEOF headers key value seenColon)
+    (h r :
+      matchBool
+        (finishHeaderLine self r headers key value seenColon)
+        (matchBool
+          (self r headers key value seenColon trimValue)
+          (matchBool
+            (matchBool
+              (self r headers key value true true)
+              (self r headers key (pair h value) true false)
+              (boolAnd? trimValue (equal? h 32)))
+            (matchBool
+              (self r headers key value true true)
+              (self r headers (pair (toLowerAsciiByte h) key) value false true)
+              (equal? h 58))
+            seenColon)
+          (equal? h 13))
+        (equal? h 10))
+    bs)
+
+parseHeaders = (bs :
+  y parseHeaders_ bs t t t false true)
+
+-- ---------------------------------------------------------------------------
+--  Content-Length parsing
+-- ---------------------------------------------------------------------------
+
+bit0? = (x :
+  isZero? x)
+
+bit1? = (x :
+  triage
+    false
+    (a : isZero? a)
+    (_ _ : false)
+    x)
+
+low3 = (b0 b1 b2 :
+  matchBool
+    (matchBool
+      (matchBool 7 6 (bit1? b0))
+      (matchBool 5 4 (bit1? b0))
+      (bit1? b1))
+    (matchBool
+      (matchBool 3 2 (bit1? b0))
+      (matchBool 1 0 (bit1? b0))
+      (bit1? b1))
+    (bit1? b2))
+
+decimalDigit = (c :
+  triage
+    nothing
+    (_ : nothing)
+    (b0 r0 :
+      triage
+        nothing
+        (_ : nothing)
+        (b1 r1 :
+          triage
+            nothing
+            (_ : nothing)
+            (b2 r2 :
+              triage
+                nothing
+                (_ : nothing)
+                (b3 r3 :
+                  triage
+                    nothing
+                    (_ : nothing)
+                    (b4 r4 :
+                      triage
+                        nothing
+                        (_ : nothing)
+                        (b5 r5 :
+                          matchBool
+                            (matchBool
+                              (matchBool
+                                (matchBool
+                                  (matchBool
+                                    (just (low3 b0 b1 b2))
+                                    (matchBool
+                                      (matchBool
+                                        (just (matchBool 9 8 (bit1? b0)))
+                                        nothing
+                                        (bit0? b2))
+                                      nothing
+                                      (bit0? b1))
+                                    (bit0? b3))
+                                  nothing
+                                  (bit1? b5))
+                                nothing
+                                (bit1? b4))
+                              nothing
+                              (isZero? r5))
+                            nothing
+                            true)
+                        r4)
+                    r3)
+                r2)
+            r1)
+        r0)
+    c)
+
+readDecimal_ = (self bytes acc :
+  matchList
+    (just acc)
+    (h r :
+      matchMaybe
+        nothing
+        (d : self r (add (mul acc 10) d))
+        (decimalDigit h))
+    bytes)
+
+readDecimal = (bytes :
+  matchBool
+    nothing
+    (y readDecimal_ bytes 0)
+    (emptyList? bytes))
+
+maxBodyBytesDecimal = "1048576"
+
+byte0? b = equal? b 48
+digitLtMax? maxDigit digit = lt? digit maxDigit
+
+stripLeadingZeros_ self raw =
+  lazyList
+    (_ : t)
+    (c r :
+      lazyBool
+        (_ : self r)
+        (_ : raw)
+        (byte0? c))
+    raw
+
+decimalLengthLte_ self max raw =
+  lazyList
+    (_ : true)
+    (_ rest :
+      lazyList
+        (_ : false)
+        (_ maxRest : self maxRest rest)
+        max)
+    raw
+
+decimalSameLength_ self max raw =
+  lazyList
+    (_ :
+      lazyList
+        (_ : true)
+        (_ _ : false)
+        max)
+    (_ rest :
+      lazyList
+        (_ : false)
+        (_ maxRest : self maxRest rest)
+        max)
+    raw
+
+sameLengthDecimalLte_ self max raw less =
+  lazyList
+    (_ : true)
+    (digit rest :
+      lazyList
+        (_ : false)
+        (maxDigit maxRest :
+          lazyBool
+            (_ : self maxRest rest true)
+            (_ :
+              lazyBool
+                (_ : self maxRest rest true)
+                (_ :
+                  lazyBool
+                    (_ : self maxRest rest false)
+                    (_ : false)
+                    (equal? digit maxDigit))
+                (digitLtMax? maxDigit digit))
+            less)
+        max)
+    raw
+
+decimalLengthLte? max raw = y decimalLengthLte_ max raw
+
+decimalSameLength? max raw = y decimalSameLength_ max raw
+
+decimalBytesLte? max raw =
+  let trimmed = y stripLeadingZeros_ raw in
+  lazyBool
+    (_ : y sameLengthDecimalLte_ max trimmed false)
+    (_ : decimalLengthLte? max trimmed)
+    (decimalSameLength? max trimmed)
+
+parseContentLengthValue = (raw :
+  matchMaybe
+    (err 400 "Bad Request\n")
+    (n :
+      lazyBool
+        (_ : ok (just n) t)
+        (_ : err 413 "Request body too large\n")
+        (decimalBytesLte? maxBodyBytesDecimal raw))
+    (readDecimal raw))
+
+contentLength_ = (self headers :
+  matchList
+    (ok nothing t)
+    (h r :
+      matchBool
+        (parseContentLengthValue (snd h))
+        (self r)
+        (equal? "content-length" (fst h)))
+    headers)
+
+contentLength = (headers :
+  y contentLength_ headers)
+
+-- ---------------------------------------------------------------------------
+--  Body reading
+-- ---------------------------------------------------------------------------
+
+bodyReadState = (remaining accRev rest :
+  pair remaining (pair accRev rest))
+
+bodyReadRemaining = (state :
+  fst state)
+
+bodyReadAccRev = (state :
+  fst (snd state))
+
+bodyReadRest = (state :
+  snd (snd state))
+
+takeBodyBytes_ = (self bytes remaining accRev :
+  lazyBool
+    (_ : bodyReadState 0 accRev bytes)
+    (_ :
+      lazyList
+        (_ : bodyReadState remaining accRev t)
+        (h r :
+          self r (pred remaining) (pair h accRev))
+        bytes)
+    (isZero? remaining))
+
+takeBodyBytes = (bytes remaining accRev :
+  y takeBodyBytes_ bytes remaining accRev)
+
+shiftRight1 n = triage 0 (_ : 0) (_ rest : rest) n
+
+shiftRight2 n = shiftRight1 (shiftRight1 n)
+shiftRight4 n = shiftRight2 (shiftRight2 n)
+shiftRight8 n = shiftRight4 (shiftRight4 n)
+shiftRight12 n = shiftRight4 (shiftRight8 n)
+
+shiftRight6 n = shiftRight2 (shiftRight4 n)
+
+atLeast16? n = not? (isZero? (shiftRight4 n))
+atLeast64? n = not? (isZero? (shiftRight6 n))
+atLeast256? n = not? (isZero? (shiftRight8 n))
+atLeast1024? n = not? (isZero? (shiftRight2 (shiftRight8 n)))
+atLeast4096? n = not? (isZero? (shiftRight12 n))
+
+recvChunkMax4096 remaining =
+  lazyBool
+    (_ : 4096)
+    (_ :
+      lazyBool
+        (_ : 1024)
+        (_ :
+          lazyBool
+            (_ : 256)
+            (_ :
+              lazyBool
+                (_ : 64)
+                (_ :
+                  lazyBool
+                    (_ : 16)
+                    (_ : 1)
+                    (atLeast16? remaining))
+                (atLeast64? remaining))
+            (atLeast256? remaining))
+        (atLeast1024? remaining))
+    (atLeast4096? remaining)
+
+readBodyRecv = (self sock remaining accRev recvBytes :
+  onResult_ (recv sock recvBytes)
+    (errMsg :
+      pure
+        (err
+          400
+          (append "recv failed while reading body: " errMsg)))
+    (chunk :
+      let state = takeBodyBytes chunk remaining accRev in
+      let nextRemaining = bodyReadRemaining state in
+      let nextAccRev = bodyReadAccRev state in
+      lazyBool
+        (_ : pure (ok (reverse nextAccRev) (bodyReadRest state)))
+        (_ : self sock nextRemaining nextAccRev)
+        (isZero? nextRemaining)))
+
+readBodyMore_ = (self sock remaining accRev :
+  lazyBool
+    (_ : pure (ok (reverse accRev) t))
+    (_ : readBodyRecv self sock remaining accRev (recvChunkMax4096 remaining))
+    (isZero? remaining))
+
+readBodyMore = (sock remaining accRev :
+  y readBodyMore_ sock remaining accRev)
+
+readBodyExact = (sock expected initialBytes :
+  let state = takeBodyBytes initialBytes expected t in
+  let remaining = bodyReadRemaining state in
+  let accRev = bodyReadAccRev state in
+  lazyBool
+    (_ : pure (ok (reverse accRev) (bodyReadRest state)))
+    (_ : readBodyMore sock remaining accRev)
+    (isZero? remaining))
+
+validateBodyLength = (expected body rest :
+  let actual = length body in
+  lazyBool
+    (_ : pure (ok body rest))
+    (_ :
+      pure
+        (err
+          400
+          (append
+            "body length mismatch expected="
+            (append
+              (showNumber expected)
+              (append
+                " actual="
+                (showNumber actual))))))
+    (equal? actual expected))
+
+readBody = (sock headers initialBytes :
+  matchResult
+    (status msg :
+      pure (err status msg))
+    (maybeLen rest :
+      lazyMaybe
+        (_ : pure (ok t initialBytes))
+        (n :
+          onOk (readBodyExact sock n initialBytes)
+            (body rest :
+              validateBodyLength n body rest))
+        maybeLen)
+    (contentLength headers))
+
+-- ---------------------------------------------------------------------------
+-- Request validation
+-- ---------------------------------------------------------------------------
+
+validMethod? = (method :
+  lazyBool
+    (_ : true)
+    (_ :
+      lazyBool
+        (_ : true)
+        (_ :
+          lazyBool
+            (_ : true)
+            (_ : false)
+            (equal? method "HEAD"))
+        (equal? method "POST"))
+    (equal? method "GET"))
+
+validVersion? = (version :
+  lazyBool
+    (_ : true)
+    (_ : equal? version "HTTP/1.0")
+    (equal? version "HTTP/1.1"))
+
+validTarget? = (target :
+  startsWith? "/" target)
+
+validateRequest = (method target version headers :
+  lazyBool
+    (_ :
+      lazyBool
+        (_ :
+          lazyBool
+            (_ : ok t t)
+            (_ : err 400 "Bad Request\n")
+            (validTarget? target))
+        (_ : err 505 "HTTP Version Not Supported\n")
+        (validVersion? version))
+    (_ : err 400 "Bad Request\n")
+    (validMethod? method))
+
+-- ---------------------------------------------------------------------------
+-- 11. Handler pipeline
+-- ---------------------------------------------------------------------------
+
+routerMethod = (method :
+  lazyBool
+    (_ : "GET")
+    (_ : method)
+    (equal? method "HEAD"))
+
+respondAndClose = (sock resp :
+  onOk_ (finally (send sock resp) (closeSocket_ sock)) (_ :
+    pure (ok t t)))
+
+handleReadableRequest = (router client method target headers rest3 :
+  onResult (readBody client headers rest3)
+    (status msg :
+      respondAndClose client
+        (responseForMethod method
+          (errorResponse status msg)))
+    (body rest :
+      respondAndClose client
+        (responseForMethod method
+          (router (routerMethod method) target headers body))))
+
+handleParsedHeaders = (router client method target version rest2 :
+  matchResult
+    (code bad :
+      respondAndClose client (badRequestResponse "Bad Request\n"))
+    (headers rest3 :
+      matchResult
+        (status msg :
+          respondAndClose client
+            (responseForMethod method (errorResponse status msg)))
+        (ignored rest :
+          handleReadableRequest router client method target headers rest3)
+        (validateRequest method target version headers))
+    (parseHeaders rest2))
+
+handleParsedRequest = (router client req rest2 :
+  ((method :
+    ((target :
+      ((version :
+        handleParsedHeaders router client method target version rest2)
+       (snd (snd req))))
+     (fst (snd req))))
+   (fst req)))
+
+httpHandler = (router client peer :
+  onResult_ (recvHeaders client)
+    (status :
+      respondAndClose client
+        (badRequestResponse "Bad Request\n"))
+    (raw :
+      matchResult
+        (code bad :
+          respondAndClose client (badRequestResponse "Bad Request\n"))
+        (req rest2 :
+          handleParsedRequest router client req rest2)
+        (parseRequestLine raw)))
+
+-- ---------------------------------------------------------------------------
+-- 12. IO-aware handler pipeline
+-- ---------------------------------------------------------------------------
+
+handleReadableRequestIO = (routerIO client method target headers rest3 :
+  onResult (readBody client headers rest3)
+    (status msg :
+      respondAndClose client
+        (responseForMethod method
+          (errorResponse status msg)))
+    (body rest :
+      bind (routerIO (routerMethod method) target headers body) (resp :
+        respondAndClose client (responseForMethod method resp))))
+
+handleParsedHeadersIO = (routerIO client method target version rest2 :
+  matchResult
+    (code bad :
+      respondAndClose client (badRequestResponse "Bad Request\n"))
+    (headers rest3 :
+      matchResult
+        (status msg :
+          respondAndClose client
+            (responseForMethod method (errorResponse status msg)))
+        (ignored rest :
+          handleReadableRequestIO routerIO client method target headers rest3)
+        (validateRequest method target version headers))
+    (parseHeaders rest2))
+
+handleParsedRequestIO = (routerIO client req rest2 :
+  ((method :
+    ((target :
+      ((version :
+        handleParsedHeadersIO routerIO client method target version rest2)
+       (snd (snd req))))
+     (fst (snd req))))
+   (fst req)))
+
+httpHandlerIO = (routerIO client peer :
+  onResult_ (recvHeaders client)
+    (status :
+      respondAndClose client
+        (badRequestResponse "Bad Request\n"))
+    (raw :
+      matchResult
+        (code bad :
+          respondAndClose client (badRequestResponse "Bad Request\n"))
+        (req rest2 :
+          handleParsedRequestIO routerIO client req rest2)
+        (parseRequestLine raw)))

lib/io.tri

@@ -1,6 +1,5 @@
-!import "base.tri"        !Local
-!import "list.tri"        !Local
-!import "conversions.tri" !Local
+!import "prelude"  !Local
+!import "patterns" !Local
 
 -- IO constructors for host-interpreted interaction trees.
 -- Free-monad style: Bind is the single sequencing mechanism.
@@ -20,6 +19,15 @@ writeFile = p c        : pair 21 (pair p c)
 putBytes  = bs         : pair 12 bs
 writeBytes = p c       : pair 22 (pair p c)
 
+listDirectory   = p          : pair 23 p
+renameFile      = old new    : pair 24 (pair old new)
+createDirectory = p          : pair 25 p
+deleteFile      = p          : pair 26 p
+fileExists      = p          : pair 27 p
+
+sha256Hex       = bs         : pair 28 bs
+currentTime     = pair 29 t
+
 ask       = pair 30 t
 local     = f action   : pair 31 (pair f action)
 
@@ -37,25 +45,83 @@ sleep     = ms         : pair 63 ms
 
 thenIO = a b : bind a (_ : b)
 mapIO  = action f : bind action (x : pure (f x))
+void   = action : bind action (_ : pure t)
+
+-- ---------------------------------------------------------------------------
+-- Conditional execution
+-- ---------------------------------------------------------------------------
+
+when   = cond action : matchBool action (pure t) cond
+unless = cond action : matchBool (pure t) action cond
+
+-- ---------------------------------------------------------------------------
+-- Infinite loop
+-- ---------------------------------------------------------------------------
+
+forever = y (self : action :
+  bind action (_ :
+    self action))
+
+-- ---------------------------------------------------------------------------
+-- Result-aware combinators
+-- ---------------------------------------------------------------------------
+
+-- Propagate driver Result on error; run okCase on success.
+onOk = action okCase :
+  bind action (result :
+    matchResult
+      (err rest : pure result)
+      okCase
+      result)
+
+-- Same as onOk, but the okCase only receives the value (rest is dropped).
+onOk_ = action okCase :
+  bind action (result :
+    matchResult
+      (err rest : pure result)
+      (val _ : okCase val)
+      result)
+
+-- Generalized Result handler with explicit branches.
+onResult = action errCase okCase :
+  bind action (result :
+    matchResult errCase okCase result)
+
+-- Same as onResult, but handlers only receive the value/msg (rest is dropped).
+onResult_ = action errCase okCase :
+  bind action (result :
+    matchResult
+      (err _ : errCase err)
+      (val _ : okCase val)
+      result)
+
+mapErrIO prefix action =
+  onResult_ action
+    (e : pure (err (append prefix e) t))
+    (v : pure (ok v t))
 
 -- ---------------------------------------------------------------------------
 -- Convenience helpers
 -- ---------------------------------------------------------------------------
 
-print    = s : bind (putStr s)       (_ : pure t)
-putStrLn = s : bind (putStr (append s "\n")) (_ : pure t)
+print    = s : void (putStr s)
+putStrLn = s : void (putStr (append s "\n"))
 
 -- ---------------------------------------------------------------------------
 -- Result-aware file helpers
 -- ---------------------------------------------------------------------------
 
-onReadFile = (path errCase okCase :
-  bind (readFile path) (result :
-    matchResult errCase okCase result))
+onReadFile = path : onResult (readFile path)
 
-onWriteFile = (path contents errCase okCase :
-  bind (writeFile path contents) (result :
-    matchResult errCase okCase result))
+onWriteFile = path contents : onResult (writeFile path contents)
+
+onListDirectory   = path : onResult (listDirectory path)
+onRenameFile      = old new : onResult (renameFile old new)
+onCreateDirectory = path : onResult (createDirectory path)
+onDeleteFile      = path : onResult (deleteFile path)
+onFileExists      = path : onResult (fileExists path)
+onSha256Hex       = bs : onResult (sha256Hex bs)
+onCurrentTime     = onResult currentTime
 
 -- ---------------------------------------------------------------------------
 -- Convenience helpers for the common cases
@@ -72,15 +138,24 @@ writeFileOrPrintError = (path contents okCase :
     okCase)
 
 copyFile = (src dst :
-  bind (readFile src)
-    (result :
-      matchResult
-        (err rest : putStrLn (append "Read failed: " err))
-        (contents rest :
-          bind (writeFile dst contents)
-            (wr :
-              matchResult
-                (err rest : putStrLn (append "Write failed: " err))
-                (ok rest   : pure t)
-                wr))
-        result))
+  onResult (readFile src)
+    (err rest : putStrLn (append "Read failed: " err))
+    (contents rest :
+      onResult (writeFile dst contents)
+        (err rest : putStrLn (append "Write failed: " err))
+        (_ _ : pure t)))
+
+-- ---------------------------------------------------------------------------
+-- Resource-safe combinators
+-- ---------------------------------------------------------------------------
+
+finally = action cleanup :
+  bind action (result :
+    bind cleanup (_ :
+      pure result))
+
+bracket = acquire release use :
+  bind acquire (resource :
+    bind (use resource) (result :
+      bind (release resource) (_ :
+        pure result)))

lib/lazy.tri

@@ -0,0 +1,30 @@
+!import "base" !Local
+!import "list" !Local
+
+lazyBool = (thenK elseK cond :
+  ((chosen : chosen t)
+   (matchBool
+     thenK
+     elseK
+     cond)))
+
+lazyList = (nilK consK xs :
+  ((chosen : chosen t)
+   (matchList
+     nilK
+     (h r : (_ : consK h r))
+     xs)))
+
+lazyMaybe = (noneK someK m :
+  ((chosen : chosen t)
+   (matchMaybe
+     noneK
+     (x : (_ : someK x))
+     m)))
+
+lazyResult = (errK okK result :
+  ((chosen : chosen t)
+   (matchResult
+     (code rest : (_ : errK code rest))
+     (value rest : (_ : okK value rest))
+     result)))

lib/list.tri

@@ -1,4 +1,4 @@
-!import "base.tri" !Local
+!import "base" !Local
 
 _ = t
 
@@ -8,75 +8,434 @@ emptyList? = matchList true (_ _ : false)
 head = matchList t (head _ : head)
 tail = matchList t (_ tail : tail)
 
-append = y (self : matchList
-  (k : k)
-  (h r k : pair h (self r k)))
-
-lExist? = y (self x : matchList
-  false
-  (h z : or? (equal? x h) (self x z)))
-
-map_ = y (self :
+append_ self xs ys =
   matchList
-    (_ : t)
-    (head tail f : pair (f head) (self tail f)))
-map = f l : map_ l f
+    ys
+    (h r : pair h (self r ys))
+    xs
+append = xs ys : y append_ xs ys
 
-filter_ = y (self : matchList
-  (_ : t)
-  (head tail f : matchBool (t head) id (f head) (self tail f)))
-filter  = f l : filter_ l f
+lExist?_ self x xs =
+  matchList
+    false
+    (h r : or? (equal? x h) (self x r))
+    xs
+lExist? = x xs : y lExist?_ x xs
 
-foldl_ = y (self l f x : matchList (acc : acc) (head tail acc : self tail f (f acc head)) l x)
-foldl  = f x l : foldl_ l f x
+map_ self l f =
+  matchList
+    t
+    (h r : pair (f h) (self r f))
+    l
+map = f l : y map_ l f
 
-foldr_ = y (self l f x : matchList x (head tail : f (self tail f x) head) l)
-foldr  = f x l : foldr_ l f x
+filter_ self l f =
+  matchList
+    t
+    (h r :
+      matchBool
+        (pair h (self r f))
+        (self r f)
+        (f h))
+    l
+filter = f l : y filter_ l f
 
-length = y (self : matchList
-  0
-  (_ tail : succ (self tail)))
+foldl_ self l f acc =
+  matchList
+    acc
+    (h r : self r f (f acc h))
+    l
+foldl = f x l : y foldl_ l f x
 
-reverse = y (self : matchList
-  t
-  (head tail : append (self tail) (pair head t)))
+foldr_ self l f x =
+  matchList
+    x
+    (h r : f (self r f x) h)
+    l
+foldr = f x l : y foldr_ l f x
 
-snoc = y (self x : matchList
-  (pair x t)
-  (h z : pair h (self x z)))
+length_ self xs =
+  matchList
+    0
+    (_ r : succ (self r))
+    xs
+length = xs : y length_ xs
 
-count = y (self x : matchList
-  0
-  (h z : matchBool
-    (succ (self x z))
-    (self x z)
-    (equal? x h)))
+reverse_ self xs acc =
+  matchList
+    acc
+    (h r : self r (pair h acc))
+    xs
+reverse = xs : y reverse_ xs t
 
-last = y (self : matchList
-  t
-  (hd tl : matchBool
-    hd
-    (self tl)
-    (emptyList? tl)))
+snoc_ self x xs =
+  matchList
+    (pair x t)
+    (h r : pair h (self x r))
+    xs
+snoc = x xs : y snoc_ x xs
 
-all? = y (self pred : matchList
-  true
-  (h z : and? (pred h) (self pred z)))
+count_ self x xs =
+  matchList
+    0
+    (h r :
+      matchBool
+        (succ (self x r))
+        (self x r)
+        (equal? x h))
+    xs
+count = x xs : y count_ x xs
 
-any? = y (self pred : matchList
-  false
-  (h z : or? (pred h) (self pred z)))
-
-intersect = xs ys : filter (x : lExist? x ys) xs
-
-nth_ = y (self n xs i :
+last_ self xs =
   matchList
     t
     (h r :
       matchBool
         h
-        (self n r (succ i))
-        (equal? i n))
-    xs)
+        (self r)
+        (emptyList? r))
+    xs
+last = xs : y last_ xs
 
-nth = n xs : nth_ n xs 0
+all?_ self pred xs =
+  matchList
+    true
+    (h r : and? (pred h) (self pred r))
+    xs
+all? = pred xs : y all?_ pred xs
+
+any?_ self pred xs =
+  matchList
+    false
+    (h r : or? (pred h) (self pred r))
+    xs
+any? = pred xs : y any?_ pred xs
+
+intersect = xs ys : filter (x : lExist? x ys) xs
+
+nth_ self xs n i =
+  matchList
+    t
+    (h r :
+      matchBool
+        h
+        (self r n (succ i))
+        (equal? i n))
+    xs
+nth = n xs : y nth_ xs n 0
+
+headMaybe = matchList nothing (h _ : just h)
+
+lastMaybe_ self xs =
+  matchList
+    nothing
+    (h r :
+      matchBool
+        (just h)
+        (self r)
+        (emptyList? r))
+    xs
+lastMaybe = xs : y lastMaybe_ xs
+
+nthMaybe_ self xs n i =
+  matchList
+    nothing
+    (h r :
+      matchBool
+        (just h)
+        (self r n (succ i))
+        (equal? i n))
+    xs
+nthMaybe = n xs : y nthMaybe_ xs n 0
+
+take_ self xs n i =
+  matchList
+    t
+    (h r :
+      matchBool
+        t
+        (pair h (self r n (succ i)))
+        (equal? i n))
+    xs
+take = n xs : y take_ xs n 0
+
+drop_ self xs n i =
+  matchBool
+    xs
+    (matchList
+      t
+      (_ r : self r n (succ i))
+      xs)
+    (equal? i n)
+drop = n xs : y drop_ xs n 0
+
+splitAt = n xs : pair (take n xs) (drop n xs)
+
+concatMap_ self f xs =
+  matchList
+    t
+    (h r : append (f h) (self f r))
+    xs
+concatMap = f xs : y concatMap_ f xs
+
+find_ self pred xs =
+  matchList
+    nothing
+    (h r :
+      matchBool
+        (just h)
+        (self pred r)
+        (pred h))
+    xs
+find = pred xs : y find_ pred xs
+
+partition_ self pred xs trues falses =
+  matchList
+    (pair (reverse trues) (reverse falses))
+    (h r :
+      matchBool
+        (self pred r (pair h trues) falses)
+        (self pred r trues (pair h falses))
+        (pred h))
+    xs
+partition = pred xs : y partition_ pred xs t t
+
+strLength = length
+strAppend = append
+strEq? = equal?
+strEmpty? = emptyList?
+
+startsWith?_ self prefix input =
+  matchList
+    true
+    (ph pr :
+      matchList
+        false
+        (sh sr :
+          matchBool
+            (self pr sr)
+            false
+            (equal? ph sh))
+        input)
+    prefix
+startsWith? = prefix input : y startsWith?_ prefix input
+
+endsWith? = prefix str : startsWith? (reverse prefix) (reverse str)
+
+contains?_ self needle haystack =
+  matchBool
+    true
+    (matchList
+      false
+      (_ r : self needle r)
+      haystack)
+    (startsWith? needle haystack)
+contains? = needle haystack : y contains?_ needle haystack
+
+linesFinish current accRev =
+  reverse (pair (reverse current) accRev)
+
+lines_ self str accRev current =
+  matchList
+    (linesFinish current accRev)
+    (h r :
+      matchBool
+        (self r (pair (reverse current) accRev) t)
+        (self r accRev (pair h current))
+        (equal? h 10))
+    str
+lines = str : y lines_ str t t
+
+unlines_ self lines =
+  matchList
+    ""
+    (h r : append h (append "\n" (self r)))
+    lines
+unlines = lines : y unlines_ lines
+
+wordsAdd current accRev =
+  matchBool
+    accRev
+    (pair (reverse current) accRev)
+    (emptyList? current)
+
+words_ self str accRev current =
+  matchList
+    (reverse (wordsAdd current accRev))
+    (h r :
+      matchBool
+        (self r (wordsAdd current accRev) t)
+        (self r accRev (pair h current))
+        (equal? h 32))
+    str
+words = str : y words_ str t t
+
+unwords_ self words =
+  matchList
+    ""
+    (h r :
+      matchBool
+        h
+        (append h (append " " (self r)))
+        (emptyList? r))
+    words
+unwords = words : y unwords_ words
+
+zipWith_ self f xs ys =
+  matchList
+    t
+    (xh xt :
+      matchList
+        t
+        (yh yt : pair (f xh yh) (self f xt yt))
+        ys)
+    xs
+zipWith = f xs ys : y zipWith_ f xs ys
+
+-- ---------------------------------------------------------------------------
+-- View facts
+--
+-- Value-level metadata consumed by View tooling. These facts are ordinary Tree
+-- Calculus data, not host-side assumptions and not part of the public stdlib
+-- API exported by module manifests.
+-- ---------------------------------------------------------------------------
+
+viewFacts =
+  [(factsFact "matchList" factsTrusted
+     (factsForall [0 1]
+       (factsFn
+         [(factsVar 1)
+          (factsFn
+            [(factsVar 0) (factsList (factsVar 0))]
+            (factsVar 1))
+          (factsList (factsVar 0))]
+         (factsVar 1))))
+   (factsFact "emptyList?" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] factsBool)))
+   (factsFact "tail" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "append" factsTrusted
+     (factsForall [0]
+       (factsFn
+         [(factsList (factsVar 0))
+          (factsList (factsVar 0))]
+         (factsList (factsVar 0)))))
+   (factsFact "lExist?" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsVar 0) (factsList (factsVar 0))] factsBool)))
+   (factsFact "map" factsTrusted
+     (factsForall [0 1]
+       (factsFn
+         [(factsFn [(factsVar 0)] (factsVar 1))
+          (factsList (factsVar 0))]
+         (factsList (factsVar 1)))))
+   (factsFact "filter" factsTrusted
+     (factsForall [0]
+       (factsFn
+         [(factsFn [(factsVar 0)] factsBool)
+          (factsList (factsVar 0))]
+         (factsList (factsVar 0)))))
+   (factsFact "foldl" factsTrusted
+     (factsForall [0 1]
+       (factsFn
+         [(factsFn [(factsVar 1) (factsVar 0)] (factsVar 1))
+          (factsVar 1)
+          (factsList (factsVar 0))]
+         (factsVar 1))))
+   (factsFact "foldr" factsTrusted
+     (factsForall [0 1]
+       (factsFn
+         [(factsFn [(factsVar 1) (factsVar 0)] (factsVar 1))
+          (factsVar 1)
+          (factsList (factsVar 0))]
+         (factsVar 1))))
+   (factsFact "length" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] factsByte)))
+   (factsFact "reverse" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "snoc" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsVar 0) (factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "count" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsVar 0) (factsList (factsVar 0))] factsByte)))
+   (factsFact "all?" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsFn [(factsVar 0)] factsBool) (factsList (factsVar 0))] factsBool)))
+   (factsFact "any?" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsFn [(factsVar 0)] factsBool) (factsList (factsVar 0))] factsBool)))
+   (factsFact "intersect" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0)) (factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "headMaybe" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] (factsMaybe (factsVar 0)))))
+   (factsFact "lastMaybe" factsTrusted
+     (factsForall [0]
+       (factsFn [(factsList (factsVar 0))] (factsMaybe (factsVar 0)))))
+   (factsFact "nthMaybe" factsTrusted
+     (factsForall [0]
+       (factsFn [factsByte (factsList (factsVar 0))] (factsMaybe (factsVar 0)))))
+   (factsFact "take" factsTrusted
+     (factsForall [0]
+       (factsFn [factsByte (factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "drop" factsTrusted
+     (factsForall [0]
+       (factsFn [factsByte (factsList (factsVar 0))] (factsList (factsVar 0)))))
+   (factsFact "splitAt" factsTrusted
+     (factsForall [0]
+       (factsFn
+         [factsByte (factsList (factsVar 0))]
+         (factsPair (factsList (factsVar 0)) (factsList (factsVar 0))))))
+   (factsFact "concatMap" factsTrusted
+     (factsForall [0 1]
+       (factsFn
+         [(factsFn [(factsVar 0)] (factsList (factsVar 1)))
+          (factsList (factsVar 0))]
+         (factsList (factsVar 1)))))
+   (factsFact "find" factsTrusted
+     (factsForall [0]
+       (factsFn
+         [(factsFn [(factsVar 0)] factsBool)
+          (factsList (factsVar 0))]
+         (factsMaybe (factsVar 0)))))
+   (factsFact "partition" factsTrusted
+     (factsForall [0]
+       (factsFn
+         [(factsFn [(factsVar 0)] factsBool)
+          (factsList (factsVar 0))]
+         (factsPair (factsList (factsVar 0)) (factsList (factsVar 0))))))
+   (factsFact "strLength" factsTrusted
+     (factsFn [factsString] factsByte))
+   (factsFact "strAppend" factsTrusted
+     (factsFn [factsString factsString] factsString))
+   (factsFact "strEq?" factsTrusted
+     (factsFn [factsString factsString] factsBool))
+   (factsFact "strEmpty?" factsTrusted
+     (factsFn [factsString] factsBool))
+   (factsFact "startsWith?" factsTrusted
+     (factsFn [factsString factsString] factsBool))
+   (factsFact "endsWith?" factsTrusted
+     (factsFn [factsString factsString] factsBool))
+   (factsFact "contains?" factsTrusted
+     (factsFn [factsString factsString] factsBool))
+   (factsFact "lines" factsTrusted
+     (factsFn [factsString] (factsList factsString)))
+   (factsFact "unlines" factsTrusted
+     (factsFn [(factsList factsString)] factsString))
+   (factsFact "words" factsTrusted
+     (factsFn [factsString] (factsList factsString)))
+   (factsFact "unwords" factsTrusted
+     (factsFn [(factsList factsString)] factsString))
+   (factsFact "zipWith" factsTrusted
+     (factsForall [0 1 2]
+       (factsFn
+         [(factsFn [(factsVar 0) (factsVar 1)] (factsVar 2))
+          (factsList (factsVar 0))
+          (factsList (factsVar 1))]
+         (factsList (factsVar 2)))))]

lib/patterns.tri

@@ -1,5 +1,4 @@
-!import "base.tri" !Local
-!import "list.tri" !Local
+!import "prelude" !Local
 
 match_ = y (self value patterns :
   triage
@@ -22,3 +21,20 @@ match = (value patterns :
     patterns))
 
 otherwise = const (t t)
+
+cond_ self patterns =
+  lazyList
+    (_ : t)
+    (pattern rest :
+      matchPair
+        (testK actionK :
+          lazyBool
+            actionK
+            (_ : self rest)
+            (testK t))
+        pattern)
+    patterns
+
+cond patterns = y cond_ patterns
+
+guard testK actionK = pair testK actionK

lib/prelude.tri

@@ -0,0 +1,7 @@
+-- Standard tricu prelude.
+
+!import "base"        !Local
+!import "list"        !Local
+!import "bytes"       !Local
+!import "lazy"        !Local
+!import "conversions" !Local

lib/socket.tri

@@ -1,10 +1,9 @@
-!import "base.tri"      !Local
-!import "io.tri"        !Local
+!import "prelude" !Local
+!import "io"      !Local
 
 -- Socket primitives for the IO driver.
--- All actions return a Result tree (see lib/base.tri):
---   ok value  -- pair true (pair value t)
---   err msg   -- pair false (pair msg t)
+--   ok value t  -- pair true (pair value t)
+--   err msg t   -- pair false (pair msg t)
 
 socket      = pair 70 t
 closeSocket = sock : pair 71 sock
@@ -16,48 +15,68 @@ recv        = sock maxBytes  : pair 76 (pair sock maxBytes)
 send        = sock bytes     : pair 77 (pair sock bytes)
 getSocketName = sock         : pair 78 sock
 
--- ---------------------------------------------------------------------------
--- Convenience helpers
--- ---------------------------------------------------------------------------
+-- Result-aware wrappers over raw socket actions
+onSocket     = onResult socket
+onBindSocket = sock addr port : onResult (bindSocket sock addr port)
+onListen     = sock backlog   : onResult (listen sock backlog)
+onAccept     = sock           : onResult (accept sock)
+onConnect    = sock addr port : onResult (connect sock addr port)
+onRecv       = sock maxBytes  : onResult (recv sock maxBytes)
+onSend       = sock bytes     : onResult (send sock bytes)
+onGetSocketName = sock        : onResult (getSocketName sock)
 
-onSocket = (action errCase okCase :
-  bind action (result :
-    matchResult errCase okCase result))
+-- Result-aware wrappers that drop the 'rest' parameter
+onSocket_        = onResult_ socket
+onBindSocket_    = sock addr port   : onResult_ (bindSocket sock addr port)
+onListen_        = sock backlog     : onResult_ (listen sock backlog)
+onAccept_        = sock             : onResult_ (accept sock)
+onConnect_       = sock addr port   : onResult_ (connect sock addr port)
+onRecv_          = sock maxBytes    : onResult_ (recv sock maxBytes)
+onSend_          = sock bytes       : onResult_ (send sock bytes)
+onGetSocketName_ = sock             : onResult_ (getSocketName sock)
+
+-- Close a socket, ignoring errors.
+closeSocket_ = sock : void (closeSocket sock)
 
 -- Create a listening socket bound to an address and port.
 -- Returns ok listenSocket or err message.
 listenSocket = addr port backlog :
-  bind (socket) (result :
-    matchResult
-      (err rest : pure (err "socket creation failed"))
-      (sock rest :
-        bind (bindSocket sock addr port) (bindResult :
-          matchResult
-            (err rest : pure (err "bind failed"))
-            (_ rest :
-              bind (listen sock backlog) (listenResult :
-                matchResult
-                  (err rest : pure (err "listen failed"))
-                  (_ rest : pure (ok sock))
-                  listenResult))
-            bindResult))
-      result)
+  onOk_ socket (server :
+    onOk_ (bindSocket server addr port) (_ :
+      onOk_ (listen server backlog) (_ :
+        pure (ok server t))))
 
--- Accept a connection and return (clientSocket, peerAddr).
--- The returned peerAddr is a string like "127.0.0.1:8080".
-onAccept = (sock errCase okCase :
-  bind (accept sock) (result :
-    matchResult errCase okCase result))
+-- Accept a connection with explicit error and ok branches.
+-- okHandler receives (clientSocket, peerAddr).
+withAccepted = (server errHandler okHandler :
+  onResult (accept server)
+    errHandler
+    (accepted rest :
+      okHandler (fst accepted) (snd accepted)))
 
--- Receive all available bytes up to maxBytes.
-onRecv = (sock maxBytes errCase okCase :
-  bind (recv sock maxBytes) (result :
-    matchResult errCase okCase result))
+-- Same as withAccepted, but handlers drop the useless 'rest' parameter.
+withAccepted_ = (server errHandler okHandler :
+  onResult_ (accept server)
+    errHandler
+    (accepted :
+      okHandler (fst accepted) (snd accepted)))
 
--- Send bytes and return number of bytes sent.
-onSend = (sock bytes errCase okCase :
-  bind (send sock bytes) (result :
-    matchResult errCase okCase result))
+serveOnce = (server handler :
+  withAccepted_ server
+    (err : pure t)
+    (client peer :
+      handler client peer))
 
--- Close a socket, ignoring errors.
-closeSocket_ = sock : bind (closeSocket sock) (_ : pure t)
+serveForkingOnce = (server handler :
+  withAccepted_ server
+    (err : pure t)
+    (client peer :
+      fork (handler client peer)))
+
+serveForever = (server handler :
+  forever (serveForkingOnce server handler))
+
+connectTo = (addr port :
+  onOk socket (client rest :
+    onOk (connect client addr port) (_ rest :
+      pure (ok client rest))))

lib/views/catalog.tri

@@ -0,0 +1,267 @@
+!import "prelude" !Local
+!import "view" !Local
+
+-- Stdlib-shaped typed-program catalog. These helpers are stable lowering
+-- targets for frontend-emitted API contracts. They are monomorphic
+-- instantiations of familiar polymorphic shapes.
+listMapUseContract = (elemIn elemOut mapSym fnSym xsSym partialSym outSym :
+  typedProgram
+    outSym
+    [(typedDeclareFn
+       mapSym
+       [(viewFn [(elemIn)] elemOut) (viewList elemIn)]
+       (viewList elemOut)
+       t)
+     (typedDeclareFn fnSym [(elemIn)] elemOut t)
+     (typedValue xsSym (viewList elemIn) t)
+     (typedApply partialSym mapSym fnSym t)
+     (typedApply outSym partialSym xsSym t)
+     (typedRequire outSym (viewList elemOut) t)])
+
+headMaybeUseContract = (elem headSym xsSym outSym :
+  typedProgram
+    outSym
+    [(typedDeclareFn headSym [(viewList elem)] (viewMaybe elem) t)
+     (typedValue xsSym (viewList elem) t)
+     (typedApply outSym headSym xsSym t)
+     (typedRequire outSym (viewMaybe elem) t)])
+
+listFilterUseContract = (elem filterSym predSym xsSym partialSym outSym :
+  typedProgram
+    outSym
+    [(typedDeclareFn
+       filterSym
+       [(viewFn [(elem)] viewBool) (viewList elem)]
+       (viewList elem)
+       t)
+     (typedDeclareFn predSym [(elem)] viewBool t)
+     (typedValue xsSym (viewList elem) t)
+     (typedApply partialSym filterSym predSym t)
+     (typedApply outSym partialSym xsSym t)
+     (typedRequire outSym (viewList elem) t)])
+
+listFoldUseContract = (acc elem foldSym fnSym initSym xsSym partialFnSym partialInitSym outSym :
+  typedProgram
+    outSym
+    [(typedDeclareFn
+       foldSym
+       [(viewFn [(acc) (elem)] acc) acc (viewList elem)]
+       acc
+       t)
+     (typedDeclareFn fnSym [(acc) (elem)] acc t)
+     (typedValue initSym acc t)
+     (typedValue xsSym (viewList elem) t)
+     (typedApply partialFnSym foldSym fnSym t)
+     (typedApply partialInitSym partialFnSym initSym t)
+     (typedApply outSym partialInitSym xsSym t)
+     (typedRequire outSym acc t)])
+
+listMapMaybeUseContract = (elemIn elemOut mapMaybeSym fnSym xsSym partialSym outSym :
+  typedProgram
+    outSym
+    [(typedDeclareFn
+       mapMaybeSym
+       [(viewFn [(elemIn)] (viewMaybe elemOut)) (viewList elemIn)]
+       (viewList elemOut)
+       t)
+     (typedDeclareFn fnSym [(elemIn)] (viewMaybe elemOut) t)
+     (typedValue xsSym (viewList elemIn) t)
+     (typedApply partialSym mapMaybeSym fnSym t)
+     (typedApply outSym partialSym xsSym t)
+     (typedRequire outSym (viewList elemOut) t)])
+
+-- Concrete stdlib-shaped typed programs. These are deliberately monomorphic
+-- examples of the shapes a frontend can emit for polymorphic library functions.
+listMapBoolStringExpr = cFn <|
+    [(viewFn [(viewBool)] viewString) (viewList viewBool)] (viewList viewString)
+    |> cApply (cFn [(viewBool)] viewString)
+    |> cApply (cValue (viewList viewBool))
+    |> cRequire (viewList viewString)
+
+headMaybeBoolExpr = cFn <|
+    [(viewList viewBool)] (viewMaybe viewBool)
+    |> cApply (cValue (viewList viewBool))
+    |> cRequire (viewMaybe viewBool)
+
+listFilterBoolExpr = cFn <|
+    [(viewFn [(viewBool)] viewBool) (viewList viewBool)] (viewList viewBool)
+    |> cApply (cFn [(viewBool)] viewBool)
+    |> cApply (cValue (viewList viewBool))
+    |> cRequire (viewList viewBool)
+
+listFoldStringBoolExpr = cFn <|
+    [(viewFn [(viewString) (viewBool)] viewString) viewString (viewList viewBool)] viewString
+    |> cApply (cFn [(viewString) (viewBool)] viewString)
+    |> cApply (cValue viewString)
+    |> cApply (cValue (viewList viewBool))
+    |> cRequire viewString
+
+listMapMaybeBoolStringExpr = cFn <|
+    [(viewFn [(viewBool)] (viewMaybe viewString)) (viewList viewBool)] (viewList viewString)
+    |> cApply (cFn [(viewBool)] (viewMaybe viewString))
+    |> cApply (cValue (viewList viewBool))
+    |> cRequire (viewList viewString)
+
+-- Keep catalog exports as explicit finite typed-programs. `cCompileAt` is useful
+-- as a frontend-emission helper, but forcing generated node lists at module
+-- import time can violate top-level normalization discipline.
+listMapBoolStringContract =
+  listMapUseContract viewBool viewString 100 101 102 103 104
+headMaybeBoolContract =
+  headMaybeUseContract viewBool 110 111 112
+listFilterBoolContract =
+  listFilterUseContract viewBool 120 121 122 123 124
+listFoldStringBoolContract =
+  listFoldUseContract viewString viewBool 130 131 132 133 134 135 136
+listMapMaybeBoolStringContract =
+  listMapMaybeUseContract viewBool viewString 140 141 142 143 144
+
+listMapWrongFunctionArgContract =
+  typedProgram
+    152
+    [(typedDeclareFn
+       150
+       [(viewFn [(viewBool)] viewString) (viewList viewBool)]
+       (viewList viewString)
+       t)
+     (typedDeclareFn 151 [(viewString)] viewString t)
+     (typedApply 152 150 151 t)]
+
+listMapWrongListArgContract =
+  typedProgram
+    164
+    [(typedDeclareFn
+       160
+       [(viewFn [(viewBool)] viewString) (viewList viewBool)]
+       (viewList viewString)
+       t)
+     (typedDeclareFn 161 [(viewBool)] viewString t)
+     (typedValue 162 (viewList viewString) t)
+     (typedApply 163 160 161 t)
+     (typedApply 164 163 162 t)]
+
+listMapWrongOutputContract =
+  typedProgram
+    174
+    [(typedDeclareFn
+       170
+       [(viewFn [(viewBool)] viewString) (viewList viewBool)]
+       (viewList viewString)
+       t)
+     (typedDeclareFn 171 [(viewBool)] viewString t)
+     (typedValue 172 (viewList viewBool) t)
+     (typedApply 173 170 171 t)
+     (typedApply 174 173 172 t)
+     (typedRequire 174 (viewList viewBool) t)]
+
+listFilterWrongPredicateContract =
+  typedProgram
+    182
+    [(typedDeclareFn
+       180
+       [(viewFn [(viewBool)] viewBool) (viewList viewBool)]
+       (viewList viewBool)
+       t)
+     (typedDeclareFn 181 [(viewBool)] viewString t)
+     (typedApply 182 180 181 t)]
+
+listMapWrongListArgExpr = cFn <|
+    [(viewFn [(viewBool)] viewString) (viewList viewBool)] (viewList viewString)
+    |> cApply (cFn [(viewBool)] viewString)
+    |> cApply (cValue (viewList viewString))
+    |> cRequire (viewList viewString)
+
+listMapWrongListArgExprContract =
+  typedProgram
+    194
+    [(typedDeclareFn
+       190
+       [(viewFn [(viewBool)] viewString) (viewList viewBool)]
+       (viewList viewString)
+       t)
+     (typedDeclareFn 191 [(viewBool)] viewString t)
+     (typedValue 193 (viewList viewString) t)
+     (typedApply 192 190 191 t)
+     (typedApply 194 192 193 t)
+     (typedRequire 194 (viewList viewString) t)]
+
+viewCatalogSelfTests =
+  append
+    viewContractSelfTests
+    [ (typedContractCheck listMapBoolStringContract)
+      (typedContractCheck headMaybeBoolContract)
+      (typedContractCheck listFilterBoolContract)
+      (typedContractCheck listFoldStringBoolContract)
+      (typedContractCheck listMapMaybeBoolStringContract)
+      (viewContractExpectResult
+        "function argument view is not known"
+        (checkTypedProgramWith policyStrict listMapWrongFunctionArgContract))
+      (viewContractExpectResult
+        "function argument view is not known"
+        (checkTypedProgramWith policyStrict listMapWrongListArgContract))
+      (viewContractExpectResult
+        "required view is not known"
+        (checkTypedProgramWith policyStrict listMapWrongOutputContract))
+      (viewContractExpectResult
+        "function argument view is not known"
+        (checkTypedProgramWith policyStrict listFilterWrongPredicateContract))
+      (viewContractExpectResult
+        "function argument view is not known"
+        (checkTypedProgramWith policyStrict listMapWrongListArgExprContract))
+      (viewContractExpectErrorTag
+        errorTagOk
+        (checkTypedProgram listMapBoolStringContract))
+      (viewContractExpectErrorTag
+        errorTagMissingFunctionArgumentView
+        (checkTypedProgramWith policyStrict listMapWrongFunctionArgContract))
+      (viewContractExpectErrorTag
+        errorTagMissingFunctionArgumentView
+        (checkTypedProgramWith policyStrict listMapWrongListArgContract))
+      (viewContractExpectErrorTag
+        errorTagMissingFunctionArgumentView
+        (checkTypedProgramWith policyStrict listMapWrongListArgExprContract))
+      (viewContractExpectErrorTag
+        errorTagMissingRequiredView
+        (checkTypedProgramWith policyStrict listMapWrongOutputContract))
+      (viewContractExpectDiagnostic
+        errorTagMissingFunctionArgumentView
+        162
+        (viewList viewBool)
+        (checkTypedProgramWith policyStrict listMapWrongListArgContract))
+      (viewContractExpectDiagnostic
+        errorTagMissingRequiredView
+        174
+        (viewList viewBool)
+        (checkTypedProgramWith policyStrict listMapWrongOutputContract))
+      (viewContractExpectDiagnosticActual
+        errorTagMissingFunctionArgumentView
+        162
+        (viewList viewBool)
+        (viewList viewString)
+        (checkTypedProgramWith policyStrict listMapWrongListArgContract))
+      (viewContractExpectDiagnosticActual
+        errorTagMissingFunctionArgumentView
+        193
+        (viewList viewBool)
+        (viewList viewString)
+        (checkTypedProgramWith policyStrict listMapWrongListArgExprContract))
+      (viewContractExpectDiagnosticActual
+        errorTagMissingRequiredView
+        174
+        (viewList viewBool)
+        (viewList viewString)
+        (checkTypedProgramWith policyStrict listMapWrongOutputContract))
+      (viewContractExpectDiagnosticActual
+        errorTagMissingFunctionArgumentView
+        181
+        (viewFn [(viewBool)] viewBool)
+        (viewFn [(viewBool)] viewString)
+        (checkTypedProgramWith policyStrict listFilterWrongPredicateContract))
+      (matchResult
+        (diag env :
+          viewContractProbe
+            (equal?
+              (renderDiagnostic diag)
+              "symbol 162 expected List Bool but got List String"))
+        (env rest : "fail")
+        (checkTypedProgramWith policyStrict listMapWrongListArgContract))]

notes/iodriver-updates.md

@@ -1,749 +0,0 @@
-Below is the implementation handoff for replacing the current recursive/rebuilding IO small-step interpreter with an explicit machine stack, primarily to support `Reader` via `ask` and `local`, while setting up the right shape for eventual async.
-
-## Goal
-
-Refactor `IODriver` from this model:
-
-```haskell
-stepIO :: IOPermissions -> T -> IO Step
-
-data Step
-  = Done T
-  | Continue T
-```
-
-to an explicit abstract machine:
-
-```haskell
-Machine = Runtime + current action + continuation frames
-```
-
-This is required because `local` is dynamically scoped. It needs to modify the Reader environment for a sub-computation, then restore the previous environment exactly when that sub-computation completes. The current “rebuild `Bind left' k`” approach has nowhere to store that restoration behavior.
-
-This change should support:
-
-```tricu
-ask
-local
-```
-
-now, and keep the structure compatible with future async suspension/resumption.
-
-Do not implement async in this pass.
-
----
-
-## New action tags
-
-Extend the tricu IO action language with Reader tags:
-
-```tricu
-ask   = _        : pair 6 t
-local = f action : pair 7 (pair f action)
-```
-
-Host-side:
-
-```haskell
-data Action
-  = APure T
-  | ABind T T
-  | APutStr T
-  | AGetLine
-  | AReadFile T
-  | AWriteFile T T
-  | AAsk
-  | ALocal T T
-  deriving (Show)
-```
-
-Recommended tag allocation:
-
-```text
-0 = pure
-1 = bind
-2 = putStr
-3 = getLine
-4 = readFile
-5 = writeFile
-6 = ask
-7 = local
-```
-
-State tags can come later:
-
-```text
-8 = get
-9 = put
-```
-
-Do not add `bindR`, `bindS`, or `bindRS` yet. Reader is being added as an effect inside the existing IO action language, so the existing IO `bind` remains the only sequencing operator.
-
----
-
-## New runtime model
-
-Add a runtime context:
-
-```haskell
-data Runtime = Runtime
-  { rtPerms :: IOPermissions
-  , rtEnv   :: T
-  }
-  deriving (Show)
-```
-
-Later this can become:
-
-```haskell
-data Runtime = Runtime
-  { rtPerms :: IOPermissions
-  , rtEnv   :: T
-  , rtState :: T
-  }
-```
-
-but for this pass, keep it minimal unless State is implemented at the same time.
-
-Add continuation frames:
-
-```haskell
-data Frame
-  = BindFrame T
-  | LocalFrame T
-  deriving (Show)
-```
-
-Frame meanings:
-
-```text
-BindFrame k:
-  When the current action produces value x, continue with apply k x.
-
-LocalFrame oldEnv:
-  When the current action produces value x, restore oldEnv, then continue with x.
-```
-
-Add the machine state:
-
-```haskell
-data Machine = Machine
-  { machineRuntime :: Runtime
-  , machineCurrent :: T
-  , machineFrames  :: [Frame]
-  }
-  deriving (Show)
-```
-
-Frames should be treated as a stack, with the head as the top:
-
-```haskell
-push frame machine = machine { machineFrames = frame : machineFrames machine }
-```
-
----
-
-## New step result
-
-Replace the current `Step` with machine-oriented stepping:
-
-```haskell
-data Step
-  = Halt Runtime T
-  | Continue Machine
-  deriving (Show)
-```
-
-`Halt runtime value` means the entire IO program is done.
-
-`Continue machine` means the machine can take another step.
-
----
-
-## Core stepping semantics
-
-The central function should become:
-
-```haskell
-stepMachine :: Machine -> IO Step
-```
-
-It should decode `machineCurrent`.
-
-### `pure`
-
-When the current action is `APure value`, do not immediately halt. First inspect the frame stack.
-
-Pseudo-code:
-
-```haskell
-finishValue :: Machine -> T -> IO Step
-finishValue machine value =
-  case machineFrames machine of
-    [] ->
-      pure (Halt (machineRuntime machine) value)
-
-    BindFrame k : rest ->
-      pure (Continue machine
-        { machineCurrent = apply k value
-        , machineFrames = rest
-        })
-
-    LocalFrame oldEnv : rest ->
-      let runtime' = (machineRuntime machine) { rtEnv = oldEnv }
-      in pure (Continue machine
-        { machineRuntime = runtime'
-        , machineCurrent = pureAction value
-        , machineFrames = rest
-        })
-```
-
-You will need a helper:
-
-```haskell
-pureAction :: T -> T
-pureAction x = Fork (ofNumber 0) x
-```
-
-This is important: restoring a `LocalFrame` should not discard the value. It restores the environment and re-enters the machine as `pure value`, allowing the next frame to receive the value.
-
-### `bind`
-
-For:
-
-```haskell
-ABind left k
-```
-
-do not recursively step `left`, and do not rebuild `Bind left' k`.
-
-Instead:
-
-```haskell
-Continue machine
-  { machineCurrent = left
-  , machineFrames  = BindFrame k : machineFrames machine
-  }
-```
-
-This is the major refactor. Continuations move out of the tree and into the frame stack.
-
-### `ask`
-
-For:
-
-```haskell
-AAsk
-```
-
-produce the current Reader environment:
-
-```haskell
-finishValue machine (rtEnv (machineRuntime machine))
-```
-
-or equivalently:
-
-```haskell
-Continue machine { machineCurrent = pureAction currentEnv }
-```
-
-Prefer `finishValue` because it avoids an extra step.
-
-### `local`
-
-For:
-
-```haskell
-ALocal f action
-```
-
-do:
-
-```haskell
-let runtime = machineRuntime machine
-    oldEnv  = rtEnv runtime
-    newEnv  = apply f oldEnv
-    runtime' = runtime { rtEnv = newEnv }
-
-Continue machine
-  { machineRuntime = runtime'
-  , machineCurrent = action
-  , machineFrames  = LocalFrame oldEnv : machineFrames machine
-  }
-```
-
-This is the central correctness point.
-
-`local` enters a scoped environment by pushing a restoration frame. When the scoped action finishes, `LocalFrame oldEnv` restores the previous environment and passes the produced value onward.
-
-Nested `local` works naturally because frames stack:
-
-```tricu
-local f (
-  local g ask
-)
-```
-
-becomes:
-
-```text
-push LocalFrame env0
-set env = f env0
-
-push LocalFrame env1
-set env = g env1
-
-ask returns env2
-
-pop LocalFrame env1
-restore env1
-
-pop LocalFrame env0
-restore env0
-```
-
-### Normal IO actions
-
-For host IO actions, perform the side effect and then call `finishValue`.
-
-Examples:
-
-```haskell
-APutStr str ->
-  case decodeString str "PutStr" of
-    Right s -> do
-      putStr s
-      finishValue machine Leaf
-    Left _ ->
-      finishValue machine (errResult 6)
-```
-
-```haskell
-AReadFile path ->
-  case decodeString path "ReadFile" of
-    Right p -> do
-      result <- ...
-      finishValue machine result
-    Left _ ->
-      finishValue machine (errResult 6)
-```
-
-Important: IO actions should no longer return `Done value` directly. They should return a value to the frame stack via `finishValue`.
-
----
-
-## Decode changes
-
-Extend `decodeAction`:
-
-```haskell
-decodeAction :: T -> Either String Action
-decodeAction tree =
-  case tree of
-    Fork tag payload ->
-      case toNumber tag of
-        Right 0 -> Right (APure payload)
-
-        Right 1 -> case payload of
-          Fork left k -> Right (ABind left k)
-          _ -> Left "Invalid Bind: expected pair action continuation"
-
-        Right 2 -> Right (APutStr payload)
-
-        Right 3 -> Right AGetLine
-
-        Right 4 -> Right (AReadFile payload)
-
-        Right 5 -> case payload of
-          Fork path contents -> Right (AWriteFile path contents)
-          _ -> Left "Invalid WriteFile: expected pair path contents"
-
-        Right 6 -> Right AAsk
-
-        Right 7 -> case payload of
-          Fork f action -> Right (ALocal f action)
-          _ -> Left "Invalid Local: expected pair function action"
-
-        Right n -> Left $ "Unknown IO action tag: " ++ show n
-
-        Left err -> Left $ "Invalid action tag: " ++ err
-
-    _ ->
-      Left $ "Invalid action tree: expected pair tag payload, got " ++ show tree
-```
-
----
-
-## Runner API
-
-Add a new Reader-aware runner:
-
-```haskell
-runIOWithEnv :: IOPermissions -> T -> T -> IO T
-runIOWithEnv perms env action = loop initialMachine
-  where
-    initialMachine = Machine
-      { machineRuntime = Runtime
-          { rtPerms = perms
-          , rtEnv = env
-          }
-      , machineCurrent = action
-      , machineFrames = []
-      }
-
-    loop machine = do
-      step <- stepMachine machine
-      case step of
-        Halt _ value       -> pure value
-        Continue machine'  -> loop machine'
-```
-
-Keep the existing API as a compatibility wrapper:
-
-```haskell
-runIO :: IOPermissions -> T -> IO T
-runIO perms action =
-  runIOWithEnv perms Leaf action
-```
-
-If State is added in the same branch, prefer:
-
-```haskell
-runIOWith :: IOPermissions -> T -> T -> T -> IO (T, T)
-```
-
-where:
-
-```text
-permissions
-initial reader env
-initial state
-action
-```
-
-returns:
-
-```text
-final result
-final state
-```
-
-But if this handoff is only for Reader, use `runIOWithEnv`.
-
----
-
-## Permission helpers
-
-The current permission helper functions can mostly stay as-is, but they should read permissions from runtime:
-
-```haskell
-let perms = rtPerms (machineRuntime machine)
-```
-
-The current helpers are nested inside `stepIO`. After the refactor, either:
-
-1. keep them in a `where` block under `stepMachine`, or
-2. lift them to top-level helper functions.
-
-Prefer lifting pure/reusable helpers to top-level if this file is getting large:
-
-```haskell
-decodeString :: T -> String -> Either String String
-canonicalizeSafe :: FilePath -> IO (Either String FilePath)
-pathAllowed :: FilePath -> [FilePath] -> IO Bool
-tryReadFile :: FilePath -> IO T
-tryWriteFile :: FilePath -> String -> IO T
-okResult :: T -> T
-errResult :: Integer -> T
-ioErrorCode :: IOException -> Integer
-```
-
-This will make `stepMachine` much easier to read.
-
----
-
-## `io.tri` changes
-
-Add the Reader constructors:
-
-```tricu
-ask   = _        : pair 6 t
-local = f action : pair 7 (pair f action)
-```
-
-No new bind is required.
-
-Example usage:
-
-```tricu
-program =
-  bind ask (env :
-    putStrLn env)
-```
-
-Example `local` usage:
-
-```tricu
-program =
-  bind ask (outer :
-  bind (local (env : append env "-inner")
-        (bind ask (inner :
-          pure inner)))
-    (result :
-      bind ask (after :
-        pure result)))
-```
-
-Expected behavior:
-
-```text
-outer ask sees original env
-inner ask sees transformed env
-after ask sees original env again
-```
-
----
-
-## Tests to add
-
-Add tests around behavior, not implementation details.
-
-### 1. `ask` returns initial environment
-
-Program:
-
-```tricu
-io (bind ask (env : pure env))
-```
-
-Run with env:
-
-```text
-"dev"
-```
-
-Expected result:
-
-```text
-"dev"
-```
-
-### 2. `local` transforms environment
-
-Program:
-
-```tricu
-io (
-  local (env : append env "-local")
-    (bind ask (env : pure env))
-)
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Expected result:
-
-```text
-"root-local"
-```
-
-### 3. `local` restores environment afterward
-
-Program structure:
-
-```tricu
-bind ask (before :
-bind (local transform scopedAsk) (inside :
-bind ask (after :
-pure (pair before (pair inside after)))))
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Expected:
-
-```text
-pair "root" (pair "root-local" "root")
-```
-
-### 4. nested `local` composes correctly
-
-Program:
-
-```tricu
-local f (
-  local g ask
-)
-```
-
-Initial env:
-
-```text
-"root"
-```
-
-Example:
-
-```tricu
-f = x : append x "-f"
-g = x : append x "-g"
-```
-
-Expected inner ask:
-
-```text
-"root-f-g"
-```
-
-Also verify after both locals, environment is restored by doing a final `ask`.
-
-### 5. `local` result passes through bind correctly
-
-Program:
-
-```tricu
-bind
-  (local transform (pure "value"))
-  (x : pure x)
-```
-
-Expected:
-
-```text
-"value"
-```
-
-This catches a common bug where `LocalFrame` restores env but loses the value.
-
-### 6. IO still works through bind
-
-Existing IO tests should continue passing unchanged through `runIO`.
-
-### 7. IO inside local
-
-Program:
-
-```tricu
-local transform (
-  bind ask (env :
-  bind (putStrLn env) (_ :
-  pure env))
-)
-```
-
-Expected:
-
-```text
-prints transformed env
-returns transformed env
-```
-
-Then optionally ask after local to verify restoration.
-
----
-
-## Invariants to preserve
-
-The implementation should maintain these invariants:
-
-```text
-1. The current action is always the next instruction to evaluate.
-
-2. The frame stack contains all pending continuations and cleanup scopes.
-
-3. Bind does not recursively step its left side.
-   It pushes BindFrame and switches current to the left action.
-
-4. local does not run its action to completion.
-   It pushes LocalFrame and switches current to the scoped action.
-
-5. Only LocalFrame restores Reader environment.
-
-6. State, when added later, should not be restored by LocalFrame.
-
-7. Existing runIO behavior remains source-compatible.
-```
-
----
-
-## Common failure modes
-
-The likely bugs are:
-
-```text
-Bug: local leaks environment.
-Cause: setting rtEnv but never restoring it.
-Fix: push LocalFrame oldEnv and restore in finishValue.
-
-Bug: local restores environment but loses result.
-Cause: popping LocalFrame and halting directly.
-Fix: after restoration, continue with pureAction value.
-
-Bug: bind continuations run under the wrong env.
-Cause: LocalFrame and BindFrame pop order is wrong.
-Fix: use stack head as top. Push LocalFrame when entering local; push BindFrame when entering bind. Pop exactly one frame when a value is produced.
-
-Bug: existing IO bind tests fail.
-Cause: IO actions halt instead of passing result to finishValue.
-Fix: every completed primitive action should call finishValue.
-
-Bug: nested binds still rebuild trees.
-Cause: old ABind logic left in place.
-Fix: ABind should only push BindFrame and switch current to left.
-```
-
----
-
-## Async relevance, but not implementation
-
-This machine representation is intentionally compatible with async.
-
-A future scheduler can store:
-
-```haskell
-Machine runtime current frames
-```
-
-when a task blocks, then resume it later by restoring the same `Machine`.
-
-Do not implement any of these now:
-
-```haskell
-AFork
-AAwait
-ASleep
-TaskId
-Scheduler
-Runnable queue
-Blocked table
-```
-
-But avoid designs that would make future suspension impossible, especially recursive “run sub-computation to completion” implementations of `local`. The point of the frame machine is that every effect remains small-step and resumable.
-
----
-
-## Recommended implementation order
-
-1. Add `Runtime`, `Frame`, and `Machine`.
-2. Add `pureAction`.
-3. Replace `Step` with `Halt Runtime T | Continue Machine`.
-4. Implement `finishValue`.
-5. Rewrite `ABind` to push `BindFrame`.
-6. Rewrite existing primitive IO actions to call `finishValue`.
-7. Add `AAsk` and `ALocal`.
-8. Add `runIOWithEnv`.
-9. Rewrite `runIO` as a wrapper.
-10. Add `ask` and `local` to `io.tri`.
-11. Add Reader behavior tests.
-12. Run all existing IO tests and confirm no regressions.
-
-The key handoff instruction is: implement `local` as a continuation frame, not as a recursive nested run. This keeps the interpreter genuinely small-step and gives the eventual async runtime the exact representation it will need for suspension and resumption.

notes/recursive-consumers.md

@@ -1,81 +0,0 @@
-# Recursive Consumer Argument Order
-
-## Rule
-
-Put consumed data first in recursive workers in `tricu` code.
-
-*AVOID* this shape:
-
-```text
-worker control state input
-```
-
-*USE* this shape:
-
-```text
-worker input control state
-```
-
-The consumed structure should block recursion when it is unknown. Counters, indexes, lengths, and accumulator state should not be able to drive recursion over abstract input.
-
-## Bad shape
-
-The original `readBytes_` worker put loop-control arguments before the byte stream:
-
-```tricu
-readBytes_ = y (self n i bs original acc :
-  matchBool
-    (ok (reverse acc) bs)
-    (matchResult
-      (code rest : err code original)
-      (actual rest :
-        self n (succ i) rest original (pair actual acc))
-      (readU8 bs))
-    (equal? i n))
-
-readBytes = (n bs : readBytes_ n 0 bs bs t)
-```
-
-With a partial application like:
-
-```tricu
-readBytes 2
-```
-
-the evaluator knows `n = 2` and `i = 0`, but `bs` is still abstract. That lets the counter check drive recursive specialization before the byte stream is available, which can build a huge symbolic residual tree. This has been proven; do not reason about it further.
-
-## Good shape
-
-The corrected worker takes the byte stream first and immediately case-analyzes it:
-
-```tricu
-readBytes_ = y (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 : readBytes_ bs n 0 bs t)
-```
-
-Now:
-
-```tricu
-readBytes 2
-```
-
-becomes a function waiting on `bs`. Since the worker immediately performs `matchList ... bs`, evaluation blocks on the missing input instead of unrolling the counter loop.
-
-## Takeaway
-
-```text
-Let consumed data drive recursion.
-Do not let counters unroll over abstract input.
-```

notes/tricu-normalization-rules.md

@@ -0,0 +1,248 @@
+# The takeaway
+
+Consumed data must block recursion.
+Control data must not drive recursion.
+Branches with work must be lazy.
+Top-level fixed points must be hidden behind wrappers.
+Fixed-format data should be destructured finitely, not sliced recursively.
+
+## Rules for normalization-safe `tricu`
+
+A top-level definition must normalize when its runtime inputs are still abstract. Therefore, avoid any shape where known control data can unfold recursion before the consumed data is available.
+
+## 1. Put consumed data first
+
+Recursive workers should take the structure they consume before counters, indexes, limits, accumulators, or other control state.
+
+Avoid:
+
+```tricu
+worker index records state
+```
+
+Prefer:
+
+```tricu
+worker records index state
+```
+
+The worker’s first real operation should usually be a case split on the consumed value:
+
+```tricu
+worker_ = (self records state :
+  lazyList
+    nilCase
+    consCase
+    records)
+```
+
+## 2. Do not use generic recursive consumers on abstract fixed-format data
+
+Avoid applying helpers like these to abstract values in top-level-normalized definitions:
+
+```tricu
+take n xs
+drop n xs
+nth n xs
+length xs
+startsWith? prefix xs
+bytesTake n bytes
+bytesDrop n bytes
+```
+
+These can be driven by known counters, indexes, lengths, or prefixes while `xs` is still abstract.
+
+For fixed-format data, use finite destructuring helpers instead:
+
+```tricu
+withNodePayloadForkIndices payload shortK indicesK
+hashShard hash
+```
+
+This keeps the recursion bounded by syntax, not by a runtime counter.
+
+## 3. Use lazy eliminators when a branch contains work
+
+If a branch contains recursion, IO construction, parsing, lookup, response construction, or anything that may recurse internally, do not pass it as an ordinary branch value.
+
+Avoid:
+
+```tricu
+matchBool
+  resultNow
+  (self rest state)
+  cond
+```
+
+Prefer:
+
+```tricu
+lazyBool
+  (_ : resultNow)
+  (_ : self rest state)
+  cond
+```
+
+Same rule for result, maybe, and list elimination:
+
+```tricu
+lazyBool
+lazyResult
+lazyMaybe
+lazyList
+```
+
+Strict eliminators are safe only when both branches are already cheap normal forms.
+
+## 4. Do not expose top-level fixed points directly
+
+Avoid top-level definitions like:
+
+```tricu
+foo_ = y (self input state : ...)
+```
+
+Prefer the library-style split:
+
+```tricu
+foo_ = (self input state : ...)
+
+foo = (input state :
+  y foo_ input state)
+```
+
+This prevents each independently-normalized top-level definition from trying to normalize the fixed point itself.
+
+## 5. Keep recursive self-application small and structurally progressing
+
+Prefer recursive calls shaped like:
+
+```tricu
+self rest nextState
+```
+
+over wide calls like:
+
+```tricu
+self rest index i limit acc flags
+```
+
+Pack non-consumed state into a record/pair if needed.
+
+The consumed argument should visibly progress:
+
+```tricu
+self rest nextState
+```
+
+not restart from the original structure:
+
+```tricu
+self originalRecords newIndex newState
+```
+
+Restarting from the original input inside recursive branches can create residual trees with no obvious structural progress.
+
+## 6. Recursive state updates must be non-recursive
+
+Do not call a recursive helper while constructing the next recursive state.
+
+Avoid:
+
+```tricu
+self rest (listSnoc acc value)
+```
+
+because `listSnoc` is itself recursive.
+
+Prefer constant-time constructors:
+
+```tricu
+self rest (pair value acc)
+```
+
+If order matters, reverse later only when the input is concrete, or store explicit indexes in an association list.
+
+## 7. Do not rebuild from the whole input when a prefix invariant exists
+
+If validation guarantees child references point backward, use that invariant.
+
+Avoid:
+
+```tricu
+buildTree allRecords childIndex
+```
+
+inside the build of each node.
+
+Prefer:
+
+```tricu
+lookup childIndex builtPrefix
+```
+
+For Arboricx nodes, this meant scanning records once left-to-right and resolving children from `builtTrees`.
+
+## 8. Make route/path helpers consumed-data-driven
+
+For request paths, hashes, and byte strings, avoid counter/prefix-driven recursive operations over abstract request data.
+
+Avoid:
+
+```tricu
+take 3 hash
+drop 23 target
+startsWith? prefix target
+```
+
+Prefer:
+
+```tricu
+hashShard hash
+stripPrefix prefix target
+```
+
+where the helper case-analyzes the consumed runtime data before recurring.
+
+For fixed small slices like the first three hash bytes, use finite destructuring rather than `take`.
+
+## 9. Treat top-level normalization as stricter than runtime evaluation
+
+A function can be semantically correct at runtime and still fail import normalization.
+
+Ask this for every top-level definition:
+
+```text
+Can this normalize while all of its arguments are unknown?
+```
+
+If the answer depends on “the branch will not be taken” or “the input will be concrete by then,” the definition is probably not normalization-safe.
+
+## 10. When a definition hangs alphabetically, inspect reachable dependencies
+
+The alphabetically first hanging definition is not necessarily the root cause. It may simply be the first definition that reaches a later problematic helper.
+
+Debug by replacing reachable branches with constants:
+
+```tricu
+foo = (... : pure notFoundResponse)
+```
+
+Then add back one dependency at a time. If a constant version normalizes, the issue is in reachable branch work, not the wrapper itself.
+
+## Compact checklist
+
+Before adding or exporting a definition, check:
+
+```text
+1. Does every recursive worker consume unknown data first?
+2. Is every recursive branch thunked with lazy eliminators?
+3. Is `y` applied inside the public wrapper, not exposed as a top-level worker value?
+4. Are recursive self-calls visibly progressing on consumed data?
+5. Are recursive state updates constant-time?
+6. Are `take`, `drop`, `nth`, `length`, `startsWith?`, or byte slicing used on abstract data?
+7. Could a known counter, index, prefix, or length drive recursion?
+8. Are fixed-format fields parsed with finite destructuring helpers?
+9. Does any branch construct dynamic paths/responses from abstract data using recursive list helpers?
+10. Can the definition normalize with all runtime arguments still unknown?
+```

notes/view-contract-trust-provenance.md

@@ -0,0 +1,122 @@
+# View Contract trust provenance and controlled intensionality
+
+## Problem
+
+Tree Calculus / tricu code can perform raw intensional observation through `t` /
+`triage`-like power. Exact detection of whether an arbitrary term ever reaches
+rule 3 is undecidable: the SK fragment is already Turing-complete, and a program
+can construct/apply an intensional observer iff an encoded machine halts.
+
+Therefore View Contracts must not rely on an exact semantic test for "will this
+term inspect representation?".
+
+## Key correction
+
+A purely syntactic invariant such as "the initial tree contains no
+`Fork(Fork(_, _), _)`" is not reduction-closed. For example:
+
+```text
+Fork (Stem (Fork a b)) c  ==>  Fork (Fork a b) c
+```
+
+So absence of a current rule-3 redex is not enough.
+
+## Direction
+
+Use explicit provenance/capability discipline, not exact intensionality
+decision.
+
+View Contract checking and parametric checked-subset validation are distinct:
+
+- View Contract checking: verifies executable tree artifacts against declared
+  boundary Views.
+- Parametric checked-subset validation: verifies that abstraction/parametricity
+  claims do not depend on raw untrusted intensional observation.
+
+Unchecked/raw Tree Calculus can always inspect trees. Existential/abstract Views
+are checker-level opacity: checked clients cannot justify representation-specific
+operations unless an exported trusted capability/eliminator provides them.
+
+## Provenance model
+
+Contract facts/artifacts should carry explicit provenance. Do not rely on module
+or catalog convention.
+
+Recommended durable provenance classes:
+
+```text
+Checked  -- derived by checked lowering / checker validation
+Trusted  -- asserted by a trusted boundary, e.g. a primitive eliminator API
+Unchecked -- no abstraction/parametricity guarantee; raw/assumed fact if exposed
+```
+
+The correct granularity is per exported View fact, not per module. A single
+module may contain checked definitions, trusted eliminators, and unchecked raw
+helpers.
+
+## Controlled intensionality
+
+Raw intensionality should be tracked by dependency/provenance, not syntax-only.
+
+- Direct `triage` / arbitrary `t` eliminator use is raw intensional capability.
+- Trusted eliminators expose controlled observation and do not taint clients.
+- Calling unchecked/untrusted code taints the caller for parametricity purposes.
+- Constructors/literals are not automatically tainting unless they expose raw
+  inspection power.
+
+Parametric checked mode rejects annotated definitions whose derivation depends
+on raw/untrusted intensionality, while trusted facts may describe raw internals
+behind explicit contracts.
+
+## Trusted eliminator kernel
+
+First trusted observation capabilities should be the smallest useful kernels:
+
+```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
+```
+
+Derived functions should be checked against these trusted capabilities where
+possible. Raw recursive kernels and other code
+that passes through fixed-point/intensional machinery should publish explicit
+`Trusted` facts rather than being treated as checked.
+
+Current stdlib shape:
+
+```text
+Checked annotations where the body checks through trusted capabilities:
+  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
+
+Trusted value-level facts for raw/recursive stdlib boundaries:
+  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
+```
+
+Do not assign total contracts to partial APIs such as:
+
+```text
+head : List a -> a
+```
+
+Prefer `headMaybe : List a -> Maybe a`, or later introduce `NonEmptyList a`.
+
+## Implementation order
+
+Most-correct tractable path:
+
+1. Add contract provenance to the Haskell View model and portable artifacts. ✅
+2. Preserve provenance through module exports/imports/re-exports. ✅
+3. Teach checker environments to distinguish checked vs trusted facts. ✅
+4. Add trusted stdlib eliminator facts. ◐ initial value-level `viewFacts` landed for `matchBool`, `matchMaybe`, `matchList`; Haskell trusted catalog removed
+5. Add parametric-mode dependency/effect checking. ◐ local raw-dependency and unchecked-import rejection landed
+6. Annotate/publish derived stdlib Views at the right provenance. ◐ checked `maybeMap`/`maybeBind`/`maybeOr`; trusted value-level facts for recursive list combinators
+
+Avoid introducing implicit trusted catalogs before provenance exists; that would
+create semantics that later need to be unwound.

src/Check.hs

@@ -0,0 +1,43 @@
+module Check
+  ( module Check.Core
+  , module Check.IO
+  , checkFile
+  , checkFileWithStore
+  , checkSource
+  ) where
+
+import Check.Core
+import Check.IO
+import ContentStore (ObjectRef, StorePath, getViewType)
+import Eval (evalTricu)
+import FileEval (LoadedSource(..), defaultStorePath, evaluateFile, evaluateFileWithStore, loadFileWithStore, valueViewFactsFromEnv)
+import Research (Env, ViewType)
+
+import qualified Data.Map as Map
+
+import System.IO.Unsafe (unsafePerformIO)
+
+checkFile :: FilePath -> IO String
+checkFile path = do
+  store <- defaultStorePath
+  checkFileWithStore store path
+
+checkFileWithStore :: StorePath -> FilePath -> IO String
+checkFileWithStore store path = do
+  loaded <- loadFileWithStore store path
+  viewEnv <- evaluateFileWithStore (Just store) "./lib/view.tri"
+  let baseEnv = Map.union viewEnv (loadedImports loaded)
+      checkerEnv = evalTricu baseEnv (loadedAst loaded)
+  imports <- importedViewsFromResolvedModulesEither (loadImportedView store) (loadedModules loaded)
+  valueFacts <- either (errorWithoutStackTrace . ("invalid value-level viewFacts: " ++)) pure (valueViewFactsFromEnv checkerEnv)
+  checkProgramWithEnvAndImportedViews checkerEnv (imports ++ valueFacts) (loadedAst loaded)
+
+viewCheckerEnv :: Env
+viewCheckerEnv = unsafePerformIO (evaluateFile "./lib/view.tri")
+{-# NOINLINE viewCheckerEnv #-}
+
+checkSource :: String -> IO String
+checkSource = checkSourceWithEnv viewCheckerEnv
+
+loadImportedView :: StorePath -> ObjectRef -> IO (Either String ViewType)
+loadImportedView = getViewType

src/Check/Core.hs

@@ -0,0 +1,959 @@
+module Check.Core
+  ( ImportedView(..)
+  , importedViewsFromResolvedModules
+  , importedViewsFromResolvedModulesEither
+  , checkProgramWithEnvAndImportedViews
+  , checkSourceWithEnv
+  , checkSourceWithEnvAndImportedViews
+  , lowerSource
+  , lowerSourceWithDebug
+  , lowerSourceWithImportedViews
+  , lowerSourceWithImportedViewsDebug
+  , lowerViewExpr
+  ) where
+
+import Control.Applicative ((<|>))
+import Control.Monad.State.Strict
+import Data.Char (isDigit)
+import Data.Maybe (mapMaybe)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+
+import ContentStore.Alias (ObjectRef(..))
+import Eval (evalTricu, result)
+import Module.Resolver
+  ( ResolvedExport(..)
+  , ResolvedModule(..)
+  )
+import Parser (parseTricu)
+import Research
+
+data ImportedView = ImportedView
+  { importedViewName       :: String
+  , importedViewType       :: ViewType
+  , importedViewProvenance :: ViewProvenance
+  } deriving (Show, Eq)
+
+-- Convert module-resolution metadata into checker evidence inputs. The loader
+-- decodes a portable view artifact into a syntactic ViewType, but this function
+-- does not judge compatibility or policy. It only says: this resolved imported
+-- name has an advertised view fact that should be emitted into the typed program.
+importedViewsFromResolvedModules :: (ObjectRef -> IO (Maybe ViewType)) -> [ResolvedModule] -> IO [ImportedView]
+importedViewsFromResolvedModules loadView = importedViewsFromResolvedModulesEither loadViewEither
+  where
+    loadViewEither ref = do
+      mView <- loadView ref
+      pure $ maybe (Left "artifact not found or could not be decoded") Right mView
+
+importedViewsFromResolvedModulesEither :: (ObjectRef -> IO (Either String ViewType)) -> [ResolvedModule] -> IO [ImportedView]
+importedViewsFromResolvedModulesEither loadView modules = concat <$> mapM fromModule modules
+  where
+    fromModule m = concat <$> mapM fromExport (resolvedModuleExports m)
+
+    fromExport ex = case resolvedExportView ex of
+      Nothing -> pure []
+      Just ref -> do
+        eView <- loadView ref
+        case eView of
+          Left err -> errorWithoutStackTrace $
+            "View Contract artifact invalid for imported export "
+            ++ show (resolvedExportLocalName ex)
+            ++ " (kind " ++ showRefKind ref ++ ", hash " ++ showRefHash ref ++ "): "
+            ++ err
+          Right view -> pure [ImportedView (resolvedExportLocalName ex) view (maybe ViewUnchecked id (resolvedExportProvenance ex))]
+
+    showRefKind = T.unpack . objectRefKind
+    showRefHash = T.unpack . objectRefHash
+
+checkSourceWithEnv :: Env -> String -> IO String
+checkSourceWithEnv checkerEnv = checkSourceWithEnvAndImportedViews checkerEnv []
+
+checkSourceWithEnvAndImportedViews :: Env -> [ImportedView] -> String -> IO String
+checkSourceWithEnvAndImportedViews checkerEnv imports source =
+  checkProgramWithEnvAndImportedViews checkerEnv imports (parseTricu source)
+
+checkProgramWithEnvAndImportedViews :: Env -> [ImportedView] -> [TricuAST] -> IO String
+checkProgramWithEnvAndImportedViews checkerEnv imports asts = do
+  case lowerProgramWithImportedViewsDebugInEnv checkerEnv imports asts of
+    Left err -> pure err
+    Right (typedProgramSource, debugNames) -> do
+      let input =
+            "matchResult " ++
+            "(diag env : renderDiagnostic diag) " ++
+            "(exec env : matchResult (runtimeDiag runtimeEnv : renderDiagnostic runtimeDiag) (_ runtimeEnv : \"ok\") (runChecked exec)) " ++
+            "(checkTypedProgramWith policyStrict " ++ parens typedProgramSource ++ ")"
+      let env = evalTricu checkerEnv (parseTricu input)
+      pure $ case toString (result env) of
+        Right s -> annotateDiagnostic debugNames s
+        Left _  -> formatT Decode (result env)
+
+-- Debug names are a frontend-only side table. The portable checker renders
+-- canonical numeric-symbol diagnostics; the CLI annotates that presentation
+-- afterward without feeding labels back into checker semantics.
+annotateDiagnostic :: Map.Map Integer String -> String -> String
+annotateDiagnostic debugNames message =
+  case words message of
+    ("symbol" : symText : rest)
+      | all isDigit symText
+      , Just label <- Map.lookup (read symText) debugNames ->
+          "symbol " ++ symText ++ " (" ++ label ++ ") " ++ unwords rest
+    _ -> message
+
+viewExprHasParametricBinder :: ViewExpr -> Bool
+viewExprHasParametricBinder expr = case expr of
+  VEVar _ -> True
+  VEVarId _ -> True
+  VEList items -> any viewExprHasParametricBinder items
+  VEApp fn arg -> viewExprHasParametricBinder fn || viewExprHasParametricBinder arg
+  VEForall binders body -> not (null binders) || viewExprHasParametricBinder body
+  VEExists binders body -> not (null binders) || viewExprHasParametricBinder body
+  VEName _ -> False
+  VEInt _ -> False
+  VEString _ -> False
+  VERaw _ -> False
+
+rawTaintedDefinitions :: Set.Set String -> [TricuAST] -> Map.Map String String
+rawTaintedDefinitions allowedExternalFacts asts = fixedPoint initiallyRaw
+  where
+    allowedFacts = allowedExternalFacts
+    definitions = Map.fromList
+      [ (name, (args, body))
+      | ast <- asts
+      , Just (name, args, body) <- [definitionBody ast]
+      ]
+    localNames = Map.keysSet definitions
+    initiallyRaw = Map.mapMaybeWithKey
+      (\name (args, body) ->
+        if name `Set.member` allowedFacts
+          then Nothing
+          else definitionUnsafeBaseReason localNames allowedFacts (Set.fromList args) body)
+      definitions
+
+    fixedPoint tainted =
+      let tainted' = Map.mapMaybeWithKey (transitiveReason tainted) definitions
+          combined = Map.union tainted tainted'
+      in if combined == tainted then tainted else fixedPoint combined
+
+    transitiveReason tainted name (args, body)
+      | name `Map.member` tainted = Nothing
+      | name `Set.member` allowedFacts = Nothing
+      | otherwise = case filter (`Map.member` tainted) (astFreeRefs (foldr Set.delete localNames args) body) of
+          helper : _ -> Just $ "depends on raw-tainted local helper " ++ show helper ++ " (" ++ tainted Map.! helper ++ ")"
+          [] -> Nothing
+
+    definitionBody ast = case ast of
+      SDef name args body -> Just (name, args, body)
+      SDefAnn name args _ body -> Just (name, defArgNames args, body)
+      _ -> Nothing
+
+definitionUnsafeBaseReason :: Set.Set String -> Set.Set String -> Set.Set String -> TricuAST -> Maybe String
+definitionUnsafeBaseReason localNames allowedExternalFacts bound ast = case ast of
+  SVar name _
+    | name `Set.member` bound -> Nothing
+    | name `Set.member` localNames -> Nothing
+    | name `Set.member` allowedExternalFacts -> Nothing
+    | name == "triage" -> Just "uses raw triage directly"
+    | otherwise -> Just $ "depends on unchecked or unknown external name " ++ show name
+  SInt _ -> Nothing
+  SStr _ -> Nothing
+  SList items -> firstJust (map (definitionUnsafeBaseReason localNames allowedExternalFacts bound) items)
+  SDef _ args body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound args) body
+  SDefAnn _ args _ body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound (defArgNames args)) body
+  SApp fn arg -> definitionUnsafeBaseReason localNames allowedExternalFacts bound fn <|> definitionUnsafeBaseReason localNames allowedExternalFacts bound arg
+  TLeaf -> Just "uses raw t directly"
+  TStem _ -> Just "uses raw t directly"
+  TFork _ _ -> Just "uses raw t directly"
+  SLambda args body -> definitionUnsafeBaseReason localNames allowedExternalFacts (foldr Set.insert bound args) body
+  SEmpty -> Nothing
+  SImport _ _ -> Nothing
+
+firstJust :: [Maybe a] -> Maybe a
+firstJust [] = Nothing
+firstJust (Just x : _) = Just x
+firstJust (Nothing : xs) = firstJust xs
+
+astFreeRefs :: Set.Set String -> TricuAST -> [String]
+astFreeRefs candidates ast = case ast of
+  SVar name _ | name `Set.member` candidates -> [name]
+  SVar _ _ -> []
+  SInt _ -> []
+  SStr _ -> []
+  SList items -> concatMap (astFreeRefs candidates) items
+  SDef _ args body -> astFreeRefs (foldr Set.delete candidates args) body
+  SDefAnn _ args _ body -> astFreeRefs (foldr Set.delete candidates (defArgNames args)) body
+  SApp fn arg -> astFreeRefs candidates fn ++ astFreeRefs candidates arg
+  TLeaf -> []
+  TStem inner -> astFreeRefs candidates inner
+  TFork left right -> astFreeRefs candidates left ++ astFreeRefs candidates right
+  SLambda args body -> astFreeRefs (foldr Set.delete candidates args) body
+  SEmpty -> []
+  SImport _ _ -> []
+
+defArgNames :: [DefArg] -> [String]
+defArgNames = mapMaybe defArgName
+  where
+    defArgName (DefBinder name _) = Just name
+    defArgName (DefPhantom _) = Nothing
+
+lowerSource :: String -> Either String String
+lowerSource = lowerProgram . parseTricu
+
+lowerSourceWithDebug :: String -> Either String (String, Map.Map Integer String)
+lowerSourceWithDebug = lowerProgramWithDebug . parseTricu
+
+lowerSourceWithImportedViews :: [ImportedView] -> String -> Either String String
+lowerSourceWithImportedViews imports = lowerProgramWithImportedViews imports . parseTricu
+
+lowerSourceWithImportedViewsDebug :: [ImportedView] -> String -> Either String (String, Map.Map Integer String)
+lowerSourceWithImportedViewsDebug imports = lowerProgramWithImportedViewsDebug imports . parseTricu
+
+-- Symbol allocation is intentionally deterministic so emitted view-tree
+-- nodes are stable and lower-only tests can inspect them directly:
+--
+-- * top-level definitions receive symbols 0..n-1 in source order;
+-- * local binders, literals, application results, and synthetic typed nodes
+--   are allocated monotonically from nextSym;
+-- * external names are allocated on first reference and then reused.
+--
+-- Symbols are view-tree node identifiers only. Checker semantics remain in
+-- lib/view.tri; the frontend only emits typed/checkable structure about these
+-- symbols.
+data LowerState = LowerState
+  { nextSym :: Integer
+  , topSyms :: Map.Map String Integer
+  , scopes :: [Map.Map String Integer]
+  , externSyms :: Map.Map String Integer
+  , knownNodeViews :: Map.Map Integer ViewExpr
+  , nodePayloads :: Map.Map Integer T
+  , debugNames :: Map.Map Integer String
+  , rawTaintedDefs :: Map.Map String String
+  }
+
+type LowerM a = StateT LowerState (Either String) a
+
+lowerProgram :: [TricuAST] -> Either String String
+lowerProgram asts = fst <$> lowerProgramWithDebug asts
+
+lowerProgramWithDebug :: [TricuAST] -> Either String (String, Map.Map Integer String)
+lowerProgramWithDebug = lowerProgramWithImportedViewsDebug []
+
+lowerProgramWithImportedViews :: [ImportedView] -> [TricuAST] -> Either String String
+lowerProgramWithImportedViews imports asts = fst <$> lowerProgramWithImportedViewsDebug imports asts
+
+lowerProgramWithImportedViewsDebug :: [ImportedView] -> [TricuAST] -> Either String (String, Map.Map Integer String)
+lowerProgramWithImportedViewsDebug = lowerProgramWithImportedViewsDebugInEnv Map.empty
+
+lowerProgramWithImportedViewsDebugInEnv :: Env -> [ImportedView] -> [TricuAST] -> Either String (String, Map.Map Integer String)
+lowerProgramWithImportedViewsDebugInEnv checkerEnvForLowering imports asts = do
+  let definitions = [ def | def <- asts, isDefinition def ]
+      topNames = map definitionName definitions
+      tops = Map.fromList (zip topNames [0..])
+      topCount = Map.size tops
+      importCandidates = Set.fromList (map importedViewName imports) `Set.difference` Set.fromList topNames
+      usedImportNames = Set.fromList (concatMap (astFreeRefs importCandidates) asts)
+      activeImports = filter (\imported -> importedViewName imported `Set.member` usedImportNames) imports
+      importedSyms = Map.fromList
+        [ (importedViewName imported, fromIntegral (topCount + idx))
+        | (idx, imported) <- zip [0..] activeImports
+        ]
+      topDebug = Map.fromList [ (sym, name) | (name, sym) <- Map.toList tops ]
+      importDebug = Map.fromList
+        [ (sym, "imported " ++ name)
+        | (name, sym) <- Map.toList importedSyms
+        ]
+      localFactByName = Map.fromList [(importedViewName imported, imported) | imported <- imports, importedViewName imported `elem` topNames]
+      trustedLocalFacts =
+        [ (sym, viewTypeToExpr (importedViewType imported), importedViewProvenance imported)
+        | (name, sym) <- Map.toList tops
+        , Just imported <- [Map.lookup name localFactByName]
+        , importedViewProvenance imported `elem` [ViewChecked, ViewTrusted]
+        ]
+      trustedLocalKnown = Map.fromList [(sym, view) | (sym, view, _) <- trustedLocalFacts]
+      importKnown = Map.fromList
+        [ (sym, viewTypeToExpr (importedViewType imported))
+        | imported <- activeImports
+        , Just sym <- [Map.lookup (importedViewName imported) importedSyms]
+        ]
+      payloads = Map.fromList $
+        [ (sym, term)
+        | (name, sym) <- Map.toList tops
+        , Just term <- [Map.lookup name checkerEnvForLowering]
+        ] ++
+        [ (sym, term)
+        | (name, sym) <- Map.toList importedSyms
+        , Just term <- [Map.lookup name checkerEnvForLowering]
+        ]
+      annotated = [ def | def@SDefAnn {} <- asts ]
+      allowedExternalFacts = Set.fromList
+        [ importedViewName imported
+        | imported <- imports
+        , importedViewProvenance imported `elem` [ViewChecked, ViewTrusted]
+        ]
+      taintedDefs = rawTaintedDefinitions allowedExternalFacts asts
+      initialState = LowerState
+        { nextSym = fromIntegral (Map.size tops + Map.size importedSyms)
+        , topSyms = tops
+        , scopes = []
+        , externSyms = importedSyms
+        , knownNodeViews = Map.union trustedLocalKnown importKnown
+        , nodePayloads = payloads
+        , debugNames = Map.union topDebug importDebug
+        , rawTaintedDefs = taintedDefs
+        }
+  (localNodes, finalState) <- runStateT (lowerAnnotatedProgram annotated) initialState
+  trustedLocalNodes <- mapM (lowerImportedView (nodePayloads finalState)) trustedLocalFacts
+  importNodes <- mapM (lowerImportedView (nodePayloads finalState))
+    [ (sym, viewTypeToExpr (importedViewType imported), importedViewProvenance imported)
+    | imported <- activeImports
+    , Just sym <- [Map.lookup (importedViewName imported) importedSyms]
+    ]
+  let nodes = trustedLocalNodes ++ importNodes ++ localNodes
+      rootSym = if null nodes then 0 else nextSym finalState - 1
+      typedProgramSource =
+        "typedProgram " ++ show rootSym ++ " [" ++ unwords (map parens nodes) ++ "]"
+  pure (typedProgramSource, debugNames finalState)
+lowerImportedView :: Map.Map Integer T -> (Integer, ViewExpr, ViewProvenance) -> Either String String
+lowerImportedView payloadsBySym (sym, view, provenance) = do
+  viewExpr <- lowerViewExpr view
+  let payload = maybe "t" treeSource (Map.lookup sym payloadsBySym)
+  pure $ "typedValueWithProvenance " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload ++ " " ++ viewProvenanceSource provenance
+
+lowerAnnotatedProgram :: [TricuAST] -> LowerM [String]
+lowerAnnotatedProgram defs = do
+  declarations <- concat <$> mapM lowerDefinitionDeclaration defs
+  flows <- concat <$> mapM lowerDefinitionFlow defs
+  pure (declarations ++ flows)
+
+lowerDefinitionDeclaration :: TricuAST -> LowerM [String]
+lowerDefinitionDeclaration (SDefAnn name args ret _) = do
+  let (_, _, declaredView) = canonicalDefinitionViews args ret
+  tainted <- gets rawTaintedDefs
+  if viewExprHasParametricBinder declaredView && name `Map.member` tainted
+    then liftEither (Left $ "parametric View definition " ++ show name ++ " depends on raw intensional Tree Calculus machinery (" ++ tainted Map.! name ++ "); use a trusted eliminator boundary instead")
+    else do
+      sym <- symbolForTop name
+      recordKnown sym declaredView
+      node <- typedValueNode sym declaredView
+      pure [node]
+lowerDefinitionDeclaration _ = liftEither (Left "internal check error: expected annotated definition")
+
+lowerDefinitionFlow :: TricuAST -> LowerM [String]
+lowerDefinitionFlow (SDefAnn _ args ret body) = withDefinitionScope args $ do
+  let (flowArgs, flowRet, _) = canonicalDefinitionViews args ret
+  binderNodes <- concat <$> mapM lowerBinderDeclaration flowArgs
+  let phantomViews = map lowerPhantomArgType (phantomArgs flowArgs)
+  (returnArgs, returnResult) <- lowerReturnObligation flowRet
+  bodyNodes <- lowerBodyWithPhantoms (phantomViews ++ returnArgs) returnResult body
+  pure (binderNodes ++ bodyNodes)
+lowerDefinitionFlow _ = liftEither (Left "internal check error: expected annotated definition")
+
+viewAnyType :: ViewExpr
+viewAnyType = VEName "Any"
+
+canonicalDefinitionViews :: [DefArg] -> Maybe ViewExpr -> ([DefArg], Maybe ViewExpr, ViewExpr)
+canonicalDefinitionViews args ret =
+  let rawView = declaredDefinitionView args ret
+      vars = Set.toList (freeViewVars rawView)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      mappedArgs = map (mapDefArgView (rewriteViewVars binderMap)) args
+      mappedRet = fmap (rewriteViewVars binderMap) ret
+      mappedView = declaredDefinitionView mappedArgs mappedRet
+      binders = map snd binderIds
+      declaredView = if null vars then mappedView else VEForall binders mappedView
+  in (mappedArgs, mappedRet, declaredView)
+
+declaredDefinitionView :: [DefArg] -> Maybe ViewExpr -> ViewExpr
+declaredDefinitionView args ret =
+  case map argType args of
+    [] -> resultType
+    views -> viewExprFn views resultType
+  where
+    resultType = maybe viewAnyType id ret
+
+mapDefArgView :: (ViewExpr -> ViewExpr) -> DefArg -> DefArg
+mapDefArgView f (DefBinder name mTy) = DefBinder name (fmap f mTy)
+mapDefArgView f (DefPhantom ty) = DefPhantom (f ty)
+
+argType :: DefArg -> ViewExpr
+argType (DefBinder _ Nothing) = viewAnyType
+argType (DefBinder _ (Just ty)) = ty
+argType (DefPhantom ty) = ty
+
+emitDeclaration :: Integer -> [String] -> String -> LowerM String
+emitDeclaration sym [] retExpr = do
+  payload <- payloadSourceFor sym
+  pure $ "typedValue " ++ show sym ++ " " ++ parens retExpr ++ " " ++ payload
+emitDeclaration sym views retExpr = do
+  payload <- payloadSourceFor sym
+  pure $ "typedValue " ++ show sym ++ " (viewFn [" ++ unwords (map parens views) ++ "] " ++ parens retExpr ++ ") " ++ payload
+
+typedValueNode :: Integer -> ViewExpr -> LowerM String
+typedValueNode sym view = typedValueNodeWithProvenance sym view ViewChecked
+
+typedValueNodeWithProvenance :: Integer -> ViewExpr -> ViewProvenance -> LowerM String
+typedValueNodeWithProvenance sym view provenance = do
+  viewExpr <- liftEither (lowerViewExpr view)
+  payload <- payloadSourceFor sym
+  pure ("typedValueWithProvenance " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload ++ " " ++ viewProvenanceSource provenance)
+
+typedRequireNode :: Integer -> ViewExpr -> LowerM String
+typedRequireNode sym view = do
+  viewExpr <- liftEither (lowerViewExpr view)
+  payload <- payloadSourceFor sym
+  pure ("typedRequire " ++ show sym ++ " " ++ parens viewExpr ++ " " ++ payload)
+
+viewProvenanceSource :: ViewProvenance -> String
+viewProvenanceSource ViewChecked = "viewProvenanceChecked"
+viewProvenanceSource ViewTrusted = "viewProvenanceTrusted"
+viewProvenanceSource ViewUnchecked = "viewProvenanceUnchecked"
+
+declareKnown :: Integer -> ViewExpr -> LowerM String
+declareKnown sym view = do
+  recordKnown sym view
+  typedValueNode sym view
+
+declareKnownWithPayload :: Integer -> ViewExpr -> T -> LowerM String
+declareKnownWithPayload sym view payload = do
+  recordPayload sym payload
+  declareKnown sym view
+
+declareKnownFresh :: ViewExpr -> LowerM (Integer, [String])
+declareKnownFresh view = do
+  sym <- freshSym
+  node <- declareKnown sym view
+  pure (sym, [node])
+
+declareKnownFreshWithPayload :: ViewExpr -> T -> LowerM (Integer, [String])
+declareKnownFreshWithPayload view payload = do
+  sym <- freshSym
+  node <- declareKnownWithPayload sym view payload
+  pure (sym, [node])
+
+declareAndRequireFresh :: ViewExpr -> LowerM (Integer, [String])
+declareAndRequireFresh view = do
+  sym <- freshSym
+  declareNode <- declareKnown sym view
+  requireNode <- typedRequireNode sym view
+  pure (sym, [declareNode, requireNode])
+
+declareAndRequireFreshWithPayload :: ViewExpr -> T -> LowerM (Integer, [String])
+declareAndRequireFreshWithPayload view payload = do
+  sym <- freshSym
+  declareNode <- declareKnownWithPayload sym view payload
+  requireNode <- typedRequireNode sym view
+  pure (sym, [declareNode, requireNode])
+
+lowerBinderDeclaration :: DefArg -> LowerM [String]
+lowerBinderDeclaration (DefBinder name mTy) = do
+  sym <- symbolForLocal name
+  node <- declareKnown sym (maybe viewAnyType id mTy)
+  pure [node]
+lowerBinderDeclaration (DefPhantom _) = pure []
+
+lowerBodyWithPhantoms :: [ViewExpr] -> ViewExpr -> TricuAST -> LowerM [String]
+lowerBodyWithPhantoms [] _ SLambda {} = pure []
+lowerBodyWithPhantoms [] expected body =
+  lowerExprAgainst body expected
+lowerBodyWithPhantoms phantomViews expected (SLambda params body) =
+  lowerLambdaSpine phantomViews expected params body
+lowerBodyWithPhantoms phantomViews expected body =
+  lowerExprAgainst body (residualViewExpr phantomViews expected)
+
+lowerLambdaSpine :: [ViewExpr] -> ViewExpr -> [String] -> TricuAST -> LowerM [String]
+lowerLambdaSpine phantomViews expected [] body = lowerBodyWithPhantoms phantomViews expected body
+lowerLambdaSpine [] _ _ _ = pure []
+lowerLambdaSpine (view : views) expected (param : params) body =
+  withLocalBinder param $ \paramSym -> do
+    declareParam <- declareKnown paramSym view
+    restNodes <- lowerLambdaSpine views expected params body
+    pure (declareParam : restNodes)
+
+residualViewExpr :: [ViewExpr] -> ViewExpr -> ViewExpr
+residualViewExpr [] resultView = resultView
+residualViewExpr args resultView = viewExprFn args resultView
+
+phantomArgs :: [DefArg] -> [DefArg]
+phantomArgs [] = []
+phantomArgs (DefPhantom ty : rest) = DefPhantom ty : phantomArgs rest
+phantomArgs (_ : rest) = phantomArgs rest
+
+lowerPhantomArgType :: DefArg -> ViewExpr
+lowerPhantomArgType (DefPhantom ty) = ty
+lowerPhantomArgType _ = error "internal check error: expected phantom arg"
+
+lowerReturnObligation :: Maybe ViewExpr -> LowerM ([ViewExpr], ViewExpr)
+lowerReturnObligation Nothing = pure ([], viewAnyType)
+lowerReturnObligation (Just ty) = pure (peelFnObligation ty)
+
+peelFnObligation :: ViewExpr -> ([ViewExpr], ViewExpr)
+peelFnObligation ty = case viewExprFnParts ty of
+  Just (args, resultView) ->
+    let (restArgs, finalResult) = peelFnObligation resultView
+    in (args ++ restArgs, finalResult)
+  Nothing -> ([], ty)
+
+withDefinitionScope :: [DefArg] -> LowerM a -> LowerM a
+withDefinitionScope args action = do
+  binderEntries <- mapM allocateBinder [ name | DefBinder name _ <- args ]
+  modify $ \st -> st { scopes = Map.fromList binderEntries : scopes st }
+  resultValue <- action
+  modify $ \st -> st { scopes = drop 1 (scopes st) }
+  pure resultValue
+
+allocateBinder :: String -> LowerM (String, Integer)
+allocateBinder name = do
+  sym <- freshSym
+  recordDebugName sym name
+  pure (name, sym)
+
+withLocalBinder :: String -> (Integer -> LowerM a) -> LowerM a
+withLocalBinder name action = do
+  sym <- freshSym
+  recordDebugName sym name
+  withLocalAlias name sym (action sym)
+
+withLocalAlias :: String -> Integer -> LowerM a -> LowerM a
+withLocalAlias name sym action = do
+  modify $ \st -> st { scopes = Map.singleton name sym : scopes st }
+  resultValue <- action
+  modify $ \st -> st { scopes = drop 1 (scopes st) }
+  pure resultValue
+
+recordKnown :: Integer -> ViewExpr -> LowerM ()
+recordKnown sym view =
+  modify $ \st -> st { knownNodeViews = Map.insert sym view (knownNodeViews st) }
+
+recordPayload :: Integer -> T -> LowerM ()
+recordPayload sym payload =
+  modify $ \st -> st { nodePayloads = Map.insert sym payload (nodePayloads st) }
+
+payloadFor :: Integer -> LowerM (Maybe T)
+payloadFor sym = do
+  st <- get
+  pure (Map.lookup sym (nodePayloads st))
+
+payloadSourceFor :: Integer -> LowerM String
+payloadSourceFor sym = maybe "t" treeSource <$> payloadFor sym
+
+knownNodeViewFor :: Integer -> LowerM (Maybe ViewExpr)
+knownNodeViewFor sym = do
+  st <- get
+  pure (Map.lookup sym (knownNodeViews st))
+
+recordDebugName :: Integer -> String -> LowerM ()
+recordDebugName sym label =
+  modify $ \st -> st { debugNames = Map.insertWith keepExisting sym label (debugNames st) }
+  where
+    keepExisting _ old = old
+
+lowerExpr :: TricuAST -> LowerM (Integer, [String])
+lowerExpr expr = do
+  (sym, nodes, _) <- lowerExprKnown expr
+  pure (sym, nodes)
+
+lowerExprAgainst :: TricuAST -> ViewExpr -> LowerM [String]
+lowerExprAgainst body expected = do
+  (_, nodes, _) <- lowerExprKnownAgainst body expected
+  pure nodes
+
+lowerExprKnownAgainst :: TricuAST -> ViewExpr -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerExprKnownAgainst expr expected = case (expr, viewExprAsType expected) of
+  (SApp (SApp (SVar "pair" _) left) right, Just (VTPair leftView rightView)) ->
+    let leftExpr = viewTypeToExpr leftView
+        rightExpr = viewTypeToExpr rightView
+    in lowerUnshadowedConstructor "pair" expr expected $ do
+      (_, leftNodes, _) <- lowerExprKnownAgainst left leftExpr
+      (_, rightNodes, _) <- lowerExprKnownAgainst right rightExpr
+      (sym, nodes) <- declareAndRequireFresh expected
+      pure (sym, leftNodes ++ rightNodes ++ nodes, Just expected)
+  (SApp (SVar "just" _) value, Just (VTMaybe elemView)) ->
+    let elemExpr = viewTypeToExpr elemView
+    in lowerUnshadowedConstructor "just" expr expected $ do
+      (_, valueNodes, _) <- lowerExprKnownAgainst value elemExpr
+      (sym, nodes) <- declareAndRequireFresh expected
+      pure (sym, valueNodes ++ nodes, Just expected)
+  (SVar "nothing" _, Just (VTMaybe _)) ->
+    lowerUnshadowedConstructor "nothing" expr expected $ do
+      (sym, nodes) <- declareAndRequireFresh expected
+      pure (sym, nodes, Just expected)
+  (SApp (SApp (SVar "ok" _) value) rest, Just (VTResult _ okView)) ->
+    lowerUnshadowedConstructor "ok" expr expected $
+      lowerResultConstructor expected (viewTypeToExpr okView) value rest
+  (SApp (SApp (SVar "err" _) value) rest, Just (VTResult errView _)) ->
+    lowerUnshadowedConstructor "err" expr expected $
+      lowerResultConstructor expected (viewTypeToExpr errView) value rest
+  (SApp (SLambda [name] body) value, _) -> do
+    (valueSym, valueNodes, _) <- lowerExprKnown value
+    bodyResult <- withLocalAlias name valueSym (lowerExprKnownAgainst body expected)
+    let (bodySym, bodyNodes, bodyKnown) = bodyResult
+    pure (bodySym, valueNodes ++ bodyNodes, bodyKnown)
+  (SList items, Just (VTList elemView)) -> do
+    let elemExpr = viewTypeToExpr elemView
+    lowered <- mapM (`lowerExprKnownAgainst` elemExpr) items
+    let itemNodes = concat [ nodes | (_, nodes, _) <- lowered ]
+    (sym, nodes) <- declareAndRequireFresh expected
+    pure (sym, itemNodes ++ nodes, Just expected)
+  (SLambda _ _, _) ->
+    case peelFnObligation expected of
+      ([], _) -> lowerExprKnownAndRequire expr expected
+      (argViews, resultView) -> lowerLambdaAgainst argViews resultView expr
+  _ -> lowerExprKnownAndRequire expr expected
+
+lowerUnshadowedConstructor :: String -> TricuAST -> ViewExpr -> LowerM (Integer, [String], Maybe ViewExpr) -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerUnshadowedConstructor name fallback expected lowerCtor = do
+  ctorIsUnbound <- nameIsUnbound name
+  if ctorIsUnbound
+    then lowerCtor
+    else lowerExprKnownAndRequire fallback expected
+
+lowerResultConstructor :: ViewExpr -> ViewExpr -> TricuAST -> TricuAST -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerResultConstructor expected valueView value rest = do
+  (_, valueNodes, _) <- lowerExprKnownAgainst value valueView
+  (_, restNodes, _) <- lowerExprKnown rest
+  (sym, nodes) <- declareAndRequireFresh expected
+  pure (sym, valueNodes ++ restNodes ++ nodes, Just expected)
+
+lowerExprKnownAndRequire :: TricuAST -> ViewExpr -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerExprKnownAndRequire body expected = do
+  (bodySym, bodyNodes, known) <- lowerExprKnown body
+  requireNode <- typedRequireNode bodySym expected
+  pure (bodySym, bodyNodes ++ [requireNode], known)
+
+lowerLambdaAgainst :: [ViewExpr] -> ViewExpr -> TricuAST -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerLambdaAgainst argViews resultView (SLambda params body) = do
+  nodes <- lowerLambdaSpine argViews resultView params body
+  sym <- freshSym
+  let fnView = residualViewExpr argViews resultView
+  declareNode <- declareKnown sym fnView
+  pure (sym, nodes ++ [declareNode], Just fnView)
+lowerLambdaAgainst argViews resultView body =
+  lowerExprKnownAndRequire body (residualViewExpr argViews resultView)
+
+lowerExprKnown :: TricuAST -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerExprKnown (SVar name _) = do
+  sym <- symbolForName name
+  known <- knownNodeViewFor sym
+  pure (sym, [], known)
+lowerExprKnown (SStr s) = do
+  let view = VEName "String"
+  (sym, nodes) <- declareKnownFreshWithPayload view (ofString s)
+  recordDebugName sym "string literal"
+  pure (sym, nodes, Just view)
+lowerExprKnown (SInt n)
+  | n >= 0 && n <= 255 = do
+      let view = VEName "Byte"
+      (sym, nodes) <- declareKnownFreshWithPayload view (ofNumber n)
+      recordDebugName sym "byte literal"
+      pure (sym, nodes, Just view)
+  | otherwise = do
+      sym <- freshSym
+      pure (sym, [], Nothing)
+lowerExprKnown TLeaf = do
+  let view = VEName "Unit"
+  (sym, nodes) <- declareKnownFreshWithPayload view Leaf
+  recordDebugName sym "unit literal"
+  pure (sym, nodes, Just view)
+lowerExprKnown (SList items) = do
+  (sym, nodes, view, _) <- lowerListLiteral items
+  pure (sym, nodes, Just view)
+lowerExprKnown (SApp (SLambda [name] body) value) = do
+  (valueSym, valueNodes, known) <- lowerExprKnown value
+  bodyResult <- withLocalAlias name valueSym (lowerExprKnown body)
+  let (bodySym, bodyNodes, bodyKnown) = bodyResult
+  pure (bodySym, valueNodes ++ bodyNodes, bodyKnown)
+lowerExprKnown (SApp func arg) = do
+  (funcSym, funcNodes, funcKnown) <- lowerExprKnown func
+  (argSym, argNodes, _) <- lowerApplicationArgument funcKnown arg
+  outSym <- freshSym
+  recordDebugName outSym (applicationDebugLabel func)
+  funcPayload <- payloadFor funcSym
+  argPayload <- payloadFor argSym
+  case (funcPayload, argPayload) of
+    (Just f, Just a) -> recordPayload outSym (apply f a)
+    _ -> pure ()
+  applyPayload <- payloadSourceFor outSym
+  let applyNode = "typedApply " ++ show outSym ++ " " ++ show funcSym ++ " " ++ show argSym ++ " " ++ applyPayload
+      outKnown = applicationResultView funcKnown
+  mapM_ (recordKnown outSym) outKnown
+  pure (outSym, funcNodes ++ argNodes ++ [applyNode], outKnown)
+lowerExprKnown (SLambda params body) = do
+  nodes <- lowerUnannotatedLambda params body
+  sym <- freshSym
+  pure (sym, nodes, Nothing)
+lowerExprKnown _ = do
+  sym <- freshSym
+  pure (sym, [], Nothing)
+
+lowerListLiteral :: [TricuAST] -> LowerM (Integer, [String], ViewExpr, [Integer])
+lowerListLiteral items = do
+  lowered <- mapM lowerExprKnown items
+  let itemSyms = [ itemSym | (itemSym, _, _) <- lowered ]
+      itemNodes = concat [ nodes | (_, nodes, _) <- lowered ]
+      view = listLiteralView [ known | (_, _, known) <- lowered ]
+  itemPayloads <- mapM payloadFor itemSyms
+  let mPayload = ofList <$> sequence itemPayloads
+  (sym, declareNodes) <- case mPayload of
+    Just payload -> declareKnownFreshWithPayload view payload
+    Nothing -> declareKnownFresh view
+  pure (sym, itemNodes ++ declareNodes, view, itemSyms)
+
+lowerApplicationArgument :: Maybe ViewExpr -> TricuAST -> LowerM (Integer, [String], Maybe ViewExpr)
+lowerApplicationArgument (Just fnView) arg =
+  case viewExprFnParts fnView of
+    Just (argView : _, _)
+      | containsViewVar argView -> lowerExprKnown arg
+      | otherwise -> lowerExprKnownAgainst arg argView
+    _ -> lowerExprKnown arg
+lowerApplicationArgument _ arg =
+  lowerExprKnown arg
+
+containsViewVar :: ViewExpr -> Bool
+containsViewVar view = case view of
+  VEVar _ -> True
+  VEVarId _ -> True
+  VEList items -> any containsViewVar items
+  VEApp f a -> containsViewVar f || containsViewVar a
+  VEForall _ body -> containsViewVar body
+  VEExists _ body -> containsViewVar body
+  _ -> False
+
+applicationDebugLabel :: TricuAST -> String
+applicationDebugLabel func =
+  case applicationHeadName func of
+    Just name -> name ++ " application result"
+    Nothing   -> "application result"
+
+applicationHeadName :: TricuAST -> Maybe String
+applicationHeadName (SVar name _) = Just name
+applicationHeadName (SApp func _) = applicationHeadName func
+applicationHeadName _ = Nothing
+
+applicationResultView :: Maybe ViewExpr -> Maybe ViewExpr
+applicationResultView (Just fnView) = case viewExprFnParts fnView of
+  Just (_ : restArgs, resultView) ->
+    Just $ case restArgs of
+      [] -> resultView
+      _  -> viewExprFn restArgs resultView
+  _ -> Nothing
+applicationResultView _ = Nothing
+
+listLiteralView :: [Maybe ViewExpr] -> ViewExpr
+listLiteralView [] = viewExprList viewAnyType
+listLiteralView (Just firstView : rest)
+  | all (== Just firstView) rest = viewExprList firstView
+listLiteralView _ = viewExprList viewAnyType
+
+lowerUnannotatedLambda :: [String] -> TricuAST -> LowerM [String]
+lowerUnannotatedLambda [] body = do
+  (_, nodes) <- lowerExpr body
+  pure nodes
+lowerUnannotatedLambda (param : params) body =
+  withLocalBinder param $ \paramSym -> do
+    declareParam <- declareKnown paramSym viewAnyType
+    restNodes <- lowerUnannotatedLambda params body
+    pure (declareParam : restNodes)
+
+symbolForTop :: String -> LowerM Integer
+symbolForTop name = do
+  st <- get
+  case Map.lookup name (topSyms st) of
+    Just sym -> pure sym
+    Nothing -> liftEither (Left $ "internal check error: missing top-level symbol: " ++ name)
+
+symbolForLocal :: String -> LowerM Integer
+symbolForLocal name = do
+  st <- get
+  case lookupInScopes name (scopes st) of
+    Just sym -> pure sym
+    Nothing -> liftEither (Left $ "internal check error: missing local symbol: " ++ name)
+
+symbolForName :: String -> LowerM Integer
+symbolForName name = do
+  st <- get
+  case lookupInScopes name (scopes st) of
+    Just sym -> pure sym
+    Nothing -> case Map.lookup name (topSyms st) of
+      Just sym -> pure sym
+      Nothing -> symbolForExternal name
+
+symbolForExternal :: String -> LowerM Integer
+symbolForExternal name = do
+  st <- get
+  case Map.lookup name (externSyms st) of
+    Just sym -> pure sym
+    Nothing -> do
+      sym <- freshSym
+      recordDebugName sym ("external " ++ name)
+      modify $ \st' -> st' { externSyms = Map.insert name sym (externSyms st') }
+      pure sym
+
+nameIsUnbound :: String -> LowerM Bool
+nameIsUnbound name = do
+  st <- get
+  pure $ case lookupInScopes name (scopes st) of
+    Just _ -> False
+    Nothing -> Map.notMember name (topSyms st)
+
+lookupInScopes :: String -> [Map.Map String Integer] -> Maybe Integer
+lookupInScopes _ [] = Nothing
+lookupInScopes name (scope : rest) =
+  case Map.lookup name scope of
+    Just sym -> Just sym
+    Nothing -> lookupInScopes name rest
+
+freshSym :: LowerM Integer
+freshSym = do
+  st <- get
+  let sym = nextSym st
+  put st { nextSym = sym + 1 }
+  pure sym
+
+isDefinition :: TricuAST -> Bool
+isDefinition SDef {} = True
+isDefinition SDefAnn {} = True
+isDefinition _ = False
+
+definitionName :: TricuAST -> String
+definitionName (SDef name _ _) = name
+definitionName (SDefAnn name _ _ _) = name
+definitionName _ = error "definitionName: expected top-level definition"
+
+liftEither :: Either String a -> LowerM a
+liftEither value = StateT $ \st -> case value of
+  Left err -> Left err
+  Right resultValue -> Right (resultValue, st)
+
+lowerArgView :: DefArg -> LowerM String
+lowerArgView (DefBinder _ Nothing) = pure "viewAny"
+lowerArgView (DefBinder _ (Just ty)) = liftEither (lowerViewExpr ty)
+lowerArgView (DefPhantom ty) = liftEither (lowerViewExpr ty)
+
+viewTypeToExpr :: ViewType -> ViewExpr
+viewTypeToExpr view = case view of
+  VTName name -> VEName name
+  VTVar varId -> VEVarId varId
+  VTRef n -> VEApp (VEName "Ref") (VEInt n)
+  VTRefText s -> VEApp (VEName "Ref") (VEString s)
+  VTList item -> VEApp (VEName "List") (viewTypeToExpr item)
+  VTMaybe item -> VEApp (VEName "Maybe") (viewTypeToExpr item)
+  VTPair left right -> VEApp (VEApp (VEName "Pair") (viewTypeToExpr left)) (viewTypeToExpr right)
+  VTResult err ok -> VEApp (VEApp (VEName "Result") (viewTypeToExpr err)) (viewTypeToExpr ok)
+  VTGuarded base guard -> VEApp (VEApp (VEName "viewGuarded") (viewTypeToExpr base)) (VERaw (treeSource guard))
+  VTForall binders body -> VEForall binders (viewTypeToExpr body)
+  VTExists binders body -> VEExists binders (viewTypeToExpr body)
+  VTFn args resultView -> viewExprFn (map viewTypeToExpr args) (viewTypeToExpr resultView)
+
+viewExprFn :: [ViewExpr] -> ViewExpr -> ViewExpr
+viewExprFn args resultView = VEApp (VEApp (VEName "Fn") (VEList args)) resultView
+
+viewExprList :: ViewExpr -> ViewExpr
+viewExprList = VEApp (VEName "List")
+
+viewExprFnParts :: ViewExpr -> Maybe ([ViewExpr], ViewExpr)
+viewExprFnParts (VEForall _ body) = viewExprFnParts body
+viewExprFnParts (VEApp (VEApp (VEName "Fn") (VEList args)) resultView) = Just (args, resultView)
+viewExprFnParts _ = Nothing
+
+viewExprAsType :: ViewExpr -> Maybe ViewType
+viewExprAsType view = case view of
+  VEName name -> Just (VTName name)
+  VEVar _ -> Nothing
+  VEVarId varId -> Just (VTVar varId)
+  VEApp (VEName "Ref") (VEInt n) -> Just (VTRef n)
+  VEApp (VEName "Ref") (VEString s) -> Just (VTRefText s)
+  VEApp (VEName "List") item -> VTList <$> viewExprAsType item
+  VEApp (VEName "Maybe") item -> VTMaybe <$> viewExprAsType item
+  VEApp (VEApp (VEName "Pair") left) right -> VTPair <$> viewExprAsType left <*> viewExprAsType right
+  VEApp (VEApp (VEName "Result") err) ok -> VTResult <$> viewExprAsType err <*> viewExprAsType ok
+  VEApp (VEApp (VEName "Fn") (VEList args)) resultView -> VTFn <$> mapM viewExprAsType args <*> viewExprAsType resultView
+  VEForall binders body -> VTForall binders <$> viewExprAsType body
+  VEExists binders body -> VTExists binders <$> viewExprAsType body
+  _ -> Nothing
+
+lowerViewExpr :: ViewExpr -> Either String String
+lowerViewExpr ty = case ty of
+  VEName "Any" -> Right "viewAny"
+  VEName "Bool" -> Right "viewBool"
+  VEName "String" -> Right "viewString"
+  VEName "Byte" -> Right "viewByte"
+  VEName "Unit" -> Right "viewUnit"
+  VEName name -> Right name
+  VEVar name -> Right $ "viewVar " ++ show name
+  VEVarId varId -> Right $ "viewVar " ++ show varId
+  VEInt n -> Right (show n)
+  VEString s -> Right (show s)
+  VEList items -> do
+    itemExprs <- mapM lowerViewExpr items
+    Right $ "[" ++ unwords (map parens itemExprs) ++ "]"
+  VEApp (VEName "Ref") (VEInt n) -> Right $ "viewRef " ++ show n
+  VEApp (VEName "Ref") (VEString s) -> Right $ "viewRef " ++ show s
+  VEApp (VEName "List") elemView -> do
+    elemExpr <- lowerViewExpr elemView
+    Right $ "viewList " ++ parens elemExpr
+  VEApp (VEName "Maybe") elemView -> do
+    elemExpr <- lowerViewExpr elemView
+    Right $ "viewMaybe " ++ parens elemExpr
+  VEApp (VEApp (VEName "Pair") left) right -> do
+    l <- lowerViewExpr left
+    r <- lowerViewExpr right
+    Right $ "viewPair " ++ parens l ++ " " ++ parens r
+  VEApp (VEApp (VEName "Result") err) ok -> do
+    e <- lowerViewExpr err
+    a <- lowerViewExpr ok
+    Right $ "viewResult " ++ parens e ++ " " ++ parens a
+  VEApp (VEApp (VEName "Fn") (VEList args)) resultView -> do
+    as <- mapM lowerViewExpr args
+    r <- lowerViewExpr resultView
+    Right $ "viewFn [" ++ unwords (map parens as) ++ "] " ++ parens r
+  VEApp func arg -> do
+    f <- lowerViewExpr func
+    a <- lowerViewExpr arg
+    Right $ parens f ++ " " ++ parens a
+  VEForall binders body -> do
+    bodyExpr <- lowerViewExpr body
+    Right $ "viewForall " ++ lowerStringList binders ++ " " ++ parens bodyExpr
+  VEExists binders body -> do
+    bodyExpr <- lowerViewExpr body
+    Right $ "viewExists " ++ lowerStringList binders ++ " " ++ parens bodyExpr
+  VERaw raw -> Right raw
+
+lowerStringList :: [Integer] -> String
+lowerStringList items = "[" ++ unwords (map (parens . show) items) ++ "]"
+
+quantifyFreeViewVars :: ViewExpr -> ViewExpr
+quantifyFreeViewVars view =
+  let vars = Set.toList (freeViewVars view)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      body = rewriteViewVars binderMap view
+      binders = map snd binderIds
+  in if null vars then view else VEForall binders body
+
+rewriteViewVars :: Map.Map String Integer -> ViewExpr -> ViewExpr
+rewriteViewVars binderMap view = case view of
+  VEVar name -> maybe (VEVar name) VEVarId (Map.lookup name binderMap)
+  VEList items -> VEList (map (rewriteViewVars binderMap) items)
+  VEApp f a -> VEApp (rewriteViewVars binderMap f) (rewriteViewVars binderMap a)
+  VEForall binders body -> VEForall binders (rewriteViewVars binderMap body)
+  VEExists binders body -> VEExists binders (rewriteViewVars binderMap body)
+  _ -> view
+
+freeViewVars :: ViewExpr -> Set.Set String
+freeViewVars view = case view of
+  VEVar name -> Set.singleton name
+  VEVarId _ -> Set.empty
+  VEList items -> Set.unions (map freeViewVars items)
+  VEApp f a -> Set.union (freeViewVars f) (freeViewVars a)
+  VEForall _ body -> freeViewVars body
+  VEExists _ body -> freeViewVars body
+  _ -> Set.empty
+
+treeSource :: T -> String
+treeSource Leaf = "t"
+treeSource (Stem x) = "(t " ++ treeSource x ++ ")"
+treeSource (Fork x y) = "(t " ++ treeSource x ++ " " ++ treeSource y ++ ")"
+
+parens :: String -> String
+parens s = "(" ++ s ++ ")"

src/Check/IO.hs

@@ -0,0 +1,417 @@
+module Check.IO
+  ( instrumentIOContinuations
+  ) where
+
+import Control.Monad.State.Strict
+import qualified Data.Map as Map
+
+import Check.Core (lowerViewExpr)
+import Parser (parseTricu)
+import Research
+
+viewAnyType :: ViewExpr
+viewAnyType = VEName "Any"
+
+argType :: DefArg -> ViewExpr
+argType (DefBinder _ Nothing) = viewAnyType
+argType (DefBinder _ (Just ty)) = ty
+argType (DefPhantom ty) = ty
+
+declaredDefinitionView :: [DefArg] -> Maybe ViewExpr -> ViewExpr
+declaredDefinitionView args ret =
+  case map argType args of
+    [] -> resultType
+    views -> viewExprFn views resultType
+  where
+    resultType = maybe viewAnyType id ret
+
+viewExprFn :: [ViewExpr] -> ViewExpr -> ViewExpr
+viewExprFn args resultView = VEApp (VEApp (VEName "Fn") (VEList args)) resultView
+
+viewExprList :: ViewExpr -> ViewExpr
+viewExprList = VEApp (VEName "List")
+
+viewExprFnParts :: ViewExpr -> Maybe ([ViewExpr], ViewExpr)
+viewExprFnParts (VEForall _ body) = viewExprFnParts body
+viewExprFnParts (VEApp (VEApp (VEName "Fn") (VEList args)) resultView) = Just (args, resultView)
+viewExprFnParts _ = Nothing
+
+viewExprAsType :: ViewExpr -> Maybe ViewType
+viewExprAsType view = case view of
+  VEName name -> Just (VTName name)
+  VEVar _ -> Nothing
+  VEVarId varId -> Just (VTVar varId)
+  VEApp (VEName "Ref") (VEInt n) -> Just (VTRef n)
+  VEApp (VEName "Ref") (VEString st) -> Just (VTRefText st)
+  VEApp (VEName "List") item -> VTList <$> viewExprAsType item
+  VEApp (VEName "Maybe") item -> VTMaybe <$> viewExprAsType item
+  VEApp (VEApp (VEName "Pair") left) right -> VTPair <$> viewExprAsType left <*> viewExprAsType right
+  VEApp (VEApp (VEName "Result") err) ok -> VTResult <$> viewExprAsType err <*> viewExprAsType ok
+  VEApp (VEApp (VEName "Fn") (VEList args)) resultView -> VTFn <$> mapM viewExprAsType args <*> viewExprAsType resultView
+  VEForall binders body -> VTForall binders <$> viewExprAsType body
+  VEExists binders body -> VTExists binders <$> viewExprAsType body
+  _ -> Nothing
+
+viewTypeToExpr :: ViewType -> ViewExpr
+viewTypeToExpr view = case view of
+  VTName name -> VEName name
+  VTVar varId -> VEVarId varId
+  VTRef n -> VEApp (VEName "Ref") (VEInt n)
+  VTRefText st -> VEApp (VEName "Ref") (VEString st)
+  VTList item -> VEApp (VEName "List") (viewTypeToExpr item)
+  VTMaybe item -> VEApp (VEName "Maybe") (viewTypeToExpr item)
+  VTPair left right -> VEApp (VEApp (VEName "Pair") (viewTypeToExpr left)) (viewTypeToExpr right)
+  VTResult err ok -> VEApp (VEApp (VEName "Result") (viewTypeToExpr err)) (viewTypeToExpr ok)
+  VTGuarded base guard -> VEApp (VEApp (VEName "viewGuarded") (viewTypeToExpr base)) (VERaw (treeSource guard))
+  VTForall binders body -> VEForall binders (viewTypeToExpr body)
+  VTExists binders body -> VEExists binders (viewTypeToExpr body)
+  VTFn args resultView -> viewExprFn (map viewTypeToExpr args) (viewTypeToExpr resultView)
+
+treeSource :: T -> String
+treeSource Leaf = "t"
+treeSource (Stem x) = "(t " ++ treeSource x ++ ")"
+treeSource (Fork x y) = "(t " ++ treeSource x ++ " " ++ treeSource y ++ ")"
+
+applicationResultView :: Maybe ViewExpr -> Maybe ViewExpr
+applicationResultView (Just fnView) = case viewExprFnParts fnView of
+  Just (_ : restArgs, resultView) ->
+    Just $ case restArgs of
+      [] -> resultView
+      _  -> viewExprFn restArgs resultView
+  _ -> Nothing
+applicationResultView _ = Nothing
+
+-- Instrument source-level IO continuations so pure calls to annotated
+-- functions can run the already-portable checked-exec protocol at runtime.
+-- This is deliberately a lowering pass: it builds checked boundaries once from
+-- source annotations, then ordinary IO execution only evaluates runChecked.
+instrumentIOContinuations :: [TricuAST] -> Either String [TricuAST]
+instrumentIOContinuations asts = mapM transformTop asts
+  where
+    contracts = Map.fromList
+      [ (name, (args, ret, body))
+      | SDefAnn name args ret body <- asts
+      , all isRuntimeBinder args
+      ]
+
+    isRuntimeBinder DefBinder {} = True
+    isRuntimeBinder DefPhantom {} = False
+
+    transformTop (SDef name params body) = SDef name params <$> transformExpr body
+    transformTop (SDefAnn name args ret body) = SDefAnn name args ret <$> transformExpr body
+    transformTop other = transformExpr other
+
+    transformExpr expr = case expr of
+      SApp (SVar "io" h) action -> SApp (SVar "io" h) <$> transformIOAction action
+      SApp f a -> SApp <$> transformExpr f <*> transformExpr a
+      SLambda params body -> SLambda params <$> transformExpr body
+      TStem x -> TStem <$> transformExpr x
+      TFork x y -> TFork <$> transformExpr x <*> transformExpr y
+      _ -> pure expr
+
+    transformIOAction action = case action of
+      SApp (SVar "pure" _) value ->
+        case checkedPureActionFor value of
+          Just checked -> parseOne checked
+          Nothing -> SApp (SVar "pure" Nothing) <$> transformExpr value
+      SApp (SApp (SVar "bind" h) left) (SLambda params body) ->
+        SApp <$> (SApp (SVar "bind" h) <$> transformIOAction left) <*> (SLambda params <$> transformIOAction body)
+      SApp f a -> SApp <$> transformIOAction f <*> transformIOAction a
+      SLambda params body -> SLambda params <$> transformIOAction body
+      _ -> transformExpr action
+
+    checkedPureActionFor value =
+      case contractedApplication value of
+        Just (name, defArgs, ret, body, callArgs) ->
+          Just (checkedPureApplicationActionSource contracts name defArgs ret body callArgs)
+        Nothing ->
+          if mentionsContractedName contracts value
+            then Just (checkedPureValueActionSource contracts value)
+            else Nothing
+      where
+        contractedApplication valueExpr = do
+          (headExpr, callArgs) <- applicationSpine valueExpr
+          name <- case headExpr of
+            SVar n _ -> Just n
+            _ -> Nothing
+          (defArgs, ret, body) <- Map.lookup name contracts
+          if length callArgs == length defArgs
+            then Just (name, defArgs, ret, body, callArgs)
+            else Nothing
+
+    parseOne source = case parseTricu source of
+      [expr] -> Right expr
+      _ -> Left $ "internal check error: could not parse generated checked IO action: " ++ source
+
+applicationSpine :: TricuAST -> Maybe (TricuAST, [TricuAST])
+applicationSpine expr = Just (go expr [])
+  where
+    go (SApp f a) args = go f (a : args)
+    go headExpr args = (headExpr, args)
+
+checkedPureApplicationActionSource :: RuntimeContracts -> String -> [DefArg] -> Maybe ViewExpr -> TricuAST -> [TricuAST] -> String
+checkedPureApplicationActionSource contracts name defArgs ret body callArgs =
+  checkedProgramAction boundaryProgram ("(_ runtimeEnv : " ++ bodyAction ++ ")")
+  where
+    argViews = map argType defArgs
+    retView = maybe viewAnyType id ret
+    fnView = "viewFn [" ++ unwords (map (parens . unsafeLowerViewExpr) argViews) ++ "] " ++ parens (unsafeLowerViewExpr retView)
+    boundaryRoot = fromIntegral (length callArgs * 2) :: Integer
+    boundaryProgram = "typedProgram " ++ show boundaryRoot ++ " [" ++ unwords (map parens boundaryNodes) ++ "]"
+    boundaryNodes = functionNode : concat argApplyNodes
+    functionNode = "typedValue 0 " ++ parens fnView ++ " " ++ parens (astSource (SVar name Nothing))
+    argApplyNodes =
+      [ let argSym = fromIntegral (idx * 2 - 1) :: Integer
+            outSym = fromIntegral (idx * 2) :: Integer
+            calleeSym = if idx == 1 then 0 else fromIntegral ((idx - 1) * 2)
+            argView = argRuntimeViewSource view
+            prefixArgs = take idx callArgs
+            payload = astSource (foldl SApp (SVar name Nothing) prefixArgs)
+        in [ "typedValue " ++ show argSym ++ " " ++ parens argView ++ " " ++ parens (astSource arg)
+           , "typedApply " ++ show outSym ++ " " ++ show calleeSym ++ " " ++ show argSym ++ " " ++ parens payload
+           ]
+      | (idx, (view, arg)) <- zip [1 :: Int ..] (zip argViews callArgs)
+      ]
+    (bodyRoot, bodyNodes) = runtimeBodyProgramNodes contracts defArgs retView body callArgs
+    bodyProgram = "typedProgram " ++ show bodyRoot ++ " [" ++ unwords (map parens bodyNodes) ++ "]"
+    bodyAction = checkedProgramAction bodyProgram "(value runtimeEnv : pure value)"
+
+type RuntimeContracts = Map.Map String ([DefArg], Maybe ViewExpr, TricuAST)
+
+mentionsContractedName :: RuntimeContracts -> TricuAST -> Bool
+mentionsContractedName contracts expr = case expr of
+  SVar name _ -> Map.member name contracts
+  SApp f a -> mentionsContractedName contracts f || mentionsContractedName contracts a
+  SLambda _ body -> mentionsContractedName contracts body
+  SList items -> any (mentionsContractedName contracts) items
+  TStem x -> mentionsContractedName contracts x
+  TFork x y -> mentionsContractedName contracts x || mentionsContractedName contracts y
+  SDef _ _ body -> mentionsContractedName contracts body
+  SDefAnn _ _ _ body -> mentionsContractedName contracts body
+  _ -> False
+
+checkedPureValueActionSource :: RuntimeContracts -> TricuAST -> String
+checkedPureValueActionSource contracts value =
+  checkedProgramAction program "(value runtimeEnv : pure value)"
+  where
+    (rootSym, nodes) = runtimeExpressionProgramNodes contracts value viewAnyType
+    program = "typedProgram " ++ show rootSym ++ " [" ++ unwords (map parens nodes) ++ "]"
+
+checkedProgramAction :: String -> String -> String
+checkedProgramAction program okCase =
+  "matchResult " ++
+  "(diag env : pure (renderDiagnostic diag)) " ++
+  "(exec env : matchResult " ++
+    "(runtimeDiag runtimeEnv : pure (renderDiagnostic runtimeDiag)) " ++
+    okCase ++ " " ++
+    "(runChecked exec)) " ++
+  "(checkTypedProgramWith policyStrict " ++ parens program ++ ")"
+
+runtimeExpressionProgramNodes :: RuntimeContracts -> TricuAST -> ViewExpr -> (Integer, [String])
+runtimeExpressionProgramNodes contracts expr expected =
+  let (rootSym, nodes, _) = runRuntimeLower 0 Map.empty Map.empty Map.empty contracts (lowerRuntimeExprAgainst expr expected)
+  in (rootSym, nodes)
+
+runtimeBodyProgramNodes :: RuntimeContracts -> [DefArg] -> ViewExpr -> TricuAST -> [TricuAST] -> (Integer, [String])
+runtimeBodyProgramNodes contracts defArgs retView body callArgs =
+  let binders = [ (idx, name, maybe viewAnyType id mView, arg)
+                | (idx, (DefBinder name mView, arg)) <- zip [0 :: Integer ..] (zip defArgs callArgs)
+                ]
+      initialNext = fromIntegral (length binders)
+      initialKnown = Map.fromList [ (idx, view) | (idx, _, view, _) <- binders ]
+      subst = Map.fromList [ (name, arg) | (_, name, _, arg) <- binders ]
+      symbols = Map.fromList [ (name, idx) | (idx, name, _, _) <- binders ]
+      argNodes = concatMap argBoundaryNodes binders
+      (rootSym, bodyNodes, _) = runRuntimeLower initialNext initialKnown subst symbols contracts (lowerRuntimeExpr body)
+      resultRequire = "typedRequire " ++ show rootSym ++ " " ++ parens (unsafeLowerViewExpr retView) ++ " " ++ parens (astSource (substAst subst body))
+  in (rootSym, argNodes ++ bodyNodes ++ [resultRequire])
+  where
+    argBoundaryNodes (idx, _name, view, arg) =
+      [ "typedValue " ++ show idx ++ " " ++ parens (argRuntimeViewSource view) ++ " " ++ parens (astSource arg)
+      , "typedRequire " ++ show idx ++ " " ++ parens (unsafeLowerViewExpr view) ++ " " ++ parens (astSource arg)
+      ]
+
+data RuntimeLower = RuntimeLower
+  { runtimeNext :: Integer
+  , runtimeKnown :: Map.Map Integer ViewExpr
+  , runtimeSubst :: Map.Map String TricuAST
+  , runtimeSymbols :: Map.Map String Integer
+  , runtimeContracts :: RuntimeContracts
+  }
+
+type RuntimeM a = State RuntimeLower a
+
+runRuntimeLower :: Integer -> Map.Map Integer ViewExpr -> Map.Map String TricuAST -> Map.Map String Integer -> RuntimeContracts -> RuntimeM (Integer, [String], Maybe ViewExpr) -> (Integer, [String], Maybe ViewExpr)
+runRuntimeLower next known subst symbols contracts action = evalState action RuntimeLower
+  { runtimeNext = next
+  , runtimeKnown = known
+  , runtimeSubst = subst
+  , runtimeSymbols = symbols
+  , runtimeContracts = contracts
+  }
+
+freshRuntimeSym :: RuntimeM Integer
+freshRuntimeSym = do
+  st <- get
+  let sym = runtimeNext st
+  put st { runtimeNext = sym + 1 }
+  pure sym
+
+runtimeKnownFor :: Integer -> RuntimeM (Maybe ViewExpr)
+runtimeKnownFor sym = gets (Map.lookup sym . runtimeKnown)
+
+recordRuntimeKnown :: Integer -> ViewExpr -> RuntimeM ()
+recordRuntimeKnown sym view = modify $ \st -> st { runtimeKnown = Map.insert sym view (runtimeKnown st) }
+
+lowerRuntimeExpr :: TricuAST -> RuntimeM (Integer, [String], Maybe ViewExpr)
+lowerRuntimeExpr expr = case expr of
+  SVar name _ -> do
+    symbols <- gets runtimeSymbols
+    case Map.lookup name symbols of
+      Just sym -> do
+        known <- runtimeKnownFor sym
+        pure (sym, [], known)
+      Nothing -> do
+        contracts <- gets runtimeContracts
+        sym <- freshRuntimeSym
+        case Map.lookup name contracts of
+          Just (defArgs, ret, _) -> do
+            let view = declaredDefinitionView defArgs ret
+                viewSource = unsafeLowerViewExpr view
+            recordRuntimeKnown sym view
+            pure (sym, ["typedValue " ++ show sym ++ " " ++ parens viewSource ++ " " ++ parens (astSource expr)], Just view)
+          Nothing ->
+            pure (sym, ["typedValue " ++ show sym ++ " viewAny " ++ parens (astSource expr)], Just viewAnyType)
+  SStr s -> do
+    sym <- freshRuntimeSym
+    let view = VEName "String"
+    recordRuntimeKnown sym view
+    pure (sym, ["typedValue " ++ show sym ++ " viewString " ++ parens (astSource (SStr s))], Just view)
+  SInt n | n >= 0 && n <= 255 -> do
+    sym <- freshRuntimeSym
+    let view = VEName "Byte"
+    recordRuntimeKnown sym view
+    pure (sym, ["typedValue " ++ show sym ++ " viewByte " ++ show n], Just view)
+  TLeaf -> do
+    sym <- freshRuntimeSym
+    let view = VEName "Unit"
+    recordRuntimeKnown sym view
+    pure (sym, ["typedValue " ++ show sym ++ " viewUnit t"], Just view)
+  SList items -> do
+    lowered <- mapM lowerRuntimeExpr items
+    sym <- freshRuntimeSym
+    let view = viewExprList viewAnyType
+    recordRuntimeKnown sym view
+    subst <- gets runtimeSubst
+    let payload = astSource (substAst subst expr)
+    pure (sym, concat [ ns | (_, ns, _) <- lowered ] ++ ["typedValue " ++ show sym ++ " " ++ parens (unsafeLowerViewExpr view) ++ " " ++ parens payload], Just view)
+  SApp f a -> lowerRuntimeApplication f a expr
+  _ -> do
+    sym <- freshRuntimeSym
+    subst <- gets runtimeSubst
+    pure (sym, ["typedValue " ++ show sym ++ " viewAny " ++ parens (astSource (substAst subst expr))], Just viewAnyType)
+
+lowerRuntimeApplication :: TricuAST -> TricuAST -> TricuAST -> RuntimeM (Integer, [String], Maybe ViewExpr)
+lowerRuntimeApplication f a expr = do
+    (fSym, fNodes, fKnown) <- lowerRuntimeExpr f
+    let expectedArg = case fKnown >>= viewExprFnParts of
+          Just (argView : _, _) -> Just argView
+          _ -> Nothing
+    (aSym, aNodes, _) <- case expectedArg of
+      Just view -> lowerRuntimeExprAgainst a view
+      Nothing -> lowerRuntimeExpr a
+    outSym <- freshRuntimeSym
+    let outKnown = applicationResultView fKnown
+    mapM_ (recordRuntimeKnown outSym) outKnown
+    subst <- gets runtimeSubst
+    let payload = astSource (substAst subst expr)
+        applyNode = "typedApply " ++ show outSym ++ " " ++ show fSym ++ " " ++ show aSym ++ " " ++ parens payload
+    pure (outSym, fNodes ++ aNodes ++ [applyNode], outKnown)
+
+lowerRuntimeExprAgainst :: TricuAST -> ViewExpr -> RuntimeM (Integer, [String], Maybe ViewExpr)
+lowerRuntimeExprAgainst expr expected = do
+  mBoundary <- dynamicBoundaryValue expr expected
+  case mBoundary of
+    Just resultValue -> pure resultValue
+    Nothing -> do
+      (sym, nodes, known) <- lowerRuntimeExpr expr
+      subst <- gets runtimeSubst
+      let requireNode = "typedRequire " ++ show sym ++ " " ++ parens (unsafeLowerViewExpr expected) ++ " " ++ parens (astSource (substAst subst expr))
+      pure (sym, nodes ++ [requireNode], known)
+
+-- IO continuations receive host-produced values whose structural View may not be
+-- statically known to the source lowerer. At an explicit annotated boundary we
+-- may introduce the requested base observation and let guarded Views perform the
+-- runtime assertion. This keeps guard failures in checked-exec instead of
+-- rejecting dynamic IO values as frontend-unknown Any.
+dynamicBoundaryValue :: TricuAST -> ViewExpr -> RuntimeM (Maybe (Integer, [String], Maybe ViewExpr))
+dynamicBoundaryValue expr expected = case expr of
+  SVar name _ -> do
+    symbols <- gets runtimeSymbols
+    contracts <- gets runtimeContracts
+    case (Map.lookup name symbols, Map.lookup name contracts) of
+      (Nothing, Nothing) -> do
+        subst <- gets runtimeSubst
+        sym <- freshRuntimeSym
+        let payload = astSource (substAst subst expr)
+            knownView = dynamicBoundaryKnownView expected
+            valueNode = "typedValue " ++ show sym ++ " " ++ parens (unsafeLowerViewExpr knownView) ++ " " ++ parens payload
+            requireNode = "typedRequire " ++ show sym ++ " " ++ parens (unsafeLowerViewExpr expected) ++ " " ++ parens payload
+        recordRuntimeKnown sym knownView
+        pure (Just (sym, [valueNode, requireNode], Just knownView))
+      _ -> pure Nothing
+  _ -> pure Nothing
+
+dynamicBoundaryKnownView :: ViewExpr -> ViewExpr
+dynamicBoundaryKnownView view = case viewExprAsType view of
+  Just (VTGuarded base _) -> viewTypeToExpr base
+  _ -> view
+
+substAst :: Map.Map String TricuAST -> TricuAST -> TricuAST
+substAst subst expr = case expr of
+  SVar name Nothing -> Map.findWithDefault expr name subst
+  SApp f a -> SApp (substAst subst f) (substAst subst a)
+  SLambda params body -> SLambda params (substAst (foldr Map.delete subst params) body)
+  SList items -> SList (map (substAst subst) items)
+  TStem x -> TStem (substAst subst x)
+  TFork x y -> TFork (substAst subst x) (substAst subst y)
+  _ -> expr
+
+argRuntimeViewSource :: ViewExpr -> String
+argRuntimeViewSource view =
+  "lazyBool (_ : guardedViewBase " ++ v ++ ") (_ : " ++ v ++ ") (guardedView? " ++ v ++ ")"
+  where
+    v = parens (unsafeLowerViewExpr view)
+
+unsafeLowerViewExpr :: ViewExpr -> String
+unsafeLowerViewExpr view = case lowerViewExpr view of
+  Right source -> source
+  Left err -> errorWithoutStackTrace err
+
+astSource :: TricuAST -> String
+astSource expr = case expr of
+  SVar name Nothing -> name
+  SVar name (Just hash) -> name ++ "#" ++ hash
+  SInt n -> show n
+  SStr s -> show s
+  SList items -> "[" ++ unwords (map (parens . astSource) items) ++ "]"
+  SApp f a -> parens (astSource f) ++ " " ++ parens (astSource a)
+  SLambda params body -> parens (unwords params ++ " : " ++ astSource body)
+  TLeaf -> "t"
+  TStem x -> "(t " ++ astSource x ++ ")"
+  TFork x y -> "(t " ++ astSource x ++ " " ++ astSource y ++ ")"
+  SEmpty -> "[]"
+  SDef name params body -> name ++ " " ++ unwords params ++ " = " ++ astSource body
+  SDefAnn name args ret body -> name ++ " " ++ unwords (map defArgSource args) ++ maybe "" ((" =@" ++) . viewAnnSource) ret ++ " " ++ astSource body
+  SImport path ns -> "!import " ++ show path ++ " " ++ ns
+
+viewAnnSource :: ViewExpr -> String
+viewAnnSource = unsafeLowerViewExpr
+
+defArgSource :: DefArg -> String
+defArgSource (DefBinder name Nothing) = name
+defArgSource (DefBinder name (Just view)) = name ++ "@" ++ viewAnnSource view
+defArgSource (DefPhantom view) = "@" ++ viewAnnSource view
+
+parens :: String -> String
+parens s = "(" ++ s ++ ")"

src/ContentStore.hs

@@ -1,316 +1,17 @@
-module ContentStore where
+module ContentStore
+  ( module ContentStore.Object
+  , module ContentStore.Filesystem
+  , module ContentStore.Arboricx
+  , module ContentStore.Alias
+  , module ContentStore.Resolver
+  , module ContentStore.ViewTree
+  , module ContentStore.ViewContract
+  ) where
 
-import Research
-
-import Control.Monad                  (foldM, forM_, void)
-import Data.ByteString                (ByteString)
-import Data.Char                      (isHexDigit)
-import Data.List                      (nub, sort)
-import Data.Maybe                     (catMaybes, fromMaybe)
-import Data.Text                      (Text)
-import Database.SQLite.Simple
-import System.Directory               (createDirectoryIfMissing, getXdgDirectory, XdgDirectory(..))
-import System.Environment             (lookupEnv)
-import System.Exit                    (die)
-import System.FilePath                ((</>), takeDirectory)
-
-import qualified Data.Map             as Map
-import qualified Data.Text            as T
-
-data StoredNode = StoredNode ByteString deriving (Show)
-
-instance FromRow StoredNode where
-  fromRow = StoredNode <$> field
-
-data StoredTerm = StoredTerm
-  { termHash :: Text
-  , termNames :: Text
-  , termMetadata :: Text
-  , termCreatedAt :: Integer
-  , termTags :: Text
-  } deriving (Show)
-
-instance FromRow StoredTerm where
-  fromRow = StoredTerm <$> field <*> field <*> field <*> field <*> field
-
-parseNameList :: Text -> [Text]
-parseNameList = filter (not . T.null) . T.splitOn ","
-
-serializeNameList :: [Text] -> Text
-serializeNameList = T.intercalate "," . nub . sort
-
-initContentStore :: IO Connection
-initContentStore = initContentStoreWithPath Nothing
-
--- | Initialise a content store with an explicit path, or fall back
---   to the environment variable / default location.
-initContentStoreWithPath :: Maybe FilePath -> IO Connection
-initContentStoreWithPath mPath = do
-  dbPath <- case mPath of
-    Just p  -> return p
-    Nothing -> getContentStorePath
-  createDirectoryIfMissing True (takeDirectory dbPath)
-  conn <- open dbPath
-  setupDatabase conn
-  return conn
-
--- | Initialise a database connection (file-backed or in-memory).
---   This is factored out so tests can reuse it with ":memory:".
-setupDatabase :: Connection -> IO ()
-setupDatabase conn = do
-  execute_ conn "CREATE TABLE IF NOT EXISTS terms (\
-                \hash TEXT PRIMARY KEY, \
-                \names TEXT, \
-                \metadata TEXT, \
-                \created_at INTEGER DEFAULT (strftime('%s','now')), \
-                \tags TEXT DEFAULT '')"
-  execute_ conn "CREATE INDEX IF NOT EXISTS terms_names_idx ON terms(names)"
-  execute_ conn "CREATE INDEX IF NOT EXISTS terms_tags_idx ON terms(tags)"
-  execute_ conn "CREATE TABLE IF NOT EXISTS merkle_nodes (\
-                \hash TEXT PRIMARY KEY, \
-                \node_data BLOB NOT NULL)"
-  -- Seed canonical Leaf node payload (0x00)
-  putMerkleNode conn NLeaf
-
--- | Create an in-memory ContentStore connection (for tests).
-newContentStore :: IO Connection
-newContentStore = do
-  conn <- open ":memory:"
-  setupDatabase conn
-  return conn
-
-getContentStorePath :: IO FilePath
-getContentStorePath = do
-  maybeLocalPath <- lookupEnv "TRICU_DB_PATH"
-  case maybeLocalPath of
-    Just p -> return p
-    Nothing -> do
-      dataDir <- getXdgDirectory XdgData "tricu"
-      return $ dataDir </> "content-store.db"
-
-
-
-hashTerm :: T -> Text
-hashTerm = nodeHash . buildMerkle
-
-storeTerm :: Connection -> [String] -> T -> IO Text
-storeTerm conn newNamesStrList term = do
-  let termHashText = hashTerm term
-      newNamesTextList = map T.pack newNamesStrList
-      metadataText = T.pack "{}"
-  -- Store all Merkle nodes for this term
-  _ <- storeMerkleNodes conn term
-  existingNamesQuery <- query conn
-    "SELECT names FROM terms WHERE hash = ?"
-    (Only termHashText) :: IO [Only Text]
-
-  case existingNamesQuery of
-    [] -> do
-      let allNamesToStore = serializeNameList newNamesTextList
-      execute conn
-        "INSERT INTO terms (hash, names, metadata, tags) VALUES (?, ?, ?, ?)"
-        (termHashText, allNamesToStore, metadataText, T.pack "")
-    [(Only currentNamesText)] -> do
-      let currentNamesList = parseNameList currentNamesText
-      let combinedNamesList = currentNamesList ++ newNamesTextList
-      let allNamesToStore = serializeNameList combinedNamesList
-      execute conn
-        "UPDATE terms SET names = ?, metadata = ? WHERE hash = ?"
-        (allNamesToStore, metadataText, termHashText)
-    _ -> errorWithoutStackTrace $ "Multiple terms with same hash? " ++ show (length existingNamesQuery)
-
-  return termHashText
-
--- | Reconstruct a Tree Calculus term from its Merkle root hash.
---   Recursively loads nodes and rebuilds the T structure.
-loadTree :: Connection -> MerkleHash -> IO (Maybe T)
-loadTree conn h = do
-  maybeNode <- getNodeMerkle conn h
-  case maybeNode of
-    Nothing -> return Nothing
-    Just node -> Just <$> buildTree node
-  where
-    buildTree :: Node -> IO T
-    buildTree NLeaf = return Leaf
-    buildTree (NStem childHash) = do
-      child <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn childHash
-      return (Stem child)
-    buildTree (NFork lHash rHash) = do
-      left <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn lHash
-      right <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn rHash
-      return (Fork left right)
-
--- | Store all nodes of a Merkle DAG by traversing the Term and building/storing nodes.
---   Returns the hash of the root node.
-storeMerkleNodes :: Connection -> T -> IO MerkleHash
-storeMerkleNodes conn Leaf = do
-  putMerkleNode conn NLeaf
-  return $ nodeHash NLeaf
-storeMerkleNodes conn (Stem t) = do
-  childHash <- storeMerkleNodes conn t
-  let thisNode = NStem childHash
-  putMerkleNode conn thisNode
-  return $ nodeHash thisNode
-storeMerkleNodes conn (Fork l r) = do
-  leftHash <- storeMerkleNodes conn l
-  rightHash <- storeMerkleNodes conn r
-  let thisNode = NFork leftHash rightHash
-  putMerkleNode conn thisNode
-  return $ nodeHash thisNode
-
-
--- | Insert a Merkle node into the store (idempotent).
-putMerkleNode :: Connection -> Node -> IO ()
-putMerkleNode conn node =
-  execute conn "INSERT OR IGNORE INTO merkle_nodes (hash, node_data) VALUES (?, ?)"
-    (nodeHash node, serializeNode node)
-
--- | Retrieve a Merkle node by its hash.
-getNodeMerkle :: Connection -> MerkleHash -> IO (Maybe Node)
-getNodeMerkle conn h =
-  queryMaybeOne conn "SELECT node_data FROM merkle_nodes WHERE hash = ?" (Only h) >>= \case
-    Just (StoredNode bs) -> return $ Just (deserializeNode bs)
-    Nothing              -> return Nothing
-
-
-
-hashToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
-hashToTerm conn hashText =
-  queryMaybeOne conn (selectStoredTermFields <> " WHERE hash = ?") (Only hashText)
-
-nameToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
-nameToTerm conn nameText =
-  queryMaybeOne conn
-    (selectStoredTermFields <> " WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC LIMIT 1")
-    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
-
-listStoredTerms :: Connection -> IO [StoredTerm]
-listStoredTerms conn =
-  query_ conn (selectStoredTermFields <> " ORDER BY created_at DESC")
-
-storeEnvironment :: Connection -> Env -> IO ()
-storeEnvironment conn env = do
-  let defs = Map.toList $ Map.delete "!result" env
-  let groupedDefs = Map.toList $ Map.fromListWith (++) [(term, [name]) | (name, term) <- defs]
-
-  forM_ groupedDefs $ \(term, namesList) -> case namesList of
-    _:_ -> void $ storeTerm conn namesList term
-    _ -> errorWithoutStackTrace "storeEnvironment: empty names list"
-
-loadTerm :: Connection -> String -> IO (Maybe T)
-loadTerm conn identifier = do
-  result <- getTerm conn (T.pack identifier)
-  case result of
-    Just storedTerm -> loadTree conn (termHash storedTerm)
-    Nothing -> return Nothing
-
-getTerm :: Connection -> Text -> IO (Maybe StoredTerm)
-getTerm conn identifier = do
-  if '#' `elem` (T.unpack identifier)
-    then hashToTerm conn (T.pack $ drop 1 (T.unpack identifier))
-    else nameToTerm conn identifier
-
-loadEnvironment :: Connection -> IO Env
-loadEnvironment conn = do
-  terms <- listStoredTerms conn
-  foldM addTermToEnv Map.empty terms
-  where
-    addTermToEnv env storedTerm = do
-      maybeT <- loadTree conn (termHash storedTerm)
-      case maybeT of
-        Just t -> do
-          let namesList = parseNameList (termNames storedTerm)
-          return $ foldl (\e name -> Map.insert (T.unpack name) t e) env namesList
-        Nothing -> return env
-
-termVersions :: Connection -> String -> IO [(Text, T, Integer)]
-termVersions conn name = do
-  let nameText = T.pack name
-  results <- query conn
-    ("SELECT hash, created_at FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC")
-    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
-
-  catMaybes <$> mapM (\(hashVal, timestamp) -> do
-    maybeT <- loadTree conn hashVal
-    return $ fmap (\t -> (hashVal, t, timestamp)) maybeT
-    ) results
-
-setTag :: Connection -> Text -> Text -> IO ()
-setTag conn hash tagValue = do
-  exists <- termExists conn hash
-  if exists
-    then do
-      currentTagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
-      case currentTagsQuery of
-        [Only tagsText] -> do
-          let tagsList = parseNameList tagsText
-              newTagsList = tagValue : tagsList
-              newTags = serializeNameList newTagsList
-          execute conn "UPDATE terms SET tags = ? WHERE hash = ?" (newTags, hash)
-        _ -> putStrLn $ "Term with hash " ++ T.unpack hash ++ " not found (should not happen if exists is true)"
-    else
-      putStrLn $ "Term with hash " ++ T.unpack hash ++ " does not exist"
-
-termExists :: Connection -> Text -> IO Bool
-termExists conn hash = do
-  results <- query conn "SELECT 1 FROM terms WHERE hash = ? LIMIT 1" (Only hash) :: IO [[Int]]
-  return $ not (null results)
-
-termToTags :: Connection -> Text -> IO [Text]
-termToTags conn hash = do
-  tagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
-  case tagsQuery of
-    [Only tagsText] -> return $ parseNameList tagsText
-    _ -> return []
-
-tagToTerm :: Connection -> Text -> IO [StoredTerm]
-tagToTerm conn tagValue = do
-  let pattern = "%" <> tagValue <> "%"
-  query conn (selectStoredTermFields <> " WHERE tags LIKE ? ORDER BY created_at DESC") (Only pattern)
-
-allTermTags :: Connection -> IO [StoredTerm]
-allTermTags conn = do
-  query_ conn (selectStoredTermFields <> " WHERE tags IS NOT NULL AND tags != '' ORDER BY created_at DESC")
-
-selectStoredTermFields :: Query
-selectStoredTermFields = "SELECT hash, names, metadata, created_at, tags FROM terms"
-
-queryMaybeOne :: (FromRow r, ToRow q) => Connection -> Query -> q -> IO (Maybe r)
-queryMaybeOne conn qry params = do
-  results <- query conn qry params
-  case results of
-    [row] -> return $ Just row
-    _     -> return Nothing
-
--- | Resolve a user-supplied identifier (full/prefix hash, term name) to
---   a single term hash and the list of names bound to it.  Dies on
---   ambiguity or missing term (matching the CLI @export@ semantics).
-resolveExportTarget :: Connection -> String -> IO (Text, [Text])
-resolveExportTarget conn input = do
-  let raw = T.pack $ dropWhile (== '#') input
-  byName <- query conn
-    "SELECT hash FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC"
-    (raw, raw <> T.pack ",%", T.pack "," <> raw <> T.pack ",%", T.pack "%," <> raw) :: IO [Only T.Text]
-  case byName of
-    [Only fullHash] -> namesForHash conn fullHash >>= \names -> return (fullHash, names)
-    (_:_) -> die $ "Ambiguous term name: " ++ input
-    [] -> do
-      byHash <- query conn "SELECT hash FROM terms WHERE hash LIKE ? ORDER BY created_at DESC"
-        (Only (raw <> T.pack "%")) :: IO [Only T.Text]
-      case byHash of
-        [Only fullHash] -> namesForHash conn fullHash >>= \names -> return (fullHash, names)
-        [] -> if looksLikeHash raw
-          then return (raw, [])
-          else die $ "No term found matching: " ++ input
-        _ -> die $ "Ambiguous hash prefix: " ++ input
-
-namesForHash :: Connection -> Text -> IO [Text]
-namesForHash conn h = do
-  stored <- hashToTerm conn h
-  return $ maybe [] (parseNameList . termNames) stored
-
--- | Return 'True' when @t@ looks like a full or partial SHA-256 hex hash.
-looksLikeHash :: Text -> Bool
-looksLikeHash t =
-  let len = T.length t
-  in len >= 16 && len <= 64 && T.all isHexDigit t
+import ContentStore.Arboricx
+import ContentStore.Alias
+import ContentStore.Filesystem
+import ContentStore.Object
+import ContentStore.Resolver
+import ContentStore.ViewTree
+import ContentStore.ViewContract

src/ContentStore/Alias.hs

@@ -0,0 +1,81 @@
+module ContentStore.Alias
+  ( AliasKind(..)
+  , ObjectRef(..)
+  , aliasKindDirectory
+  , writeAlias
+  , readAlias
+  , listAliases
+  ) where
+
+import ContentStore.Filesystem (ensureStore)
+import ContentStore.Object
+
+import Data.Text (Text)
+import System.Directory (createDirectoryIfMissing, doesFileExist, listDirectory)
+import System.FilePath ((</>))
+
+import qualified Data.Text as Text
+import qualified Data.Text.IO as TextIO
+
+-- | Mutable workspace alias categories. Aliases are human-facing pointers to
+-- immutable content objects; they are not content identity.
+data AliasKind
+  = NameAlias
+  | ModuleAlias
+  | PackageAlias
+  deriving (Eq, Ord, Show)
+
+data ObjectRef = ObjectRef
+  { objectRefKind :: Text
+  , objectRefHash :: ObjectHash
+  } deriving (Eq, Ord, Show)
+
+aliasKindDirectory :: AliasKind -> FilePath
+aliasKindDirectory NameAlias = "names"
+aliasKindDirectory ModuleAlias = "modules"
+aliasKindDirectory PackageAlias = "packages"
+
+writeAlias :: StorePath -> AliasKind -> Text -> ObjectRef -> IO ()
+writeAlias store@(StorePath root) kind name ref = do
+  ensureStore store
+  let dir = root </> "aliases" </> aliasKindDirectory kind
+  createDirectoryIfMissing True dir
+  TextIO.writeFile (dir </> Text.unpack name) (encodeObjectRef ref)
+
+readAlias :: StorePath -> AliasKind -> Text -> IO (Maybe ObjectRef)
+readAlias store@(StorePath root) kind name = do
+  ensureStore store
+  let path = root </> "aliases" </> aliasKindDirectory kind </> Text.unpack name
+  exists <- doesFileExist path
+  if not exists
+    then return Nothing
+    else decodeObjectRef <$> TextIO.readFile path
+
+listAliases :: StorePath -> AliasKind -> IO [(Text, ObjectRef)]
+listAliases store@(StorePath root) kind = do
+  ensureStore store
+  let dir = root </> "aliases" </> aliasKindDirectory kind
+  names <- listDirectory dir
+  fmap concat $ mapM load names
+  where
+    load name = do
+      mRef <- readAlias store kind (Text.pack name)
+      return $ maybe [] (\ref -> [(Text.pack name, ref)]) mRef
+
+encodeObjectRef :: ObjectRef -> Text
+encodeObjectRef ref = Text.unlines
+  [ "kind: " <> objectRefKind ref
+  , "hash: " <> objectRefHash ref
+  ]
+
+decodeObjectRef :: Text -> Maybe ObjectRef
+decodeObjectRef txt = do
+  kind <- lookupField "kind" fields
+  hash <- lookupField "hash" fields
+  return ObjectRef { objectRefKind = kind, objectRefHash = hash }
+  where
+    fields = map parseLine (Text.lines txt)
+    parseLine line =
+      let (k, rest) = Text.breakOn ":" line
+      in (Text.strip k, Text.strip (Text.drop 1 rest))
+    lookupField key = lookup key

src/ContentStore/Arboricx.hs

@@ -0,0 +1,94 @@
+module ContentStore.Arboricx
+  ( merkleNodeDomain
+  , putNode
+  , getNode
+  , treeTermDomain
+  , encodeTreeTerm
+  , decodeTreeTerm
+  , putTreeTerm
+  , getTreeTerm
+  , putTree
+  , getTree
+  ) where
+
+import ContentStore.Filesystem
+import ContentStore.Object
+import Research
+
+import qualified Data.ByteString as BS
+
+merkleNodeDomain :: Domain
+merkleNodeDomain = Domain "arboricx.merkle.node.v1"
+
+treeTermDomain :: Domain
+treeTermDomain = Domain "arboricx.tree-term.v1"
+
+putNode :: StorePath -> Node -> IO ObjectHash
+putNode store node = putObject store merkleNodeDomain (serializeNode node)
+
+getNode :: StorePath -> ObjectHash -> IO (Maybe Node)
+getNode store h = fmap deserializeNode <$> getObject store h
+
+-- | Store a complete normal tree as one content object. Merkle nodes remain
+-- available for DAG use cases, but module executable exports use this object
+-- kind to avoid filesystem writes for every subtree of large normal forms.
+encodeTreeTerm :: T -> BS.ByteString
+encodeTreeTerm Leaf = BS.pack [0x00]
+encodeTreeTerm (Stem t) = BS.cons 0x01 (encodeTreeTerm t)
+encodeTreeTerm (Fork l r) = BS.cons 0x02 (encodeTreeTerm l <> encodeTreeTerm r)
+
+decodeTreeTerm :: BS.ByteString -> Either String T
+decodeTreeTerm payload = do
+  (term, rest) <- getTerm payload
+  if BS.null rest
+    then Right term
+    else Left "trailing bytes after tree term"
+  where
+    getTerm bs = case BS.uncons bs of
+      Nothing -> Left "unexpected end of tree term"
+      Just (0x00, rest) -> Right (Leaf, rest)
+      Just (0x01, rest) -> do
+        (child, afterChild) <- getTerm rest
+        Right (Stem child, afterChild)
+      Just (0x02, rest) -> do
+        (left, afterLeft) <- getTerm rest
+        (right, afterRight) <- getTerm afterLeft
+        Right (Fork left right, afterRight)
+      Just (tag, _) -> Left $ "unknown tree term tag: " ++ show tag
+
+putTreeTerm :: StorePath -> T -> IO ObjectHash
+putTreeTerm store = putObject store treeTermDomain . encodeTreeTerm
+
+getTreeTerm :: StorePath -> ObjectHash -> IO (Maybe T)
+getTreeTerm store h = do
+  mPayload <- getObject store h
+  case mPayload of
+    Nothing -> pure Nothing
+    Just payload -> case decodeTreeTerm payload of
+      Left err -> fail $ "invalid tree term " ++ show h ++ ": " ++ err
+      Right term -> pure (Just term)
+
+putTree :: StorePath -> T -> IO ObjectHash
+putTree store = go
+  where
+    go Leaf = putNode store NLeaf
+    go (Stem t) = do
+      child <- go t
+      putNode store (NStem child)
+    go (Fork l r) = do
+      left <- go l
+      right <- go r
+      putNode store (NFork left right)
+
+getTree :: StorePath -> ObjectHash -> IO (Maybe T)
+getTree store root = do
+  mNode <- getNode store root
+  case mNode of
+    Nothing -> return Nothing
+    Just node -> case node of
+      NLeaf -> return (Just Leaf)
+      NStem child -> fmap Stem <$> getTree store child
+      NFork left right -> do
+        ml <- getTree store left
+        mr <- getTree store right
+        return $ Fork <$> ml <*> mr

src/ContentStore/Bundle.hs

@@ -0,0 +1,37 @@
+module ContentStore.Bundle
+  ( packBundleFromStore
+  , unpackBundleToStore
+  ) where
+
+import ContentStore.Arboricx
+import ContentStore.Object
+import Wire
+
+import Control.Monad (forM)
+import Data.ByteString (ByteString)
+import Data.Text (Text)
+import qualified Data.Vector as V
+
+-- | Pack named CAS tree terms into an indexed Arboricx transport bundle.
+packBundleFromStore :: StorePath -> [(Text, ObjectHash)] -> IO Bundle
+packBundleFromStore store exports = do
+  terms <- forM exports $ \(name, root) -> do
+    mt <- getTreeTerm store root
+    case mt of
+      Nothing -> fail $ "CAS tree term not found: " ++ show root
+      Just term -> return (name, term)
+  return (buildBundle terms)
+
+-- | Unpack an indexed Arboricx transport bundle into CAS tree terms.
+-- Returns each manifest export name paired with its stored CAS tree-term hash.
+unpackBundleToStore :: StorePath -> ByteString -> IO [(Text, ObjectHash)]
+unpackBundleToStore store bs = case decodeBundle bs of
+  Left err -> fail $ "ContentStore.Bundle.unpackBundleToStore decode: " ++ err
+  Right bundle -> case verifyBundle bundle of
+    Left err -> fail $ "ContentStore.Bundle.unpackBundleToStore verify: " ++ err
+    Right () -> do
+      let terms = reconstructBundleTerms (bundleNodes bundle)
+      forM (manifestExports $ bundleManifest bundle) $ \exported -> do
+        let term = terms V.! fromIntegral (exportRoot exported)
+        root <- putTreeTerm store term
+        return (exportName exported, root)

src/ContentStore/Filesystem.hs

@@ -0,0 +1,60 @@
+module ContentStore.Filesystem
+  ( putObject
+  , getObject
+  , objectPath
+  , ensureStore
+  ) where
+
+import ContentStore.Object
+
+import Control.Monad    (unless, when)
+import Data.Text        (unpack)
+import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile, renameFile)
+import System.FilePath  ((</>))
+import System.IO        (hClose, openBinaryTempFile)
+
+import qualified Data.ByteString as BS
+
+ensureStore :: StorePath -> IO ()
+ensureStore (StorePath root) = do
+  createDirectoryIfMissing True (root </> "objects")
+  createDirectoryIfMissing True (root </> "aliases" </> "names")
+  createDirectoryIfMissing True (root </> "aliases" </> "modules")
+  createDirectoryIfMissing True (root </> "aliases" </> "packages")
+  createDirectoryIfMissing True (root </> "manifests")
+  createDirectoryIfMissing True (root </> "tmp")
+
+objectPath :: StorePath -> ObjectHash -> FilePath
+objectPath (StorePath root) h = root </> "objects" </> shardForHash h </> unpack h
+
+putObject :: StorePath -> Domain -> BS.ByteString -> IO ObjectHash
+putObject store@(StorePath root) domain payload = do
+  ensureStore store
+  let h = hashObject domain payload
+      shardDir = root </> "objects" </> shardForHash h
+      finalPath = objectPath store h
+  createDirectoryIfMissing True shardDir
+  exists <- doesFileExist finalPath
+  if exists
+    then verifyExisting finalPath
+    else do
+      let tmpDir = root </> "tmp"
+      (tmpPath, handle) <- openBinaryTempFile tmpDir (unpack h ++ ".tmp")
+      BS.hPut handle payload
+      hClose handle
+      raced <- doesFileExist finalPath
+      if raced
+        then removeFile tmpPath >> verifyExisting finalPath
+        else renameFile tmpPath finalPath
+  return h
+  where
+    verifyExisting path = do
+      existing <- BS.readFile path
+      when (existing /= payload) $
+        fail $ "content-addressed object exists with mismatched bytes: " ++ path
+
+getObject :: StorePath -> ObjectHash -> IO (Maybe BS.ByteString)
+getObject store h = do
+  let path = objectPath store h
+  exists <- doesFileExist path
+  if exists then Just <$> BS.readFile path else return Nothing

src/ContentStore/Object.hs

@@ -0,0 +1,45 @@
+module ContentStore.Object
+  ( Domain(..)
+  , ObjectHash
+  , StorePath(..)
+  , hashObject
+  , hashToText
+  , textToHashBytes
+  , shardForHash
+  ) where
+
+import Crypto.Hash            (Digest, SHA256, hash)
+import Data.ByteArray         (convert)
+import Data.ByteString.Base16 (decode, encode)
+import Data.Text              (Text)
+import Data.Text.Encoding     (decodeUtf8, encodeUtf8)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text       as T
+
+newtype Domain = Domain { unDomain :: Text }
+  deriving (Eq, Ord, Show)
+
+type ObjectHash = Text
+
+newtype StorePath = StorePath { unStorePath :: FilePath }
+  deriving (Eq, Ord, Show)
+
+hashObject :: Domain -> BS.ByteString -> ObjectHash
+hashObject (Domain domain) payload = hashToText digest
+  where
+    digest :: Digest SHA256
+    digest = hash (encodeUtf8 domain <> BS.pack [0x00] <> payload)
+
+hashToText :: Digest SHA256 -> Text
+hashToText = decodeUtf8 . encode . (convert :: Digest SHA256 -> BS.ByteString)
+
+textToHashBytes :: Text -> Either String BS.ByteString
+textToHashBytes h = case decode (encodeUtf8 h) of
+  Left _ -> Left "invalid hexadecimal hash"
+  Right raw
+    | BS.length raw == 32 -> Right raw
+    | otherwise -> Left "hash must decode to 32 bytes"
+
+shardForHash :: ObjectHash -> FilePath
+shardForHash = T.unpack . T.take 3

src/ContentStore/Resolver.hs

@@ -0,0 +1,110 @@
+module ContentStore.Resolver
+  ( ObjectResolver(..)
+  , filesystemResolver
+  , cachedFilesystemResolver
+  , resolveObjectByHash
+  , resolveManifest
+  , resolveTree
+  ) where
+
+import ContentStore.Alias
+import ContentStore.Arboricx
+import ContentStore.Filesystem
+import ContentStore.Object
+import Module.Manifest
+import Research (Node(..), T, deserializeNode)
+import qualified Research
+
+import Data.ByteString (ByteString)
+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef')
+import qualified Data.Map as Map
+import qualified Data.Text as T
+
+-- | Object and alias resolution capability. Module/import code should depend on
+-- this boundary rather than on a concrete filesystem store. Future resolvers can
+-- add trusted remotes, registries, or caches while preserving the same verified
+-- content-addressed interface.
+data ObjectResolver = ObjectResolver
+  { resolverAlias    :: AliasKind -> T.Text -> IO (Maybe ObjectRef)
+  , resolverObject   :: ObjectRef -> IO (Maybe ByteString)
+  , resolverManifest :: ObjectHash -> IO (Maybe ModuleManifest)
+  , resolverTree     :: ObjectHash -> IO (Maybe T)
+  }
+
+filesystemResolver :: StorePath -> ObjectResolver
+filesystemResolver store = resolver
+  where
+    resolver = ObjectResolver
+      { resolverAlias = readAlias store
+      , resolverObject = \ref -> getObject store (objectRefHash ref)
+      , resolverManifest = resolveManifestFromObjects resolver
+      , resolverTree = resolveTreeFromObjects resolver
+      }
+
+cachedFilesystemResolver :: StorePath -> IO ObjectResolver
+cachedFilesystemResolver store = do
+  objectCache <- newIORef Map.empty
+  manifestCache <- newIORef Map.empty
+  treeCache <- newIORef Map.empty
+  let resolver = ObjectResolver
+        { resolverAlias = readAlias store
+        , resolverObject = cachedLookup objectCache (\ref -> getObject store (objectRefHash ref))
+        , resolverManifest = cachedLookup manifestCache (resolveManifestFromObjects resolver)
+        , resolverTree = cachedLookup treeCache (resolveTreeFromObjects resolver)
+        }
+  return resolver
+  where
+    cachedLookup :: Ord k => IORef (Map.Map k v) -> (k -> IO v) -> k -> IO v
+    cachedLookup ref load key = do
+      cache <- readIORef ref
+      case Map.lookup key cache of
+        Just value -> return value
+        Nothing -> do
+          value <- load key
+          atomicModifyIORef' ref (\m -> (Map.insert key value m, ()))
+          return value
+
+resolveObjectByHash :: ObjectResolver -> T.Text -> ObjectHash -> IO (Maybe ByteString)
+resolveObjectByHash resolver kind h =
+  resolverObject resolver (ObjectRef kind h)
+
+resolveManifest :: ObjectResolver -> ObjectHash -> IO (Maybe ModuleManifest)
+resolveManifest = resolverManifest
+
+resolveManifestFromObjects :: ObjectResolver -> ObjectHash -> IO (Maybe ModuleManifest)
+resolveManifestFromObjects resolver h = do
+  mBytes <- resolveObjectByHash resolver (unDomain manifestDomain) h
+  case mBytes of
+    Nothing -> return Nothing
+    Just bytes -> case decodeManifest bytes of
+      Left err -> fail $ "invalid module manifest " ++ T.unpack h ++ ": " ++ err
+      Right manifest -> return (Just manifest)
+
+resolveTree :: ObjectResolver -> ObjectHash -> IO (Maybe T)
+resolveTree = resolverTree
+
+resolveTreeFromObjects :: ObjectResolver -> ObjectHash -> IO (Maybe T)
+resolveTreeFromObjects resolver h = do
+  mNode <- resolveNode resolver h
+  case mNode of
+    Nothing -> return Nothing
+    Just node -> hydrate node
+  where
+    resolveNode r nodeHash = do
+      mBytes <- resolveObjectByHash r (unDomain merkleNodeDomain) nodeHash
+      case mBytes of
+        Nothing -> return Nothing
+        Just bytes -> return (Just (deserializeNode bytes))
+
+    hydrate NLeaf = return (Just Research.Leaf)
+    hydrate (NStem child) = fmap Research.Stem <$> hydrateHash child
+    hydrate (NFork left right) = do
+      l <- hydrateHash left
+      r <- hydrateHash right
+      return $ Research.Fork <$> l <*> r
+
+    hydrateHash nodeHash = do
+      mChild <- resolveNode resolver nodeHash
+      case mChild of
+        Nothing -> return Nothing
+        Just child -> hydrate child

src/ContentStore/ViewContract.hs

@@ -0,0 +1,265 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module ContentStore.ViewContract
+  ( viewContractTypeKind
+  , viewContractTypeDomain
+  , encodeViewType
+  , decodeViewType
+  , treeToViewType
+  , viewTypeToTree
+  , putViewType
+  , getViewType
+  ) where
+
+import ContentStore.Alias (ObjectRef(..))
+import ContentStore.Arboricx (decodeTreeTerm, encodeTreeTerm)
+import ContentStore.Filesystem (getObject, putObject)
+import ContentStore.Object (Domain(..), StorePath, ObjectHash)
+import Research (T(..), ViewRef(..), ViewType(..), pattern VTRef, pattern VTRefText, ofList, ofNumber, ofString, toList, toNumber, toString)
+
+import Data.Bits (shiftL, shiftR, (.&.))
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Data.Word (Word8)
+import Text.Read (readMaybe)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+viewContractTypeKind :: Text
+viewContractTypeKind = "arboricx.view-contract.type.v1"
+
+viewContractTypeDomain :: Domain
+viewContractTypeDomain = Domain viewContractTypeKind
+
+encodeViewType :: ViewType -> BS.ByteString
+encodeViewType = go
+  where
+    go (VTName name) = BS.cons 0x00 (putBytes (encodeUtf8 (T.pack name)))
+    go (VTVar varId) = BS.cons 0x08 (putU32 (fromIntegral varId))
+    go (VTRefRaw (ViewRefInt n)) = BS.cons 0x01 (putBytes (encodeUtf8 (T.pack ("i:" ++ show n))))
+    go (VTRefRaw (ViewRefText s)) = BS.cons 0x01 (putBytes (encodeUtf8 (T.pack ("s:" ++ s))))
+    go (VTList item) = BS.cons 0x02 (go item)
+    go (VTMaybe item) = BS.cons 0x03 (go item)
+    go (VTPair left right) = BS.cons 0x04 (go left <> go right)
+    go (VTResult err ok) = BS.cons 0x05 (go err <> go ok)
+    go (VTGuarded base guard) = BS.cons 0x07 (go base <> putBytes (encodeTreeTerm guard))
+    go (VTForall binders body) = BS.cons 0x09 (putIntegerList binders <> go body)
+    go (VTExists binders body) = BS.cons 0x0a (putIntegerList binders <> go body)
+    go (VTFn args result) =
+      BS.cons 0x06 (putU32 (length args) <> mconcat (map go args) <> go result)
+
+putViewType :: StorePath -> ViewType -> IO ObjectRef
+putViewType store view = do
+  h <- putObject store viewContractTypeDomain (encodeViewType view)
+  pure ObjectRef { objectRefKind = viewContractTypeKind, objectRefHash = h }
+
+getViewType :: StorePath -> ObjectRef -> IO (Either String ViewType)
+getViewType store ref
+  | objectRefKind ref /= viewContractTypeKind =
+      pure $ Left $ "unsupported View Contract type object kind: " ++ T.unpack (objectRefKind ref)
+  | otherwise = do
+      mPayload <- getObject store (objectRefHash ref)
+      pure $ case mPayload of
+        Nothing -> Left $ "missing View Contract type object: " ++ T.unpack (objectRefHash ref)
+        Just payload -> decodeViewType payload
+
+decodeViewType :: BS.ByteString -> Either String ViewType
+decodeViewType payload = do
+  (view, rest) <- getViewTypeBytes payload
+  if BS.null rest
+    then Right view
+    else Left "trailing bytes after View Contract type"
+
+viewTypeToTree :: ViewType -> T
+viewTypeToTree view = case view of
+  VTName "Any" -> record 0 []
+  VTName "Bool" -> viewTypeToTree (VTRef 0)
+  VTName "String" -> viewTypeToTree (VTRef 1)
+  VTName "Byte" -> viewTypeToTree (VTRef 2)
+  VTName "Unit" -> viewTypeToTree (VTRef 3)
+  VTName name -> viewTypeToTree (VTRefText name)
+  VTVar varId -> record 8 [field 10 (ofNumber varId)]
+  VTRefRaw ref -> record 2 [field 2 (viewRefToTree ref)]
+  VTList item -> record 3 [field 3 (viewTypeToTree item)]
+  VTMaybe item -> record 4 [field 3 (viewTypeToTree item)]
+  VTPair left right -> record 5 [field 4 (viewTypeToTree left), field 5 (viewTypeToTree right)]
+  VTResult err ok -> record 6 [field 6 (viewTypeToTree err), field 7 (viewTypeToTree ok)]
+  VTGuarded base guard -> record 7 [field 8 (viewTypeToTree base), field 9 guard]
+  VTForall binders body -> record 9 [field 11 (ofList (map ofNumber binders)), field 12 (viewTypeToTree body)]
+  VTExists binders body -> record 10 [field 11 (ofList (map ofNumber binders)), field 12 (viewTypeToTree body)]
+  VTFn args result -> record 1 [field 0 (ofList (map viewTypeToTree args)), field 1 (viewTypeToTree result)]
+  where
+    record tag fields = Fork (ofNumber tag) (ofList fields)
+    field tag value = Fork (ofNumber tag) value
+    viewRefToTree (ViewRefInt n) = ofNumber n
+    viewRefToTree (ViewRefText s) = ofString s
+
+treeToViewType :: T -> Either String ViewType
+treeToViewType viewTree = do
+  (tag, fields) <- recordParts viewTree
+  case tag of
+    0 -> do
+      expectNoFields fields "Any"
+      Right (VTName "Any")
+    1 -> do
+      argsTree <- fieldValueAt 0 fields
+      resultTree <- fieldValueAt 1 fields
+      args <- toList argsTree
+      VTFn <$> mapM treeToViewType args <*> treeToViewType resultTree
+    2 -> VTRefRaw <$> (fieldValueAt 2 fields >>= viewRefFromTree)
+    3 -> VTList <$> (fieldValueAt 3 fields >>= treeToViewType)
+    4 -> VTMaybe <$> (fieldValueAt 3 fields >>= treeToViewType)
+    5 -> VTPair <$> (fieldValueAt 4 fields >>= treeToViewType) <*> (fieldValueAt 5 fields >>= treeToViewType)
+    6 -> VTResult <$> (fieldValueAt 6 fields >>= treeToViewType) <*> (fieldValueAt 7 fields >>= treeToViewType)
+    7 -> VTGuarded <$> (fieldValueAt 8 fields >>= treeToViewType) <*> fieldValueAt 9 fields
+    8 -> VTVar <$> (fieldValueAt 10 fields >>= toNumber)
+    9 -> VTForall <$> (fieldValueAt 11 fields >>= integerListFromTree) <*> (fieldValueAt 12 fields >>= treeToViewType)
+    10 -> VTExists <$> (fieldValueAt 11 fields >>= integerListFromTree) <*> (fieldValueAt 12 fields >>= treeToViewType)
+    _ -> Left $ "unknown View Contract view tag in tree: " ++ show tag
+  where
+    recordParts (Fork tagTree fieldsTree) = do
+      tag <- toNumber tagTree
+      fields <- toList fieldsTree
+      pure (tag, fields)
+    recordParts _ = Left "View Contract view tree is not a record"
+
+    expectNoFields fields label =
+      if null fields
+        then Right ()
+        else Left $ "View Contract " ++ label ++ " view has unexpected fields"
+
+    fieldValueAt expectedTag fields = do
+      values <- mapM fieldParts fields
+      case values of
+        [(actualTag, value)] | actualTag == expectedTag -> Right value
+        _ -> case lookup expectedTag values of
+          Just value -> Right value
+          Nothing -> Left $ "View Contract view tree missing field tag: " ++ show expectedTag
+
+    fieldParts (Fork tagTree value) = do
+      tag <- toNumber tagTree
+      pure (tag, value)
+    fieldParts _ = Left "View Contract view field is not a pair"
+
+    integerListFromTree tree = toList tree >>= mapM toNumber
+
+    viewRefFromTree tree =
+      case toNumber tree of
+        Right n -> Right (ViewRefInt n)
+        Left _ -> ViewRefText <$> toString tree
+
+getViewTypeBytes :: BS.ByteString -> Either String (ViewType, BS.ByteString)
+getViewTypeBytes bs = case BS.uncons bs of
+  Nothing -> Left "unexpected end of View Contract type"
+  Just (tag, rest) -> case tag of
+    0x00 -> do
+      (rawName, afterName) <- getBytes rest
+      name <- either (const (Left "View Contract type name is not valid UTF-8")) Right (decodeUtf8' rawName)
+      pure (VTName (T.unpack name), afterName)
+    0x01 -> do
+      (rawRef, afterRef) <- getBytes rest
+      refText <- either (const (Left "View Contract ref is not valid UTF-8")) Right (decodeUtf8' rawRef)
+      ref <- parseViewRef (T.unpack refText)
+      pure (VTRefRaw ref, afterRef)
+    0x02 -> do
+      (item, afterItem) <- getViewTypeBytes rest
+      pure (VTList item, afterItem)
+    0x03 -> do
+      (item, afterItem) <- getViewTypeBytes rest
+      pure (VTMaybe item, afterItem)
+    0x04 -> do
+      (left, afterLeft) <- getViewTypeBytes rest
+      (right, afterRight) <- getViewTypeBytes afterLeft
+      pure (VTPair left right, afterRight)
+    0x05 -> do
+      (err, afterErr) <- getViewTypeBytes rest
+      (ok, afterOk) <- getViewTypeBytes afterErr
+      pure (VTResult err ok, afterOk)
+    0x06 -> do
+      (argc, afterArgc) <- getU32 rest
+      (args, afterArgs) <- getMany argc afterArgc
+      (result, afterResult) <- getViewTypeBytes afterArgs
+      pure (VTFn args result, afterResult)
+    0x07 -> do
+      (base, afterBase) <- getViewTypeBytes rest
+      (rawGuard, afterGuard) <- getBytes afterBase
+      guard <- decodeTreeTerm rawGuard
+      pure (VTGuarded base guard, afterGuard)
+    0x08 -> do
+      (varId, afterVarId) <- getU32 rest
+      pure (VTVar (fromIntegral varId), afterVarId)
+    0x09 -> do
+      (binders, afterBinders) <- getIntegerList rest
+      (body, afterBody) <- getViewTypeBytes afterBinders
+      pure (VTForall binders body, afterBody)
+    0x0a -> do
+      (binders, afterBinders) <- getIntegerList rest
+      (body, afterBody) <- getViewTypeBytes afterBinders
+      pure (VTExists binders body, afterBody)
+    _ -> Left $ "unknown View Contract type tag: " ++ show tag
+
+parseViewRef :: String -> Either String ViewRef
+parseViewRef raw = case raw of
+  'i' : ':' : rest -> ViewRefInt <$> maybe (Left "View Contract integer ref is not an integer") Right (readMaybe rest)
+  's' : ':' : rest -> Right (ViewRefText rest)
+  legacy -> ViewRefInt <$> maybe (Left "View Contract ref is neither tagged nor a legacy integer") Right (readMaybe legacy)
+
+getMany :: Int -> BS.ByteString -> Either String ([ViewType], BS.ByteString)
+getMany n bs
+  | n < 0 = Left "negative View Contract argument count"
+  | otherwise = go n bs []
+  where
+    go 0 rest acc = Right (reverse acc, rest)
+    go k rest acc = do
+      (item, afterItem) <- getViewTypeBytes rest
+      go (k - 1) afterItem (item : acc)
+
+putIntegerList :: [Integer] -> BS.ByteString
+putIntegerList items = putU32 (length items) <> mconcat (map (putU32 . fromIntegral) items)
+
+getIntegerList :: BS.ByteString -> Either String ([Integer], BS.ByteString)
+getIntegerList bs = do
+  (count, afterCount) <- getU32 bs
+  go count afterCount []
+  where
+    go 0 rest acc = Right (reverse acc, rest)
+    go n rest acc = do
+      (varId, afterVarId) <- getU32 rest
+      go (n - 1) afterVarId (fromIntegral varId : acc)
+
+putBytes :: BS.ByteString -> BS.ByteString
+putBytes bytes = putU32 (BS.length bytes) <> bytes
+
+getBytes :: BS.ByteString -> Either String (BS.ByteString, BS.ByteString)
+getBytes bs = do
+  (len, afterLen) <- getU32 bs
+  let (payload, rest) = BS.splitAt len afterLen
+  if BS.length payload == len
+    then Right (payload, rest)
+    else Left "truncated length-prefixed View Contract field"
+
+putU32 :: Int -> BS.ByteString
+putU32 n
+  | n < 0 = error "putU32: negative length"
+  | n > 0xffffffff = error "putU32: length too large"
+  | otherwise = BS.pack
+      [ fromIntegral ((n `shiftR` 24) .&. 0xff)
+      , fromIntegral ((n `shiftR` 16) .&. 0xff)
+      , fromIntegral ((n `shiftR` 8) .&. 0xff)
+      , fromIntegral (n .&. 0xff)
+      ]
+
+getU32 :: BS.ByteString -> Either String (Int, BS.ByteString)
+getU32 bs
+  | BS.length bs < 4 = Left "truncated View Contract u32"
+  | otherwise =
+      let [b0, b1, b2, b3] = BS.unpack (BS.take 4 bs)
+          n = word8ToInt b0 `shiftL` 24
+            + word8ToInt b1 `shiftL` 16
+            + word8ToInt b2 `shiftL` 8
+            + word8ToInt b3
+      in Right (n, BS.drop 4 bs)
+
+word8ToInt :: Word8 -> Int
+word8ToInt = fromIntegral

src/ContentStore/ViewTree.hs

@@ -0,0 +1,192 @@
+module ContentStore.ViewTree
+  ( viewTreeKind
+  , viewTreeDomain
+  , encodeViewTree
+  , decodeViewTree
+  , singletonViewTree
+  , singletonViewTreeWithProvenance
+  , viewTreeRootTerm
+  , viewTreeRootViewFact
+  , putViewTree
+  , getViewTree
+  ) where
+
+import ContentStore.Arboricx (decodeTreeTerm, encodeTreeTerm)
+import ContentStore.Alias (ObjectRef(..))
+import ContentStore.Filesystem (getObject, putObject)
+import ContentStore.Object (Domain(..), StorePath)
+import ContentStore.ViewContract (treeToViewType, viewTypeToTree)
+import Research (T(..), ViewProvenance(..), ViewType(..), ofList, ofNumber, toList, toNumber)
+
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+
+viewTreeKind :: T.Text
+viewTreeKind = "arboricx.view-tree.v1"
+
+viewTreeDomain :: Domain
+viewTreeDomain = Domain viewTreeKind
+
+-- View-tree artifacts are ordinary tree data. Their node envelope semantics
+-- live in lib/view.tri; this module only provides CAS persistence for the
+-- portable tree payload.
+encodeViewTree :: T -> BS.ByteString
+encodeViewTree = encodeTreeTerm
+
+decodeViewTree :: BS.ByteString -> Either String T
+decodeViewTree = decodeTreeTerm
+
+singletonViewTree :: Maybe ViewType -> T -> T
+singletonViewTree mView term = singletonViewTreeWithProvenance (fmap (\view -> (view, ViewUnchecked)) mView) term
+
+singletonViewTreeWithProvenance :: Maybe (ViewType, ViewProvenance) -> T -> T
+singletonViewTreeWithProvenance mViewFact term =
+  record typedProgramTag
+    [ field typedProgramFieldRoot (ofNumber 0)
+    , field typedProgramFieldNodes (ofList [typedValueNode 0 (maybe viewAnyTree (viewTypeToTree . fst) mViewFact) term (fmap snd mViewFact)])
+    ]
+
+-- | Extract the executable root payload from a view-tree artifact without
+-- judging view validity. Checker semantics remain in lib/view.tri; this is only
+-- the module loader's payload projection for imports.
+viewTreeRootTerm :: T -> Either String T
+viewTreeRootTerm tree = do
+  tag <- recordTag tree
+  if tag /= typedProgramTag
+    then Left $ "view-tree root has unexpected tag: " ++ show tag
+    else do
+      root <- fieldValue typedProgramFieldRoot tree >>= toNumber
+      nodes <- fieldValue typedProgramFieldNodes tree >>= toList
+      lookupRoot root nodes
+  where
+    lookupRoot _ [] = Left "view-tree root symbol not found"
+    lookupRoot root (node : rest) = do
+      sym <- fieldValue typedNodeFieldSymbol node >>= toNumber
+      if sym == root
+        then nodeTerm node
+        else lookupRoot root rest
+
+    nodeTerm node = do
+      tag <- recordTag node
+      case tag of
+        21 -> fieldValue typedNodeFieldTerm node
+        22 -> fieldValue typedNodeFieldTerm node
+        23 -> fieldValue typedNodeFieldTerm node
+        _  -> Left $ "view-tree node has unexpected tag: " ++ show tag
+
+viewTreeRootViewFact :: T -> Either String (Maybe (ViewType, ViewProvenance))
+viewTreeRootViewFact tree = do
+  tag <- recordTag tree
+  if tag /= typedProgramTag
+    then Left $ "view-tree root has unexpected tag: " ++ show tag
+    else do
+      root <- fieldValue typedProgramFieldRoot tree >>= toNumber
+      nodes <- fieldValue typedProgramFieldNodes tree >>= toList
+      lookupRoot root nodes
+  where
+    lookupRoot _ [] = Left "view-tree root symbol not found"
+    lookupRoot root (node : rest) = do
+      sym <- fieldValue typedNodeFieldSymbol node >>= toNumber
+      if sym == root
+        then nodeViewFact node
+        else lookupRoot root rest
+
+    nodeViewFact node = do
+      tag <- recordTag node
+      case tag of
+        21 -> do
+          view <- fieldValue typedNodeFieldView node >>= treeToViewType
+          provenance <- maybe (Right ViewUnchecked) treeToViewProvenance (fieldValueMaybe typedNodeFieldProvenance node)
+          Right (Just (view, provenance))
+        23 -> do
+          view <- fieldValue typedNodeFieldView node >>= treeToViewType
+          provenance <- maybe (Right ViewUnchecked) treeToViewProvenance (fieldValueMaybe typedNodeFieldProvenance node)
+          Right (Just (view, provenance))
+        22 -> Right Nothing
+        _  -> Left $ "view-tree node has unexpected tag: " ++ show tag
+
+record :: Integer -> [T] -> T
+record tag fields = Fork (ofNumber tag) (ofList fields)
+
+field :: Integer -> T -> T
+field tag value = Fork (ofNumber tag) value
+
+typedValueNode :: Integer -> T -> T -> Maybe ViewProvenance -> T
+typedValueNode sym view term mProvenance =
+  record typedNodeTagValue $
+    [ field typedNodeFieldSymbol (ofNumber sym)
+    , field typedNodeFieldView view
+    , field typedNodeFieldTerm term
+    ] ++ maybe [] (\provenance -> [field typedNodeFieldProvenance (viewProvenanceToTree provenance)]) mProvenance
+
+viewProvenanceToTree :: ViewProvenance -> T
+viewProvenanceToTree ViewChecked = ofNumber 0
+viewProvenanceToTree ViewTrusted = ofNumber 1
+viewProvenanceToTree ViewUnchecked = ofNumber 2
+
+viewAnyTree :: T
+viewAnyTree = record 0 []
+
+recordTag :: T -> Either String Integer
+recordTag (Fork tagTree _) = toNumber tagTree
+recordTag _ = Left "view-tree value is not a record"
+
+recordFields :: T -> Either String [T]
+recordFields (Fork _ fieldsTree) = toList fieldsTree
+recordFields _ = Left "view-tree value is not a record"
+
+fieldValue :: Integer -> T -> Either String T
+fieldValue expected recordTree = do
+  fields <- recordFields recordTree
+  values <- mapM fieldParts fields
+  case lookup expected values of
+    Just value -> Right value
+    Nothing -> Left $ "view-tree missing field tag: " ++ show expected
+
+fieldValueMaybe :: Integer -> T -> Maybe T
+fieldValueMaybe expected recordTree = do
+  fields <- either (const Nothing) Just (recordFields recordTree)
+  values <- either (const Nothing) Just (mapM fieldParts fields)
+  lookup expected values
+
+fieldParts :: T -> Either String (Integer, T)
+fieldParts (Fork tagTree value) = do
+  tag <- toNumber tagTree
+  Right (tag, value)
+fieldParts _ = Left "view-tree field is not a pair"
+
+typedProgramTag, typedProgramFieldRoot, typedProgramFieldNodes :: Integer
+typedProgramTag = 20
+typedProgramFieldRoot = 0
+typedProgramFieldNodes = 1
+
+typedNodeTagValue, typedNodeFieldSymbol, typedNodeFieldView, typedNodeFieldTerm, typedNodeFieldProvenance :: Integer
+typedNodeTagValue = 21
+typedNodeFieldSymbol = 0
+typedNodeFieldView = 1
+typedNodeFieldTerm = 2
+typedNodeFieldProvenance = 5
+
+treeToViewProvenance :: T -> Either String ViewProvenance
+treeToViewProvenance tree = do
+  tag <- toNumber tree
+  case tag of
+    0 -> Right ViewChecked
+    1 -> Right ViewTrusted
+    2 -> Right ViewUnchecked
+    _ -> Left $ "unknown view-tree View Contract provenance tag: " ++ show tag
+
+putViewTree :: StorePath -> T -> IO ObjectRef
+putViewTree store viewTree = do
+  h <- putObject store viewTreeDomain (encodeViewTree viewTree)
+  pure ObjectRef { objectRefKind = viewTreeKind, objectRefHash = h }
+
+getViewTree :: StorePath -> ObjectRef -> IO (Either String T)
+getViewTree store ref
+  | objectRefKind ref /= viewTreeKind =
+      pure $ Left $ "unsupported view-tree object kind: " ++ T.unpack (objectRefKind ref)
+  | otherwise = do
+      mPayload <- getObject store (objectRefHash ref)
+      pure $ case mPayload of
+        Nothing -> Left $ "missing view-tree object: " ++ T.unpack (objectRefHash ref)
+        Just payload -> decodeViewTree payload

src/Eval.hs

@@ -1,19 +1,16 @@
 module Eval where
 
-import ContentStore
 import Parser
 import Research
 
-import Control.Monad (foldM)
 import Data.List (partition, (\\), elemIndex, foldl')
 import Data.Map  ()
 import Data.Set  (Set)
-import Database.SQLite.Simple
+import Debug.Trace (trace)
 
 import qualified Data.Foldable as F ()
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.Text as T
 
 data DB
   = BVar Int
@@ -42,6 +39,16 @@ evalSingle env term
            -> Map.insert "!result" res (Map.insert name res env)
          Nothing
            -> Map.insert "!result" res (Map.insert name res env)
+  | SDefAnn name args _ body <- term
+  = let params = annotatedBinders args
+        res = evalASTSync env (if null params then body else SLambda params body)
+    in case Map.lookup name env of
+         Just existingValue
+           | existingValue == res -> env
+           | otherwise
+           -> Map.insert "!result" res (Map.insert name res env)
+         Nothing
+           -> Map.insert "!result" res (Map.insert name res env)
   | SApp func arg <- term
   = let res = apply (evalASTSync env func) (evalASTSync env arg)
     in Map.insert "!result" res env
@@ -86,94 +93,17 @@ evalASTSync env term = case term of
   SEmpty -> Leaf
   _ -> errorWithoutStackTrace $ "Unexpected AST term: " ++ show term
 
-evalAST :: Maybe Connection -> Map.Map String T.Text -> TricuAST -> IO T
-evalAST mconn selectedVersions ast = do
-  let varNames = collectVarNames ast
-  resolvedEnv <- resolveTermsFromStore mconn selectedVersions varNames
-  return $ evalASTSync resolvedEnv ast
-
--- | Evaluate a single AST term using a local environment augmented by
---   lazily-resolved store terms.
-evalASTWithEnv :: Maybe Connection -> Env -> TricuAST -> IO T
-evalASTWithEnv mconn localEnv ast = do
-  let varNames = collectVarNames ast
-  storeEnv <- resolveTermsFromStore mconn Map.empty varNames
-  let combinedEnv = Map.union localEnv storeEnv
-  return $ evalASTSync combinedEnv ast
-
-evalSingleWithStore :: Maybe Connection -> Env -> TricuAST -> IO Env
-evalSingleWithStore mconn env term
-  | SDef name params body <- term = do
-      res <- evalASTWithEnv mconn env (if null params then body else SLambda params body)
-      case Map.lookup name env of
-        Just existingValue
-          | existingValue == res -> return env
-          | otherwise -> return $ Map.insert "!result" res (Map.insert name res env)
-        Nothing -> return $ Map.insert "!result" res (Map.insert name res env)
-  | otherwise = do
-      res <- evalASTWithEnv mconn env term
-      return $ Map.insert "!result" res env
-
-evalTricuWithStore :: Maybe Connection -> Env -> [TricuAST] -> IO Env
-evalTricuWithStore mconn env x = go env (reorderDefs env (map recoverParams x))
-  where
-    go env' []     = return env'
-    go env' [def]  = do
-      updatedEnv <- evalSingleWithStore mconn env' def
-      return $ Map.insert "!result" (result updatedEnv) updatedEnv
-    go env' (def:xs) = do
-      updatedEnv <- evalSingleWithStore mconn env' def
-      evalTricuWithStore mconn updatedEnv xs
+evalAST :: Env -> TricuAST -> IO T
+evalAST env ast = return $ evalASTSync env ast
 
 recoverParams :: TricuAST -> TricuAST
 recoverParams (SDef name [] (SLambda params body)) = SDef name params body
 recoverParams term = term
 
-collectVarNames :: TricuAST -> [(String, Maybe String)]
-collectVarNames = go []
-  where
-    go acc (SVar name mhash) = (name, mhash) : acc
-    go acc (SApp t u) = go (go acc t) u
-    go acc (SLambda vars body) =
-      let boundVars = Set.fromList vars
-          collected = go [] body
-      in acc ++ filter (\(name, _) -> not $ Set.member name boundVars) collected
-    go acc (TStem t) = go acc t
-    go acc (TFork t u) = go (go acc t) u
-    go acc (SList xs) = foldl' go acc xs
-    go acc _ = acc
-
-resolveTermsFromStore :: Maybe Connection -> Map.Map String T.Text -> [(String, Maybe String)] -> IO Env
-resolveTermsFromStore Nothing _ _ = return Map.empty
-resolveTermsFromStore (Just conn) selectedVersions varNames = do
-  foldM (\env (name, mhash) -> do
-    term <- resolveTermFromStore conn selectedVersions name mhash
-    case term of
-      Just t -> return $ Map.insert (getVarKey name mhash) t env
-      Nothing -> return env
-      ) Map.empty varNames
-  where
-    getVarKey name Nothing = name
-    getVarKey name (Just hash) = name ++ "#" ++ hash
-
-resolveTermFromStore :: Connection -> Map.Map String T.Text -> String -> Maybe String -> IO (Maybe T)
-resolveTermFromStore conn selectedVersions name mhash = case mhash of
-  Just hashPrefix -> do
-    versions <- termVersions conn name
-    let matchingVersions = filter (\(hash, _, _) ->
-          T.isPrefixOf (T.pack hashPrefix) hash) versions
-    case matchingVersions of
-      [] -> return Nothing
-      [(_, term, _)] -> return $ Just term
-      _ -> return Nothing
-  Nothing -> case Map.lookup name selectedVersions of
-    Just hash -> loadTree conn hash
-    Nothing -> do
-      versions <- termVersions conn name
-      case versions of
-        [] -> return Nothing
-        [(_, term, _)] -> return $ Just term
-        _ -> return $ Just (head (map (\(_, t, _) -> t) versions))
+annotatedBinders :: [DefArg] -> [String]
+annotatedBinders [] = []
+annotatedBinders (DefBinder name _ : rest) = name : annotatedBinders rest
+annotatedBinders (DefPhantom _ : rest) = annotatedBinders rest
 
 elimLambda :: TricuAST -> TricuAST
 elimLambda = go
@@ -261,6 +191,7 @@ freeVars (SVar v (Just _)) = Set.singleton v
 freeVars (SApp t u) = Set.union (freeVars t) (freeVars u)
 freeVars (SLambda vs body) = Set.difference (freeVars body) (Set.fromList vs)
 freeVars (SDef _ params body) = Set.difference (freeVars body) (Set.fromList params)
+freeVars (SDefAnn _ args _ body) = Set.difference (freeVars body) (Set.fromList (annotatedBinders args))
 freeVars (TStem t) = freeVars t
 freeVars (TFork t u) = Set.union (freeVars t) (freeVars u)
 freeVars (SList xs) = foldMap freeVars xs
@@ -274,13 +205,13 @@ reorderDefs env defs
   | otherwise = orderedDefs ++ others
   where
     (defsOnly, others) = partition isDef defs
-    defNames = [ name | SDef name _ _ <- defsOnly ]
+    defNames = [ defName def | def <- defsOnly ]
 
     defsWithFreeVars = [(def, freeVars def) | def <- defsOnly]
 
     graph = buildDepGraph defsOnly
     sortedDefs = sortDeps graph
-    defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly]
+    defMap = Map.fromList [(defName def, def) | def <- defsOnly]
     orderedDefs = map (defMap Map.!) sortedDefs
 
     freeVarsDefs = foldMap snd defsWithFreeVars
@@ -290,6 +221,7 @@ reorderDefs env defs
     missingDeps = Set.toList (allFreeVars `Set.difference` validNames)
 
     isDef SDef {} = True
+    isDef SDefAnn {} = True
     isDef _       = False
 
 buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
@@ -299,11 +231,11 @@ buildDepGraph topDefs
         "Conflicting definitions detected: " ++ show conflictingDefs
   | otherwise =
       Map.fromList
-        [ (name, depends topDefs def)
-        | def@(SDef name _ _) <- topDefs]
+        [ (defName def, depends topDefs def)
+        | def <- topDefs]
   where
     defsMap = Map.fromListWith (++)
-      [(name, [(name, body)]) | SDef name _ body <- topDefs]
+      [(defName def, [(defName def, defBody def)]) | def <- topDefs]
 
     conflictingDefs =
       [ name
@@ -329,10 +261,24 @@ sortDeps graph = go [] Set.empty (Map.keys graph)
                  (Set.union sortedSet (Set.fromList ready))
                  notReady
 
+defName :: TricuAST -> String
+defName (SDef name _ _) = name
+defName (SDefAnn name _ _ _) = name
+defName _ = error "defName: expected definition"
+
+defBody :: TricuAST -> TricuAST
+defBody (SDef _ _ body) = body
+defBody (SDefAnn _ _ _ body) = body
+defBody _ = error "defBody: expected definition"
+
 depends :: [TricuAST] -> TricuAST -> Set.Set String
-depends topDefs def@(SDef _ _ _) =
+depends topDefs def@SDef {} =
   Set.intersection
-    (Set.fromList [n | SDef n _ _ <- topDefs])
+    (Set.fromList [defName d | d <- topDefs])
+    (freeVars def)
+depends topDefs def@SDefAnn {} =
+  Set.intersection
+    (Set.fromList [defName d | d <- topDefs])
     (freeVars def)
 depends _ _ = Set.empty
 
@@ -352,6 +298,7 @@ findVarNames ast = case ast of
   SApp a b -> findVarNames a ++ findVarNames b
   SLambda args body -> findVarNames body \\ args
   SDef name args body -> name : (findVarNames body \\ args)
+  SDefAnn name args _ body -> name : (findVarNames body \\ annotatedBinders args)
   _ -> []
 
 -- Convert named TricuAST to De Bruijn form
@@ -371,6 +318,7 @@ toDB env = \case
   SList xs     -> BList (map (toDB env) xs)
   SEmpty       -> BEmpty
   SDef{}       -> error "toDB: unexpected SDef at this stage"
+  SDefAnn{}    -> error "toDB: unexpected SDefAnn at this stage"
   SImport _ _  -> BEmpty
 
 -- Does a term depend on the current binder (level 0)?

src/FileEval.hs

@@ -1,22 +1,45 @@
 module FileEval
-  ( preprocessFile
+  ( ContractMode(..)
+  , LoadedSource(..)
+  , preprocessFile
+  , preprocessFileWithStore
+  , preprocessFileWithResolver
   , evaluateFile
-  , evaluateFileWithContext
   , evaluateFileWithStore
+  , evaluateFileWithContext
+  , evaluateFileWithContextWithStore
+  , evaluateFileWithContextWithStoreAndMode
   , evaluateFileResult
   , compileFile
+  , compileFileWithStore
+  , loadFileWithStore
+  , loadFileWithStoreMode
+  , valueViewFactsFromEnv
+  , defaultStorePath
   ) where
 
-import Eval (evalTricu, evalTricuWithStore)
+import Check.Core
+  ( ImportedView(..)
+  , checkProgramWithEnvAndImportedViews
+  , importedViewsFromResolvedModulesEither
+  , lowerViewExpr
+  )
+import ContentStore
+import Eval (evalASTSync, evalTricu, freeVars, result)
 import Lexer
+import Module.Manifest
+import Module.Resolver
+import Module.Workspace
 import Parser
 import Research
 import Wire (buildBundle, encodeBundle, decodeBundle, verifyBundle, Bundle(..))
-import Database.SQLite.Simple (Connection)
 
-import Data.List       (partition)
+import Data.List       (partition, isPrefixOf)
 import Data.Maybe      (mapMaybe)
-import System.FilePath (takeDirectory, normalise, (</>))
+import Control.Monad   (forM)
+import qualified Data.Set as Set
+import System.Directory (getHomeDirectory, getTemporaryDirectory)
+import System.FilePath ((</>))
 import System.Exit (die)
 
 import qualified Data.ByteString as BS
@@ -32,153 +55,353 @@ extractMain env =
     Just evalResult -> Right evalResult
     Nothing -> Left "No `main` function detected"
 
-processImports :: Set.Set FilePath -> FilePath -> FilePath -> [TricuAST]
-                 -> Either String ([TricuAST], [(FilePath, String, FilePath)])
-processImports seen _base currentPath asts =
+data ContractMode
+  = EnforceContracts
+  | IgnoreContracts
+  deriving (Eq, Show)
+
+data LoadedSource = LoadedSource
+  { loadedImports :: Env
+  , loadedAst     :: [TricuAST]
+  , loadedModules :: [ResolvedModule]
+  }
+
+data LoadContext = LoadContext
+  { loadResolver  :: ObjectResolver
+  , loadStore     :: Maybe StorePath
+  , loadWorkspace :: Workspace
+  , loadContracts :: ContractMode
+  }
+
+processImports :: [TricuAST] -> ([TricuAST], [(String, String)])
+processImports asts =
   let (imports, nonImports) = partition isImp asts
-      importPaths = mapMaybe getImportInfo imports
-  in if currentPath `Set.member` seen
-     then Left $ "Encountered cyclic import: " ++ currentPath
-     else Right (nonImports, importPaths)
+      importTargets = mapMaybe getImportInfo imports
+  in (nonImports, importTargets)
   where
     isImp (SImport _ _) = True
     isImp _ = False
-    getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p)
+    getImportInfo (SImport p n) = Just (p, n)
     getImportInfo _ = Nothing
 
 evaluateFileResult :: FilePath -> IO T
 evaluateFileResult filePath = do
-  contents <- readFile filePath
-  let tokens = lexTricu contents
-  case parseProgram tokens of
-    Left err -> errorWithoutStackTrace (handleParseError tokens err)
-    Right _ast -> do
-      processedAst <- preprocessFile filePath
-      let finalEnv = evalTricu Map.empty processedAst
-      case extractMain finalEnv of
-        Right evalResult -> return evalResult
-        Left err -> errorWithoutStackTrace err
+  env <- evaluateFile filePath
+  case extractMain env of
+    Right evalResult -> return evalResult
+    Left err -> errorWithoutStackTrace err
 
 evaluateFile :: FilePath -> IO Env
-evaluateFile filePath = do
-  contents <- readFile filePath
-  let tokens = lexTricu contents
-  case parseProgram tokens of
-    Left err -> errorWithoutStackTrace (handleParseError tokens err)
-    Right _ast -> do
-      ast <- preprocessFile filePath
-      pure $ evalTricu Map.empty ast
+evaluateFile = evaluateFileWithStore Nothing
+
+evaluateFileWithStore :: Maybe StorePath -> FilePath -> IO Env
+evaluateFileWithStore mStore filePath = do
+  loaded <- maybe loadFile loadFileWithStore mStore filePath
+  pure $ evalTricu (loadedImports loaded) (loadedAst loaded)
 
 evaluateFileWithContext :: Env -> FilePath -> IO Env
-evaluateFileWithContext env filePath = do
-  contents <- readFile filePath
-  let tokens = lexTricu contents
-  case parseProgram tokens of
-    Left err -> errorWithoutStackTrace (handleParseError tokens err)
-    Right _ast -> do
-      ast <- preprocessFile filePath
-      pure $ evalTricu env ast
+evaluateFileWithContext = evaluateFileWithContextWithStore Nothing
 
--- | File evaluation that lazily resolves missing names from the
---   content store instead of pre-loading the entire store into memory.
-evaluateFileWithStore :: Maybe Connection -> Env -> FilePath -> IO Env
-evaluateFileWithStore mconn env filePath = do
-  contents <- readFile filePath
-  let tokens = lexTricu contents
-  case parseProgram tokens of
-    Left err -> errorWithoutStackTrace (handleParseError tokens err)
-    Right _ast -> do
-      ast <- preprocessFile filePath
-      evalTricuWithStore mconn env ast
+evaluateFileWithContextWithStore :: Maybe StorePath -> Env -> FilePath -> IO Env
+evaluateFileWithContextWithStore mStore =
+  evaluateFileWithContextWithStoreAndMode EnforceContracts mStore
+
+evaluateFileWithContextWithStoreAndMode :: ContractMode -> Maybe StorePath -> Env -> FilePath -> IO Env
+evaluateFileWithContextWithStoreAndMode mode mStore env filePath = do
+  loaded <- case mStore of
+    Nothing    -> loadFileMode mode filePath
+    Just store -> loadFileWithStoreMode mode store filePath
+  pure $ evalTricu (Map.union (loadedImports loaded) env) (loadedAst loaded)
 
 preprocessFile :: FilePath -> IO [TricuAST]
-preprocessFile p = preprocessFile' Set.empty p p
+preprocessFile p = loadedAst <$> loadFile p
 
-preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
-preprocessFile' seen base currentPath = do
+preprocessFileWithStore :: StorePath -> FilePath -> IO [TricuAST]
+preprocessFileWithStore store p = loadedAst <$> loadFileWithStore store p
+
+preprocessFileWithResolver :: ObjectResolver -> FilePath -> IO [TricuAST]
+preprocessFileWithResolver resolver p = loadedAst <$> loadFileWithResolver resolver p
+
+loadFile :: FilePath -> IO LoadedSource
+loadFile = loadFileMode EnforceContracts
+
+loadFileMode :: ContractMode -> FilePath -> IO LoadedSource
+loadFileMode mode p = do
+  store <- defaultStorePath
+  loadFileWithStoreMode mode store p
+
+loadFileWithStore :: StorePath -> FilePath -> IO LoadedSource
+loadFileWithStore = loadFileWithStoreMode EnforceContracts
+
+loadFileWithStoreMode :: ContractMode -> StorePath -> FilePath -> IO LoadedSource
+loadFileWithStoreMode mode store p = do
+  workspace <- findWorkspaceFor p
+  resolver <- cachedFilesystemResolver store
+  let ctx = LoadContext resolver (Just store) workspace mode
+  loadFile' ctx p
+
+loadFileWithResolver :: ObjectResolver -> FilePath -> IO LoadedSource
+loadFileWithResolver resolver p = do
+  let ctx = LoadContext resolver Nothing emptyWorkspace EnforceContracts
+  loadFile' ctx p
+
+loadFile' :: LoadContext -> FilePath -> IO LoadedSource
+loadFile' ctx currentPath = do
   contents <- readFile currentPath
   let tokens = lexTricu contents
   case parseProgram tokens of
     Left err -> errorWithoutStackTrace (handleParseError tokens err)
     Right ast ->
-      case processImports seen base currentPath ast of
-        Left err -> errorWithoutStackTrace err
-        Right (nonImports, importPaths) -> do
-          let seen' = Set.insert currentPath seen
-          imported <- concat <$> mapM (processImportPath seen' base) importPaths
-          pure $ imported ++ nonImports
+      let (nonImports, importTargets) = processImports ast
+      in do
+        let reexportOnlyModule = null (topLevelDefinitions nonImports) && not (null importTargets)
+        resolvedModules <- mapM (\(target, name) -> do
+            ensureWorkspaceModule ctx target
+            resolveModuleImportSelecting (loadResolver ctx) (selectedExportsForImport reexportOnlyModule target name nonImports) target name) importTargets
+        let moduleEnv = resolvedModulesEnv resolvedModules
+        pure LoadedSource
+          { loadedImports = moduleEnv
+          , loadedAst = nonImports
+          , loadedModules = resolvedModules
+          }
+
+ensureWorkspaceModule :: LoadContext -> String -> IO ()
+ensureWorkspaceModule ctx moduleTarget = do
+  existing <- resolverAlias (loadResolver ctx) ModuleAlias (T.pack moduleTarget)
+  case existing of
+    Just _ -> return ()
+    Nothing -> do
+      mSource <- resolveSourceModulePath ctx moduleTarget
+      case (loadStore ctx, mSource) of
+        (Just store, Just sourcePath) -> buildWorkspaceModule ctx store moduleTarget sourcePath
+        _ -> return ()
+
+resolveSourceModulePath :: LoadContext -> String -> IO (Maybe FilePath)
+resolveSourceModulePath ctx moduleTarget =
+  return (lookupWorkspaceModule (loadWorkspace ctx) (T.pack moduleTarget))
+
+buildWorkspaceModule :: LoadContext -> StorePath -> String -> FilePath -> IO ()
+buildWorkspaceModule ctx store moduleName sourcePath = do
+  loaded <- loadFile' ctx sourcePath
+  let asts = loadedAst loaded
+  case loadContracts ctx of
+    EnforceContracts -> enforceWorkspaceModuleContracts store moduleName (loadedImports loaded) (loadedModules loaded) asts
+    IgnoreContracts  -> pure ()
+  let env = evalTricu (loadedImports loaded) asts
+      localNames = topLevelDefinitions asts
+      localViewExprs = topLevelDefinitionViews asts
+      localViews = case loadContracts ctx of
+        EnforceContracts
+          | Map.null localViewExprs -> pure (Right Map.empty)
+          | otherwise -> do
+              viewEnv <- evaluateFileWithContextWithStoreAndMode IgnoreContracts (Just store) Map.empty "./lib/view.tri"
+              let checkerEnv = evalTricu (Map.union viewEnv (loadedImports loaded)) asts
+              pure (resolveDefinitionViews checkerEnv localViewExprs)
+        IgnoreContracts -> pure (Right Map.empty)
+      names = if null localNames
+        then filter (/= "!result") (Map.keys env)
+        else localNames
+  localViewsResult <- localViews
+  resolvedLocalViews <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid exported View Contract annotation: ") ++)) pure localViewsResult
+  importedViews <- importedViewsFromResolvedModulesEither (getViewType store) (loadedModules loaded)
+  valueFacts <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid value-level viewFacts: ") ++)) pure (valueViewFactsFromEnv env)
+  validateValueViewFactExports moduleName names valueFacts
+  let localViewFacts = Map.map (\view -> (view, ViewChecked)) resolvedLocalViews
+      importedViewFacts = Map.fromList [(importedViewName iv, (importedViewType iv, importedViewProvenance iv)) | iv <- importedViews]
+      valueViewFacts = Map.fromList [(importedViewName iv, (importedViewType iv, importedViewProvenance iv)) | iv <- valueFacts]
+      exportViewFacts = Map.unions [localViewFacts, valueViewFacts, importedViewFacts]
+  exports <- mapM (buildExport env exportViewFacts) names
+  manifestHash <- putManifest store (ModuleManifest [] exports)
+  writeAlias store ModuleAlias (T.pack moduleName) (ObjectRef (unDomain manifestDomain) manifestHash)
   where
-    processImportPath _seen _base (_path, name, importPath) = do
-      ast <- preprocessFile' _seen _base importPath
-      pure $ map (nsDefinition (if name == "!Local" then "" else name))
-           $ filter (not . isImp) ast
-    isImp (SImport _ _) = True
-    isImp _ = False
+    buildExport env viewFacts name = case Map.lookup name env of
+      Nothing -> errorWithoutStackTrace $ "Workspace module export not found after evaluation: " ++ name
+      Just term -> do
+        let exportFact = Map.lookup name viewFacts
+            exportView = fmap fst exportFact
+            exportProvenance = fmap snd exportFact
+        rootRef <- putViewTree store (singletonViewTreeWithProvenance exportFact term)
+        viewRef <- mapM (putViewType store) exportView
+        return ModuleExport
+          { moduleExportName = T.pack name
+          , moduleExportObject = rootRef
+          , moduleExportAbi = "arboricx.abi.view-tree.v1"
+          , moduleExportView = viewRef
+          , moduleExportViewProvenance = exportProvenance
+          }
 
-makeRelativeTo :: FilePath -> FilePath -> FilePath
-makeRelativeTo f i =
-    let d = takeDirectory f
-    in normalise $ d </> i
+enforceWorkspaceModuleContracts :: StorePath -> String -> Env -> [ResolvedModule] -> [TricuAST] -> IO ()
+enforceWorkspaceModuleContracts store moduleName importEnv modules asts
+  | not (any isAnnotatedDefinition asts) = pure ()
+  | otherwise = do
+      viewEnv <- evaluateFileWithContextWithStoreAndMode IgnoreContracts (Just store) Map.empty "./lib/view.tri"
+      let checkerEnv = evalTricu (Map.union viewEnv importEnv) asts
+      imports <- importedViewsFromResolvedModulesEither (getViewType store) modules
+      valueFacts <- either (errorWithoutStackTrace . (("Workspace module " ++ show moduleName ++ " has invalid value-level viewFacts: ") ++)) pure (valueViewFactsFromEnv checkerEnv)
+      resultText <- checkProgramWithEnvAndImportedViews checkerEnv (imports ++ valueFacts) asts
+      case resultText of
+        "ok" -> pure ()
+        diagnostic -> errorWithoutStackTrace $
+          "Workspace module " ++ show moduleName ++ " failed View Contract check: " ++ diagnostic
 
-nsDefinition :: String -> TricuAST -> TricuAST
-nsDefinition "" def = def
-nsDefinition moduleName (SDef name args body)
-  | isPrefixed name = SDef name args (nsBody moduleName body)
-  | otherwise = SDef (nsVariable moduleName name)
-                        args (nsBody moduleName body)
-nsDefinition moduleName other =
-  nsBody moduleName other
+valueViewFactsFromEnv :: Env -> Either String [ImportedView]
+valueViewFactsFromEnv env = case Map.lookup "viewFacts" env of
+  Nothing -> Right []
+  Just factsTree -> do
+    facts <- context "viewFacts is not a list" (toList factsTree)
+    decoded <- forM (zip [0 :: Int ..] facts) (uncurry decodeFactAt)
+    rejectDuplicateFacts decoded
+    pure decoded
+  where
+    decodeFactAt index factTree = do
+      (nameTree, rest) <- context prefix (pairParts factTree)
+      name <- context (prefix ++ ": export name is not a string") (toString nameTree)
+      (provenanceTree, viewTree) <- context (prefixFor name ++ ": payload is not a pair") (pairParts rest)
+      provenance <- context (prefixFor name ++ ": invalid provenance") (decodeProvenance provenanceTree)
+      view <- context (prefixFor name ++ ": malformed View") (treeToViewType viewTree)
+      pure (ImportedView name view provenance)
+      where
+        prefix = "viewFacts[" ++ show index ++ "]"
+        prefixFor name = prefix ++ " for " ++ show name
 
-nsBody :: String -> TricuAST -> TricuAST
-nsBody moduleName (SVar name mhash)
-  | isPrefixed name = SVar name mhash
-  | otherwise = SVar (nsVariable moduleName name) mhash
-nsBody moduleName (SApp func arg) =
-  SApp (nsBody moduleName func) (nsBody moduleName arg)
-nsBody moduleName (SLambda args body) =
-  SLambda args (nsBodyScoped moduleName args body)
-nsBody moduleName (SList items) =
-  SList (map (nsBody moduleName) items)
-nsBody moduleName (TFork left right) =
-  TFork (nsBody moduleName left) (nsBody moduleName right)
-nsBody moduleName (TStem subtree) =
-  TStem (nsBody moduleName subtree)
-nsBody moduleName (SDef name args body) =
-  SDef (nsVariable moduleName name) args (nsBodyScoped moduleName args body)
-nsBody _ other = other
+    pairParts (Fork left right) = Right (left, right)
+    pairParts _ = Left "expected pair"
 
-nsBodyScoped :: String -> [String] -> TricuAST -> TricuAST
-nsBodyScoped moduleName args body = case body of
-  SVar name mhash ->
-    if name `elem` args
-      then SVar name mhash
-      else nsBody moduleName (SVar name mhash)
-  SApp func arg ->
-    SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
-  SLambda innerArgs innerBody ->
-    SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
-  SList items ->
-    SList (map (nsBodyScoped moduleName args) items)
-  TFork left right ->
-    TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right)
-  TStem subtree ->
-    TStem (nsBodyScoped moduleName args subtree)
-  SDef name innerArgs innerBody ->
-    SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
-  other -> other
+    decodeProvenance tree = do
+      n <- toNumber tree
+      case n of
+        0 -> Right ViewChecked
+        1 -> Right ViewTrusted
+        2 -> Right ViewUnchecked
+        _ -> Left $ "unknown provenance tag " ++ show n
 
-isPrefixed :: String -> Bool
-isPrefixed name = '.' `elem` name
+    rejectDuplicateFacts facts = go Set.empty facts
+      where
+        go _ [] = Right ()
+        go seen (fact : rest)
+          | importedViewName fact `Set.member` seen = Left $ "duplicate viewFacts entry for " ++ show (importedViewName fact)
+          | otherwise = go (Set.insert (importedViewName fact) seen) rest
 
-nsVariable :: String -> String -> String
-nsVariable "" name = name
-nsVariable moduleName name = moduleName ++ "." ++ name
+    context label = either (Left . ((label ++ ": ") ++)) Right
+
+validateValueViewFactExports :: String -> [String] -> [ImportedView] -> IO ()
+validateValueViewFactExports moduleName exportedNames facts = do
+  let exported = Set.fromList exportedNames
+      missing = [importedViewName fact | fact <- facts, importedViewName fact `Set.notMember` exported]
+  case missing of
+    [] -> pure ()
+    name : _ -> errorWithoutStackTrace $
+      "Workspace module " ++ show moduleName ++ " has value-level viewFacts for non-exported name " ++ show name
+
+isAnnotatedDefinition :: TricuAST -> Bool
+isAnnotatedDefinition SDefAnn {} = True
+isAnnotatedDefinition _ = False
+
+topLevelDefinitions :: [TricuAST] -> [String]
+topLevelDefinitions = mapMaybe go
+  where
+    go (SDef name _ _) | not (isViewFactMetadataName name) = Just name
+    go (SDefAnn name _ _ _) | not (isViewFactMetadataName name) = Just name
+    go _ = Nothing
+
+isViewFactMetadataName :: String -> Bool
+isViewFactMetadataName name = name == "viewFacts"
+
+topLevelDefinitionViews :: [TricuAST] -> Map.Map String ViewExpr
+topLevelDefinitionViews asts = Map.fromList (mapMaybe go asts)
+  where
+    go (SDefAnn name args resultView _) = Just (name, definitionView args resultView)
+    go _ = Nothing
+
+resolveDefinitionViews :: Env -> Map.Map String ViewExpr -> Either String (Map.Map String ViewType)
+resolveDefinitionViews env = mapM (resolveViewExpression env)
+
+resolveViewExpression :: Env -> ViewExpr -> Either String ViewType
+resolveViewExpression checkerEnv view = do
+  expr <- lowerViewExpr view
+  let term = evalASTSync checkerEnv (head (parseTricu expr))
+      probeEnv = Map.insert "__candidateView" term checkerEnv
+      probe = evalTricu probeEnv (parseTricu "viewContractProbe (wellFormedView? __candidateView)")
+  case toString (result probe) of
+    Right "ok" -> treeToViewType term
+    Right other -> Left $ "malformed view expression " ++ show expr ++ ": " ++ other
+    Left err -> Left $ "could not validate view expression " ++ show expr ++ ": " ++ err
+
+definitionView :: [DefArg] -> Maybe ViewExpr -> ViewExpr
+definitionView args resultView = quantifyFreeViewVars $
+  case argViews of
+    [] -> finalView
+    _  -> VEApp (VEApp (VEName "Fn") (VEList argViews)) finalView
+  where
+    argViews = map defArgView args
+    finalView = maybe exportedViewAny id resultView
+
+quantifyFreeViewVars :: ViewExpr -> ViewExpr
+quantifyFreeViewVars view =
+  let vars = Set.toList (freeViewVars view)
+      binderIds = zip vars [0..]
+      binderMap = Map.fromList binderIds
+      body = rewriteViewVars binderMap view
+      binders = map snd binderIds
+  in if null vars then view else VEForall binders body
+
+rewriteViewVars :: Map.Map String Integer -> ViewExpr -> ViewExpr
+rewriteViewVars binderMap view = case view of
+  VEVar name -> maybe (VEVar name) VEVarId (Map.lookup name binderMap)
+  VEList items -> VEList (map (rewriteViewVars binderMap) items)
+  VEApp f a -> VEApp (rewriteViewVars binderMap f) (rewriteViewVars binderMap a)
+  VEForall binders body -> VEForall binders (rewriteViewVars binderMap body)
+  VEExists binders body -> VEExists binders (rewriteViewVars binderMap body)
+  _ -> view
+
+freeViewVars :: ViewExpr -> Set.Set String
+freeViewVars view = case view of
+  VEVar name -> Set.singleton name
+  VEVarId _ -> Set.empty
+  VEList items -> Set.unions (map freeViewVars items)
+  VEApp f a -> Set.union (freeViewVars f) (freeViewVars a)
+  VEForall _ body -> freeViewVars body
+  VEExists _ body -> freeViewVars body
+  _ -> Set.empty
+
+defArgView :: DefArg -> ViewExpr
+defArgView (DefBinder _ Nothing) = exportedViewAny
+defArgView (DefBinder _ (Just ty)) = ty
+defArgView (DefPhantom ty) = ty
+
+exportedViewAny :: ViewExpr
+exportedViewAny = VEName "Any"
+
+defaultStorePath :: IO StorePath
+defaultStorePath = do
+  home <- getHomeDirectory
+  if home == "/homeless-shelter"
+    then do
+      tmp <- getTemporaryDirectory
+      return (StorePath (tmp </> "tricu" </> "store"))
+    else return (StorePath (home </> ".tricu" </> "store"))
+
+selectedExportsForImport :: Bool -> String -> String -> [TricuAST] -> Maybe (Set.Set T.Text)
+selectedExportsForImport True _ _ _ = Nothing
+selectedExportsForImport False _moduleTarget importNamespace asts =
+  Just $ Set.fromList directSelections
+  where
+    directSelections = mapMaybe select (Set.toList used)
+    used = foldMap freeVars asts
+    prefix = importNamespace ++ "."
+    select name
+      | importNamespace == "!Local" = Just (T.pack name)
+      | prefix `isPrefixOf` name = Just (T.pack (drop (length prefix) name))
+      | otherwise = Nothing
 
 -- | Compile a tricu source file to a standalone Arboricx bundle.
 -- Emits a canonical indexed bundle with no SHA-256 hashing.
 compileFile :: FilePath -> FilePath -> [T.Text] -> IO ()
-compileFile inputPath outputPath maybeNames = do
-  env <- evaluateFile inputPath
+compileFile = compileFileWithStore Nothing
+
+compileFileWithStore :: Maybe StorePath -> FilePath -> FilePath -> [T.Text] -> IO ()
+compileFileWithStore mStore inputPath outputPath maybeNames = do
+  env <- evaluateFileWithStore mStore inputPath
   let defaultNames = ["main"]
       wantedNames  = if null maybeNames then defaultNames else maybeNames
       wantedNamesUnpacked = map T.unpack wantedNames

src/IODriver.hs

@@ -8,15 +8,22 @@ module IODriver
   , runIOWith
   ) where
 
-import Research (T(..), apply, toString, toNumber, ofString, ofNumber, ofBytes, toBytes)
+import Research (T(..), apply, toString, toNumber, ofString, ofNumber, ofBytes, toBytes, ofList)
 import qualified Data.ByteString as BS
 import System.IO (putStr, getLine)
 import qualified System.IO as IO
 import Control.Exception (try, catch, IOException, SomeException)
 import System.IO.Error (isDoesNotExistError, isPermissionError, isAlreadyExistsError)
-import Data.List (isPrefixOf)
-import System.FilePath (normalise, isRelative, (</>), addTrailingPathSeparator, splitDirectories)
-import System.Directory (canonicalizePath, doesPathExist, getCurrentDirectory)
+import Data.List (isPrefixOf, isInfixOf)
+import System.FilePath (normalise, isRelative, (</>), addTrailingPathSeparator, splitDirectories, takeDirectory)
+import System.Directory (canonicalizePath, doesPathExist, getCurrentDirectory, listDirectory, createDirectory, renameFile, removeFile, doesDirectoryExist)
+import Data.Time.Clock.POSIX (getPOSIXTime)
+import Crypto.Hash (hash, SHA256, Digest)
+import Data.ByteArray (convert)
+import Data.ByteString.Base16 (encode)
+import Data.Text.Encoding (decodeUtf8)
+import qualified Data.Text as T
+import Data.Char (toLower)
 import qualified Data.Map.Strict as Map
 import Data.Map.Strict (Map)
 import qualified Data.Sequence as Seq
@@ -202,6 +209,13 @@ data Action
   | AReadFile T
   | AWriteFile T T
   | AWriteBytes T T
+  | AListDirectory T
+  | ARenameFile T T
+  | ACreateDirectory T
+  | ADeleteFile T
+  | AFileExists T
+  | ASha256Hex T
+  | ACurrentTime
   | AAsk
   | ALocal T T
   | AGet
@@ -239,6 +253,17 @@ tagReadFile = 20
 tagWriteFile = 21
 tagWriteBytes = 22
 
+tagListDirectory, tagRenameFile, tagCreateDirectory, tagDeleteFile, tagFileExists :: Integer
+tagListDirectory = 23
+tagRenameFile = 24
+tagCreateDirectory = 25
+tagDeleteFile = 26
+tagFileExists = 27
+
+tagSha256Hex, tagCurrentTime :: Integer
+tagSha256Hex = 28
+tagCurrentTime = 29
+
 tagAsk, tagLocal :: Integer
 tagAsk = 30
 tagLocal = 31
@@ -319,6 +344,29 @@ decodeAction tree =
             Fork path contents -> Right (AWriteBytes path contents)
             _ -> Left "Invalid WriteBytes: expected pair path contents"
 
+        Right n | n == tagListDirectory ->
+          Right (AListDirectory payload)
+
+        Right n | n == tagRenameFile ->
+          case payload of
+            Fork old new -> Right (ARenameFile old new)
+            _ -> Left "Invalid RenameFile: expected pair oldPath newPath"
+
+        Right n | n == tagCreateDirectory ->
+          Right (ACreateDirectory payload)
+
+        Right n | n == tagDeleteFile ->
+          Right (ADeleteFile payload)
+
+        Right n | n == tagFileExists ->
+          Right (AFileExists payload)
+
+        Right n | n == tagSha256Hex ->
+          Right (ASha256Hex payload)
+
+        Right n | n == tagCurrentTime ->
+          Right ACurrentTime
+
         Right n | n == tagAsk ->
           Right AAsk
 
@@ -481,6 +529,64 @@ stepMachine sockVar machine =
               Left _ -> finishValue machine (errResult "invalid bytes")
           Left _ -> finishValue machine (errResult "invalid string")
 
+      AListDirectory pathTree ->
+        case decodeString pathTree "ListDirectory" of
+          Right p -> do
+            mDeny <- checkReadPerm p
+            case mDeny of
+              Just denied -> finishValue machine denied
+              Nothing     -> pure (AsyncAction (tryListDirectory p) machine)
+          Left _ -> finishValue machine (errResult "invalid string")
+
+      ARenameFile oldTree newTree ->
+        case decodeString oldTree "RenameFile" of
+          Right old ->
+            case decodeString newTree "RenameFile" of
+              Right new -> do
+                mDenyOld <- checkWritePerm old
+                mDenyNew <- checkWritePerm new
+                case (mDenyOld, mDenyNew) of
+                  (Just denied, _) -> finishValue machine denied
+                  (_, Just denied) -> finishValue machine denied
+                  (Nothing, Nothing) -> pure (AsyncAction (tryRenameFile old new) machine)
+              Left _ -> finishValue machine (errResult "invalid string")
+          Left _ -> finishValue machine (errResult "invalid string")
+
+      ACreateDirectory pathTree ->
+        case decodeString pathTree "CreateDirectory" of
+          Right p -> do
+            mDeny <- checkWritePerm p
+            case mDeny of
+              Just denied -> finishValue machine denied
+              Nothing     -> pure (AsyncAction (tryCreateDirectory p) machine)
+          Left _ -> finishValue machine (errResult "invalid string")
+
+      ADeleteFile pathTree ->
+        case decodeString pathTree "DeleteFile" of
+          Right p -> do
+            mDeny <- checkWritePerm p
+            case mDeny of
+              Just denied -> finishValue machine denied
+              Nothing     -> pure (AsyncAction (tryDeleteFile p) machine)
+          Left _ -> finishValue machine (errResult "invalid string")
+
+      AFileExists pathTree ->
+        case decodeString pathTree "FileExists" of
+          Right p -> do
+            mDeny <- checkReadPerm p
+            case mDeny of
+              Just denied -> finishValue machine denied
+              Nothing     -> pure (AsyncAction (tryFileExists p) machine)
+          Left _ -> finishValue machine (errResult "invalid string")
+
+      ASha256Hex bytesTree ->
+        case decodeBytes bytesTree "Sha256Hex" of
+          Right bs -> pure (AsyncAction (pure $ trySha256Hex bs) machine)
+          Left _ -> finishValue machine (errResult "invalid bytes")
+
+      ACurrentTime ->
+        pure (AsyncAction (tryCurrentTime) machine)
+
       AAsk ->
         finishValue machine (rtEnv (machineRuntime machine))
 
@@ -818,6 +924,107 @@ stepMachine sockVar machine =
         Right () -> return $ okResult Leaf
         Left e   -> return $ errResult (ioErrorString e)
 
+    tryListDirectory path = do
+      exists <- doesPathExist path
+      if not exists
+        then return $ errResult "does not exist"
+        else do
+          isDir <- doesDirectoryExist path
+          if not isDir
+            then return $ errResult "not a directory"
+            else do
+              result <- try (listDirectory path) :: IO (Either IOException [FilePath])
+              case result of
+                Right entries ->
+                  let filtered = filter (`notElem` [".", ".."]) entries
+                  in return $ okResult (ofList (map ofString filtered))
+                Left e -> return $ errResult (ioErrorString e)
+
+    tryRenameFile old new = do
+      oldExists <- doesPathExist old
+      if not oldExists
+        then return $ errResult "does not exist"
+        else do
+          result <- try (renameFile old new) :: IO (Either IOException ())
+          case result of
+            Right () -> return $ okResult Leaf
+            Left e
+              | isDoesNotExistError e -> return $ errResult "does not exist"
+              | isPermissionError e -> return $ errResult "permission denied"
+              | "cross-device" `isInfixOf` map toLower (show e) || "exdev" `isInfixOf` map toLower (show e) ->
+                  return $ errResult "cross-device rename"
+              | otherwise -> return $ errResult (ioErrorString e)
+
+    tryCreateDirectory path = do
+      exists <- doesPathExist path
+      if exists
+        then do
+          isDir <- doesDirectoryExist path
+          if isDir
+            then return $ okResult Leaf
+            else return $ errResult "already exists"
+        else do
+          let parent = takeDirectory path
+          parentExists <- doesPathExist parent
+          if parentExists
+            then do
+              parentIsDir <- doesDirectoryExist parent
+              if parentIsDir
+                then do
+                  result <- try (createDirectory path) :: IO (Either IOException ())
+                  case result of
+                    Right () -> return $ okResult Leaf
+                    Left e
+                      | isDoesNotExistError e -> return $ errResult "does not exist"
+                      | isPermissionError e -> return $ errResult "permission denied"
+                      | isAlreadyExistsError e -> return $ errResult "already exists"
+                      | otherwise -> return $ errResult (ioErrorString e)
+                else return $ errResult "not a directory"
+            else do
+              result <- try (createDirectory path) :: IO (Either IOException ())
+              case result of
+                Right () -> return $ okResult Leaf
+                Left e
+                  | isDoesNotExistError e -> return $ errResult "does not exist"
+                  | isPermissionError e -> return $ errResult "permission denied"
+                  | isAlreadyExistsError e -> return $ errResult "already exists"
+                  | otherwise -> return $ errResult (ioErrorString e)
+
+    tryDeleteFile path = do
+      exists <- doesPathExist path
+      if not exists
+        then return $ okResult Leaf
+        else do
+          isDir <- doesDirectoryExist path
+          if isDir
+            then return $ errResult "is a directory"
+            else do
+              result <- try (removeFile path) :: IO (Either IOException ())
+              case result of
+                Right () -> return $ okResult Leaf
+                Left e
+                  | isDoesNotExistError e -> return $ okResult Leaf
+                  | isPermissionError e -> return $ errResult "permission denied"
+                  | otherwise -> return $ errResult (ioErrorString e)
+
+    tryFileExists path = do
+      result <- try (doesPathExist path) :: IO (Either IOException Bool)
+      case result of
+        Right exists -> return $ okResult (if exists then Stem Leaf else Leaf)
+        Left e
+          | isPermissionError e -> return $ errResult "permission denied"
+          | otherwise -> return $ errResult (ioErrorString e)
+
+    trySha256Hex bs =
+      let digest = hash bs :: Digest SHA256
+          hexBs = encode (convert digest)
+          hexStr = T.unpack (decodeUtf8 hexBs)
+      in okResult (ofString hexStr)
+
+    tryCurrentTime = do
+      now <- getPOSIXTime
+      return $ okResult (ofNumber (floor now))
+
     decodeString t ctx =
       case toString t of
         Right s  -> Right s

src/Lexer.hs

@@ -32,38 +32,61 @@ tricuLexer = do
   where
     tricuLexer' =
       [ try lnewline
-      , try namespace
+      , try indentMarker
       , try dot
       , try identifierWithHash
-      , try identifier
       , try keywordT
+      , try identifier
+      , try namespace
       , try integerLiteral
       , try stringLiteral
+      , try assignAt
       , assign
+      , atSign
       , colon
       , openParen
       , closeParen
       , openBracket
       , closeBracket
+      , try bindArrow
       , try arrowLeft
       , try arrowRight
       ]
 
 lexTricu :: String -> [LToken]
-lexTricu input = case runParser tricuLexer "" input of
+lexTricu input = case runParser tricuLexer "" (insertIndentMarkers input) of
   Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
   Right toks -> toks
 
+insertIndentMarkers :: String -> String
+insertIndentMarkers = go False False
+  where
+    marker n = '\v' : show n ++ " "
+
+    go _ _ [] = []
+    go inString escaped (c:cs)
+      | inString =
+          c : go (not (c == '"' && not escaped)) (c == '\\' && not escaped) cs
+      | c == '"' = c : go True False cs
+      | c == '\n' =
+          let (spaces, rest) = span (== ' ') cs
+              n = length spaces
+          in if n == 0
+               then '\n' : go False False rest
+               else '\n' : marker n ++ go False False rest
+      | c == '\t' = errorWithoutStackTrace "Tabs are not allowed for indentation; use two spaces per indent level"
+      | otherwise = c : go False False cs
+
 
 keywordT :: Lexer LToken
 keywordT = string "t" *> notFollowedBy alphaNumChar $> LKeywordT
 
 identifierWithHash :: Lexer LToken
 identifierWithHash = do
-  first <- lowerChar <|> char '_'
+  first <- letterChar <|> char '_'
   rest  <- many $ letterChar
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
-              <|> char '$'  <|> char '@' <|> char '%'
+              <|> char '$'  <|> char '%'
                         <|> char '\''
   _ <- char '#' -- Consume '#'
   hashString <- some (alphaNumChar <|> char '-') -- Ensures at least one char for hash
@@ -82,10 +105,10 @@ identifierWithHash = do
 
 identifier :: Lexer LToken
 identifier = do
-  first <- lowerChar <|> char '_'
+  first <- letterChar <|> char '_'
   rest  <- many $ letterChar
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
-              <|> char '$'  <|> char '@' <|> char '%'
+              <|> char '$'  <|> char '%'
                         <|> char '\''
   let name = first : rest
   if name == "t" || name == "!result"
@@ -93,12 +116,7 @@ identifier = do
     else return (LIdentifier name)
 
 namespace :: Lexer LToken
-namespace = do
-  name <- try (string "!Local") <|> do
-    first <- upperChar
-    rest <- many (letterChar <|> digitChar)
-    return (first:rest)
-  return (LNamespace name)
+namespace = LNamespace <$> string "!Local"
 
 dot :: Lexer LToken
 dot = char '.' $> LDot
@@ -109,12 +127,27 @@ lImport = do
   space1
   LStringLiteral path <- stringLiteral
   space1
-  LNamespace name <- namespace
+  name <- importAlias
   return (LImport path name)
 
+importAlias :: Lexer String
+importAlias = string "!Local" <|> do
+  first <- letterChar <|> char '_'
+  rest <- many (letterChar <|> digitChar <|> char '_' <|> char '-' <|> char '?' <|> char '$' <|> char '%' <|> char '\'' <|> char '.')
+  let name = first : rest
+  if name == "t" || name == "!result"
+    then fail "Keywords (`t`, `!result`) cannot be used as an import alias"
+    else pure name
+
+assignAt :: Lexer LToken
+assignAt = string "=@" $> LAssignAt
+
 assign :: Lexer LToken
 assign = char '=' $> LAssign
 
+atSign :: Lexer LToken
+atSign = char '@' $> LAt
+
 colon :: Lexer LToken
 colon = char ':' $> LColon
 
@@ -136,9 +169,18 @@ arrowLeft = string "<|" $> LArrowLeft
 arrowRight :: Lexer LToken
 arrowRight = string "|>" $> LArrowRight
 
+bindArrow :: Lexer LToken
+bindArrow = string "<-" $> LBindArrow
+
 lnewline :: Lexer LToken
 lnewline = char '\n' $> LNewline
 
+indentMarker :: Lexer LToken
+indentMarker = do
+  void (char '\v')
+  n <- some digitChar
+  pure (LIndent (read n))
+
 sc :: Lexer ()
 sc = space
   (void $ takeWhile1P (Just "space") (\c -> c == ' ' || c == '\t'))

src/Main.hs

@@ -1,18 +1,27 @@
 module Main where
 
-import ContentStore (initContentStoreWithPath, loadEnvironment, loadTerm, loadTree, resolveExportTarget)
+import Check (checkFile, checkFileWithStore, instrumentIOContinuations)
+import ContentStore
+import ContentStore.Bundle
+import Module.Manifest
 import System.Exit (die)
-import Server (runServerWithPath)
-import Eval (evalTricu, evalTricuWithStore, mainResult, result)
-import FileEval (evaluateFileWithContext, evaluateFileWithStore, compileFile)
+import Eval (evalTricu, mainResult, result)
+import FileEval
+  ( ContractMode(..)
+  , LoadedSource(..)
+  , defaultStorePath
+  , evaluateFileWithContextWithStoreAndMode
+  , evaluateFileWithStore
+  , loadFileWithStoreMode
+  , compileFileWithStore
+  )
 import IODriver (IOPermissions(..), runIO)
 import Parser (parseTricu)
 import REPL (repl)
 import Research (T, EvaluatedForm(..), Env, formatT, exportDag)
-import Wire (buildBundle, encodeBundle, importBundle, defaultExportNames, Bundle(..))
+import Wire (encodeBundle, defaultExportNames, Bundle(..))
 
 import Control.Monad (foldM, unless, when)
-import Data.Text (unpack, pack)
 import qualified Data.Text as T
 import Data.Version (showVersion)
 import Paths_tricu (version)
@@ -21,10 +30,9 @@ import Options.Applicative
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Sequence as Seq
-import Database.SQLite.Simple (Connection, close)
-
 import qualified Data.Map as Map
-import System.Environment (lookupEnv)
+import System.Directory (getHomeDirectory)
+import System.FilePath (takeBaseName, (</>))
 
 -- ---------------------------------------------------------------------------
 -- CLI argument types
@@ -32,11 +40,16 @@ import System.Environment (lookupEnv)
 
 data TricuArgs
   = Repl
+  | Check
+      { checkInput :: FilePath
+      , checkStore :: Maybe FilePath
+      }
   | Eval
       { evalFiles         :: [FilePath]
+      , evalStore         :: Maybe FilePath
       , evalFormat        :: EvaluatedForm
       , evalOutput        :: FilePath
-      , evalDb            :: Maybe FilePath
+      , evalUnchecked     :: Bool
       , evalIo            :: Bool
       , evalAllowRead     :: [FilePath]
       , evalAllowWrite    :: [FilePath]
@@ -46,25 +59,31 @@ data TricuArgs
       }
   | ArboricxCompile
       { compileInput   :: FilePath
+      , compileStore   :: Maybe FilePath
       , compileOutput  :: FilePath
       , compileNames   :: [String]
-      , compileDb      :: Maybe FilePath
       }
   | ArboricxImport
-      { importFile :: FilePath
-      , importDb   :: Maybe FilePath
+      { importFile   :: FilePath
+      , importStore  :: Maybe FilePath
+      , importModule :: Maybe String
       }
   | ArboricxExport
       { exportTargets :: [String]
+      , exportModules :: [String]
       , exportOutput  :: FilePath
       , exportNames   :: [String]
-      , exportDb      :: Maybe FilePath
+      , exportStore   :: Maybe FilePath
       , dag           :: Bool
       }
-  | ArboricxServe
-      { serveHost :: String
-      , servePort :: Int
-      , serveDb   :: Maybe FilePath
+  | StoreAliasList
+      { storeAliasKind :: AliasKind
+      , storePathOpt   :: Maybe FilePath
+      }
+  | StoreAliasGet
+      { storeAliasKind :: AliasKind
+      , storeAliasName :: String
+      , storePathOpt   :: Maybe FilePath
       }
   deriving (Show)
 
@@ -80,17 +99,35 @@ readEvaluatedForm = eitherReader $ \s -> case s of
   "ternary" -> Right Ternary
   "ascii"   -> Right Ascii
   "decode"  -> Right Decode
-  _         -> Left $ "Unknown format: " ++ s ++ ". Expected: tree, fsl, ast, ternary, ascii, decode"
+  "number"  -> Right Number
+  "string"  -> Right StringLit
+  _         -> Left $ "Unknown format: " ++ s ++ ". Expected: tree, fsl, ast, ternary, ascii, decode, number, string"
+
+checkParser :: Parser TricuArgs
+checkParser = Check
+  <$> argument str (metavar "FILE")
+  <*> optional (option str
+      ( long "store"
+     <> short 's'
+     <> metavar "PATH"
+     <> help "Content-addressed store path for module import resolution"
+      ))
 
 evalParser :: Parser TricuArgs
 evalParser = Eval
   <$> many (argument str (metavar "FILE..."))
+  <*> optional (option str
+      ( long "store"
+     <> short 's'
+     <> metavar "PATH"
+     <> help "Content-addressed store path for module import resolution"
+      ))
   <*> option readEvaluatedForm
       ( long "format"
      <> short 'f'
      <> metavar "FORM"
      <> value Tree
-     <> help "Output format: tree, fsl, ast, ternary, ascii, decode"
+     <> help "Output format: tree, fsl, ast, ternary, ascii, decode, number, string"
       )
   <*> option str
       ( long "output"
@@ -99,12 +136,10 @@ evalParser = Eval
      <> value ""
      <> help "Write output to file instead of stdout"
       )
-  <*> optional (option str
-      ( long "db"
-     <> short 'd'
-     <> metavar "PATH"
-     <> help "Content store database path"
-      ))
+  <*> switch
+      ( long "unchecked"
+     <> help "Evaluate as untyped code: ignore View Contract annotations and do not publish unchecked view refs"
+      )
   <*> switch
       ( long "io"
      <> help "Interpret the result as an IO action tree and execute it"
@@ -141,6 +176,12 @@ compileParser = ArboricxCompile
      <> value ""
      <> help "Input .tri source file"
       )
+  <*> optional (option str
+      ( long "store"
+     <> short 's'
+     <> metavar "PATH"
+     <> help "Content-addressed store path for module import resolution"
+      ))
   <*> option str
       ( long "output"
      <> short 'o'
@@ -154,12 +195,6 @@ compileParser = ArboricxCompile
      <> metavar "NAME"
      <> help "Definition name(s) to export as bundle roots (repeatable)"
       ))
-  <*> optional (option str
-      ( long "db"
-     <> short 'd'
-     <> metavar "PATH"
-     <> help "Content store database path"
-      ))
 
 importParser :: Parser TricuArgs
 importParser = ArboricxImport
@@ -171,10 +206,16 @@ importParser = ArboricxImport
      <> help "Bundle file to import"
       )
   <*> optional (option str
-      ( long "db"
-     <> short 'd'
+      ( long "store"
+     <> short 's'
      <> metavar "PATH"
-     <> help "Content store database path"
+     <> help "Content-addressed store path"
+      ))
+  <*> optional (option str
+      ( long "module"
+     <> short 'm'
+     <> metavar "NAME"
+     <> help "Module alias to create for the imported bundle (defaults to bundle file basename)"
       ))
 
 exportParser :: Parser TricuArgs
@@ -185,6 +226,12 @@ exportParser = ArboricxExport
      <> metavar "TARGET"
      <> help "Target hash or name (repeatable)"
       ))
+  <*> many (option str
+      ( long "module"
+     <> short 'm'
+     <> metavar "MODULE"
+     <> help "Module alias or manifest hash to export (repeatable; bundle export only)"
+      ))
   <*> option str
       ( long "output"
      <> short 'o'
@@ -199,37 +246,53 @@ exportParser = ArboricxExport
      <> help "Export name(s) for the bundle manifest (repeatable)"
       ))
   <*> optional (option str
-      ( long "db"
-     <> short 'd'
+      ( long "store"
+     <> short 's'
      <> metavar "PATH"
-     <> help "Content store database path"
+     <> help "Content-addressed store path"
       ))
   <*> switch
       ( long "dag"
      <> help "Export as a topologically-sorted DAG node table instead of a bundle"
       )
 
-serveParser :: Parser TricuArgs
-serveParser = ArboricxServe
-  <$> option str
-      ( long "host"
-     <> metavar "HOST"
-     <> value "127.0.0.1"
-     <> help "Host to bind the server to"
-      )
-  <*> option auto
-      ( long "port"
-     <> short 'p'
-     <> metavar "PORT"
-     <> value 8787
-     <> help "HTTP port to listen on"
-      )
-  <*> optional (option str
-      ( long "db"
-     <> short 'd'
-     <> metavar "PATH"
-     <> help "Content store database path"
-      ))
+aliasKindReader :: ReadM AliasKind
+aliasKindReader = eitherReader $ \s -> case s of
+  "names"    -> Right NameAlias
+  "name"     -> Right NameAlias
+  "modules"  -> Right ModuleAlias
+  "module"   -> Right ModuleAlias
+  "packages" -> Right PackageAlias
+  "package"  -> Right PackageAlias
+  _          -> Left "alias kind must be one of: names, modules, packages"
+
+storePathParser :: Parser (Maybe FilePath)
+storePathParser = optional (option str
+  ( long "store"
+ <> short 's'
+ <> metavar "PATH"
+ <> help "Content-addressed store path"
+  ))
+
+aliasKindParser :: Parser AliasKind
+aliasKindParser = option aliasKindReader
+  ( long "kind"
+ <> short 'k'
+ <> metavar "KIND"
+ <> value NameAlias
+ <> help "Alias kind: names, modules, packages (default: names)"
+  )
+
+storeAliasListParser :: Parser TricuArgs
+storeAliasListParser = StoreAliasList
+  <$> aliasKindParser
+  <*> storePathParser
+
+storeAliasGetParser :: Parser TricuArgs
+storeAliasGetParser = StoreAliasGet
+  <$> aliasKindParser
+  <*> argument str (metavar "NAME")
+  <*> storePathParser
 
 versionStr :: String
 versionStr = "tricu " ++ showVersion version
@@ -239,10 +302,14 @@ tricuParser = (subparser topCommands <|> pure Repl)
   <**> infoOption versionStr (long "version" <> help "Show version")
   where
     topCommands = mconcat
-      [ command "eval" (info (evalParser <**> helper)
+      [ command "check" (info (checkParser <**> helper)
+          (progDesc "Check View Contract annotations and report ok or diagnostics"))
+      , command "eval" (info (evalParser <**> helper)
           (progDesc "Evaluate tricu source and print the result of the final expression"))
       , command "arboricx" (info (arboricxParser <**> helper)
           (progDesc "Arboricx bundle operations"))
+      , command "store" (info (storeParser <**> helper)
+          (progDesc "Inspect and manage the content-addressed store"))
       ]
 
 arboricxParser :: Parser TricuArgs
@@ -253,8 +320,20 @@ arboricxParser = subparser $ mconcat
       (progDesc "Import an Arboricx bundle into the content store"))
   , command "export" (info (exportParser <**> helper)
       (progDesc "Export one or more terms from the content store"))
-  , command "serve" (info (serveParser <**> helper)
-      (progDesc "Start a read-only HTTP server for Arboricx bundles"))
+  ]
+
+storeParser :: Parser TricuArgs
+storeParser = subparser $ mconcat
+  [ command "alias" (info (storeAliasParser <**> helper)
+      (progDesc "Inspect workspace aliases"))
+  ]
+
+storeAliasParser :: Parser TricuArgs
+storeAliasParser = subparser $ mconcat
+  [ command "list" (info (storeAliasListParser <**> helper)
+      (progDesc "List aliases by kind"))
+  , command "get" (info (storeAliasGetParser <**> helper)
+      (progDesc "Resolve an alias by kind and name"))
   ]
 
 -- ---------------------------------------------------------------------------
@@ -270,11 +349,14 @@ main = do
     )
   case args of
     Repl               -> runRepl
+    Check {}           -> runCheck args
     Eval {}            -> runEval args
     ArboricxCompile {} -> runCompile args
     ArboricxImport {}  -> runImport args
     ArboricxExport {}  -> runExport args
-    ArboricxServe {}   -> runServe args
+    StoreAliasList {}  -> runStoreAliasList args
+    StoreAliasGet {}   -> runStoreAliasGet args
+
 
 -- ---------------------------------------------------------------------------
 -- Command runners
@@ -286,25 +368,40 @@ runRepl = do
   putStrLn "You may exit with `CTRL+D` or the `!exit` command."
   repl
 
+runCheck :: TricuArgs -> IO ()
+runCheck opts = do
+  output <- case checkStore opts of
+    Nothing -> checkFile (checkInput opts)
+    Just storePath -> checkFileWithStore (StorePath storePath) (checkInput opts)
+  putStrLn output
+
+evaluateCheckedIOFile :: StorePath -> ContractMode -> Env -> FilePath -> IO Env
+evaluateCheckedIOFile store mode env filePath = do
+  loaded <- loadFileWithStoreMode mode store filePath
+  checkedAst <- case instrumentIOContinuations (loadedAst loaded) of
+    Left err -> die err
+    Right asts -> pure asts
+  viewEnv <- evaluateFileWithStore (Just store) "./lib/view.tri"
+  pure $ evalTricu (Map.unions [viewEnv, loadedImports loaded, env]) checkedAst
+
 runEval :: TricuArgs -> IO ()
 runEval opts = do
   let files = evalFiles opts
       form  = evalFormat opts
       out   = evalOutput opts
-  mconn <- case evalDb opts of
-    Just dbPath -> Just <$> initContentStoreWithPath (Just dbPath)
-    Nothing     -> do
-      mDbPath <- lookupEnv "TRICU_DB_PATH"
-      case mDbPath of
-        Just _  -> Just <$> initContentStoreWithPath Nothing
-        Nothing -> return Nothing
   resultT <- case files of
     [] -> do
       input <- getContents
-      env <- evalTricuWithStore mconn Map.empty (parseTricu input)
+      let env = evalTricu Map.empty (parseTricu input)
       return $ result env
     _  -> do
-      finalEnv <- foldM (evaluateFileWithStore mconn) Map.empty files
+      mStoreOpt <- traverse (pure . StorePath) (evalStore opts)
+      let contractMode = if evalUnchecked opts then IgnoreContracts else EnforceContracts
+      finalEnv <- if evalIo opts && contractMode == EnforceContracts
+        then do
+          store <- maybe defaultStorePath pure mStoreOpt
+          foldM (evaluateCheckedIOFile store contractMode) Map.empty files
+        else foldM (evaluateFileWithContextWithStoreAndMode contractMode mStoreOpt) Map.empty files
       return $ mainResult finalEnv
   finalT <- if evalIo opts
     then do
@@ -319,9 +416,6 @@ runEval opts = do
         Left err  -> die $ "IO error: " ++ err
         Right val -> pure val
     else return resultT
-  case mconn of
-    Just conn -> close conn
-    Nothing   -> return ()
   writeOutput out (formatT form finalT)
 
 runCompile :: TricuArgs -> IO ()
@@ -329,20 +423,36 @@ runCompile opts = do
   let input = compileInput opts
       out   = compileOutput opts
       names = compileNames opts
+      mStore = StorePath <$> compileStore opts
   when (null out)   $ die "tricu arboricx compile: --output is required"
   when (null input) $ die "tricu arboricx compile: input file is required"
   let nameTexts = if null names then [] else map T.pack names
-  compileFile input out nameTexts
+  compileFileWithStore mStore input out nameTexts
 
 runImport :: TricuArgs -> IO ()
 runImport opts = do
   let file = importFile opts
   when (null file) $ die "tricu arboricx import: input file is required"
-  withContentStore (importDb opts) $ \conn -> do
-    bundleData <- BL.readFile file
-    roots <- map T.unpack <$> importBundle conn (BL.toStrict bundleData)
-    putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
-    mapM_ (\r -> putStrLn $ "  " ++ r) roots
+  store <- resolveStorePath (importStore opts)
+  bundleData <- BL.readFile file
+  roots <- unpackBundleToStore store (BL.toStrict bundleData)
+  mapM_ (\(name, root) ->
+    writeAlias store NameAlias name (treeTermRef root)) roots
+  let manifest = ModuleManifest []
+        [ ModuleExport
+            name
+            (treeTermRef root)
+            "arboricx.abi.tree.v1"
+            Nothing
+            Nothing
+        | (name, root) <- roots
+        ]
+      moduleName = T.pack $ maybe (takeBaseName file) id (importModule opts)
+  manifestHash <- putManifest store manifest
+  writeAlias store ModuleAlias moduleName (ObjectRef (unDomain manifestDomain) manifestHash)
+  putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
+  mapM_ (\(name, root) -> putStrLn $ "  " ++ T.unpack name ++ " -> " ++ T.unpack root) roots
+  putStrLn $ "Created module alias " ++ T.unpack moduleName ++ " -> " ++ T.unpack manifestHash
 
 runExport :: TricuArgs -> IO ()
 runExport opts =
@@ -353,37 +463,53 @@ runExport opts =
 runExportBundle :: TricuArgs -> IO ()
 runExportBundle opts = do
   let targets = exportTargets opts
+      modules = exportModules opts
       out     = exportOutput opts
       names   = exportNames opts
-  when (null out)     $ die "tricu arboricx export: --output is required"
-  when (null targets) $ die "tricu arboricx export: at least one --target is required"
-  withContentStore (exportDb opts) $ \conn -> do
-    terms <- mapM (\t -> do
-      (h, _) <- resolveExportTarget conn t
-      maybeTree <- loadTree conn h
-      case maybeTree of
-        Nothing -> die $ "Term not found in store: " ++ t
-        Just tree -> return tree) targets
-    let expNames = if null names
-          then defaultExportNames (length terms)
-          else map T.pack names
-    when (length expNames /= length terms) $
-      die "tricu arboricx export: number of --name values must match number of TARGETs"
-    let namedTerms = zip expNames terms
-        bundle = buildBundle namedTerms
-        bundleData = encodeBundle bundle
-    BL.writeFile out (BL.fromStrict bundleData)
-    putStrLn $ "Exported bundle with " ++ show (length namedTerms) ++ " export(s) to " ++ out
-    putStrLn $ "  nodes: " ++ show (Seq.length (bundleNodes bundle))
-    putStrLn $ "  size: " ++ show (BS.length bundleData) ++ " bytes"
+  when (null out) $ die "tricu arboricx export: --output is required"
+  when (null targets && null modules) $
+    die "tricu arboricx export: at least one --target or --module is required"
+  store <- resolveStorePath (exportStore opts)
+  targetRoots <- mapM (resolveStoreTarget store) targets
+  moduleRoots <- concat <$> mapM (resolveModuleExports store) modules
+  let targetEntries = zip (defaultExportNames (length targetRoots)) targetRoots
+      entries = targetEntries ++ moduleRoots
+      expNames = if null names then map fst entries else map T.pack names
+  when (length expNames /= length entries) $
+    die "tricu arboricx export: number of --name values must match number of exported roots"
+  bundle <- packBundleFromStore store (zip expNames (map snd entries))
+  let bundleData = encodeBundle bundle
+  BL.writeFile out (BL.fromStrict bundleData)
+  putStrLn $ "Exported bundle with " ++ show (length entries) ++ " export(s) to " ++ out
+  putStrLn $ "  nodes: " ++ show (Seq.length (bundleNodes bundle))
+  putStrLn $ "  size: " ++ show (BS.length bundleData) ++ " bytes"
+
+runStoreAliasList :: TricuArgs -> IO ()
+runStoreAliasList opts = do
+  store <- resolveStorePath (storePathOpt opts)
+  aliases <- listAliases store (storeAliasKind opts)
+  mapM_ (\(name, ref) -> putStrLn $ T.unpack name ++ " -> " ++ formatObjectRef ref) aliases
+
+runStoreAliasGet :: TricuArgs -> IO ()
+runStoreAliasGet opts = do
+  store <- resolveStorePath (storePathOpt opts)
+  mRef <- readAlias store (storeAliasKind opts) (T.pack $ storeAliasName opts)
+  case mRef of
+    Nothing  -> die $ "alias not found: " ++ storeAliasName opts
+    Just ref -> putStrLn $ storeAliasName opts ++ " -> " ++ formatObjectRef ref
 
 runExportDag :: TricuArgs -> IO ()
 runExportDag opts = do
   let targets = exportTargets opts
+      modules = exportModules opts
       out     = exportOutput opts
+  unless (null modules) $
+    die "tricu arboricx export --dag: --module is only supported for bundle export"
   case targets of
-    [target] -> withContentStore (exportDb opts) $ \conn -> do
-      maybeTerm <- loadTerm conn target
+    [target] -> do
+      store <- resolveStorePath (exportStore opts)
+      root <- resolveStoreTarget store target
+      maybeTerm <- getTreeTerm store root
       case maybeTerm of
         Nothing -> die $ "Term not found: " ++ target
         Just term -> do
@@ -395,26 +521,58 @@ runExportDag opts = do
     [] -> die "tricu arboricx export --dag: exactly one --target is required"
     _  -> die "tricu arboricx export --dag: exactly one --target is required"
 
-runServe :: TricuArgs -> IO ()
-runServe opts = do
-  let hostStr = serveHost opts
-      portNum = servePort opts
-  putStrLn $ "Starting Arboricx bundle server on " ++ hostStr ++ ":" ++ show portNum
-  putStrLn $ "  GET /bundle/hash/:hash   -- primary endpoint"
-  putStrLn $ "  GET /bundle/name/:name   -- convenience endpoint"
-  putStrLn $ "  Content-Type: application/vnd.arboricx.bundle"
-  runServerWithPath (serveDb opts) hostStr portNum
-
 -- ---------------------------------------------------------------------------
 -- Helpers
 -- ---------------------------------------------------------------------------
 
-withContentStore :: Maybe FilePath -> (Connection -> IO a) -> IO a
-withContentStore mPath act = do
-  conn <- initContentStoreWithPath mPath
-  result <- act conn
-  close conn
-  return result
+resolveStorePath :: Maybe FilePath -> IO StorePath
+resolveStorePath (Just path) = return (StorePath path)
+resolveStorePath Nothing = do
+  home <- getHomeDirectory
+  return (StorePath (home </> ".tricu" </> "store"))
+
+treeTermRef :: ObjectHash -> ObjectRef
+treeTermRef = ObjectRef (unDomain treeTermDomain)
+
+resolveStoreTarget :: StorePath -> String -> IO ObjectHash
+resolveStoreTarget store target = do
+  mAlias <- readAlias store NameAlias (T.pack target)
+  let root = maybe (T.pack target) objectRefHash mAlias
+  mTree <- getTreeTerm store root
+  case mTree of
+    Just _ -> return root
+    Nothing -> die $ "Term not found in store: " ++ target
+
+resolveModuleExports :: StorePath -> String -> IO [(T.Text, ObjectHash)]
+resolveModuleExports store moduleTarget = do
+  manifestHash <- resolveModuleManifestHash store moduleTarget
+  mManifest <- getManifest store manifestHash
+  manifest <- case mManifest of
+    Nothing -> die $ "Module manifest not found in store: " ++ moduleTarget
+    Just value -> return value
+  mapM exportEntry (moduleManifestExports manifest)
+  where
+    exportEntry ex = do
+      let ref = moduleExportObject ex
+      unless (objectRefKind ref == unDomain treeTermDomain) $
+        die $ "Unsupported module export object kind for " ++ T.unpack (moduleExportName ex) ++ ": " ++ T.unpack (objectRefKind ref)
+      mTree <- getTreeTerm store (objectRefHash ref)
+      case mTree of
+        Nothing -> die $ "Module export tree term not found: " ++ T.unpack (moduleExportName ex)
+        Just _  -> return (moduleExportName ex, objectRefHash ref)
+
+resolveModuleManifestHash :: StorePath -> String -> IO ObjectHash
+resolveModuleManifestHash store moduleTarget = do
+  mAlias <- readAlias store ModuleAlias (T.pack moduleTarget)
+  case mAlias of
+    Just ref -> do
+      unless (objectRefKind ref == unDomain manifestDomain) $
+        die $ "Module alias does not point at a module manifest: " ++ moduleTarget
+      return (objectRefHash ref)
+    Nothing -> return (T.pack moduleTarget)
+
+formatObjectRef :: ObjectRef -> String
+formatObjectRef ref = T.unpack (objectRefKind ref) ++ " " ++ T.unpack (objectRefHash ref)
 
 writeOutput :: FilePath -> String -> IO ()
 writeOutput path content

src/Module/Manifest.hs

@@ -0,0 +1,166 @@
+module Module.Manifest
+  ( ModuleManifest(..)
+  , ModuleReference(..)
+  , ModuleExport(..)
+  , manifestDomain
+  , encodeManifest
+  , decodeManifest
+  , putManifest
+  , getManifest
+  ) where
+
+import ContentStore.Filesystem (getObject, putObject)
+import ContentStore.Object
+import ContentStore.Alias (ObjectRef(..))
+import Research (ViewProvenance(..))
+
+import Data.ByteString (ByteString)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+
+import qualified Data.Text as Text
+
+-- | Immutable module artifact. Names are export labels inside this manifest;
+-- content identity is carried by object references and the manifest CAS hash.
+data ModuleManifest = ModuleManifest
+  { moduleManifestReferences :: [ModuleReference]
+  , moduleManifestExports    :: [ModuleExport]
+  } deriving (Eq, Ord, Show)
+
+-- | Direct content-addressed reference needed to understand, fetch, or audit
+-- this manifest. The alias is human-facing metadata for diagnostics/workspace
+-- presentation; the referenced object is the portable identity. These are not
+-- source-language imports.
+data ModuleReference = ModuleReference
+  { moduleReferenceAlias :: Text
+  , moduleReferenceRef   :: ObjectRef
+  } deriving (Eq, Ord, Show)
+
+-- | Exported executable artifact plus optional direct View Contract type.
+data ModuleExport = ModuleExport
+  { moduleExportName           :: Text
+  , moduleExportObject         :: ObjectRef
+  , moduleExportAbi            :: Text
+  , moduleExportView           :: Maybe ObjectRef
+  , moduleExportViewProvenance :: Maybe ViewProvenance
+  } deriving (Eq, Ord, Show)
+
+manifestDomain :: Domain
+manifestDomain = Domain "arboricx.module-manifest.v1"
+
+encodeManifest :: ModuleManifest -> ByteString
+encodeManifest manifest = encodeUtf8 $ Text.unlines $
+  ["arboricx.module-manifest.v1"]
+  ++ map encodeReference (moduleManifestReferences manifest)
+  ++ map encodeExport (moduleManifestExports manifest)
+  where
+    encodeReference ref = Text.intercalate "\t"
+      [ "reference"
+      , esc (moduleReferenceAlias ref)
+      , esc (objectRefKind $ moduleReferenceRef ref)
+      , esc (objectRefHash $ moduleReferenceRef ref)
+      ]
+    encodeExport ex = Text.intercalate "\t"
+      [ "export"
+      , esc (moduleExportName ex)
+      , esc (objectRefKind $ moduleExportObject ex)
+      , esc (objectRefHash $ moduleExportObject ex)
+      , esc (moduleExportAbi ex)
+      , maybe "-" (esc . objectRefKind) (moduleExportView ex)
+      , maybe "-" (esc . objectRefHash) (moduleExportView ex)
+      , maybe "-" encodeProvenance (moduleExportViewProvenance ex)
+      ]
+
+-- | Parse the canonical manifest encoding.
+decodeManifest :: ByteString -> Either String ModuleManifest
+decodeManifest bs = do
+  txt <- either (Left . show) Right (decodeUtf8' bs)
+  case Text.lines txt of
+    [] -> Left "empty module manifest"
+    header : rows
+      | header /= "arboricx.module-manifest.v1" -> Left "unsupported module manifest version"
+      | otherwise -> foldl step (Right (ModuleManifest [] [])) rows
+  where
+    step acc line = do
+      manifest <- acc
+      case Text.splitOn "\t" line of
+        ["reference", alias, kind, hash] -> do
+          ref <- ModuleReference <$> unesc alias <*> (ObjectRef <$> unesc kind <*> unesc hash)
+          Right manifest { moduleManifestReferences = moduleManifestReferences manifest ++ [ref] }
+        ["export", name, kind, hash, abi, viewKind, viewHash] -> do
+          -- Legacy manifests predate explicit View Contract provenance. Keep
+          -- the decoded field absent; checker import code treats absent
+          -- provenance as ViewUnchecked/Assumed at the use boundary.
+          view <- optionalRef viewKind viewHash
+          ex <- ModuleExport
+            <$> unesc name
+            <*> (ObjectRef <$> unesc kind <*> unesc hash)
+            <*> unesc abi
+            <*> pure view
+            <*> pure Nothing
+          Right manifest { moduleManifestExports = moduleManifestExports manifest ++ [ex] }
+        ["export", name, kind, hash, abi, viewKind, viewHash, provenanceText] -> do
+          view <- optionalRef viewKind viewHash
+          provenance <- optionalProvenance provenanceText
+          ex <- ModuleExport
+            <$> unesc name
+            <*> (ObjectRef <$> unesc kind <*> unesc hash)
+            <*> unesc abi
+            <*> pure view
+            <*> pure provenance
+          Right manifest { moduleManifestExports = moduleManifestExports manifest ++ [ex] }
+        _ -> Left $ "invalid module manifest row: " ++ Text.unpack line
+
+putManifest :: StorePath -> ModuleManifest -> IO ObjectHash
+putManifest store = putObject store manifestDomain . encodeManifest
+
+getManifest :: StorePath -> ObjectHash -> IO (Maybe ModuleManifest)
+getManifest store h = do
+  mBytes <- getObject store h
+  case mBytes of
+    Nothing -> return Nothing
+    Just bytes -> case decodeManifest bytes of
+      Left err -> fail $ "invalid module manifest " ++ Text.unpack h ++ ": " ++ err
+      Right manifest -> return (Just manifest)
+
+optionalRef :: Text -> Text -> Either String (Maybe ObjectRef)
+optionalRef "-" "-" = Right Nothing
+optionalRef kind hash = Just <$> (ObjectRef <$> unesc kind <*> unesc hash)
+
+encodeProvenance :: ViewProvenance -> Text
+encodeProvenance ViewChecked = "checked"
+encodeProvenance ViewTrusted = "trusted"
+encodeProvenance ViewUnchecked = "unchecked"
+
+optionalProvenance :: Text -> Either String (Maybe ViewProvenance)
+optionalProvenance "-" = Right Nothing
+optionalProvenance "checked" = Right (Just ViewChecked)
+optionalProvenance "trusted" = Right (Just ViewTrusted)
+optionalProvenance "unchecked" = Right (Just ViewUnchecked)
+optionalProvenance other = Left $ "invalid View Contract provenance: " ++ Text.unpack other
+
+esc :: Text -> Text
+esc = Text.concatMap $ \c -> case c of
+  '%'  -> "%25"
+  '\t' -> "%09"
+  '\n' -> "%0A"
+  '\r' -> "%0D"
+  _    -> Text.singleton c
+
+unesc :: Text -> Either String Text
+unesc txt = go txt ""
+  where
+    go rest acc = case Text.uncons rest of
+      Nothing -> Right acc
+      Just ('%', xs) ->
+        let (code, tail') = Text.splitAt 2 xs
+            decoded = case code of
+              "25" -> Just "%"
+              "09" -> Just "\t"
+              "0A" -> Just "\n"
+              "0D" -> Just "\r"
+              _    -> Nothing
+        in case decoded of
+          Nothing -> Left $ "invalid percent escape: %" ++ Text.unpack code
+          Just c  -> go tail' (acc <> c)
+      Just (c, xs) -> go xs (acc <> Text.singleton c)

src/Module/Resolver.hs

@@ -0,0 +1,155 @@
+module Module.Resolver
+  ( ResolvedExport(..)
+  , ResolvedModule(..)
+  , resolveModuleImport
+  , resolveModuleImportSelecting
+  , resolveModuleImports
+  , resolvedModulesEnv
+  ) where
+
+import ContentStore.Alias
+import ContentStore.Arboricx (decodeTreeTerm, treeTermDomain)
+import ContentStore.ViewTree (decodeViewTree, viewTreeKind, viewTreeRootTerm)
+import ContentStore.Object
+import ContentStore.Resolver
+import Module.Manifest
+import Research
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+
+-- | A manifest export resolved into the importing source's local lexical scope.
+-- The executable term is loaded, while object/view refs remain available for
+-- later checker and diagnostics phases.
+data ResolvedExport = ResolvedExport
+  { resolvedExportSourceName :: T.Text
+  , resolvedExportLocalName  :: String
+  , resolvedExportObject     :: ObjectRef
+  , resolvedExportAbi        :: T.Text
+  , resolvedExportView       :: Maybe ObjectRef
+  , resolvedExportProvenance :: Maybe ViewProvenance
+  , resolvedExportTerm       :: T
+  } deriving (Show, Eq)
+
+data ResolvedModule = ResolvedModule
+  { resolvedModuleTarget    :: String
+  , resolvedModuleNamespace :: String
+  , resolvedModuleManifest  :: ObjectHash
+  , resolvedModuleExports   :: [ResolvedExport]
+  } deriving (Show, Eq)
+
+resolveModuleImports :: ObjectResolver -> [TricuAST] -> IO ([ResolvedModule], [TricuAST])
+resolveModuleImports resolver asts = do
+  let (imports, nonImports) = foldr splitImport ([], []) asts
+  modules <- mapM (uncurry (resolveModuleImport resolver)) imports
+  return (modules, nonImports)
+  where
+    splitImport (SImport target namespace) (is, rest) = ((target, namespace) : is, rest)
+    splitImport ast (is, rest) = (is, ast : rest)
+
+resolveModuleImport :: ObjectResolver -> String -> String -> IO ResolvedModule
+resolveModuleImport resolver moduleTarget namespace =
+  resolveModuleImportSelecting resolver Nothing moduleTarget namespace
+
+resolveModuleImportSelecting :: ObjectResolver -> Maybe (Set.Set T.Text) -> String -> String -> IO ResolvedModule
+resolveModuleImportSelecting resolver selected moduleTarget namespace = do
+  manifestHash <- resolveModuleManifestHash resolver moduleTarget
+  mManifest <- resolveManifest resolver manifestHash
+  manifest <- case mManifest of
+    Nothing -> errorWithoutStackTrace $
+      "Module import failed for " ++ show moduleTarget
+      ++ " as " ++ show namespace
+      ++ ": manifest object not found (kind " ++ T.unpack (unDomain manifestDomain)
+      ++ ", hash " ++ T.unpack manifestHash ++ ")"
+    Just value -> return value
+  let wantedExports = case selected of
+        Nothing -> moduleManifestExports manifest
+        Just names -> filter (\ex -> moduleExportName ex `Set.member` names) (moduleManifestExports manifest)
+  exports <- mapM (resolveModuleExport resolver localNamespace) wantedExports
+  return ResolvedModule
+    { resolvedModuleTarget = moduleTarget
+    , resolvedModuleNamespace = namespace
+    , resolvedModuleManifest = manifestHash
+    , resolvedModuleExports = exports
+    }
+  where
+    localNamespace = if namespace == "!Local" then "" else namespace
+
+resolveModuleExport :: ObjectResolver -> String -> ModuleExport -> IO ResolvedExport
+resolveModuleExport resolver namespace ex = do
+  let ref = moduleExportObject ex
+      sourceName = moduleExportName ex
+  term <- resolveExportTerm resolver sourceName ref
+  return ResolvedExport
+        { resolvedExportSourceName = sourceName
+        , resolvedExportLocalName = nsVariable namespace (T.unpack sourceName)
+        , resolvedExportObject = ref
+        , resolvedExportAbi = moduleExportAbi ex
+        , resolvedExportView = moduleExportView ex
+        , resolvedExportProvenance = moduleExportViewProvenance ex
+        , resolvedExportTerm = term
+        }
+
+resolveExportTerm :: ObjectResolver -> T.Text -> ObjectRef -> IO T
+resolveExportTerm resolver sourceName ref
+  | objectRefKind ref == viewTreeKind = do
+      bytes <- requireObject "view tree"
+      case decodeViewTree bytes >>= viewTreeRootTerm of
+        Left err -> errorWithoutStackTrace $
+          "Module export " ++ show (T.unpack sourceName)
+          ++ " references invalid view tree " ++ T.unpack (objectRefHash ref)
+          ++ ": " ++ err
+        Right term -> return term
+  | objectRefKind ref == unDomain treeTermDomain = do
+      bytes <- requireObject "tree term"
+      case decodeTreeTerm bytes of
+        Left err -> errorWithoutStackTrace $
+          "Module export " ++ show (T.unpack sourceName)
+          ++ " references invalid tree term " ++ T.unpack (objectRefHash ref)
+          ++ ": " ++ err
+        Right term -> return term
+  | otherwise = errorWithoutStackTrace $
+      "Module export " ++ show (T.unpack sourceName)
+      ++ " has unsupported object kind " ++ show (T.unpack (objectRefKind ref))
+      ++ "; expected " ++ show (T.unpack viewTreeKind)
+      ++ " or " ++ show (T.unpack (unDomain treeTermDomain))
+  where
+    requireObject label = do
+      mBytes <- resolverObject resolver ref
+      case mBytes of
+        Just bytes -> return bytes
+        Nothing -> errorWithoutStackTrace $
+          "Module export " ++ show (T.unpack sourceName)
+          ++ " references missing " ++ label ++ " " ++ T.unpack (objectRefHash ref)
+          ++ " (kind " ++ T.unpack (objectRefKind ref) ++ ")"
+
+resolvedModulesEnv :: [ResolvedModule] -> Env
+resolvedModulesEnv modules = Map.fromList
+  [ (resolvedExportLocalName ex, resolvedExportTerm ex)
+  | m <- modules
+  , ex <- resolvedModuleExports m
+  ]
+
+resolveModuleManifestHash :: ObjectResolver -> String -> IO ObjectHash
+resolveModuleManifestHash resolver moduleTarget = do
+  mAlias <- resolverAlias resolver ModuleAlias (T.pack moduleTarget)
+  case mAlias of
+    Just ref ->
+      if objectRefKind ref == unDomain manifestDomain
+        then return (objectRefHash ref)
+        else errorWithoutStackTrace $
+          "Module alias " ++ show moduleTarget
+          ++ " points at unsupported object kind " ++ show (T.unpack (objectRefKind ref))
+          ++ "; expected " ++ show (T.unpack (unDomain manifestDomain))
+          ++ " (hash " ++ T.unpack (objectRefHash ref) ++ ")"
+    Nothing ->
+      case textToHashBytes (T.pack moduleTarget) of
+        Right _ -> return (T.pack moduleTarget)
+        Left _ -> errorWithoutStackTrace $
+          "Module alias not found: " ++ show moduleTarget
+          ++ "; add it to tricu.workspace or write a ModuleAlias, or import by manifest hash"
+
+nsVariable :: String -> String -> String
+nsVariable "" name = name
+nsVariable moduleName name = moduleName ++ "." ++ name

src/Module/Workspace.hs

@@ -0,0 +1,66 @@
+module Module.Workspace
+  ( Workspace(..)
+  , emptyWorkspace
+  , lookupWorkspaceModule
+  , findWorkspaceFor
+  , parseWorkspace
+  ) where
+
+import Data.Char (isSpace)
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import System.Directory (doesDirectoryExist, doesFileExist)
+import System.FilePath (takeDirectory, (</>))
+
+data Workspace = Workspace
+  { workspaceRoot    :: FilePath
+  , workspaceModules :: Map.Map T.Text FilePath
+  } deriving (Show, Eq)
+
+emptyWorkspace :: Workspace
+emptyWorkspace = Workspace "" Map.empty
+
+lookupWorkspaceModule :: Workspace -> T.Text -> Maybe FilePath
+lookupWorkspaceModule (Workspace root modules) name = (root </>) <$> Map.lookup name modules
+
+findWorkspaceFor :: FilePath -> IO Workspace
+findWorkspaceFor sourcePath = search (takeDirectory sourcePath)
+  where
+    search dir = do
+      let path = dir </> "tricu.workspace"
+      exists <- doesFileExist path
+      if exists
+        then parseWorkspaceAt dir <$> readFile path
+        else do
+          let parent = takeDirectory dir
+          if parent == dir
+            then return emptyWorkspace
+            else do
+              parentExists <- doesDirectoryExist parent
+              if parentExists then search parent else return emptyWorkspace
+
+parseWorkspace :: String -> Workspace
+parseWorkspace = parseWorkspaceAt ""
+
+parseWorkspaceAt :: FilePath -> String -> Workspace
+parseWorkspaceAt root input = Workspace root $ Map.fromList
+  [ (T.pack name, path)
+  | raw <- lines input
+  , Just (name, path) <- [parseLine raw]
+  ]
+
+parseLine :: String -> Maybe (String, FilePath)
+parseLine raw =
+  let line = trim (takeWhile (/= '#') raw)
+  in case words line of
+    [] -> Nothing
+    ["module", name, "=", path] -> Just (name, stripQuotes path)
+    _ -> Nothing
+
+trim :: String -> String
+trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse
+
+stripQuotes :: String -> String
+stripQuotes s = case s of
+  ('"':rest) | not (null rest) && last rest == '"' -> init rest
+  _ -> s

src/Parser.hs

@@ -16,7 +16,7 @@ data Context = Top | Nested
   deriving (Eq, Show)
 
 reservedNames :: Set.Set String
-reservedNames = Set.fromList ["t", "!result"]
+reservedNames = Set.fromList ["t", "!result", "let", "in", "where", "do"]
 
 parseTricu :: String -> [TricuAST]
 parseTricu input =
@@ -69,17 +69,144 @@ manyItemsP = do
 topItemP :: TokParser TricuAST
 topItemP = do
   toks <- getInput
+  case definitionHeadTop toks of
+    Just _  -> definitionP
+    Nothing -> exprTopP
+
+definitionHeadTop :: [LToken] -> Maybe (String, [String])
+definitionHeadTop toks =
   case toks of
-    LIdentifier _ : LAssign : _ -> definitionP
-    _                           -> exprTopP
+    LIdentifier name : rest
+      | name `Set.notMember` reservedNames
+      , definitionAssignOnLine rest -> Just (name, [])
+    _ -> Nothing
+
+-- A top-level definition head is any identifier-led line containing `=` or `=@`.
+-- Detailed validation happens in definitionP.
+definitionAssignOnLine :: [LToken] -> Bool
+definitionAssignOnLine [] = False
+definitionAssignOnLine (LNewline : _) = False
+definitionAssignOnLine (LAssign : _) = True
+definitionAssignOnLine (LAssignAt : _) = True
+definitionAssignOnLine (LIdentifier "where" : _) = False
+definitionAssignOnLine (LIdentifier "in" : _) = False
+definitionAssignOnLine (_ : rest) = definitionAssignOnLine rest
 
 definitionP :: TokParser TricuAST
 definitionP = do
   name <- identifierNameP
-  void (tok (== LAssign) "=")
-  skipNestedNewlines
-  body <- exprTopP
-  pure (SDef name [] body)
+  (args, annotated) <- definitionArgsP False
+  ret <- optional returnAnnotationP
+  bodyIndent <- skipNestedNewlinesGetIndent
+  body <- exprAtIndentP bodyIndent
+  if annotated || ret /= Nothing
+    then pure (SDefAnn name args ret body)
+    else pure (SDef name (binderNames args) body)
+
+binderNames :: [DefArg] -> [String]
+binderNames [] = []
+binderNames (DefBinder name _ : rest) = name : binderNames rest
+binderNames (DefPhantom _ : rest) = binderNames rest
+
+definitionArgsP :: Bool -> TokParser ([DefArg], Bool)
+definitionArgsP seenPhantom = do
+  mt <- peekP
+  case mt of
+    Just LAssign -> do
+      void (tok (== LAssign) "=")
+      pure ([], False)
+    Just LAssignAt -> pure ([], False)
+    Just (LIdentifier _) | not seenPhantom -> do
+      name <- identifierNameP
+      mAnn <- optional (try (tok (== LAt) "@" *> annotationTypeP))
+      (rest, ann) <- definitionArgsP seenPhantom
+      pure (DefBinder name mAnn : rest, ann || mAnn /= Nothing)
+    Just LAt -> do
+      void (tok (== LAt) "@")
+      ty <- annotationTypeP
+      (rest, ann) <- definitionArgsP True
+      pure (DefPhantom ty : rest, True || ann)
+    Just (LIdentifier _) -> fail "named binders cannot appear after phantom type annotations"
+    _ -> fail "expected definition argument or assignment"
+
+returnAnnotationP :: TokParser ViewExpr
+returnAnnotationP = do
+  void (tok (== LAssignAt) "=@")
+  annotationTypeP
+
+annotationTypeP :: TokParser ViewExpr
+annotationTypeP =
+      atomicTypeP
+  <|> parenTypeP
+
+parenTypeP :: TokParser ViewExpr
+parenTypeP = do
+  void (tok (== LOpenParen) "(")
+  ty <- typeP
+  void (tok (== LCloseParen) ")")
+  pure ty
+
+typeP :: TokParser ViewExpr
+typeP = appTypeP
+
+appTypeP :: TokParser ViewExpr
+appTypeP = do
+  first <- typeAtomP
+  rest <- many typeAtomP
+  pure (foldl VEApp first rest)
+
+typeAtomP :: TokParser ViewExpr
+typeAtomP =
+      typeListP
+  <|> typeStringP
+  <|> typeIntP
+  <|> atomicTypeP
+  <|> parenTypeP
+
+typeListP :: TokParser ViewExpr
+typeListP = do
+  void (tok (== LOpenBracket) "[")
+  args <- many typeP
+  void (tok (== LCloseBracket) "]")
+  pure (VEList args)
+
+typeIntP :: TokParser ViewExpr
+typeIntP = do
+  n <- tok isInt "integer"
+  case n of
+    LIntegerLiteral i -> pure (VEInt (fromIntegral i))
+    _                 -> fail "internal parser error: expected integer"
+  where
+    isInt (LIntegerLiteral _) = True
+    isInt _                   = False
+
+typeStringP :: TokParser ViewExpr
+typeStringP = do
+  s <- tok isString "string"
+  case s of
+    LStringLiteral value -> pure (VEString value)
+    _                    -> fail "internal parser error: expected string"
+  where
+    isString (LStringLiteral _) = True
+    isString _                  = False
+
+atomicTypeP :: TokParser ViewExpr
+atomicTypeP = do
+  t <- tok isTypeName "type name"
+  case t of
+    LNamespace name -> pure (VEName name)
+    LIdentifier name
+      | isViewVarName name -> pure (VEVar name)
+      | otherwise -> pure (VEName name)
+    _ -> fail "internal parser error: expected type name"
+  where
+    isViewVarName ('_' : rest) = not (null rest)
+    isViewVarName _ = False
+
+isTypeName :: LToken -> Bool
+isTypeName (LNamespace _) = True
+isTypeName (LIdentifier _) = True
+isTypeName _ = False
 
 importP :: TokParser TricuAST
 importP = do
@@ -96,7 +223,7 @@ exprTopP = do
   toks <- getInput
   case lambdaHeadTop toks of
     Just params -> lambdaP Top params
-    Nothing     -> pipeTopP
+    Nothing     -> whereChainP pipeTopP
 
 exprNestedP :: TokParser TricuAST
 exprNestedP = do
@@ -104,7 +231,14 @@ exprNestedP = do
   toks <- getInput
   case lambdaHeadNested toks of
     Just params -> lambdaP Nested params
-    Nothing     -> pipeNestedP
+    Nothing     -> whereChainP pipeNestedP
+
+exprAtIndentP :: Int -> TokParser TricuAST
+exprAtIndentP n = do
+  toks <- getInput
+  case lambdaHeadTop toks of
+    Just params -> lambdaP Top params
+    Nothing     -> whereChainP (pipeAtIndentP n)
 
 lambdaP :: Context -> [String] -> TokParser TricuAST
 lambdaP ctx params = do
@@ -130,15 +264,17 @@ lambdaHeadNested toks =
     _ -> Nothing
 
 collectIdentifiersNoNewlines :: [LToken] -> ([String], [LToken])
-collectIdentifiersNoNewlines (LIdentifier name : rest) =
-  let (names, final) = collectIdentifiersNoNewlines rest
-  in (name : names, final)
+collectIdentifiersNoNewlines (LIdentifier name : rest)
+  | name `Set.notMember` reservedNames =
+      let (names, final) = collectIdentifiersNoNewlines rest
+      in (name : names, final)
 collectIdentifiersNoNewlines rest = ([], rest)
 
 collectIdentifiersWithNewlines :: [LToken] -> ([String], [LToken])
-collectIdentifiersWithNewlines (LIdentifier name : rest) =
-  let (names, final) = collectIdentifiersWithNewlines (dropNewlines rest)
-  in (name : names, final)
+collectIdentifiersWithNewlines (LIdentifier name : rest)
+  | name `Set.notMember` reservedNames =
+      let (names, final) = collectIdentifiersWithNewlines (dropNewlines rest)
+      in (name : names, final)
 collectIdentifiersWithNewlines rest = ([], rest)
 
 consumeLambdaHead :: Context -> [String] -> TokParser ()
@@ -174,7 +310,11 @@ applyPipe acc (PipeForward, rhs) =
 
 pipeTopP :: TokParser TricuAST
 pipeTopP =
-  pipeChainP appTopP appNestedP
+  pipeAtIndentP 0
+
+pipeAtIndentP :: Int -> TokParser TricuAST
+pipeAtIndentP n =
+  pipeChainP (appAtIndentP n) (appAtIndentP n)
 
 pipeNestedP :: TokParser TricuAST
 pipeNestedP =
@@ -199,18 +339,52 @@ pipeOpP =
   <|> (tok (== LArrowRight) "|>" *> pure PipeForward)
 
 appTopP :: TokParser TricuAST
-appTopP = do
-  first <- atomTopP
-  appRestTopP first
+appTopP = appAtIndentP 0
 
-appRestTopP :: TricuAST -> TokParser TricuAST
-appRestTopP acc = do
-  mt <- peekP
-  case mt of
-    Just t | startsAtom t -> do
+appAtIndentP :: Int -> TokParser TricuAST
+appAtIndentP n = do
+  first <- atomTopP
+  appRestAtIndentP n first
+
+appRestAtIndentP :: Int -> TricuAST -> TokParser TricuAST
+appRestAtIndentP currentIndent acc = do
+  toks <- getInput
+  let shouldContinue = case toks of
+        LNewline : LIndent n : rest
+          | currentIndent > 0
+          , n > currentIndent
+          , not (isIndentedTerminator rest)
+          , Just t <- firstNonLayout rest -> startsAtom t && not (isExprTerminator t)
+        _ -> False
+  if shouldContinue
+    then do
+      indentedNewlineP
       arg <- atomTopP
-      appRestTopP (SApp acc arg)
-    _ -> pure acc
+      appRestAtIndentP currentIndent (SApp acc arg)
+    else do
+      mt <- peekP
+      case mt of
+        Just t | startsAtom t && not (isExprTerminator t) -> do
+          arg <- atomTopP
+          appRestAtIndentP currentIndent (SApp acc arg)
+        _ -> pure acc
+
+isIndentedTerminator :: [LToken] -> Bool
+isIndentedTerminator toks =
+  case dropLayout toks of
+    LIdentifier "where" : _ -> True
+    rest                    -> definitionHeadTop rest /= Nothing
+
+firstNonLayout :: [LToken] -> Maybe LToken
+firstNonLayout toks =
+  case dropLayout toks of
+    []    -> Nothing
+    x : _ -> Just x
+
+dropLayout :: [LToken] -> [LToken]
+dropLayout (LNewline : rest)  = dropLayout rest
+dropLayout (LIndent _ : rest) = dropLayout rest
+dropLayout rest               = rest
 
 appNestedP :: TokParser TricuAST
 appNestedP = do
@@ -222,7 +396,7 @@ appRestNestedP acc = do
   skipNestedNewlines
   mt <- peekP
   case mt of
-    Just t | startsAtom t -> do
+    Just t | startsAtom t && not (isExprTerminator t) -> do
       arg <- atomNestedP
       appRestNestedP (SApp acc arg)
     _ -> pure acc
@@ -238,19 +412,29 @@ startsAtom (LIntegerLiteral _)       = True
 startsAtom (LStringLiteral _)        = True
 startsAtom _                         = False
 
+isExprTerminator :: LToken -> Bool
+isExprTerminator (LIdentifier "in")    = True
+isExprTerminator (LIdentifier "where") = True
+isExprTerminator _                      = False
+
 atomTopP :: TokParser TricuAST
 atomTopP = do
   toks <- getInput
   case toks of
-    LOpenParen : _              -> groupedP
-    LOpenBracket : _            -> listP
-    LNamespace _ : LDot : _     -> namespacedVarP
-    LIdentifier _ : _           -> plainVarP
-    LIdentifierWithHash _ _ : _ -> plainVarP
-    LKeywordT : _               -> leafP
-    LIntegerLiteral _ : _       -> intP
-    LStringLiteral _ : _        -> strP
-    _                           -> fail "expected expression atom"
+    LOpenParen : _                 -> groupedP
+    LOpenBracket : _               -> listP
+    LIdentifier _ : LDot : _       -> namespacedVarP
+    LNamespace _ : LDot : _        -> namespacedVarP
+    LIdentifier "let" : _          -> letP
+    LIdentifier "do" : _           -> doP
+    LIdentifier name : _
+      | name == "in" || name == "where" -> fail ("unexpected reserved word: " ++ name)
+      | otherwise                        -> plainVarP
+    LIdentifierWithHash _ _ : _    -> plainVarP
+    LKeywordT : _                  -> leafP
+    LIntegerLiteral _ : _          -> intP
+    LStringLiteral _ : _           -> strP
+    _                              -> fail "expected expression atom"
 
 atomNestedP :: TokParser TricuAST
 atomNestedP = skipNestedNewlines *> atomTopP
@@ -289,15 +473,119 @@ listElementP :: TokParser TricuAST
 listElementP = do
   toks <- getInput
   case toks of
-    LOpenParen : _              -> groupedP
-    LOpenBracket : _            -> listP
-    LNamespace _ : LDot : _     -> namespacedVarP
-    LIdentifier _ : _           -> plainVarP
-    LIdentifierWithHash _ _ : _ -> plainVarP
-    LKeywordT : _               -> leafP
-    LIntegerLiteral _ : _       -> intP
-    LStringLiteral _ : _        -> strP
-    _                           -> fail "expected list element"
+    LOpenParen : _                 -> groupedP
+    LOpenBracket : _               -> listP
+    LIdentifier _ : LDot : _       -> namespacedVarP
+    LNamespace _ : LDot : _        -> namespacedVarP
+    LIdentifier "let" : _          -> letP
+    LIdentifier "do" : _           -> doP
+    LIdentifier name : _
+      | name == "in" || name == "where" -> fail ("unexpected reserved word: " ++ name)
+      | otherwise                        -> plainVarP
+    LIdentifierWithHash _ _ : _    -> plainVarP
+    LKeywordT : _                  -> leafP
+    LIntegerLiteral _ : _          -> intP
+    LStringLiteral _ : _           -> strP
+    _                              -> fail "expected list element"
+
+whereChainP :: TokParser TricuAST -> TokParser TricuAST
+whereChainP parseBody = do
+  body <- parseBody
+  mWhere <- optional (try whereBindingP)
+  case mWhere of
+    Nothing -> pure body
+    Just (name, args, value) ->
+      let boundValue = foldr (\p acc -> SLambda [p] acc) value args
+      in pure (SApp (SLambda [name] body) boundValue)
+
+whereBindingP :: TokParser (String, [String], TricuAST)
+whereBindingP = do
+  skipNestedNewlines
+  void (keywordIdentifierP "where")
+  skipNestedNewlines
+  name <- identifierNameP
+  args <- many identifierNameP
+  void (tok (== LAssign) "=")
+  valueIndent <- skipNestedNewlinesGetIndent
+  value <- exprAtIndentP valueIndent
+  pure (name, args, value)
+
+letP :: TokParser TricuAST
+letP = do
+  void (keywordIdentifierP "let")
+  skipNestedNewlines
+  name <- identifierNameP
+  args <- many identifierNameP
+  void (tok (== LAssign) "=")
+  valueIndent <- skipNestedNewlinesGetIndent
+  value <- exprAtIndentP valueIndent
+  skipNestedNewlines
+  void (keywordIdentifierP "in")
+  bodyIndent <- skipNestedNewlinesGetIndent
+  body <- exprAtIndentP bodyIndent
+  let boundValue = foldr (\p acc -> SLambda [p] acc) value args
+  pure (SApp (SLambda [name] body) boundValue)
+
+data DoStmt
+  = DoBind String TricuAST
+  | DoExpr TricuAST
+  deriving (Eq, Show)
+
+doP :: TokParser TricuAST
+doP = do
+  void (keywordIdentifierP "do")
+  skipNestedNewlines
+  bindOp <- atomTopP
+  blockIndent <- requireIndentedBlockP
+  stmts <- doBlockP blockIndent
+  lowerDo bindOp stmts
+
+doBlockP :: Int -> TokParser [DoStmt]
+doBlockP blockIndent = do
+  first <- doStmtP blockIndent
+  rest <- many (try (sameIndentP blockIndent *> doStmtP blockIndent))
+  pure (first : rest)
+
+doStmtP :: Int -> TokParser DoStmt
+doStmtP blockIndent = do
+  toks <- getInput
+  case toks of
+    LIdentifier name : LBindArrow : _ -> do
+      void identifierNameP
+      void (tok (== LBindArrow) "<-")
+      exprIndent <- skipNestedNewlinesGetIndent
+      DoBind name <$> exprAtIndentP (max blockIndent exprIndent)
+    _ -> DoExpr <$> exprAtIndentP blockIndent
+
+lowerDo :: TricuAST -> [DoStmt] -> TokParser TricuAST
+lowerDo _ [] = fail "do block must contain at least one statement"
+lowerDo _ [DoExpr expr] = pure expr
+lowerDo bindOp [DoBind _ _] = fail "last do statement must be an expression"
+lowerDo bindOp (DoBind name action : rest) = do
+  body <- lowerDo bindOp rest
+  pure (SApp (SApp bindOp action) (SLambda [name] body))
+lowerDo bindOp (DoExpr action : rest) = do
+  body <- lowerDo bindOp rest
+  pure (SApp (SApp bindOp action) (SLambda ["_"] body))
+
+requireIndentedBlockP :: TokParser Int
+requireIndentedBlockP = do
+  void (tok (== LNewline) "newline")
+  t <- tok isIndent "indent"
+  case t of
+    LIndent n | n > 0 -> pure n
+    _                 -> fail "expected indented do block"
+
+sameIndentP :: Int -> TokParser ()
+sameIndentP n = do
+  void (tok (== LNewline) "newline")
+  t <- tok isIndent "indent"
+  case t of
+    LIndent m | m == n -> pure ()
+    _                  -> fail "expected do statement at same indentation"
+
+keywordIdentifierP :: String -> TokParser LToken
+keywordIdentifierP name = tok (== LIdentifier name) name
 
 leafP :: TokParser TricuAST
 leafP = tok (== LKeywordT) "t" *> pure TLeaf
@@ -320,14 +608,19 @@ namespacedVarP = do
   void (tok (== LDot) ".")
   nameTok <- tok isVar "identifier"
   case (nsTok, nameTok) of
+    (LIdentifier ns, LIdentifier name) ->
+      pure (SVar (ns ++ "." ++ name) Nothing)
+    (LIdentifier ns, LIdentifierWithHash name hash) ->
+      pure (SVar (ns ++ "." ++ name) (Just hash))
     (LNamespace ns, LIdentifier name) ->
       pure (SVar (ns ++ "." ++ name) Nothing)
     (LNamespace ns, LIdentifierWithHash name hash) ->
       pure (SVar (ns ++ "." ++ name) (Just hash))
     _ -> fail "internal parser error: expected namespaced identifier"
   where
-    isNamespace (LNamespace _) = True
-    isNamespace _              = False
+    isNamespace (LIdentifier name) = name `Set.notMember` reservedNames
+    isNamespace (LNamespace _)    = True
+    isNamespace _                 = False
 
     isVar (LIdentifier _)           = True
     isVar (LIdentifierWithHash _ _) = True
@@ -381,14 +674,50 @@ atEndP :: TokParser Bool
 atEndP = null <$> getInput
 
 skipTopNewlines :: TokParser ()
-skipTopNewlines = skipMany (tok (== LNewline) "newline")
+skipTopNewlines = skipMany newlineWithOptionalIndentP
 
 skipNestedNewlines :: TokParser ()
-skipNestedNewlines = skipMany (tok (== LNewline) "newline")
+skipNestedNewlines = void skipNestedNewlinesGetIndent
+
+skipNestedNewlinesGetIndent :: TokParser Int
+skipNestedNewlinesGetIndent = go 0
+  where
+    go lastIndent = do
+      mt <- optional (try newlineWithOptionalIndentValueP)
+      case mt of
+        Nothing -> pure lastIndent
+        Just n  -> go n
+
+newlineWithOptionalIndentP :: TokParser ()
+newlineWithOptionalIndentP = void newlineWithOptionalIndentValueP
+
+newlineWithOptionalIndentValueP :: TokParser Int
+newlineWithOptionalIndentValueP = do
+  void (tok (== LNewline) "newline")
+  mt <- optional indentP
+  pure $ case mt of
+    Just (LIndent n) -> n
+    _                -> 0
+
+indentedNewlineP :: TokParser ()
+indentedNewlineP = do
+  void (tok (== LNewline) "newline")
+  t <- tok isIndent "indent"
+  case t of
+    LIndent n | n > 0 -> pure ()
+    _                 -> fail "expected indented continuation"
+
+indentP :: TokParser LToken
+indentP = tok isIndent "indent"
+
+isIndent :: LToken -> Bool
+isIndent (LIndent _) = True
+isIndent _           = False
 
 dropNewlines :: [LToken] -> [LToken]
-dropNewlines (LNewline : rest) = dropNewlines rest
-dropNewlines rest              = rest
+dropNewlines (LNewline : LIndent _ : rest) = dropNewlines rest
+dropNewlines (LNewline : rest)             = dropNewlines rest
+dropNewlines rest                          = rest
 
 handleParseError :: [LToken] -> ParseErrorBundle [LToken] Void -> String
 handleParseError toks bundle =

src/REPL.hs

@@ -1,675 +1,241 @@
 module REPL where
 
-import ContentStore
-import Eval
+import Check (checkFileWithStore)
+import Eval (evalTricu, result)
 import FileEval
-import Lexer ()
-import Parser
-import Research
-import Wire (buildBundle, encodeBundle, importBundle)
+  ( ContractMode(..)
+  , LoadedSource(..)
+  , defaultStorePath
+  , loadFileWithStoreMode
+  )
+import Parser (parseTricu)
+import Research (EvaluatedForm(..), Env, formatT)
+import ContentStore (StorePath(..))
 
-import Control.Concurrent (forkIO, threadDelay, killThread, ThreadId)
-import Control.Exception         (SomeException, catch, displayException)
-import Control.Monad ()
-import Control.Monad (forever, when, forM_, foldM, unless)
-import Control.Monad.Catch       (handle)
-import Control.Monad.IO.Class    (liftIO)
-import Control.Monad.Trans.Class ()
-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.ByteString ()
-import Data.Char                 (isSpace)
-
-import qualified Data.ByteString.Lazy as BL
-import Data.IORef (newIORef, readIORef, writeIORef)
-import Data.List                 (dropWhileEnd, isPrefixOf, find)
-import Data.Maybe (isJust, fromJust)
-import Data.Time (getCurrentTime, diffUTCTime)
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-import Data.Time.Format (formatTime, defaultTimeLocale)
+import Control.Exception (SomeException, catch, displayException)
+import Control.Monad.IO.Class (liftIO)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.List (isPrefixOf, sort)
 import Data.Version (showVersion)
-import Database.SQLite.Simple (Connection, Only(..), query)
 import Paths_tricu (version)
-import System.Console.ANSI (setSGR, SGR(..), ConsoleLayer(..), ColorIntensity(..), Color(..))
 import System.Console.Haskeline
-import System.Directory (doesFileExist, createDirectoryIfMissing)
-import System.FSNotify
-import System.FilePath (takeDirectory, (</>))
-import Text.Read (readMaybe)
+import System.Directory (doesFileExist)
 
 import qualified Data.Map as Map
-import qualified Data.Text as T
-import qualified Data.Text.IO as T ()
 
+-- | Source-local REPL with the same filesystem CAS/module loader used by the
+-- CLI. View Contract checking is explicit (`!check`); evaluation can run in
+-- normal publishing mode or unchecked mode.
 data REPLState = REPLState
-  { replForm :: EvaluatedForm
-  , replContentStore :: Maybe Connection
-  , replWatchedFile :: Maybe FilePath
-  , replSelectedVersions :: Map.Map String T.Text
-  , replWatcherThread :: Maybe ThreadId
+  { replForm      :: EvaluatedForm
+  , replEnv       :: Env
+  , replStore     :: StorePath
+  , replContracts :: ContractMode
+  , replEnvRef    :: IORef Env
   }
 
 repl :: IO ()
 repl = do
-  conn <- ContentStore.initContentStore 
-  runInputT settings (withInterrupt (loop (REPLState Decode (Just conn) Nothing Map.empty Nothing)))
+  store <- defaultStorePath
+  envRef <- newIORef Map.empty
+  let settings = Settings
+        { complete = completeRepl envRef
+        , historyFile = Just "~/.local/state/tricu/history"
+        , autoAddHistory = True
+        }
+  runInputT settings (loop (REPLState Decode Map.empty store EnforceContracts envRef))
   where
-    settings :: Settings IO
-    settings = Settings
-      { complete = completeWord Nothing " \t" completeCommands
-      , historyFile = Just "~/.local/state/tricu/history"
-      , autoAddHistory = True
-      }
-
-    completeCommands :: String -> IO [Completion]
-    completeCommands str = return $ map simpleCompletion $
-      filter (str `isPrefixOf`) commands
-      where
-        commands = [ "!exit"
-                   , "!output"
-                   , "!import"
-                   , "!clear"
-                   , "!reset"
-                   , "!help"
-                   , "!definitions"
-                   , "!watch"
-                   , "!refresh"
-                   , "!versions"
-                   , "!select"
-                   , "!tag"
-                   , "!export"
-                   , "!bundleimport"
-                   ]
 
     loop :: REPLState -> InputT IO ()
-    loop state = handle (\Interrupt -> interruptHandler state Interrupt) $ do
+    loop state = do
       minput <- getInputLine "tricu < "
       case minput of
         Nothing -> return ()
-        Just s
-          | strip s == "" -> loop state
-          | strip s == "!exit" -> outputStrLn "Exiting tricu"
-          | strip s == "!clear" -> do
-              liftIO $ putStr "\ESC[2J\ESC[H"
-              loop state
-          | strip s == "!reset" -> do
-              outputStrLn "Selected versions reset"
-              loop state { replSelectedVersions = Map.empty }
-          | strip s == "!help" -> do
-              outputStrLn $ "tricu version " ++ showVersion version
-              outputStrLn "Available commands:"
-              outputStrLn "  !exit        - Exit the REPL"
-              outputStrLn "  !clear       - Clear the screen"
-              outputStrLn "  !reset       - Reset preferences for selected versions"
-              outputStrLn "  !help        - Show tricu version and available commands"
-              outputStrLn "  !output      - Change output format (tree|fsl|ast|ternary|ascii|decode)"
-              outputStrLn "  !definitions - List all defined terms in the content store"
-              outputStrLn "  !import      - Import definitions from file to the content store"
-              outputStrLn "  !watch       - Watch a file for changes, evaluate terms, and store them"
-              outputStrLn "  !versions    - Show all versions of a term by name"
-              outputStrLn "  !select      - Select a specific version of a term for subsequent lookups"
-              outputStrLn "  !tag         - Add or update a tag for a term by hash or name"
-              outputStrLn "  !export      - Export a term bundle to file (hash, file)"
-              outputStrLn "  !bundleimport- Import a bundle file into the content store"
-              loop state
-          | strip s == "!output" -> handleOutput state
-          | strip s == "!definitions" -> handleDefinitions state
-          | "!import" `isPrefixOf` strip s -> handleImport state
-          | "!watch" `isPrefixOf` strip s -> handleWatch state
-          | strip s == "!refresh" -> handleRefresh state
-          | "!versions" `isPrefixOf` strip s -> handleVersions state
-          | "!select" `isPrefixOf` strip s -> handleSelect state
-          | "!tag" `isPrefixOf` strip s -> handleTag state
-          | "!export" `isPrefixOf` strip s -> handleExport state
-          | "!bundleimport" `isPrefixOf` strip s -> handleBundleImport state
-          | take 2 s == "--" -> loop state
-          | otherwise -> do
-              evalResult <- liftIO $ catch
-                (processInput state s)
-                (errorHandler state)
-              loop evalResult
+        Just raw -> do
+          let s = strip raw
+          case s of
+            "" -> loop state
+            "!exit" -> outputStrLn "Exiting tricu"
+            "!clear" -> liftIO (putStr "\ESC[2J\ESC[H") >> loop state
+            "!reset" -> do
+              liftIO $ writeIORef (replEnvRef state) Map.empty
+              outputStrLn "Environment reset"
+              loop state { replEnv = Map.empty }
+            "!help" -> printHelp >> loop state
+            "!output" -> handleOutput state
+            "!env" -> handleEnv state >> loop state
+            _ | "!load" `isPrefixOf` s -> handleLoad state (strip $ drop 5 s)
+              | "!check" `isPrefixOf` s -> handleCheck state (strip $ drop 6 s)
+              | "!store" `isPrefixOf` s -> handleStore state (strip $ drop 6 s)
+              | "!format" `isPrefixOf` s -> handleFormat state (strip $ drop 7 s)
+              | "!unchecked" `isPrefixOf` s -> handleUnchecked state (strip $ drop 10 s)
+              | take 2 s == "--" -> loop state
+              | otherwise -> do
+                  next <- liftIO $ catch (processInput state raw) (errorHandler state)
+                  loop next
+
+    printHelp :: InputT IO ()
+    printHelp = do
+      outputStrLn $ "tricu version " ++ showVersion version
+      outputStrLn "Available commands:"
+      outputStrLn "  !exit                  - Exit the REPL"
+      outputStrLn "  !clear                 - Clear the screen"
+      outputStrLn "  !reset                 - Reset the in-memory environment"
+      outputStrLn "  !help                  - Show this help"
+      outputStrLn "  !output                - Change output format interactively"
+      outputStrLn "  !format FORM           - Set output format: tree, fsl, ast, ternary, ascii, decode, number, string"
+      outputStrLn "  !load FILE             - Load and evaluate a .tri file into the environment"
+      outputStrLn "  !check FILE            - Check View Contract annotations in a .tri file"
+      outputStrLn "  !store [PATH]          - Show or set the content-addressed store path"
+      outputStrLn "  !unchecked [on|off]    - Show or set unchecked eval mode"
+      outputStrLn "  !env                   - List names currently in the REPL environment"
 
     handleOutput :: REPLState -> InputT IO ()
     handleOutput state = do
-      let formats = [Decode, Tree, FSL, AST, Ternary, Ascii]
+      let formats = outputFormats
       outputStrLn "Available output formats:"
       mapM_ (\(i, f) -> outputStrLn $ show (i :: Int) ++ ". " ++ show f)
         (zip [1..] formats)
-
-      evalResult <- runMaybeT $ do
-        input <- MaybeT $ getInputLine "Select output format (1-6) < "
-        case reads input of
-          [(n, "")] | n >= 1 && n <= 6 ->
-            return $ formats !! (n-1)
-          _ -> MaybeT $ return Nothing
-
-      case evalResult of
-        Nothing -> do
-          outputStrLn "Invalid selection. Keeping current output format."
-          loop state
-        Just newForm -> do
+      input <- getInputLine "Select output format (1-8) < "
+      case input >>= readMaybeInt of
+        Just n | n >= 1 && n <= length formats -> do
+          let newForm = formats !! (n - 1)
           outputStrLn $ "Output format changed to: " ++ show newForm
           loop state { replForm = newForm }
+        _ -> outputStrLn "Invalid selection. Keeping current output format." >> loop state
 
-    handleDefinitions :: REPLState -> InputT IO ()
-    handleDefinitions state = case replContentStore state of
-      Nothing -> do
-        liftIO $ printError "Content store not initialized"
-        loop state
-      Just conn -> do
-        terms <- liftIO $ ContentStore.listStoredTerms conn
+    handleFormat :: REPLState -> String -> InputT IO ()
+    handleFormat state arg =
+      case readEvaluatedForm arg of
+        Just form -> outputStrLn ("Output format changed to: " ++ show form) >> loop state { replForm = form }
+        Nothing -> outputStrLn "Usage: !format tree|fsl|ast|ternary|ascii|decode|number|string" >> loop state
 
-        if null terms
-          then do
-            liftIO $ printWarning "No terms in content store."
-            loop state
-          else do
-            liftIO $ do
-              printSuccess $ "Content store contains " ++ show (length terms) ++ " terms:"
-
-            let maxNameWidth = maximum $ map (length . T.unpack . termNames) terms
-
-            forM_ terms $ \term -> do
-              let namesStr = T.unpack (termNames term)
-                  hash = termHash term
-                  padding = replicate (maxNameWidth - length namesStr) ' '
-                  
-              liftIO $ do
-                putStr "  "
-                printVariable namesStr
-                putStr padding
-                putStr " [hash: "
-                displayColoredHash hash
-                putStrLn "]"
-                
-                tags <- ContentStore.termToTags conn hash 
-                unless (null tags) $ displayTags tags
-
-            loop state
-
-    handleImport :: REPLState -> InputT IO ()
-    handleImport state = do
-      let fset = setComplete completeFilename defaultSettings
-      filename <- runInputT fset $ getInputLineWithInitial "File to import: " ("", "")
-      case filename of
-        Nothing -> loop state
-        Just f -> do
-          let cleanFilename = strip f
-          exists <- liftIO $ doesFileExist cleanFilename
+    handleLoad :: REPLState -> String -> InputT IO ()
+    handleLoad state path
+      | null path = outputStrLn "Usage: !load FILE" >> loop state
+      | otherwise = do
+          exists <- liftIO $ doesFileExist path
           if not exists
-            then do
-              liftIO $ printError $ "File not found: " ++ cleanFilename
+            then outputStrLn ("File not found: " ++ path) >> loop state
+            else do
+              loaded <- liftIO $ loadFileWithStoreMode (replContracts state) (replStore state) path
+              let env' = evalTricu (Map.union (loadedImports loaded) (replEnv state)) (loadedAst loaded)
+              liftIO $ writeIORef (replEnvRef state) env'
+              outputStrLn $ "Loaded " ++ path
+              loop state { replEnv = env' }
+
+    handleCheck :: REPLState -> String -> InputT IO ()
+    handleCheck state path
+      | null path = outputStrLn "Usage: !check FILE" >> loop state
+      | otherwise = do
+          exists <- liftIO $ doesFileExist path
+          if not exists
+            then outputStrLn ("File not found: " ++ path) >> loop state
+            else do
+              output <- liftIO $ checkFileWithStore (replStore state) path
+              outputStrLn output
               loop state
-            else importFile state cleanFilename
 
-    importFile :: REPLState -> String -> InputT IO ()
-    importFile state cleanFilename = do
-      _code <- liftIO $ readFile cleanFilename
-      case replContentStore state of
-        Nothing -> do
-          liftIO $ printError "Content store not initialized"
+    handleStore :: REPLState -> String -> InputT IO ()
+    handleStore state path
+      | null path = do
+          outputStrLn $ "Store: " ++ storePathString (replStore state)
           loop state
-        Just conn -> do
-          env <- liftIO $ evaluateFile cleanFilename
+      | otherwise = do
+          outputStrLn $ "Store changed to: " ++ path
+          loop state { replStore = StorePath path }
 
-          liftIO $ do
-            printSuccess $ "Importing file: " ++ cleanFilename
-            let defs = Map.toList $ Map.delete "!result" env
+    handleUnchecked :: REPLState -> String -> InputT IO ()
+    handleUnchecked state arg = setUnchecked state arg
 
-            importedCount <- foldM (\count (name, term) -> do
-              hash <- ContentStore.storeTerm conn [name] term
-              printSuccess $ "Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
-              return (count + (1 :: Int))
-              ) 0 defs
+    setUnchecked :: REPLState -> String -> InputT IO ()
+    setUnchecked state arg = case arg of
+      ""    -> reportContracts state >> loop state
+      "on"  -> setMode IgnoreContracts
+      "off" -> setMode EnforceContracts
+      _     -> outputStrLn "Usage: !unchecked [on|off]" >> loop state
+      where
+        setMode mode = do
+          outputStrLn $ contractModeMessage mode
+          loop state { replContracts = mode }
 
-            printSuccess $ "Imported " ++ show importedCount ++ " definitions successfully"
+    reportContracts :: REPLState -> InputT IO ()
+    reportContracts state = outputStrLn $ contractModeMessage (replContracts state)
 
-          loop state
-
-    handleWatch :: REPLState -> InputT IO ()
-    handleWatch state = do
-      dbPath <- liftIO ContentStore.getContentStorePath
-      let filepath = takeDirectory dbPath </> "scratch.tri"
-      let dirPath = takeDirectory filepath
-
-      liftIO $ createDirectoryIfMissing True dirPath
-
-      fileExists <- liftIO $ doesFileExist filepath
-      unless fileExists $ liftIO $ writeFile filepath "-- tricu scratch file\n\n"
-
-      outputStrLn $ "Using scratch file: " ++ filepath
-
-      when (isJust (replWatcherThread state)) $ do
-        outputStrLn "Stopping previous file watch"
-        liftIO $ killThread (fromJust $ replWatcherThread state)
-
-      outputStrLn $ "Starting to watch file: " ++ filepath
-      outputStrLn "Press Ctrl+C to stop watching and return to REPL"
-
-      liftIO $ processWatchedFile filepath (replContentStore state) (replSelectedVersions state) (replForm state)
-
-      lastProcessedRef <- liftIO $ newIORef =<< getCurrentTime
-
-      watcherId <- liftIO $ forkIO $ withManager $ \mgr -> do
-        _stopAction <- watchDir mgr dirPath (\ev -> eventPath ev == filepath) $ \_ -> do
-          now <- getCurrentTime
-          lastProcessed <- readIORef lastProcessedRef
-          when (diffUTCTime now lastProcessed > 0.5) $ do
-            putStrLn $ "\nFile changed: " ++ filepath
-            processWatchedFile filepath (replContentStore state) (replSelectedVersions state) (replForm state)
-            writeIORef lastProcessedRef now
-        forever $ threadDelay 1000000
-
-      watchLoop state { replWatchedFile = Just filepath, replWatcherThread = Just watcherId }
-
-    _handleUnwatch :: REPLState -> InputT IO ()
-    _handleUnwatch state = case replWatchedFile state of
-      Nothing -> do
-        outputStrLn "No file is currently being watched"
-        loop state
-      Just path -> do
-        outputStrLn $ "Stopped watching " ++ path
-        when (isJust (replWatcherThread state)) $ do
-          liftIO $ killThread (fromJust $ replWatcherThread state)
-        loop state { replWatchedFile = Nothing, replWatcherThread = Nothing }
-
-    handleRefresh :: REPLState -> InputT IO ()
-    handleRefresh state = case replContentStore state of
-      Nothing -> do
-        outputStrLn "Content store not initialized"
-        loop state
-      Just _conn -> do
-        outputStrLn "Environment refreshed from content store (definitions are live)"
-        loop state
-
-    handleVersions :: REPLState -> InputT IO ()
-    handleVersions state = case replContentStore state of
-      Nothing -> do
-        liftIO $ printError "Content store not initialized"
-        loop state
-      Just conn -> do
-        liftIO $ printPrompt "Term name: "
-        nameInput <- getInputLine ""
-        case nameInput of
-          Nothing -> loop state
-          Just n -> do
-            let termName = strip n
-            versions <- liftIO $ ContentStore.termVersions conn termName
-            if null versions
-              then liftIO $ printError $ "No versions found for term: " ++ termName
-              else do
-                liftIO $ do
-                  printKeyword "Versions of "
-                  printVariable termName
-                  putStrLn ":"
-                  
-                  forM_ (zip [1..] versions) $ \(i, (hash, _, ts)) -> do
-                    tags <- ContentStore.termToTags conn hash
-                    putStr $ show (i :: Int) ++ ". "
-                    displayColoredHash hash
-                    putStr $ " (" ++ formatTimestamp ts ++ ")"
-                    unless (null tags) $ do
-                      putStr " ["
-                      printKeyword "Tags: "
-                      forM_ (zip [0..] tags) $ \(j, tag) -> do
-                        printTag (T.unpack tag)
-                        when (j < length tags - 1) $ putStr ", "
-                      putStr "]"
-                    putStrLn ""
-        loop state
-
-    handleSelect :: REPLState -> InputT IO ()
-    handleSelect state = case replContentStore state of
-      Nothing -> do
-        liftIO $ printError "Content store not initialized"
-        loop state
-      Just conn -> do
-        liftIO $ printPrompt "Term name: "
-        nameInput <- getInputLine ""
-        case nameInput of
-          Nothing -> loop state
-          Just n -> do
-            let cleanName = strip n
-            versions <- liftIO $ ContentStore.termVersions conn cleanName
-            if null versions
-              then do
-                liftIO $ printError $ "No versions found for term: " ++ cleanName
-                loop state
-              else do
-                liftIO $ do
-                  printKeyword "Versions of "
-                  printVariable cleanName
-                  putStrLn ":"
-                  
-                  forM_ (zip [1..] versions) $ \(i, (hash, _, ts)) -> do
-                    tags <- ContentStore.termToTags conn hash
-                    putStr $ show (i :: Int) ++ ". "
-                    displayColoredHash hash
-                    putStr $ " (" ++ formatTimestamp ts ++ ")"
-                    unless (null tags) $ do
-                      putStr " ["
-                      printKeyword "Tags: "
-                      forM_ (zip [0..] tags) $ \(j, tag) -> do
-                        printTag (T.unpack tag)
-                        when (j < length tags - 1) $ putStr ", "
-                      putStr "]"
-                    putStrLn ""
-
-                liftIO $ printPrompt "Select version (number or full hash, Enter to cancel): "
-                choiceInput <- getInputLine ""
-                let choice = strip <$> choiceInput
-
-                selectedHash <- case choice of
-                    Just selectedStr | not (null selectedStr) -> do
-                        case readMaybe selectedStr :: Maybe Int of
-                            Just idx | idx > 0 && idx <= length versions -> do
-                                let (h, _, _) = versions !! (idx - 1)
-                                return $ Just h
-                            _ -> do
-                                let potentialHash = T.pack selectedStr
-                                let foundByHash = find (\(h, _, _) -> T.isPrefixOf potentialHash h) versions
-                                case foundByHash of
-                                    Just (h, _, _) -> return $ Just h
-                                    Nothing -> do
-                                        liftIO $ printError "Invalid selection or hash not found in list."
-                                        return Nothing
-                    _ -> return Nothing
-
-                case selectedHash of
-                    Just hashToSelect -> do
-                        let newState = state { replSelectedVersions =
-                                              Map.insert cleanName hashToSelect (replSelectedVersions state) }
-                        liftIO $ do
-                          printSuccess "Selected version "
-                          displayColoredHash hashToSelect
-                          putStr " for term "
-                          printVariable cleanName
-                          putStrLn ""
-                        loop newState
-                    Nothing -> loop state
-
-    handleTag :: REPLState -> InputT IO ()
-    handleTag state = case replContentStore state of
-      Nothing -> do
-        liftIO $ printError "Content store not initialized"
-        loop state
-      Just conn -> do
-        liftIO $ printPrompt "Term hash (full or prefix) or name (most recent version will be used): "
-        identInput <- getInputLine ""
-        case identInput of
-          Nothing -> loop state
-          Just ident -> do
-            let cleanIdent = strip ident
-            
-            mFullHash <- liftIO $ resolveIdentifierToHash conn cleanIdent
-
-            case mFullHash of
-              Nothing -> do
-                liftIO $ printError $ "Could not resolve identifier: " ++ cleanIdent
-                loop state
-              Just fullHash -> do
-                liftIO $ do
-                    putStr "Tagging term with hash: "
-                    displayColoredHash fullHash
-                    putStrLn ""
-                tags <- liftIO $ ContentStore.termToTags conn fullHash
-                unless (null tags) $ do
-                  liftIO $ do
-                    printKeyword "Existing tags:"
-                    displayTags tags
-
-                liftIO $ printPrompt "Tag to add/set: "
-                tagValueInput <- getInputLine ""
-                case tagValueInput of
-                  Nothing -> loop state
-                  Just tv -> do
-                    let tagVal = T.pack (strip tv)
-                    liftIO $ do
-                      ContentStore.setTag conn fullHash tagVal 
-                      printSuccess $ "Tag '"
-                      printTag (T.unpack tagVal)
-                      putStr "' set for term with hash "
-                      displayColoredHash fullHash
-                      putStrLn ""
-                    loop state
-
-    resolveIdentifierToHash :: Connection -> String -> IO (Maybe T.Text)
-    resolveIdentifierToHash conn ident
-        | T.pack "#" `T.isInfixOf` T.pack ident = do
-            let hashPrefix = T.pack ident
-            matchingHashes <- liftIO $ query conn "SELECT hash FROM terms WHERE hash LIKE ?" (Only (hashPrefix <> "%")) :: IO [Only T.Text]
-            case matchingHashes of
-                [Only fullHash] -> return $ Just fullHash
-                [] -> do printError $ "No hash found starting with: " ++ T.unpack hashPrefix; return Nothing
-                _  -> do printError $ "Ambiguous hash prefix: " ++ T.unpack hashPrefix; return Nothing
-        | otherwise = do
-            versions <- ContentStore.termVersions conn ident
-            if null versions
-            then do printError $ "No versions found for term name: " ++ ident; return Nothing
-            else return $ Just $ (\(h,_,_) -> h) $ head versions
-
-    handleExport :: REPLState -> InputT IO ()
-    handleExport state = do
-      let fset = setComplete completeFilename defaultSettings
-      hashInput <- runInputT fset $ getInputLineWithInitial "Hash or name: " ("", "")
-      case hashInput of
-        Nothing -> loop state
-        Just hashStr -> do
-          fileInput <- runInputT fset $ getInputLineWithInitial "Output file: " ("", "")
-          case fileInput of
-            Nothing -> loop state
-            Just outFile -> case replContentStore state of
-              Nothing -> do
-                liftIO $ printError "Content store not initialized"
-                loop state
-              Just conn -> do
-                let cleanHash = strip hashStr
-                hash <- liftIO $ do
-                  let h = T.pack cleanHash
-                  if '#' `T.elem` h
-                    then return h
-                    else do
-                      results <- query conn "SELECT hash FROM terms WHERE names LIKE ? LIMIT 1"
-                        (Only (h <> "%")) :: IO [Only T.Text]
-                      case results of
-                        [Only fullHash] -> return fullHash
-                        [] -> do
-                          results2 <- query conn "SELECT hash FROM terms WHERE hash LIKE ? LIMIT 1"
-                            (Only (h <> "%")) :: IO [Only T.Text]
-                          case results2 of
-                            [Only fullHash] -> return fullHash
-                            _ -> do
-                              printError $ "No term found matching: " ++ cleanHash
-                              return h
-                        _ -> do
-                          printError $ "Ambiguous match for: " ++ cleanHash
-                          return h
-                maybeTree <- liftIO $ loadTree conn hash
-                case maybeTree of
-                  Nothing -> do
-                    liftIO $ printError $ "Term not found in store: " ++ T.unpack hash
-                    loop state
-                  Just tree -> do
-                    let bundle = buildBundle [(T.pack "root", tree)]
-                        bundleData = encodeBundle bundle
-                    liftIO $ BL.writeFile outFile (BL.fromStrict bundleData)
-                    liftIO $ do
-                      printSuccess $ "Exported bundle with root "
-                      displayColoredHash hash
-                      putStrLn $ " to " ++ outFile
-                    loop state
-
-    handleBundleImport :: REPLState -> InputT IO ()
-    handleBundleImport state = do
-      let fset = setComplete completeFilename defaultSettings
-      fileInput <- runInputT fset $ getInputLineWithInitial "Bundle file: " ("", "")
-      case fileInput of
-        Nothing -> loop state
-        Just inFile -> case replContentStore state of
-          Nothing -> do
-            liftIO $ printError "Content store not initialized"
-            loop state
-          Just conn -> do
-            exists <- liftIO $ doesFileExist inFile
-            if not exists
-              then do
-                liftIO $ printError $ "File not found: " ++ inFile
-                loop state
-              else do
-                bundleData <- liftIO $ BL.readFile inFile
-                roots <- liftIO $ importBundle conn (BL.toStrict bundleData)
-                liftIO $ do
-                  printSuccess $ "Imported " ++ show (length roots) ++ " root(s):"
-                  mapM_ (\r -> putStrLn $ "  " ++ T.unpack r) roots
-                loop state
-
-    interruptHandler :: REPLState -> Interrupt -> InputT IO ()
-    interruptHandler state _ = do
-      liftIO $ do
-        printWarning "Interrupted with CTRL+C"
-        printWarning "You can use the !exit command or CTRL+D to exit"
-      loop state
-
-    errorHandler :: REPLState -> SomeException -> IO REPLState
-    errorHandler state e = do
-      printError $ "Error: " ++ displayException e
-      return state
+    handleEnv :: REPLState -> InputT IO ()
+    handleEnv state =
+      case sort (Map.keys (replEnv state)) of
+        [] -> outputStrLn "Environment is empty"
+        names -> mapM_ outputStrLn names
 
     processInput :: REPLState -> String -> IO REPLState
     processInput state input = do
-      let asts = parseTricu input
-      case asts of
-        [] -> return state
-        _ -> case replContentStore state of
-          Nothing -> do
-            printError "Content store not initialized"
-            return state
-          Just conn -> do
-            newState <- foldM (\s astNode -> do
-              let varsInAst = Eval.findVarNames astNode
-              foldM (\currentSelectionState varName ->
-                if Map.member varName (replSelectedVersions currentSelectionState)
-                  then return currentSelectionState
-                  else do
-                    versions <- ContentStore.termVersions conn varName
-                    if length versions > 1
-                      then do
-                        let (latestHash, _, _) = head versions
-                        liftIO $ printWarning $ "Multiple versions of '" ++ varName ++ "' found. Using most recent."
-                        return currentSelectionState { replSelectedVersions = Map.insert varName latestHash (replSelectedVersions currentSelectionState) }
-                      else return currentSelectionState
-                ) s varsInAst
-              ) state asts
+      let env' = evalTricu (replEnv state) (parseTricu input)
+      writeIORef (replEnvRef state) env'
+      putStrLn $ formatT (replForm state) (result env')
+      return state { replEnv = env' }
 
-            forM_ asts $ \ast -> do
-              case ast of
-                SDef name [] body -> do
-                  evalResult <- evalAST (Just conn) (replSelectedVersions newState) body
-                  hash <- ContentStore.storeTerm conn [name] evalResult
+    errorHandler :: REPLState -> SomeException -> IO REPLState
+    errorHandler state e = do
+      putStrLn $ "Error: " ++ displayException e
+      return state
 
-                  liftIO $ do
-                    putStr "tricu > "
-                    printSuccess "Stored definition: "
-                    printVariable name
-                    putStr " with hash "
-                    displayColoredHash hash
-                    putStrLn ""
+completeRepl :: IORef Env -> CompletionFunc IO
+completeRepl envRef input@(left, _right)
+  | commandWantsFile line = completeFilename input
+  | "!" `isPrefixOf` line = completeWord Nothing " \t" completeCommands input
+  | otherwise = completeWord Nothing termBreakChars completeTerms input
+  where
+    line = reverse left
+    completeCommands str = return $ map simpleCompletion $
+      filter (str `isPrefixOf`) commands
+    completeTerms str = do
+      env <- readIORef envRef
+      return $ map simpleCompletion $
+        filter (str `isPrefixOf`) (sort $ Map.keys env)
+    commands =
+      [ "!exit"
+      , "!output"
+      , "!format"
+      , "!clear"
+      , "!reset"
+      , "!help"
+      , "!load"
+      , "!check"
+      , "!store"
+      , "!unchecked"
+      , "!env"
+      ]
+    commandWantsFile inputLine = any (`isPrefixOf` inputLine) ["!load ", "!check "]
+    termBreakChars = " \t\n\r()[]{}\"'"
 
-                    putStr "tricu > "
-                    printResult $ formatT (replForm newState) evalResult
-                    putStrLn ""
+outputFormats :: [EvaluatedForm]
+outputFormats = [Decode, Tree, FSL, AST, Ternary, Ascii, Number, StringLit]
 
-                _ -> do
-                  evalResult <- evalAST (Just conn) (replSelectedVersions newState) ast
-                  liftIO $ do
-                    putStr "tricu > "
-                    printResult $ formatT (replForm newState) evalResult
-                    putStrLn ""
-            return newState
+readEvaluatedForm :: String -> Maybe EvaluatedForm
+readEvaluatedForm s = case s of
+  "tree"    -> Just Tree
+  "fsl"     -> Just FSL
+  "ast"     -> Just AST
+  "ternary" -> Just Ternary
+  "ascii"   -> Just Ascii
+  "decode"  -> Just Decode
+  "number"  -> Just Number
+  "string"  -> Just StringLit
+  _         -> Nothing
 
-    strip :: String -> String
-    strip = dropWhileEnd isSpace . dropWhile isSpace
+contractModeMessage :: ContractMode -> String
+contractModeMessage EnforceContracts = "Contracts: on"
+contractModeMessage IgnoreContracts  = "Contracts: off (unchecked eval)"
 
-    watchLoop :: REPLState -> InputT IO ()
-    watchLoop state = handle (\Interrupt -> do
-                                outputStrLn "\nStopped watching file"
-                                when (isJust (replWatcherThread state)) $ do
-                                  liftIO $ killThread (fromJust $ replWatcherThread state)
-                                loop state { replWatchedFile = Nothing, replWatcherThread = Nothing }) $ do
-      liftIO $ threadDelay 1000000
-      watchLoop state
+storePathString :: StorePath -> FilePath
+storePathString (StorePath path) = path
 
-    processWatchedFile :: FilePath -> Maybe Connection -> Map.Map String T.Text -> EvaluatedForm -> IO ()
-    processWatchedFile filepath mconn selectedVersions outputForm = do
-      content <- readFile filepath
-      let asts = parseTricu content
+strip :: String -> String
+strip = f . f
+  where f = reverse . dropWhile (`elem` [' ', '\t', '\n', '\r'])
 
-      case mconn of
-        Nothing -> putStrLn "Content store not initialized for watched file processing."
-        Just conn -> do
-          forM_ asts $ \ast -> case ast of
-            SDef name [] body -> do
-              evalResult <- evalAST (Just conn) selectedVersions body
-              hash <- ContentStore.storeTerm conn [name] evalResult
-              putStrLn $ "tricu > Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
-              putStrLn $ "tricu > " ++ name ++ " = " ++ formatT outputForm evalResult
-            _ -> do
-              evalResult <- evalAST (Just conn) selectedVersions ast
-              putStrLn $ "tricu > Result: " ++ formatT outputForm evalResult
-          putStrLn $ "tricu > Processed file: " ++ filepath
-
-    formatTimestamp :: Integer -> String
-    formatTimestamp ts = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" (posixSecondsToUTCTime (fromIntegral ts))
-
-    displayColoredHash :: T.Text -> IO ()
-    displayColoredHash hash = do
-      let (prefix, rest) = T.splitAt 16 hash
-      setSGR [SetColor Foreground Vivid Cyan]
-      putStr $ T.unpack prefix
-      setSGR [SetColor Foreground Dull White]
-      putStr $ T.unpack rest
-      setSGR [Reset]
-
-    withColor :: ColorIntensity -> Color -> IO () -> IO ()
-    withColor intensity color action = do
-      setSGR [SetColor Foreground intensity color]
-      action
-      setSGR [Reset]
-
-    printColored :: ColorIntensity -> Color -> String -> IO ()
-    printColored intensity color text = withColor intensity color $ putStr text
-
-    printlnColored :: ColorIntensity -> Color -> String -> IO ()
-    printlnColored intensity color text = withColor intensity color $ putStrLn text
-
-    printSuccess :: String -> IO ()
-    printSuccess = printlnColored Vivid Green
-
-    printError :: String -> IO ()
-    printError = printlnColored Vivid Red
-
-    printWarning :: String -> IO ()
-    printWarning = printlnColored Vivid Yellow
-
-    printPrompt :: String -> IO ()
-    printPrompt = printColored Vivid Blue
-
-    printVariable :: String -> IO ()
-    printVariable = printColored Vivid Magenta
-
-    printTag :: String -> IO ()
-    printTag = printColored Vivid Yellow
-
-    printKeyword :: String -> IO ()
-    printKeyword = printColored Vivid Blue
-
-    printResult :: String -> IO ()
-    printResult = printColored Dull White
-
-    displayTags :: [T.Text] -> IO ()
-    displayTags [] = return ()
-    displayTags tags = do
-      putStr "    Tags: "
-      forM_ (zip [0..] tags) $ \(i, tag) -> do
-        printTag (T.unpack tag)
-        when (i < length tags - 1) $ putStr ", "
-      putStrLn ""
+readMaybeInt :: String -> Maybe Int
+readMaybeInt s = case reads s of
+  [(n, "")] -> Just n
+  _ -> Nothing

src/Research.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 module Research where
 
 import Crypto.Hash               (hash, SHA256, Digest)
@@ -17,6 +19,58 @@ import qualified Data.Text       as T
 data T = Leaf | Stem T | Fork T T
   deriving (Show, Eq, Ord)
 
+-- View Contract source annotations
+data ViewRef
+  = ViewRefInt Integer
+  | ViewRefText String
+  deriving (Show, Eq, Ord)
+
+data ViewProvenance
+  = ViewChecked
+  | ViewTrusted
+  | ViewUnchecked
+  deriving (Show, Eq, Ord)
+
+data ViewType
+  = VTName String
+  | VTVar Integer
+  | VTRefRaw ViewRef
+  | VTList ViewType
+  | VTMaybe ViewType
+  | VTPair ViewType ViewType
+  | VTResult ViewType ViewType
+  | VTGuarded ViewType T
+  | VTForall [Integer] ViewType
+  | VTExists [Integer] ViewType
+  | VTFn [ViewType] ViewType
+  deriving (Show, Eq, Ord)
+
+pattern VTRef :: Integer -> ViewType
+pattern VTRef n = VTRefRaw (ViewRefInt n)
+
+pattern VTRefText :: String -> ViewType
+pattern VTRefText s = VTRefRaw (ViewRefText s)
+
+{-# COMPLETE VTName, VTVar, VTRef, VTRefText, VTList, VTMaybe, VTPair, VTResult, VTGuarded, VTForall, VTExists, VTFn #-}
+
+data ViewExpr
+  = VEName String
+  | VEVar String
+  | VEVarId Integer
+  | VEInt Integer
+  | VEString String
+  | VEList [ViewExpr]
+  | VEApp ViewExpr ViewExpr
+  | VEForall [Integer] ViewExpr
+  | VEExists [Integer] ViewExpr
+  | VERaw String
+  deriving (Show, Eq, Ord)
+
+data DefArg
+  = DefBinder String (Maybe ViewExpr)
+  | DefPhantom ViewExpr
+  deriving (Show, Eq, Ord)
+
 -- Abstract Syntax Tree for tricu
 data TricuAST
   = SVar String (Maybe String)
@@ -24,6 +78,7 @@ data TricuAST
   | SStr String
   | SList [TricuAST]
   | SDef String [String] TricuAST
+  | SDefAnn String [DefArg] (Maybe ViewExpr) TricuAST
   | SApp TricuAST TricuAST
   | TLeaf
   | TStem TricuAST
@@ -41,6 +96,8 @@ data LToken
   | LNamespace String
   | LImport String String
   | LAssign
+  | LAssignAt
+  | LAt
   | LColon
   | LDot
   | LOpenParen
@@ -51,11 +108,13 @@ data LToken
   | LIntegerLiteral Int
   | LArrowLeft
   | LArrowRight
+  | LBindArrow
   | LNewline
+  | LIndent Int
   deriving (Eq, Show, Ord)
 
 -- Output formats
-data EvaluatedForm = Tree | FSL | AST | Ternary | Ascii | Decode
+data EvaluatedForm = Tree | FSL | AST | Ternary | Ascii | Decode | Number | StringLit
   deriving (Show)
 
 -- Environment containing previously evaluated TC terms
@@ -63,7 +122,6 @@ type Env = Map.Map String T
 
 -- Merkle DAG Node types
 -- Each Tree Calculus node becomes a content-addressed object.
-
 type MerkleHash = Text
 
 data Node
@@ -257,6 +315,8 @@ formatT AST          = show . toAST
 formatT Ternary      = toTernaryString
 formatT Ascii        = toAscii
 formatT Decode       = decodeResult
+formatT Number       = either (\e -> "<not-number: " ++ e ++ ">") show . toNumber
+formatT StringLit    = either (\e -> "<not-string: " ++ e ++ ">") show . toString
 
 toSimpleT :: String -> String
 toSimpleT s = T.unpack

src/Server.hs

@@ -1,210 +0,0 @@
-module Server
-  ( runServer
-  , runServerWithPath
-  ) where
-
-import ContentStore (initContentStore, initContentStoreWithPath, nameToTerm, hashToTerm, listStoredTerms,
-                     parseNameList, StoredTerm(..), termHash, loadTree)
-import Database.SQLite.Simple (Connection, close)
-import Wire (buildBundle, encodeBundle)
-
-import Control.Monad (when, void)
-import Data.Maybe (catMaybes)
-
-import Network.HTTP.Types (Header, Status, status200, status400, status404, status405, hContentType)
-import Network.Wai
-import Network.Wai.Handler.Warp (defaultSettings, runSettings, setHost, setPort)
-
-import Data.String (fromString)
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8, decodeUtf8)
-import Data.Char (isHexDigit, toLower)
-import Data.ByteString (ByteString)
-import Data.ByteString.Char8 (unpack)
-import Data.ByteString.Lazy (fromStrict)
-import qualified Data.Text as T
-
--- | Start an HTTP server that serves Arboricx bundles from the
---   local content store.
-runServer :: String -> Int -> IO ()
-runServer = runServerWithPath Nothing
-
--- | Start an HTTP server with an explicit database path.
-runServerWithPath :: Maybe FilePath -> String -> Int -> IO ()
-runServerWithPath mDbPath hostStr port =
-  runSettings settings (app mkConn)
-  where
-    mkConn = initContentStoreWithPath mDbPath
-    settings = setPort port $ setHost (fromString hostStr) defaultSettings
-
--- | WAI application backed by the content store.
-app :: IO Connection -> Application
-app mkConn request respond = case (requestMethod request, pathInfo request) of
-  ("GET", ["health"]) ->
-    respond $ healthResponse
-
-  ("GET", ["bundle", "roots"]) ->
-    rootsHandler mkConn request respond
-
-  ("GET", ["bundle", "name", nameText]) -> do
-    body <- nameHandler mkConn nameText
-    respond body
-
-  ("GET", ["bundle", "hash", hashText]) -> do
-    body <- hashHandler mkConn hashText
-    respond body
-
-  ("GET", ["terms"]) -> do
-    body <- termsResponse mkConn
-    respond body
-
-  ("POST", _) ->
-    respond $ responseLBS status405 [] "Method not allowed"
-
-  ("PUT", _) ->
-    respond $ responseLBS status405 [] "Method not allowed"
-
-  ("DELETE", _) ->
-    respond $ responseLBS status405 [] "Method not allowed"
-
-  _ ->
-    respond $ responseLBS status404 [] "not found"
-
-healthResponse :: Response
-healthResponse = responseLBS status200 [] "ok"
-
--- | GET /bundle/roots?n=root&n=helper&h=abc123...
-rootsHandler :: IO Connection -> Request -> (Response -> IO a) -> IO a
-rootsHandler mkConn request respond = do
-  conn <- mkConn
-  let qs = queryString request
-      nParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "n"]
-      hParams = catMaybes [v | (k, v) <- qs, map toLower (unpack k) == "h"]
-  -- Resolve 'n' params to (name, hash) pairs
-  nResults <- mapM (\nVal -> do
-    stored <- nameToTerm conn (decodeUtf8 nVal)
-    case stored of
-      Nothing -> return Nothing
-      Just t  -> return $ Just (decodeUtf8 nVal, termHash t)) nParams
-  let namedHashesFromN = catMaybes nResults
-  -- Validate 'h' params and build (name, hash) pairs
-  namedHashesFromH <- mapM (\hVal -> do
-    let raw = T.pack (dropWhile (=='#') (T.unpack (decodeUtf8 hVal)))
-    if T.all isHexDigit raw && T.length raw >= 16
-      then do
-        stored <- hashToTerm conn raw
-        let names = maybe "root" firstOrRoot (termNames <$> stored)
-        return $ Just (names, raw)
-      else return Nothing)
-    hParams
-  let allNamedHashes = namedHashesFromN ++ catMaybes namedHashesFromH
-  -- Require at least one root
-  when (null allNamedHashes) $ do
-    let resp = responseLBS status400 [] "400 Bad Request: at least one n= or h= parameter required"
-    close conn
-    void $ respond resp
-  -- Build and return the bundle
-  bundleData <- buildAndEncodeBundle conn allNamedHashes
-  let firstHash = snd (head allNamedHashes)
-      cd = T.pack "attachment; filename=roots.bundle"
-  close conn
-  respond $ responseLBS status200
-    (bundleHeaders firstHash cd)
-    (fromStrict bundleData)
-
--- | GET /bundle/name/:name
-nameHandler :: IO Connection -> Text -> IO Response
-nameHandler mkConn nameText = do
-  conn <- mkConn
-  stored <- nameToTerm conn nameText
-  case stored of
-    Nothing -> do
-      close conn
-      return $ textResponse status404 ("not found: " <> nameText)
-    Just term' -> do
-      let th = termHash term'
-          namedHashes = [(firstOrRoot (termNames term'), th)]
-      bundleData <- buildAndEncodeBundle conn namedHashes
-      let cd = T.pack $ "attachment; filename=" ++ safeFileName (T.unpack nameText) ++ ".bundle"
-      close conn
-      return $ responseLBS status200 (bundleHeaders th cd) (fromStrict bundleData)
-
--- | GET /bundle/hash/:hash
-hashHandler :: IO Connection -> Text -> IO Response
-hashHandler mkConn hashText =
-  let raw = T.pack (dropWhile (== '#') (T.unpack hashText))
-  in if not (T.all isHexDigit raw) || T.length raw < 16
-        then return $ responseLBS status400 [] "400 Bad Request: invalid hash"
-        else do
-          conn <- mkConn
-          stored <- hashToTerm conn raw
-          case stored of
-            Nothing -> do
-              close conn
-              return $ textResponse status404 ("not found: " <> hashText)
-            Just term' -> do
-              let th = termHash term'
-                  namedHashes' = [(firstOrRoot (termNames term'), th)]
-              bundleData <- buildAndEncodeBundle conn namedHashes'
-              close conn
-              return $ responseLBS status200
-                (bundleHeaders th "attachment; filename=hash.bundle")
-                (fromStrict bundleData)
-
--- | Helper: load terms by hash and build an indexed bundle.
-buildAndEncodeBundle :: Connection -> [(Text, Text)] -> IO ByteString
-buildAndEncodeBundle conn namedHashes = do
-  terms <- mapM (\(_, h) -> do
-    maybeTree <- loadTree conn h
-    case maybeTree of
-      Nothing -> error $ "Server: hash not found in store: " ++ T.unpack h
-      Just tree -> return tree) namedHashes
-  let namedTerms = zip (map fst namedHashes) terms
-      bundle = buildBundle namedTerms
-  return $ encodeBundle bundle
-
--- | GET /terms
-termsResponse :: IO Connection -> IO Response
-termsResponse mkConn = do
-  conn <- mkConn
-  terms <- listStoredTerms conn
-  close conn
-  let lines' = [ names <> "  " <> hash <> "  " <> T.pack (show created)
-               | term <- terms
-               , let names = termNames term
-               , let hash = termHash term
-               , let created = termCreatedAt term ]
-  return $ responseLBS status200
-    [ (hContentType, encodeUtf8 "text/plain; charset=utf-8")
-    ]
-    (fromStrict $ encodeUtf8 $ T.unlines lines')
-
-textResponse :: Status -> Text -> Response
-textResponse status body =
-  responseLBS status
-    [ (hContentType, encodeUtf8 "text/plain; charset=utf-8") ]
-    (fromStrict $ encodeUtf8 body)
-
-bundleHeaders :: Text -> Text -> [Header]
-bundleHeaders root cd =
-  [ (hContentType, encodeUtf8 "application/vnd.arboricx.bundle")
-  , ("X-Arboricx-Root-Hash", encodeUtf8 root)
-  , ("Content-Disposition", encodeUtf8 cd)
-  ]
-
-firstOrRoot :: Text -> Text
-firstOrRoot names =
-  case parseNameList names of
-    [] -> "root"
-    (x:_) -> x
-
-safeFileName :: String -> String
-safeFileName = map go
-  where
-    go c
-      | c >= 'a' && c <= 'z' = c
-      | c >= 'A' && c <= 'Z' = c
-      | c >= '0' && c <= '9' = c
-      | c == '-' = c
-      | c == '_' = c
-      | otherwise = '_'

src/Wire.hs

@@ -16,11 +16,10 @@ module Wire
   , decodeBundle
   , verifyBundle
   , buildBundle
-  , importBundle
+  , reconstructBundleTerms
   , defaultExportNames
   ) where
 
-import ContentStore (storeTerm)
 import Research hiding (Node)
 
 import Control.Monad (foldM, forM_, unless, when)
@@ -41,7 +40,6 @@ import Data.Vector (Vector)
 import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as MV
 import Data.Word (Word16, Word32, Word64, Word8)
-import Database.SQLite.Simple (Connection)
 import GHC.Generics (Generic)
 
 import qualified Data.ByteString as BS
@@ -774,11 +772,11 @@ verifyManifestConstraints manifest = do
         Left "manifest export has empty name"
 
 -- ---------------------------------------------------------------------------
--- Import into content store
+-- Bundle reconstruction
 -- ---------------------------------------------------------------------------
 
-reconstructTerms :: Seq BundleNode -> Vector T
-reconstructTerms nodes = V.create $ do
+reconstructBundleTerms :: Seq BundleNode -> Vector T
+reconstructBundleTerms nodes = V.create $ do
   let n = Seq.length nodes
   vec <- MV.new n
   forM_ (zip [0 :: Int ..] (Foldable.toList nodes)) $ \(i, node) -> do
@@ -792,19 +790,6 @@ reconstructTerms nodes = V.create $ do
     MV.write vec i t
   return vec
 
-importBundle :: Connection -> ByteString -> IO [Text]
-importBundle conn bs = case decodeBundle bs of
-  Left err -> error $ "Wire.importBundle: " ++ err
-  Right bundle -> case verifyBundle bundle of
-    Left err -> error $ "Wire.importBundle verify: " ++ err
-    Right () -> do
-      let terms = reconstructTerms (bundleNodes bundle)
-      forM_ (manifestExports $ bundleManifest bundle) $ \exp -> do
-        let term = terms V.! fromIntegral (exportRoot exp)
-        _ <- storeTerm conn [T.unpack $ exportName exp] term
-        return ()
-      return $ map exportName $ manifestExports $ bundleManifest bundle
-
 -- ---------------------------------------------------------------------------
 -- Primitive binary helpers
 -- ---------------------------------------------------------------------------