Wire prepped and basics tested

Zero GHC warnings with new opts. General cleanup and updates.

AGENTS.md

@@ -0,0 +1,157 @@
+# AGENTS.md — tricu Project Guide
+
+> For AI agents and contributors working in this repository.
+
+## 1. Build & Test
+
+```bash
+# Full build + tests
+nix build .#
+```
+
+### ⚠️ Never call `cabal` directly
+
+> **Rule of thumb:** if it builds, links, or tests, it goes through `nix`.
+
+## 2. 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.
+
+### 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
+
+| 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 |
+
+### File extensions
+
+- `.hs` — Haskell source
+- `.tri` — tricu language source (used in `lib/`, `test/`, `demos/`)
+
+## 3. Test Suite
+
+Tests live in `test/Spec.hs` and use **Tasty** + **HUnit**.
+
+```bash
+nix flake check   # or: nix build .#test
+```
+
+### 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 |
+
+### Suggesting tests
+
+You do not write or modify tests. The user writes tests to constrain your outputs. You must adhere your code to tests or suggest modifications to tests.
+
+If the user gives you explicit permission to implement a test you may proceed.
+
+## 4. tricu Language Quick Reference
+
+```
+t                      → Leaf (the base term)
+t t                    → Stem Leaf
+t t t                  → Fork Leaf Leaf
+
+x = t                  → Define term x = Leaf
+id = (a : a)           → Lambda identity (eliminates to tree calculus)
+head (map f xs)        → From lib/list.tri
+
+!import "./path.tri" NS  → Import file under namespace
+
+-- line comment
+```
+
+## 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("tricu.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. Directory Layout
+
+```
+tricu/
+├── flake.nix           # Nix flake: packages, tests, devShell
+├── tricu.cabal         # Cabal package (used via callCabal2nix)
+├── src/                # Haskell modules
+│   ├── Main.hs
+│   ├── Eval.hs
+│   ├── Parser.hs
+│   ├── Lexer.hs
+│   ├── FileEval.hs
+│   ├── REPL.hs
+│   ├── Research.hs
+│   └── ContentStore.hs
+├── test/
+│   ├── Spec.hs         # Tasty + HUnit tests
+│   ├── *.tri           # tricu test programs
+│   └── local-ns/       # Module namespace test files
+├── lib/
+│   ├── base.tri
+│   ├── list.tri
+│   └── patterns.tri
+├── demos/
+│   ├── equality.tri
+│   ├── size.tri
+│   ├── toSource.tri
+│   ├── levelOrderTraversal.tri
+│   └── patternMatching.tri
+└── AGENTS.md           # This file
+```
+
+## 8. Development Tips
+
+- **REPL:** `nix run .#` starts the interactive tricu REPL.
+- **Evaluate files:** `nix run .# -- eval -f demos/equality.tri`
+- **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.

README.md

@@ -10,6 +10,10 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
 
 Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog). The addition of Triage rules were suggested by [Johannes Bader](https://johannes-bader.com/). Johannes is also the creator of [treecalcul.us](https://treecalcul.us) which has a great intuitive code playground using his language LambAda.
 
+## Versioning
+
+This really is a repo for experimentation so I'm not doing anything sane with the versioning for now. If I decide to stabilize the project we'll start anew at 2.0.
+
 ## REPL examples
 
 ```
@@ -32,15 +36,21 @@ tricu < -- or calculate its size (/demos/size.tri)
 tricu < size not?
 tricu > 12
 
-tricu < -- REPL Commands:
+tricu < !help 
-tricu < !definitions  -- Lists all available definitions
+tricu version 1.1.0
-tricu < !output       -- Change output format (Tree, FSL, AST, etc.)
+Available commands:
-tricu < !import       -- Import definitions from a file
+    !exit        - Exit the REPL
-tricu < !exit         -- Exit the REPL
+    !clear       - Clear the screen
-tricu < !clear        -- ANSI screen clear
+    !reset       - Reset preferences for selected versions
-tricu < !save         -- Save all REPL definitions to a file that you can !import
+    !help        - Show tricu version and available commands
-tricu < !reset        -- Clear all REPL definitions
+    !output      - Change output format (tree|fsl|ast|ternary|ascii|decode)
-tricu < !version      -- Print tricu version
+    !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
+    !refresh     - Refresh environment from content store (definitions are live)
+    !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
 ```
 
 ## Installation and Use

flake.nix

@@ -9,26 +9,42 @@
   outputs = { self, nixpkgs, flake-utils }:
     flake-utils.lib.eachDefaultSystem (system:
       let
-        pkgs              = nixpkgs.legacyPackages.${system};
+        pkgs = nixpkgs.legacyPackages.${system};
-        packageName       = "tricu";
+        packageName = "tricu";
-        containerPackageName = "${packageName}-container";
-
-        customGHC = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
-          megaparsec
-        ]);
 
         haskellPackages = pkgs.haskellPackages;
+        hsLib = pkgs.haskell.lib;
 
-        enableSharedExecutables = false;
+        tricuPackage =
-        enableSharedLibraries = false;
+          haskellPackages.callCabal2nix packageName self {};
 
-        tricu = pkgs.haskell.lib.justStaticExecutables self.packages.${system}.default;
+        tricuTests =
+          hsLib.overrideCabal tricuPackage (old: {
+            doCheck = true;
+
+            configureFlags = (old.configureFlags or []) ++ [
+              "--enable-tests"
+            ];
+
+            checkPhase = ''
+              runHook preCheck
+              ./Setup test tricu-tests --show-details=direct
+              runHook postCheck
+            '';
+          });
+
+        customGHC = haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
+          megaparsec
+        ]);
       in {
+        packages.${packageName} = tricuPackage;
+        packages.default = tricuPackage;
 
-        packages.${packageName} =
+        packages.test = tricuTests;
-          haskellPackages.callCabal2nix packageName self rec {};
+
+        checks.${packageName} = tricuTests;
+        checks.default = tricuTests;
 
-        packages.default = self.packages.${system}.${packageName};
         defaultPackage = self.packages.${system}.default;
 
         devShells.default = pkgs.mkShell {
@@ -39,9 +55,10 @@
             customGHC
             upx
           ];
-          inputsFrom = builtins.attrValues self.packages.${system};
-        };
-        devShell = self.devShells.${system}.default;
 
+          inputsFrom = [
+            tricuPackage
+          ];
+        };
       });
 }

src/ContentStore.hs

@@ -1,19 +1,16 @@
 module ContentStore where
 
 import Research
-import Parser
 
-import Control.Monad                  (foldM, forM)
+import Control.Monad                  (foldM, forM_, void)
 import Data.ByteString                (ByteString)
 import Data.List                      (nub, sort)
-import Data.Maybe                     (catMaybes, fromJust)
+import Data.Maybe                     (catMaybes, fromMaybe)
 import Data.Text                      (Text)
 import Database.SQLite.Simple
-import Database.SQLite.Simple.FromRow (FromRow(..), field)
 import System.Directory               (createDirectoryIfMissing, getXdgDirectory, XdgDirectory(..))
 import System.FilePath                ((</>), takeDirectory)
 
-import qualified Data.ByteString      as BS
 import qualified Data.Map             as Map
 import qualified Data.Text            as T
 
@@ -44,10 +41,16 @@ initContentStore = do
   dbPath <- 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, \
-                \term_data BLOB, \
                 \metadata TEXT, \
                 \created_at INTEGER DEFAULT (strftime('%s','now')), \
                 \tags TEXT DEFAULT '')"
@@ -56,7 +59,15 @@ initContentStore = do
   execute_ conn "CREATE TABLE IF NOT EXISTS merkle_nodes (\
                 \hash TEXT PRIMARY KEY, \
                 \node_data BLOB NOT NULL)"
-  return   conn
+  -- 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
@@ -83,8 +94,8 @@ storeTerm conn newNamesStrList term = do
     [] -> do
       let allNamesToStore = serializeNameList newNamesTextList
       execute conn
-        "INSERT INTO terms (hash, names, term_data, metadata, tags) VALUES (?, ?, ?, ?, ?)"
+        "INSERT INTO terms (hash, names, metadata, tags) VALUES (?, ?, ?, ?)"
-        (termHashText, allNamesToStore, BS.pack [], metadataText, T.pack "")
+        (termHashText, allNamesToStore, metadataText, T.pack "")
     [(Only currentNamesText)] -> do
       let currentNamesList = parseNameList currentNamesText
       let combinedNamesList = currentNamesList ++ newNamesTextList
@@ -92,33 +103,35 @@ storeTerm conn newNamesStrList term = do
       execute conn
         "UPDATE terms SET names = ?, metadata = ? WHERE hash = ?"
         (allNamesToStore, metadataText, termHashText)
-    _ -> error $ "Multiple terms with same hash? " ++ show (length existingNamesQuery)
+    _ -> 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 conn h
+loadTree :: Connection -> MerkleHash -> IO (Maybe T)
-  | h == nodeHash NLeaf = return (Just Leaf)  -- NLeaf is implicit, not stored
+loadTree conn h = do
-  | otherwise = do
+  maybeNode <- getNodeMerkle conn h
-      maybeNode <- getNodeMerkle conn h
+  case maybeNode of
-      case maybeNode of
+    Nothing -> return Nothing
-        Nothing -> return Nothing
+    Just node -> Just <$> buildTree node
-        Just node -> Just <$> buildTree node
   where
     buildTree :: Node -> IO T
+    buildTree NLeaf = return Leaf
     buildTree (NStem childHash) = do
-      child <- fromJust <$> loadTree conn childHash
+      child <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn childHash
       return (Stem child)
     buildTree (NFork lHash rHash) = do
-      left <- fromJust <$> loadTree conn lHash
+      left <- fromMaybe (errorWithoutStackTrace "BUG: stored hash not found") <$> loadTree conn lHash
-      right <- fromJust <$> loadTree conn rHash
+      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 _ Leaf = return $ nodeHash NLeaf
+storeMerkleNodes conn Leaf = do
+  putMerkleNode conn NLeaf
+  return $ nodeHash NLeaf
 storeMerkleNodes conn (Stem t) = do
   childHash <- storeMerkleNodes conn t
   let thisNode = NStem childHash
@@ -161,14 +174,14 @@ listStoredTerms :: Connection -> IO [StoredTerm]
 listStoredTerms conn =
   query_ conn (selectStoredTermFields <> " ORDER BY created_at DESC")
 
-storeEnvironment :: Connection -> Env -> IO [(String, Text)]
+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) -> do
+  forM_ groupedDefs $ \(term, namesList) -> case namesList of
-    hashVal <- storeTerm conn namesList term
+    _:_ -> void $ storeTerm conn namesList term
-    return (head namesList, hashVal)
+    _ -> errorWithoutStackTrace "storeEnvironment: empty names list"
 
 loadTerm :: Connection -> String -> IO (Maybe T)
 loadTerm conn identifier = do

src/Eval.hs

@@ -4,14 +4,32 @@ import ContentStore
 import Parser
 import Research
 
-import Control.Monad (forM_, foldM)
+import Control.Monad (foldM)
-import Data.List (partition, (\\))
+import Data.List (partition, (\\), elemIndex, foldl')
-import Data.Map  (Map)
+import Data.Map  ()
+import Data.Set  (Set)
 import Database.SQLite.Simple
+
+import qualified Data.Foldable as F ()
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import Data.List (foldl')
+
+data DB
+  = BVar Int
+  | BFree String
+  | BLam DB
+  | BApp DB DB
+  | BLeaf
+  | BStem DB
+  | BFork DB DB
+  | BStr String
+  | BInt Integer
+  | BList [DB]
+  | BEmpty
+  deriving (Eq, Show)
+
+type Uses = [Bool]
 
 evalSingle :: Env -> TricuAST -> Env
 evalSingle env term
@@ -41,12 +59,12 @@ evalSingle env term
 evalTricu :: Env -> [TricuAST] -> Env
 evalTricu env x = go env (reorderDefs env x)
   where
-    go env []     = env
+    go env' []     = env'
-    go env [x]    =
+    go env' [def]    =
-      let updatedEnv = evalSingle env x
+      let updatedEnv = evalSingle env' def
       in Map.insert "!result" (result updatedEnv) updatedEnv
-    go env (x:xs) =
+    go env' (def:xs) =
-      evalTricu (evalSingle env x) xs
+      evalTricu (evalSingle env' def) xs
 
 evalASTSync :: Env -> TricuAST -> T
 evalASTSync env term = case term of
@@ -111,7 +129,7 @@ resolveTermFromStore conn selectedVersions name mhash = case mhash of
     case matchingVersions of
       [] -> return Nothing
       [(_, term, _)] -> return $ Just term
-      _ -> return Nothing -- Ambiguous or too many matches
+      _ -> return Nothing
   Nothing -> case Map.lookup name selectedVersions of
     Just hash -> loadTree conn hash
     Nothing -> do
@@ -119,74 +137,88 @@ resolveTermFromStore conn selectedVersions name mhash = case mhash of
       case versions of
         [] -> return Nothing
         [(_, term, _)] -> return $ Just term
-        _ -> return $ Just $ (\(_, t, _) -> t) $ head versions
+        _ -> return $ Just (head (map (\(_, t, _) -> t) versions))
 
 elimLambda :: TricuAST -> TricuAST
 elimLambda = go
   where
     go term
-      | etaReduction term   = elimLambda $ etaReduceResult term
+      | etaReduction term   = go (etaReduceResult term)
       | triagePattern term  = _TRI
       | composePattern term = _B
-      | lambdaList term     = elimLambda $ lambdaListResult term
+      | lambdaList term     = go (lambdaListResult term)
       | nestedLambda term   = nestedLambdaResult term
       | application term    = applicationResult term
       | isSList term        = slistTransform term
       | otherwise           = term
 
-    etaReduction (SLambda [v] (SApp f (SVar x Nothing))) = v == x && not (isFree v f)
+    etaReduction (SLambda [v] (SApp f (SVar x Nothing))) = v == x && not (usesBinder v f)
     etaReduction _ = False
-    etaReduceResult (SLambda [_] (SApp f _)) = f
 
-    triagePattern (SLambda [a] (SLambda [b] (SLambda [c] body))) = body == triageBody a b c
+    triagePattern (SLambda [a] (SLambda [b] (SLambda [c] body))) =
+      toDB [c,b,a] body == triageBodyDB
     triagePattern _ = False
 
-    composePattern (SLambda [f] (SLambda [g] (SLambda [x] body))) = body == composeBody f g x
+    composePattern (SLambda [f] (SLambda [g] (SLambda [x] body))) =
+      toDB [x,g,f] body == composeBodyDB
     composePattern _ = False
 
     lambdaList (SLambda [_] (SList _)) = True
     lambdaList _ = False
-    lambdaListResult (SLambda [v] (SList xs)) = SLambda [v] (foldr wrapTLeaf TLeaf xs)
-    wrapTLeaf m r = SApp (SApp TLeaf m) r
 
     nestedLambda (SLambda (_:_) _) = True
     nestedLambda _ = False
-    nestedLambdaResult (SLambda (v:vs) body)
-      | null vs   = toSKI v (go body) -- Changed elimLambda to go
-      | otherwise = go (SLambda [v] (SLambda vs body)) -- Changed elimLambda to go
 
     application (SApp _ _) = True
     application _ = False
-    applicationResult (SApp f g) = SApp (go f) (go g) -- Changed elimLambda to go
+
+    etaReduceResult (SLambda [_] (SApp f _)) = f
+    etaReduceResult _ = error "etaReduceResult: expected SLambda [v] (SApp f _)"
+
+    lambdaListResult (SLambda [v] (SList xs)) =
+      SLambda [v] (foldr wrapTLeaf TLeaf xs)
+      where
+        wrapTLeaf m r = SApp (SApp TLeaf m) r
+    lambdaListResult _ = error "lambdaListResult: expected SLambda [v] (SList xs)"
+
+    nestedLambdaResult (SLambda (v:vs) body)
+      | null vs   =
+          let body' = go body
+              db    = toDB [v] body'
+          in toSKIKiselyov db
+      | otherwise = go (SLambda [v] (SLambda vs body))
+    nestedLambdaResult _ = error "nestedLambdaResult: expected SLambda (_:_) _"
+
+    applicationResult (SApp f g) = SApp (go f) (go g)
+    applicationResult _ = error "applicationResult: expected SApp _ _"
 
     isSList (SList _) = True
     isSList _         = False
 
     slistTransform :: TricuAST -> TricuAST
     slistTransform (SList xs) = foldr (\m r -> SApp (SApp TLeaf (go m)) r) TLeaf xs
-    slistTransform ast = ast -- Should not be reached if isSList is the guard
+    slistTransform ast = ast -- Should not be reached
 
-    toSKI x (SVar y Nothing)
+_S, _K, _I, _R, _C, _B, _T, _TRI :: TricuAST
-      | x == y = _I
+_S   = parseSingle "t (t (t t t)) t"
-      | otherwise = SApp _K (SVar y Nothing)
+_K   = parseSingle "t t"
-    toSKI x (SApp m n) = SApp (SApp _S (toSKI x m)) (toSKI x n)
+_I   = parseSingle "t (t (t t)) t"
-    toSKI x (SLambda [y] body) = toSKI x (toSKI y body) -- This should ideally not happen if lambdas are fully eliminated first
+_R   = parseSingle "(t (t (t t (t (t (t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t))))))) (t t))"
-    toSKI _ sl@(SList _) = SApp _K (go sl) -- Ensure SList itself is transformed if somehow passed to toSKI directly
+_C   = parseSingle "(t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t)))"
-    toSKI _ term = SApp _K term
+_B   = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
+_T   = SApp _C _I
+_TRI = parseSingle "t (t (t t (t (t (t t t))))) t"
 
-    _S   = parseSingle "t (t (t t t)) t"
+triageBody  :: String -> String -> String -> TricuAST
-    _K   = parseSingle "t t"
+triageBody a b c   = SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a Nothing)) (SVar b Nothing))) (SVar c Nothing)
-    _I   = parseSingle "t (t (t t)) t"
+composeBody :: String -> String -> String -> TricuAST
-    _B   = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
+composeBody f g x  = SApp (SVar f Nothing) (SApp (SVar g Nothing) (SVar x Nothing))
-    _TRI = parseSingle "t (t (t t (t (t (t t t))))) t"
-
-    triageBody a b c = SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a Nothing)) (SVar b Nothing))) (SVar c Nothing)
-    composeBody f g x = SApp (SVar f Nothing) (SVar g Nothing) -- Note: This might not be the standard B combinator body f(g x)
 
 isFree :: String -> TricuAST -> Bool
-isFree x = Set.member x . freeVars
+isFree x t = Set.member x (freeVars t)
 
-freeVars :: TricuAST -> Set.Set String
+-- Keep old freeVars for compatibility with reorderDefs which still uses TricuAST
+freeVars :: TricuAST -> Set String
 freeVars (SVar v Nothing) = Set.singleton v
 freeVars (SVar v (Just _)) = Set.singleton v
 freeVars (SApp t u) = Set.union (freeVars t) (freeVars u)
@@ -242,7 +274,7 @@ buildDepGraph topDefs
 sortDeps :: Map.Map String (Set.Set String) -> [String]
 sortDeps graph = go [] Set.empty (Map.keys graph)
   where
-    go sorted sortedSet [] = sorted
+    go sorted _sortedSet [] = sorted
     go sorted sortedSet remaining =
       let ready = [ name | name <- remaining
                         , let deps = Map.findWithDefault Set.empty name graph
@@ -273,22 +305,6 @@ mainResult r = case Map.lookup "main" r of
   Just  a -> a
   Nothing -> errorWithoutStackTrace "No valid definition for `main` found."
 
-evalWithEnv :: Env -> Maybe Connection -> Map.Map String T.Text -> TricuAST -> IO T
-evalWithEnv env mconn selectedVersions ast = do
-  let varNames = findVarNames ast
-  resolvedEnv <- case mconn of
-    Just conn -> foldM (\e name ->
-      if Map.member name e
-        then return e
-        else do
-          mterm <- resolveTermFromStore conn selectedVersions name Nothing
-          case mterm of
-            Just term -> return $ Map.insert name term e
-            Nothing -> return e
-      ) env varNames
-    Nothing -> return env
-  return $ evalASTSync resolvedEnv ast
-
 findVarNames :: TricuAST -> [String]
 findVarNames ast = case ast of
   SVar name _ -> [name]
@@ -296,3 +312,283 @@ findVarNames ast = case ast of
   SLambda args body -> findVarNames body \\ args
   SDef name args body -> name : (findVarNames body \\ args)
   _ -> []
+
+-- Convert named TricuAST to De Bruijn form
+toDB :: [String] -> TricuAST -> DB
+toDB env = \case
+  SVar v _     -> maybe (BFree v) BVar (elemIndex v env)
+  SLambda vs b ->
+    let env' = reverse vs ++ env
+        body = toDB env' b
+    in foldr (\_ acc -> BLam acc) body vs
+  SApp f a     -> BApp (toDB env f) (toDB env a)
+  TLeaf        -> BLeaf
+  TStem t      -> BStem (toDB env t)
+  TFork l r    -> BFork (toDB env l) (toDB env r)
+  SStr s       -> BStr s
+  SInt n       -> BInt n
+  SList xs     -> BList (map (toDB env) xs)
+  SEmpty       -> BEmpty
+  SDef{}       -> error "toDB: unexpected SDef at this stage"
+  SImport _ _  -> BEmpty
+
+-- Does a term depend on the current binder (level 0)?
+dependsOnLevel :: Int -> DB -> Bool
+dependsOnLevel lvl = \case
+  BVar k      -> k == lvl
+  BLam t      -> dependsOnLevel (lvl + 1) t
+  BApp f a    -> dependsOnLevel lvl f || dependsOnLevel lvl a
+  BStem t     -> dependsOnLevel lvl t
+  BFork l r   -> dependsOnLevel lvl l || dependsOnLevel lvl r
+  BList xs    -> any (dependsOnLevel lvl) xs
+  _           -> False
+
+-- Collect free *global* names (i.e., unbound)
+freeDBNames :: DB -> Set String
+freeDBNames = \case
+  BFree s   -> Set.singleton s
+  BVar _    -> mempty
+  BLam t    -> freeDBNames t
+  BApp f a  -> freeDBNames f <> freeDBNames a
+  BLeaf     -> mempty
+  BStem t   -> freeDBNames t
+  BFork l r -> freeDBNames l <> freeDBNames r
+  BStr _    -> mempty
+  BInt _    -> mempty
+  BList xs  -> foldMap freeDBNames xs
+  BEmpty    -> mempty
+
+-- Helper: "is the binder named v used in body?"
+usesBinder :: String -> TricuAST -> Bool
+usesBinder v body = dependsOnLevel 0 (toDB [v] body)
+
+-- Expected DB bodies for the named special patterns (under env [a,b,c] -> indices 2,1,0)
+triageBodyDB :: DB
+triageBodyDB =
+  BApp (BApp BLeaf (BApp (BApp BLeaf (BVar 2)) (BVar 1))) (BVar 0)
+
+composeBodyDB :: DB
+composeBodyDB =
+  BApp (BVar 2) (BApp (BVar 1) (BVar 0))
+
+-- Convert DB -> TricuAST for subterms that contain NO binders (no BLam, no BVar)
+fromDBClosed :: DB -> TricuAST
+fromDBClosed = \case
+  BFree s   -> SVar s Nothing
+  BApp f a  -> SApp (fromDBClosed f) (fromDBClosed a)
+  BLeaf     -> TLeaf
+  BStem t   -> TStem (fromDBClosed t)
+  BFork l r -> TFork (fromDBClosed l) (fromDBClosed r)
+  BStr s    -> SStr s
+  BInt n    -> SInt n
+  BList xs  -> SList (map fromDBClosed xs)
+  BEmpty    -> SEmpty
+  -- Anything bound would be a logic error if we call this correctly.
+  BLam _    -> error "fromDBClosed: unexpected BLam"
+  BVar _    -> error "fromDBClosed: unexpected bound variable"
+
+-- DB-native bracket abstraction over the innermost binder (level 0).
+-- This mirrors your old toSKI, but is purely index-driven.
+toSKIDB :: DB -> TricuAST
+toSKIDB t
+  | not (dependsOnLevel 0 t) = SApp _K (fromDBClosed t)
+toSKIDB (BVar 0)             = _I
+toSKIDB (BApp n u)           = SApp (SApp _S (toSKIDB n)) (toSKIDB u)
+toSKIDB (BList xs) =
+  let anyUses = any (dependsOnLevel 0) xs
+  in if not anyUses
+        then SApp _K (SList (map fromDBClosed xs))
+        else SList (map toSKIDB xs)
+toSKIDB _other = _K `SApp` TLeaf
+
+app2 :: TricuAST -> TricuAST -> TricuAST
+app2 f x = SApp f x
+
+app3 :: TricuAST -> TricuAST -> TricuAST -> TricuAST
+app3 f x y = SApp (SApp f x) y
+
+-- Core converter that *does not* perform the λ-step; it just returns (Γ, d).
+-- Supported shapes: variables, applications, closed literals (Leaf/Int/Str/Empty),
+-- closed lists. For anything where the binder occurs under structural nodes
+-- (Stem/Fork/List-with-use), we deliberately bail so the caller can fall back.
+kisConv :: DB -> Either String (Uses, TricuAST)
+kisConv = \case
+  BVar 0     -> Right ([True], _I)
+  BVar n | n > 0 -> do
+    (g,d) <- kisConv (BVar (n - 1))
+    Right (False:g, d)
+  BVar n     -> Right ([], SVar ("BVar" ++ show n) Nothing)
+  BFree s    -> Right ([], SVar s Nothing)
+  BApp e1 e2 -> do
+    (g1,d1) <- kisConv e1
+    (g2,d2) <- kisConv e2
+    let g = zipWithDefault False (||) g1 g2   -- <- propagate Γ outside (#)
+        d = kisHash (g1,d1) (g2,d2)           -- <- (#) yields only the term
+    Right (g, d)
+  -- Treat closed constants as free 'combinator leaves' (no binder use).
+  BLeaf      -> Right ([], TLeaf)
+  BStr s     -> Right ([], SStr s)
+  BInt n     -> Right ([], SInt n)
+  BEmpty     -> Right ([], SEmpty)
+  -- Closed list: allowed. If binder is used anywhere, we punt to fallback.
+  BList xs
+    | any (dependsOnLevel 0) xs -> Left "List with binder use: fallback"
+    | otherwise                 -> Right ([], SList (map fromDBClosed xs))
+  -- For structural nodes, only allow if *closed* wrt the binder.
+  BStem t
+    | dependsOnLevel 0 t -> Left "Stem with binder use: fallback"
+    | otherwise          -> Right ([], TStem (fromDBClosed t))
+  BFork l r
+    | dependsOnLevel 0 l || dependsOnLevel 0 r -> Left "Fork with binder use: fallback"
+    | otherwise                                -> Right ([], TFork (fromDBClosed l) (fromDBClosed r))
+  -- We shouldn't see BLam under elim; treat as unsupported so we fallback.
+  BLam _      -> Left "Nested lambda under body: fallback"
+
+-- Application combiner with K-optimization (lazy weakening).
+-- Mirrors Lynn's 'optK' rules: choose among S, B, C, R based on leading flags.
+-- η-aware (#) with K-optimization (adapted from TS kiselyov_eta)
+kisHash :: (Uses, TricuAST) -> (Uses, TricuAST) -> TricuAST
+kisHash (g1, d1) (g2, d2) =
+  case g1 of
+    [] -> case g2 of
+      []            -> SApp d1 d2
+      True:gs2      -> if isId2 (g2, d2)
+                         then d1
+                         else kisHash ([], SApp _B d1) (gs2, d2)
+      False:gs2     -> kisHash ([], d1) (gs2, d2)
+
+    True:gs1 -> case g2 of
+      []            -> if isId2 (g1, d1)
+                         then SApp _T d2
+                         else kisHash ([], SApp _R d2) (gs1, d1)
+      _ ->
+        if isId2 (g1, d1) && case g2 of { False:_ -> True; _ -> False }
+          then kisHash ([], _T) (drop1 g2, d2)
+        else
+          -- NEW: coalesce the longest run of identical head pairs and apply bulk op once
+          let ((h1, h2), count) = headPairRun g1 g2
+              g1' = drop count g1
+              g2' = drop count g2
+          in case (h1, h2) of
+               (False, False) ->
+                 kisHash (g1', d1) (g2', d2)
+               (False, True)  ->
+                 let d1' = kisHash ([], bulkB count) (g1', d1)
+                 in  kisHash (g1', d1') (g2', d2)
+               (True, False)  ->
+                 let d1' = kisHash ([], bulkC count) (g1', d1)
+                 in  kisHash (g1', d1') (g2', d2)
+               (True, True)   ->
+                 let d1' = kisHash ([], bulkS count) (g1', d1)
+                 in  kisHash (g1', d1') (g2', d2)
+
+    False:gs1 -> case g2 of
+      []            -> kisHash (gs1, d1) ([], d2)
+      _             ->
+        if isId2 (g1, d1) && case g2 of { False:_ -> True; _ -> False }
+          then kisHash ([], _T) (drop1 g2, d2)
+        else case g2 of
+          True:gs2   ->
+            let d1' = kisHash ([], _B) (gs1, d1)
+            in  kisHash (gs1, d1') (gs2, d2)
+          False:gs2  ->
+            kisHash (gs1, d1) (gs2, d2)
+  where
+    drop1 (_:xs) = xs
+    drop1 []     = []
+
+
+toSKIKiselyov :: DB -> TricuAST
+toSKIKiselyov body =
+  case kisConv body of
+    Right ([], d)          -> SApp _K d
+    Right (True:_ , d)     -> d
+    Right (False:g, d)     -> kisHash ([], _K) (g, d)  -- no snd
+    Left _                 -> starSKIBCOpEtaDB body   -- was: toSKIDB body
+
+zipWithDefault :: a -> (a -> a -> a) -> [a] -> [a] -> [a]
+zipWithDefault d f []     ys     = map (f d) ys
+zipWithDefault d f xs     []     = map (\x -> f x d) xs
+zipWithDefault d f (x:xs) (y:ys) = f x y : zipWithDefault d f xs ys
+
+isNode :: TricuAST -> Bool
+isNode t = case t of
+  TLeaf -> True
+  _     -> False
+
+isApp2 :: TricuAST -> Maybe (TricuAST, TricuAST)
+isApp2 (SApp a b) = Just (a, b)
+isApp2 _          = Nothing
+
+isKop :: TricuAST -> Bool
+isKop t = case isApp2 t of
+  Just (a,b) -> isNode a && isNode b
+  _          -> False
+
+-- detects the two canonical I-shapes in the tree calculus:
+--   △ (△ (△ △)) x    OR    △ (△ △ △) △
+isId :: TricuAST -> Bool
+isId t = case isApp2 t of
+  Just (ab, c) -> case isApp2 ab of
+    Just (a, b) | isNode a ->
+      case isApp2 b of
+        Just (b1, b2) ->
+          (isNode b1 && isKop b2) ||
+          (isKop b1 && isNode b2 && isNode c)
+        _ -> False
+    _ -> False
+  _ -> False
+
+-- head-True only, tail empty, and term is identity
+isId2 :: (Uses, TricuAST) -> Bool
+isId2 (True:[], t) = isId t
+isId2 _            = False
+
+-- Bulk helpers built from SKI (no new primitives)
+bPrime :: TricuAST
+bPrime = SApp _B _B                            -- B' = B B
+
+cPrime :: TricuAST
+cPrime = SApp (SApp _B (SApp _B _C)) _B        -- C' = B (B C) B
+
+sPrime :: TricuAST
+sPrime = SApp (SApp _B (SApp _B _S)) _B        -- S' = B (B S) B
+
+bulkB :: Int -> TricuAST
+bulkB n | n <= 1    = _B
+        | otherwise = SApp bPrime (bulkB (n - 1))
+
+bulkC :: Int -> TricuAST
+bulkC n | n <= 1    = _C
+        | otherwise = SApp cPrime (bulkC (n - 1))
+
+bulkS :: Int -> TricuAST
+bulkS n | n <= 1    = _S
+        | otherwise = SApp sPrime (bulkS (n - 1))
+
+headPairRun :: [Bool] -> [Bool] -> ((Bool, Bool), Int)
+headPairRun g1 g2 =
+  case zip g1 g2 of
+    []       -> ((False, False), 0)
+    (h:rest) -> (h, 1 + length (takeWhile (== h) rest))
+
+-- DB-native star_skibc_op_eta (adapted from strategies.mts), binder = level 0
+starSKIBCOpEtaDB :: DB -> TricuAST
+starSKIBCOpEtaDB t
+  | not (dependsOnLevel 0 t) = SApp _K (fromDBClosed t)
+starSKIBCOpEtaDB (BVar 0)     = _I
+starSKIBCOpEtaDB (BApp e1 e2)
+  -- if binder not in right: use C
+  | not (dependsOnLevel 0 e2)
+  = SApp (SApp _C (starSKIBCOpEtaDB e1)) (fromDBClosed e2)
+  -- if binder not in left:
+  | not (dependsOnLevel 0 e1)
+  = case e2 of
+      -- η case: \x. f x  ==>  f
+      BVar 0 -> fromDBClosed e1
+      _      -> SApp (SApp _B (fromDBClosed e1)) (starSKIBCOpEtaDB e2)
+  -- otherwise: S
+  | otherwise
+  = SApp (SApp _S (starSKIBCOpEtaDB e1)) (starSKIBCOpEtaDB e2)
+-- Structural nodes with binder underneath: fall back to plain SKI (rare)
+starSKIBCOpEtaDB other        = toSKIDB other

src/FileEval.hs

@@ -5,11 +5,11 @@ import Lexer
 import Parser
 import Research
 
+import Control.Monad   ()
 import Data.List       (partition)
 import Data.Maybe      (mapMaybe)
-import Control.Monad   (foldM)
-import System.IO
 import System.FilePath (takeDirectory, normalise, (</>))
+import System.IO ()
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -17,12 +17,12 @@ import qualified Data.Set as Set
 extractMain :: Env -> Either String T
 extractMain env =
   case Map.lookup "main" env of
-    Just result -> Right result
+    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 =
+processImports seen _base currentPath asts =
   let (imports, nonImports) = partition isImp asts
       importPaths = mapMaybe getImportInfo imports
   in if currentPath `Set.member` seen
@@ -40,11 +40,11 @@ evaluateFileResult filePath = do
   let tokens = lexTricu contents
   case parseProgram tokens of
     Left err -> errorWithoutStackTrace (handleParseError err)
-    Right ast -> do
+    Right _ast -> do
       processedAst <- preprocessFile filePath
       let finalEnv = evalTricu Map.empty processedAst
       case extractMain finalEnv of
-        Right result -> return result
+        Right evalResult -> return evalResult
         Left err -> errorWithoutStackTrace err
 
 evaluateFile :: FilePath -> IO Env
@@ -53,7 +53,7 @@ evaluateFile filePath = do
   let tokens = lexTricu contents
   case parseProgram tokens of
     Left err -> errorWithoutStackTrace (handleParseError err)
-    Right ast -> do
+    Right _ast -> do
       ast <- preprocessFile filePath
       pure $ evalTricu Map.empty ast
 
@@ -63,7 +63,7 @@ evaluateFileWithContext env filePath = do
   let tokens = lexTricu contents
   case parseProgram tokens of
     Left err -> errorWithoutStackTrace (handleParseError err)
-    Right ast -> do
+    Right _ast -> do
       ast <- preprocessFile filePath
       pure $ evalTricu env ast
 
@@ -84,8 +84,8 @@ preprocessFile' seen base currentPath = do
           imported <- concat <$> mapM (processImportPath seen' base) importPaths
           pure $ imported ++ nonImports
   where
-    processImportPath seen base (path, name, importPath) = do
+    processImportPath _seen _base (_path, name, importPath) = do
-      ast <- preprocessFile' seen base importPath
+      ast <- preprocessFile' _seen _base importPath
       pure $ map (nsDefinition (if name == "!Local" then "" else name))
            $ filter (not . isImp) ast
     isImp (SImport _ _) = True

src/Lexer.hs

@@ -4,13 +4,12 @@ import Research
 
 import Control.Monad               (void)
 import Data.Functor                (($>))
+import Data.Set ()
 import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char hiding (space)
 import Text.Megaparsec.Char.Lexer
 
-import qualified Data.Set as Set
-
 type Lexer = Parsec Void String
 
 tricuLexer :: Lexer [LToken]
@@ -23,13 +22,13 @@ tricuLexer = do
       ]
     sc
     pure tok
-  tokens <- many $ do
+  toks <- many $ do
     tok <- choice tricuLexer'
     sc
     pure tok
   sc
   eof
-  pure (header ++ tokens)
+  pure (header ++ toks)
   where
     tricuLexer' =
       [ try lnewline
@@ -51,7 +50,7 @@ tricuLexer = do
 lexTricu :: String -> [LToken]
 lexTricu input = case runParser tricuLexer "" input of
   Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
-  Right tokens -> tokens
+  Right toks -> toks
 
 
 keywordT :: Lexer LToken
@@ -143,8 +142,8 @@ integerLiteral = do
 
 stringLiteral :: Lexer LToken
 stringLiteral = do
-  char '"'
+  void (char '"')
-  content <- manyTill Lexer.charLiteral (char '"')
+  content <- manyTill Lexer.charLiteral (void (char '"'))
   return (LStringLiteral content)
 
 charLiteral :: Lexer Char
@@ -163,3 +162,4 @@ charLiteral = escapedChar <|> normalChar
         '\\' -> '\\'
         '"'  -> '"'
         '\'' -> '\''
+        _    -> c

src/Main.hs

@@ -1,18 +1,28 @@
 module Main where
 
+import ContentStore (initContentStore, termNames, hashToTerm, parseNameList)
 import Eval                   (evalTricu, mainResult, result)
 import FileEval
 import Parser                 (parseTricu)
 import REPL
 import Research
-import ContentStore
+import Wire
 
 import Control.Monad          (foldM)
-import Control.Monad.IO.Class (liftIO)
+import Data.Char              (isHexDigit)
+import Control.Monad.IO.Class ()
+import Data.Text              (Text, unpack)
+import qualified Data.Text    as T
 import Data.Version           (showVersion)
-import Text.Megaparsec        (runParser)
 import Paths_tricu            (version)
 import System.Console.CmdArgs
+import System.IO              (hPutStrLn, stderr)
+import System.Exit            (die)
+import Text.Megaparsec        ()
+
+import qualified Data.ByteString.Lazy as BL
+import Database.SQLite.Simple (Connection, Only(..), close)
+import qualified Database.SQLite.Simple as DB (query)
 
 import qualified Data.Map as Map
 
@@ -20,6 +30,8 @@ data TricuArgs
   = Repl
   | Evaluate { file :: [FilePath], form :: EvaluatedForm }
   | TDecode { file :: [FilePath] }
+  | Export { hash :: String, exportNameOpt :: String, outFile :: FilePath }
+  | Import { inFile :: FilePath }
   deriving (Show, Data, Typeable)
 
 replMode :: TricuArgs
@@ -53,33 +65,69 @@ decodeMode = TDecode
   &= explicit
   &= name "decode"
 
+exportMode :: TricuArgs
+exportMode = Export
+  { hash = def &= help "Full/prefix hash or stored term name to export."
+             &= name "h" &= typ "HASH_OR_NAME"
+    , exportNameOpt = def &= help "Export name to place in the bundle manifest. Defaults to the stored term name when exporting by name; otherwise defaults to root."
+             &= name "n" &= typ "NAME"
+    , outFile = def &= help "Output file path for the bundle." &= name "o" &= typ "FILE"
+  }
+  &= help "Export a Merkle bundle from the content store."
+  &= explicit
+  &= name "export"
+
+importMode :: TricuArgs
+importMode = Import
+  { inFile = def &= help "Path to the bundle file to import."
+               &= name "f" &= typ "FILE"
+  }
+  &= help "Import a Merkle bundle into the content store."
+  &= explicit
+  &= name "import"
+
 main :: IO ()
 main = do
   let versionStr = "tricu Evaluator and REPL " ++ showVersion version
-  args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
+  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode, exportMode, importMode]
     &= help "tricu: Exploring Tree Calculus"
     &= program "tricu"
     &= summary versionStr
     &= versionArg [explicit, name "version", summary versionStr]
-  case args of
+  case cmdArgsParsed of
     Repl -> do
       putStrLn "Welcome to the tricu REPL"
       putStrLn "You may exit with `CTRL+D` or the `!exit` command."
       repl
-    Evaluate { file = filePaths, form = form } -> do
+    Evaluate { file = filePaths, form = outputForm } -> do
-      result <- case filePaths of
+      evalResult <- case filePaths of
         [] -> runTricuT <$> getContents
         (filePath:restFilePaths) -> do
             initialEnv <- evaluateFile filePath
             finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
             pure $ mainResult finalEnv
-      let fRes = formatT form result
+      let fRes = formatT outputForm evalResult
       putStr fRes
     TDecode { file = filePaths } -> do
       value <- case filePaths of
         [] -> getContents
         (filePath:_) -> readFile filePath
       putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
+    Export { hash = hashStr, exportNameOpt = exportNameArg, outFile = outFile } -> do
+      conn <- initContentStore
+      (resolvedHash, storedNames) <- resolveExportTarget conn hashStr
+      exportName <- chooseExportName exportNameArg hashStr storedNames
+      bundleData <- exportNamedBundle conn [(exportName, resolvedHash)]
+      BL.writeFile outFile (BL.fromStrict bundleData)
+      putStrLn $ "Exported bundle export " ++ unpack exportName ++ " -> " ++ unpack resolvedHash ++ " to " ++ outFile
+      close conn
+    Import { inFile = inFile } -> do
+      conn <- initContentStore
+      bundleData <- BL.readFile inFile
+      roots <- importBundle conn (BL.toStrict bundleData)
+      putStrLn $ "Imported " ++ show (length roots) ++ " root(s):"
+      mapM_ (\r -> putStrLn $ "  " ++ unpack r) roots
+      close conn
 
 runTricu :: String -> String
 runTricu = formatT TreeCalculus . runTricuT
@@ -124,3 +172,50 @@ runTricuEnvWithEnv env input =
       finalEnv = evalTricu env asts
       res      = result finalEnv
    in (finalEnv, formatT TreeCalculus res)
+
+resolveExportTarget :: Connection -> String -> IO (Text, [Text])
+resolveExportTarget conn input = do
+  let raw = T.pack $ dropWhile (== '#') input
+  byName <- DB.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 <- DB.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
+
+chooseExportName :: String -> String -> [Text] -> IO Text
+chooseExportName explicitName input storedNames
+  | not (null explicitName) = return $ T.pack explicitName
+  | Just firstName <- firstNonEmpty storedNames = return firstName
+  | otherwise = do
+      hPutStrLn stderr $
+        "No stored name found for export target " ++ input ++ "; using export name 'root'. "
+        ++ "Use export -n NAME to preserve a semantic name."
+      return "root"
+
+firstNonEmpty :: [Text] -> Maybe Text
+firstNonEmpty = go
+  where
+    go [] = Nothing
+    go (x:xs)
+      | T.null x = go xs
+      | otherwise = Just x
+
+looksLikeHash :: Text -> Bool
+looksLikeHash t =
+  let len = T.length t
+  in len >= 16 && len <= 64 && T.all isHexDigit t

src/Parser.hs

@@ -8,7 +8,7 @@ import Control.Monad.State
 import Data.List.NonEmpty        (toList)
 import Data.Void                 (Void)
 import Text.Megaparsec
-import Text.Megaparsec.Error     (ParseErrorBundle, errorBundlePretty)
+
 import qualified Data.Set as Set
 
 data PState = PState
@@ -20,9 +20,9 @@ type ParserM = StateT PState (Parsec Void [LToken])
 
 satisfyM :: (LToken -> Bool) -> ParserM LToken
 satisfyM f = do
-  token <- lift (satisfy f)
+  tok <- lift (satisfy f)
-  modify' (updateDepth token)
+  modify' (updateDepth tok)
-  return token
+  return tok
 
 updateDepth :: LToken -> PState -> PState
 updateDepth LOpenParen    st = st { parenDepth   = parenDepth st   + 1 }
@@ -39,12 +39,12 @@ topLevelNewline = do
     else fail "Top-level exit in nested context (paren or bracket)"
 
 parseProgram :: [LToken] -> Either (ParseErrorBundle [LToken] Void) [TricuAST]
-parseProgram tokens =
+parseProgram toks =
-  runParser (evalStateT (parseProgramM <* finalizeDepth <* eof) (PState 0 0)) "" tokens
+  runParser (evalStateT (parseProgramM <* finalizeDepth <* eof) (PState 0 0)) "" toks
 
 parseSingleExpr :: [LToken] -> Either (ParseErrorBundle [LToken] Void) TricuAST
-parseSingleExpr tokens =
+parseSingleExpr toks =
-  runParser (evalStateT (scnParserM *> parseExpressionM <* finalizeDepth <* eof) (PState 0 0)) "" tokens
+  runParser (evalStateT (scnParserM *> parseExpressionM <* finalizeDepth <* eof) (PState 0 0)) "" toks
 
 finalizeDepth :: ParserM ()
 finalizeDepth = do
@@ -195,6 +195,7 @@ parseTreeTermM = do
       | TLeaf     <- acc = TStem next
       | TStem t   <- acc = TFork t next
       | TFork _ _ <- acc = TFork acc next
+      | otherwise        = SApp acc next
 
 parseTreeLeafOrParenthesizedM :: ParserM TricuAST
 parseTreeLeafOrParenthesizedM = choice
@@ -248,20 +249,20 @@ parseGroupedItemM = do
 
 parseSingleItemM :: ParserM TricuAST
 parseSingleItemM = do
-  token <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
+  tok <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
-  if | LIdentifier name <- token -> pure (SVar name Nothing)
+  if | LIdentifier name <- tok -> pure (SVar name Nothing)
-     | token == LKeywordT        -> pure TLeaf
+     | tok == LKeywordT        -> pure TLeaf
      | otherwise                 -> fail "Unexpected token in list item"
 
 parseVarM :: ParserM TricuAST
 parseVarM = do
-  token <- satisfyM (\case
+  tok <- satisfyM (\case
     LNamespace _ -> True
     LIdentifier _ -> True
     LIdentifierWithHash _ _ -> True
     _ -> False)
 
-  case token of
+  case tok of
     LNamespace ns -> do
       _ <- satisfyM (== LDot)
       LIdentifier name <- satisfyM (\case LIdentifier _ -> True; _ -> False)
@@ -282,8 +283,8 @@ parseVarM = do
 parseIntLiteralM :: ParserM TricuAST
 parseIntLiteralM = do
   let intL = (\case LIntegerLiteral _ -> True; _ -> False)
-  token <- satisfyM intL
+  tok <- satisfyM intL
-  if | LIntegerLiteral value <- token ->
+  if | LIntegerLiteral value <- tok ->
        pure (SInt (fromIntegral value))
      | otherwise                      ->
        fail "Unexpected token while parsing integer literal"
@@ -291,8 +292,8 @@ parseIntLiteralM = do
 parseStrLiteralM :: ParserM TricuAST
 parseStrLiteralM = do
   let strL = (\case LStringLiteral _ -> True; _ -> False)
-  token <- satisfyM strL
+  tok <- satisfyM strL
-  if | LStringLiteral value <- token ->
+  if | LStringLiteral value <- tok ->
        pure (SStr value)
      | otherwise                     ->
        fail "Unexpected token while parsing string literal"
@@ -308,8 +309,8 @@ handleParseError bundle =
   in unlines ("Parse error(s) encountered:" : formattedErrors)
 
 formatError :: ParseError [LToken] Void -> String
-formatError (TrivialError offset unexpected expected) =
+formatError (TrivialError offset msgUnexpected expected) =
-  let unexpectedMsg = case unexpected of
+  let unexpectedMsg = case msgUnexpected of
         Just x  -> "unexpected token " ++ show x
         Nothing -> "unexpected end of input"
       expectedMsg = if null expected

src/REPL.hs

@@ -1,48 +1,44 @@
 module REPL where
 
+import ContentStore
 import Eval
 import FileEval
-import Lexer
+import Lexer ()
 import Parser
 import Research
-import ContentStore
+import Wire
 
 import Control.Concurrent (forkIO, threadDelay, killThread, ThreadId)
-import Control.Monad (forever, void, when, forM, forM_, foldM, unless)
+import Control.Exception         (SomeException, catch, displayException)
-import Data.ByteString (ByteString)
+import Control.Monad ()
-import Data.Maybe (isNothing, isJust, fromJust, catMaybes)
+import Control.Monad (forever, when, forM_, foldM, unless)
-import Database.SQLite.Simple (Connection, Only(..), query, query_, execute, execute_, open)
+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 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 Control.Exception         (IOException, SomeException, catch
-                                 , displayException)
-import Control.Monad             (forM_)
-import Control.Monad.Catch       (handle, MonadCatch)
-import Control.Monad.IO.Class    (liftIO)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.Char                 (isSpace, isUpper)
-import Data.List                 ((\\), dropWhile, dropWhileEnd, isPrefixOf, nub, sortBy, groupBy, intercalate, find)
-import Data.Version (showVersion)
-import Paths_tricu (version)
-import System.Console.Haskeline
-import System.Console.ANSI (setSGR, SGR(..), ConsoleLayer(..), ColorIntensity(..), 
-                           Color(..), ConsoleIntensity(..), clearFromCursorToLineEnd)
-
 import qualified Data.Map as Map
 import qualified Data.Text as T
-import qualified Data.Text.IO as T
+import qualified Data.Text.IO as T ()
-
-import Control.Concurrent (forkIO, threadDelay)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Time (UTCTime, getCurrentTime, diffUTCTime)
-import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)
-
-import Data.Time.Format (formatTime, defaultTimeLocale)
-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 
 data REPLState = REPLState
   { replForm :: EvaluatedForm
@@ -80,6 +76,8 @@ repl = do
                    , "!versions"
                    , "!select"
                    , "!tag"
+                   , "!export"
+                   , "!bundleimport"
                    ]
 
     loop :: REPLState -> InputT IO ()
@@ -110,6 +108,8 @@ repl = do
               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
@@ -119,28 +119,30 @@ repl = do
           | "!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
-              result <- liftIO $ catch
+              evalResult <- liftIO $ catch
                 (processInput state s)
                 (errorHandler state)
-              loop result
+              loop evalResult
 
     handleOutput :: REPLState -> InputT IO ()
     handleOutput state = do
       let formats = [Decode, TreeCalculus, FSL, AST, Ternary, Ascii]
       outputStrLn "Available output formats:"
-      mapM_ (\(i, f) -> outputStrLn $ show i ++ ". " ++ show f)
+      mapM_ (\(i, f) -> outputStrLn $ show (i :: Int) ++ ". " ++ show f)
         (zip [1..] formats)
 
-      result <- runMaybeT $ do
+      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 result of
+      case evalResult of
         Nothing -> do
           outputStrLn "Invalid selection. Keeping current output format."
           loop state
@@ -201,7 +203,7 @@ repl = do
 
     importFile :: REPLState -> String -> InputT IO ()
     importFile state cleanFilename = do
-      code <- liftIO $ readFile cleanFilename
+      _code <- liftIO $ readFile cleanFilename
       case replContentStore state of
         Nothing -> do
           liftIO $ printError "Content store not initialized"
@@ -216,7 +218,7 @@ repl = do
             importedCount <- foldM (\count (name, term) -> do
               hash <- ContentStore.storeTerm conn [name] term
               printSuccess $ "Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
-              return (count + 1)
+              return (count + (1 :: Int))
               ) 0 defs
             
             printSuccess $ "Imported " ++ show importedCount ++ " definitions successfully"
@@ -248,7 +250,7 @@ repl = do
       lastProcessedRef <- liftIO $ newIORef =<< getCurrentTime
 
       watcherId <- liftIO $ forkIO $ withManager $ \mgr -> do
-        stopAction <- watchDir mgr dirPath (\event -> eventPath event == filepath) $ \event -> do
+        _stopAction <- watchDir mgr dirPath (\ev -> eventPath ev == filepath) $ \_ -> do
           now <- getCurrentTime
           lastProcessed <- readIORef lastProcessedRef
           when (diffUTCTime now lastProcessed > 0.5) $ do
@@ -259,8 +261,8 @@ repl = do
 
       watchLoop state { replWatchedFile = Just filepath, replWatcherThread = Just watcherId }
 
-    handleUnwatch :: REPLState -> InputT IO ()
+    _handleUnwatch :: REPLState -> InputT IO ()
-    handleUnwatch state = case replWatchedFile state of
+    _handleUnwatch state = case replWatchedFile state of
       Nothing -> do
         outputStrLn "No file is currently being watched"
         loop state
@@ -275,7 +277,7 @@ repl = do
       Nothing -> do
         outputStrLn "Content store not initialized"
         loop state
-      Just conn -> do
+      Just _conn -> do
         outputStrLn "Environment refreshed from content store (definitions are live)"
         loop state
 
@@ -445,6 +447,74 @@ repl = do
             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
+                bundleData <- liftIO $ exportBundle conn [hash]
+                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
@@ -486,8 +556,8 @@ repl = do
             forM_ asts $ \ast -> do
               case ast of
                 SDef name [] body -> do
-                  result <- evalAST (Just conn) (replSelectedVersions newState) body
+                  evalResult <- evalAST (Just conn) (replSelectedVersions newState) body
-                  hash <- ContentStore.storeTerm conn [name] result
+                  hash <- ContentStore.storeTerm conn [name] evalResult
                   
                   liftIO $ do
                     putStr "tricu > "
@@ -498,14 +568,14 @@ repl = do
                     putStrLn ""
                     
                     putStr "tricu > "
-                    printResult $ formatT (replForm newState) result
+                    printResult $ formatT (replForm newState) evalResult
                     putStrLn ""
 
                 _ -> do
-                  result <- evalAST (Just conn) (replSelectedVersions newState) ast
+                  evalResult <- evalAST (Just conn) (replSelectedVersions newState) ast
                   liftIO $ do
                     putStr "tricu > "
-                    printResult $ formatT (replForm newState) result
+                    printResult $ formatT (replForm newState) evalResult
                     putStrLn ""
             return newState
 
@@ -531,13 +601,13 @@ repl = do
         Just conn -> do
           forM_ asts $ \ast -> case ast of
             SDef name [] body -> do
-              result <- evalAST (Just conn) selectedVersions body
+              evalResult <- evalAST (Just conn) selectedVersions body
-              hash <- ContentStore.storeTerm conn [name] result
+              hash <- ContentStore.storeTerm conn [name] evalResult
               putStrLn $ "tricu > Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
-              putStrLn $ "tricu > " ++ name ++ " = " ++ formatT outputForm result
+              putStrLn $ "tricu > " ++ name ++ " = " ++ formatT outputForm evalResult
             _ -> do
-              result <- evalAST (Just conn) selectedVersions ast
+              evalResult <- evalAST (Just conn) selectedVersions ast
-              putStrLn $ "tricu > Result: " ++ formatT outputForm result
+              putStrLn $ "tricu > Result: " ++ formatT outputForm evalResult
           putStrLn $ "tricu > Processed file: " ++ filepath
 
     formatTimestamp :: Integer -> String
@@ -552,12 +622,6 @@ repl = do
       putStr $ T.unpack rest
       setSGR [Reset]
 
-    coloredHashString :: T.Text -> String
-    coloredHashString hash = 
-      "\ESC[1;36m" ++ T.unpack (T.take 16 hash) ++ 
-      "\ESC[0;37m" ++ T.unpack (T.drop 16 hash) ++ 
-      "\ESC[0m"
-
     withColor :: ColorIntensity -> Color -> IO () -> IO ()
     withColor intensity color action = do
       setSGR [SetColor Foreground intensity color]

src/Research.hs

@@ -1,17 +1,17 @@
 module Research where
 
+import Crypto.Hash               (hash, SHA256, Digest)
 import Data.ByteArray            (convert)
-import Data.Char                 (chr, ord)
+import Data.ByteString.Base16    (decode, encode)
 import Data.List                 (intercalate)
-import Data.Map                  (Map)
+import Data.Map                  ()
-import Data.Text                 (Text, replace, unpack)
+import Data.Text                 (Text, replace)
-import Data.Word                 (Word8)
+import Data.Text.Encoding        (decodeUtf8, encodeUtf8)
 import System.Console.CmdArgs    (Data, Typeable)
 
 import qualified Data.ByteString as BS
 import qualified Data.Map        as Map
 import qualified Data.Text       as T
-import Crypto.Hash               (hash, SHA256, Digest)
 
 -- Tree Calculus Types
 data T = Leaf | Stem T | Fork T T
@@ -19,7 +19,7 @@ data T = Leaf | Stem T | Fork T T
 
 -- Abstract Syntax Tree for tricu
 data TricuAST
-  = SVar String (Maybe String)  -- Variable name and optional hash prefix
+  = SVar String (Maybe String)
   | SInt Integer
   | SStr String
   | SList [TricuAST]
@@ -76,36 +76,21 @@ data Node
 --   Fork:  0x02 || left_hash (32 bytes) || right_hash (32 bytes)
 serializeNode :: Node -> BS.ByteString
 serializeNode NLeaf        = BS.pack [0x00]
-serializeNode (NStem h)    = BS.pack [0x01] <> hexToBytes h
+serializeNode (NStem h) = BS.pack [0x01] <> go (decode (encodeUtf8 h))
-serializeNode (NFork l r)  = BS.pack [0x02] <> hexToBytes l <> hexToBytes r
+  where go (Left _) = error "Research.serializeNode: invalid hex hash"
+        go (Right bs) = bs
+serializeNode (NFork l r) = BS.pack [0x02] <> go (decode (encodeUtf8 l)) <> go (decode (encodeUtf8 r))
+  where go (Left _) = error "Research.serializeNode: invalid hex hash"
+        go (Right bs) = bs
 
 -- | Hash a node per the Merkle content-addressing spec.
 -- hash = SHA256( "tricu.merkle.node.v1" <> 0x00 <> node_payload )
 nodeHash :: Node -> MerkleHash
-nodeHash node = bytesToHex (sha256WithPrefix (serializeNode node))
+nodeHash node = decodeUtf8 (encode (sha256WithPrefix (serializeNode node)))
   where sha256WithPrefix payload =
           convert . (hash :: BS.ByteString -> Digest SHA256) $ utf8Tag <> BS.pack [0x00] <> payload
         utf8Tag = BS.pack $ map fromIntegral $ BS.unpack "tricu.merkle.node.v1"
 
--- | Convert a Hex Text hash into raw ByteString (2 hex chars per byte)
-hexToBytes :: Text -> BS.ByteString
-hexToBytes h = BS.pack $ map combinePair pairs
-  where
-    chars = unpack h
-    pairs = chunkPairs chars
-    chunkPairs :: String -> [(Char, Char)]
-    chunkPairs (c1:c2:rest) = (c1, c2) : chunkPairs rest
-    chunkPairs [] = []
-    chunkPairs _ = error "hexToBytes: odd number of hex digits"
-    combinePair :: (Char, Char) -> Word8
-    combinePair (c1, c2) = fromIntegral (hexDigitToInt c1 * 16 + hexDigitToInt c2)
-    hexDigitToInt :: Char -> Int
-    hexDigitToInt c
-      | '0' <= c && c <= '9'  = ord c - ord '0'
-      | 'a' <= c && c <= 'f'  = ord c - ord 'a' + 10
-      | 'A' <= c && c <= 'F'  = ord c - ord 'A' + 10
-      | otherwise              = error $ "Invalid hex digit: " ++ show c
-
 -- | Deserialize a Node from canonical bytes.
 deserializeNode :: BS.ByteString -> Node
 deserializeNode bs =
@@ -115,26 +100,14 @@ deserializeNode bs =
 
     Just (0x01, rest)
       | BS.length rest == 32 ->
-          NStem $ bytesToHex rest
+          NStem $ decodeUtf8 (encode rest)
 
     Just (0x02, rest)
       | BS.length rest == 64 ->
           let (l, r) = BS.splitAt 32 rest
-          in NFork (bytesToHex l) (bytesToHex r)
+          in NFork (decodeUtf8 (encode l)) (decodeUtf8 (encode r))
 
-    _ -> error "invalid merkle node payload"
+    _ -> errorWithoutStackTrace "invalid merkle node payload"
-
-
--- | Convert 32-byte ByteString back to hex Text
-bytesToHex :: BS.ByteString -> Text
-bytesToHex bs = T.pack $ concatMap byteToHexChars $ BS.unpack bs
-  where
-    byteToHexChars :: Word8 -> String
-    byteToHexChars w = [hexDigit (fromIntegral w `div` 16), hexDigit (fromIntegral w `mod` 16)]
-    hexDigit :: Int -> Char
-    hexDigit n
-      | n < 10    = chr (ord '0' + n)
-      | otherwise = chr (ord 'a' + n - 10)
 
 -- | Build a Merkle DAG from a Tree Calculus term.
 buildMerkle :: T -> Node
@@ -158,9 +131,9 @@ buildMerkle (Fork l r) = NFork (nodeHash left) (nodeHash right)
 apply :: T -> T -> T
 apply (Fork Leaf a)         _         = a
 apply (Fork (Stem a) b) c             = apply (apply a c) (apply b c)
-apply (Fork (Fork a  b) c)  Leaf      = a
+apply (Fork (Fork _a _b) _c)  Leaf      = _a
-apply (Fork (Fork a  b) c) (Stem u)   = apply b u
+apply (Fork (Fork _a _b) _c) (Stem u)   = apply _b u
-apply (Fork (Fork a  b) c) (Fork u v) = apply (apply c u) v
+apply (Fork (Fork _a _b) _c) (Fork u v) = apply (apply _c u) v
 -- Left associative `t`
 apply  Leaf b                         = Stem b
 apply (Stem a) b                      = Fork a b
@@ -202,7 +175,7 @@ toNumber _ = Left "Invalid Tree Calculus number"
 toString :: T -> Either String String
 toString tc = case toList tc of
   Right list -> traverse (fmap (toEnum . fromInteger) . toNumber) list
-  Left err -> Left "Invalid Tree Calculus string"
+  Left _ -> Left "Invalid Tree Calculus string"
 
 toList :: T -> Either String [T]
 toList Leaf = Right []

src/Wire.hs

@@ -0,0 +1,870 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Wire
+  ( Bundle (..)
+  , BundleManifest (..)
+  , TreeSpec (..)
+  , NodeHashSpec (..)
+  , RuntimeSpec (..)
+  , BundleRoot (..)
+  , BundleExport (..)
+  , BundleMetadata (..)
+  , ClosureMode (..)
+  , encodeBundle
+  , decodeBundle
+  , verifyBundle
+  , collectReachableNodes
+  , exportBundle
+  , exportNamedBundle
+  , importBundle
+  ) where
+
+import ContentStore (getNodeMerkle, loadTree, putMerkleNode, storeTerm)
+import Research
+
+import Control.Exception (SomeException, evaluate, try)
+import Control.Monad (foldM, unless, when)
+import Crypto.Hash (Digest, SHA256, hash)
+import Data.Aeson ( FromJSON (..)
+                  , ToJSON (..)
+                  , Value (String)
+                  , eitherDecodeStrict'
+                  , encode
+                  , object
+                  , withObject
+                  , (.:)
+                  , (.:?)
+                  , (.!=)
+                  , (.=)
+                  )
+import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Data.ByteArray (convert)
+import Data.ByteString (ByteString)
+import Data.Foldable (traverse_)
+import Data.Map (Map)
+import Data.Text (Text, unpack)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import Database.SQLite.Simple (Connection)
+import GHC.Generics (Generic)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+
+-- | Portable bundle major/minor version supported by this module.
+bundleMajorVersion :: Word16
+bundleMajorVersion = 1
+
+bundleMinorVersion :: Word16
+bundleMinorVersion = 0
+
+-- | Header magic for the portable executable-object container.
+bundleMagic :: ByteString
+bundleMagic = BS.pack [0x54, 0x52, 0x49, 0x43, 0x55, 0x42, 0x4e, 0x44] -- "TRICUBND"
+
+headerLength :: Int
+headerLength = 32
+
+sectionEntryLength :: Int
+sectionEntryLength = 60
+
+sectionManifest, sectionNodes :: Word32
+sectionManifest = 1
+sectionNodes = 2
+
+flagCritical :: Word16
+flagCritical = 0x0001
+
+compressionNone, digestSha256 :: Word16
+compressionNone = 0
+digestSha256 = 1
+
+-- | Backwards compatibility for the original experimental node-list format.
+legacyMagic :: ByteString
+legacyMagic = BS.pack [0x54, 0x52, 0x49, 0x43, 0x55] -- "TRICU"
+
+legacyWireVersion :: Word8
+legacyWireVersion = 0x01
+
+-- | Closure declaration. V1 only accepts complete bundles for import.
+data ClosureMode = ClosureComplete | ClosurePartial
+  deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON ClosureMode where
+  toJSON ClosureComplete = String "complete"
+  toJSON ClosurePartial = String "partial"
+
+instance FromJSON ClosureMode where
+  parseJSON (String "complete") = pure ClosureComplete
+  parseJSON (String "partial") = pure ClosurePartial
+  parseJSON _ = fail "closure must be \"complete\" or \"partial\""
+
+data NodeHashSpec = NodeHashSpec
+  { nodeHashAlgorithm :: Text
+  , nodeHashDomain :: Text
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON NodeHashSpec where
+  toJSON s = object
+    [ "algorithm" .= nodeHashAlgorithm s
+    , "domain" .= nodeHashDomain s
+    ]
+
+instance FromJSON NodeHashSpec where
+  parseJSON = withObject "NodeHashSpec" $ \o -> NodeHashSpec
+    <$> o .: "algorithm"
+    <*> o .: "domain"
+
+data TreeSpec = TreeSpec
+  { treeCalculus :: Text
+  , treeNodeHash :: NodeHashSpec
+  , treeNodePayload :: Text
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON TreeSpec where
+  toJSON s = object
+    [ "calculus" .= treeCalculus s
+    , "nodeHash" .= treeNodeHash s
+    , "nodePayload" .= treeNodePayload s
+    ]
+
+instance FromJSON TreeSpec where
+  parseJSON = withObject "TreeSpec" $ \o -> TreeSpec
+    <$> o .: "calculus"
+    <*> o .: "nodeHash"
+    <*> o .: "nodePayload"
+
+data RuntimeSpec = RuntimeSpec
+  { runtimeSemantics :: Text
+  , runtimeEvaluation :: Text
+  , runtimeAbi :: Text
+  , runtimeCapabilities :: [Text]
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON RuntimeSpec where
+  toJSON s = object
+    [ "semantics" .= runtimeSemantics s
+    , "evaluation" .= runtimeEvaluation s
+    , "abi" .= runtimeAbi s
+    , "capabilities" .= runtimeCapabilities s
+    ]
+
+instance FromJSON RuntimeSpec where
+  parseJSON = withObject "RuntimeSpec" $ \o -> RuntimeSpec
+    <$> o .: "semantics"
+    <*> o .: "evaluation"
+    <*> o .: "abi"
+    <*> o .:? "capabilities" .!= []
+
+data BundleRoot = BundleRoot
+  { rootHash :: MerkleHash
+  , rootRole :: Text
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON BundleRoot where
+  toJSON r = object
+    [ "hash" .= rootHash r
+    , "role" .= rootRole r
+    ]
+
+instance FromJSON BundleRoot where
+  parseJSON = withObject "BundleRoot" $ \o -> BundleRoot
+    <$> o .: "hash"
+    <*> o .:? "role" .!= "root"
+
+data BundleExport = BundleExport
+  { exportName :: Text
+  , exportRoot :: MerkleHash
+  , exportKind :: Text
+  , exportAbi :: Text
+  , exportInput :: Maybe Text
+  , exportOutput :: Maybe Text
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON BundleExport where
+  toJSON e = object
+    [ "name" .= exportName e
+    , "root" .= exportRoot e
+    , "kind" .= exportKind e
+    , "abi" .= exportAbi e
+    , "input" .= exportInput e
+    , "output" .= exportOutput e
+    ]
+
+instance FromJSON BundleExport where
+  parseJSON = withObject "BundleExport" $ \o -> BundleExport
+    <$> o .: "name"
+    <*> o .: "root"
+    <*> o .:? "kind" .!= "term"
+    <*> o .:? "abi" .!= "tricu.abi.tree.v1"
+    <*> o .:? "input"
+    <*> o .:? "output"
+
+data BundleMetadata = BundleMetadata
+  { metadataPackage :: Maybe Text
+  , metadataVersion :: Maybe Text
+  , metadataDescription :: Maybe Text
+  , metadataLicense :: Maybe Text
+  , metadataCreatedBy :: Maybe Text
+  } deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON BundleMetadata where
+  toJSON m = object
+    [ "package" .= metadataPackage m
+    , "version" .= metadataVersion m
+    , "description" .= metadataDescription m
+    , "license" .= metadataLicense m
+    , "createdBy" .= metadataCreatedBy m
+    ]
+
+instance FromJSON BundleMetadata where
+  parseJSON = withObject "BundleMetadata" $ \o -> BundleMetadata
+    <$> o .:? "package"
+    <*> o .:? "version"
+    <*> o .:? "description"
+    <*> o .:? "license"
+    <*> o .:? "createdBy"
+
+data BundleManifest = BundleManifest
+  { manifestSchema :: Text
+  , manifestBundleType :: Text
+  , manifestTree :: TreeSpec
+  , manifestRuntime :: RuntimeSpec
+  , manifestClosure :: ClosureMode
+  , manifestRoots :: [BundleRoot]
+  , manifestExports :: [BundleExport]
+  , manifestImports :: [Value]
+  , manifestSections :: Value
+  , manifestMetadata :: BundleMetadata
+  } deriving (Show, Eq, Generic)
+
+instance ToJSON BundleManifest where
+  toJSON m = object
+    [ "schema" .= manifestSchema m
+    , "bundleType" .= manifestBundleType m
+    , "tree" .= manifestTree m
+    , "runtime" .= manifestRuntime m
+    , "closure" .= manifestClosure m
+    , "roots" .= manifestRoots m
+    , "exports" .= manifestExports m
+    , "imports" .= manifestImports m
+    , "sections" .= manifestSections m
+    , "metadata" .= manifestMetadata m
+    ]
+
+instance FromJSON BundleManifest where
+  parseJSON = withObject "BundleManifest" $ \o -> BundleManifest
+    <$> o .: "schema"
+    <*> o .: "bundleType"
+    <*> o .: "tree"
+    <*> o .: "runtime"
+    <*> o .: "closure"
+    <*> o .: "roots"
+    <*> o .: "exports"
+    <*> o .:? "imports" .!= []
+    <*> o .:? "sections" .!= object []
+    <*> o .:? "metadata" .!= BundleMetadata Nothing Nothing Nothing Nothing Nothing
+
+-- | Portable executable-object bundle.
+--
+-- Merkle node payloads remain the language-neutral executable core:
+--   Leaf = 0x00; Stem = 0x01 || child_hash; Fork = 0x02 || left_hash || right_hash.
+-- Names, exports, runtime metadata, and package metadata live in the manifest layer.
+data Bundle = Bundle
+  { bundleVersion :: Word16
+  , bundleRoots :: [MerkleHash]
+  , bundleNodes :: Map MerkleHash ByteString
+  , bundleManifest :: BundleManifest
+  , bundleManifestBytes :: ByteString
+  } deriving (Show, Eq)
+
+-- | Encode a Bundle to portable Bundle v1 bytes.
+encodeBundle :: Bundle -> ByteString
+encodeBundle bundle =
+  let nodeSection = encodeNodeSection (bundleNodes bundle)
+      manifestBytes = if BS.null (bundleManifestBytes bundle)
+        then BL.toStrict (encode (bundleManifest bundle))
+        else bundleManifestBytes bundle
+      sectionCount = 2
+      dirOffset = fromIntegral headerLength
+      sectionDirLength = sectionCount * sectionEntryLength
+      manifestOffset = fromIntegral (headerLength + sectionDirLength)
+      nodesOffset = manifestOffset + fromIntegral (BS.length manifestBytes)
+      manifestEntry = encodeSectionEntry sectionManifest 1 flagCritical compressionNone
+        manifestOffset (fromIntegral $ BS.length manifestBytes) manifestBytes
+      nodesEntry = encodeSectionEntry sectionNodes 1 flagCritical compressionNone
+        nodesOffset (fromIntegral $ BS.length nodeSection) nodeSection
+      header = encodeHeader bundleMajorVersion bundleMinorVersion
+        (fromIntegral sectionCount) 0 dirOffset
+  in header <> manifestEntry <> nodesEntry <> manifestBytes <> nodeSection
+
+-- | Decode portable Bundle v1 bytes, with fallback support for the previous
+-- experimental TRICU node-list format.
+decodeBundle :: ByteString -> Either String Bundle
+decodeBundle bs
+  | BS.take (BS.length bundleMagic) bs == bundleMagic = decodePortableBundle bs
+  | BS.take (BS.length legacyMagic) bs == legacyMagic = decodeLegacyBundle bs
+  | otherwise = Left "invalid magic"
+
+-- ---------------------------------------------------------------------------
+-- Portable container encoding / decoding
+-- ---------------------------------------------------------------------------
+
+data SectionEntry = SectionEntry
+  { seType :: Word32
+  , seVersion :: Word16
+  , seFlags :: Word16
+  , seCompression :: Word16
+  , seDigestAlgorithm :: Word16
+  , seOffset :: Word64
+  , seLength :: Word64
+  , seDigest :: ByteString
+  } deriving (Show, Eq)
+
+encodeHeader :: Word16 -> Word16 -> Word32 -> Word64 -> Word64 -> ByteString
+encodeHeader major minor sectionCount flags dirOffset =
+  bundleMagic
+    <> encode16 major
+    <> encode16 minor
+    <> encode32 sectionCount
+    <> encode64 flags
+    <> encode64 dirOffset
+
+encodeSectionEntry :: Word32 -> Word16 -> Word16 -> Word16 -> Word64 -> Word64 -> ByteString -> ByteString
+encodeSectionEntry sectionType sectionVersion sectionFlags compression offset lengthBytes sectionBytes =
+  encode32 sectionType
+    <> encode16 sectionVersion
+    <> encode16 sectionFlags
+    <> encode16 compression
+    <> encode16 digestSha256
+    <> encode64 offset
+    <> encode64 lengthBytes
+    <> sha256 sectionBytes
+
+decodePortableBundle :: ByteString -> Either String Bundle
+decodePortableBundle bs = do
+  (major, minor, sectionCount, _flags, dirOffset) <- decodePortableHeader bs
+  when (major /= bundleMajorVersion) $
+    Left $ "unsupported bundle major version: " ++ show major
+  let dirStart = fromIntegral dirOffset
+      dirBytes = fromIntegral sectionCount * sectionEntryLength
+  when (BS.length bs < dirStart + dirBytes) $
+    Left "bundle truncated in section directory"
+  entries <- decodeSectionEntries sectionCount (BS.take dirBytes $ BS.drop dirStart bs)
+  traverse_ rejectUnknownCritical entries
+  manifestEntry <- requireSection sectionManifest entries
+  nodesEntry <- requireSection sectionNodes entries
+  manifestBytes <- readAndVerifySection bs manifestEntry
+  nodesBytes <- readAndVerifySection bs nodesEntry
+  manifest <- case eitherDecodeStrict' manifestBytes of
+    Left err -> Left $ "invalid manifest JSON: " ++ err
+    Right m -> Right m
+  nodes <- decodeNodeSection nodesBytes
+  let roots = map rootHash (manifestRoots manifest)
+  return Bundle
+    { bundleVersion = major * 1000 + minor
+    , bundleRoots = roots
+    , bundleNodes = nodes
+    , bundleManifest = manifest
+    , bundleManifestBytes = manifestBytes
+    }
+
+rejectUnknownCritical :: SectionEntry -> Either String ()
+rejectUnknownCritical entry =
+  let known = seType entry `elem` [sectionManifest, sectionNodes]
+      critical = seFlags entry .&. flagCritical /= 0
+  in when (critical && not known) $
+       Left $ "unknown critical section type: " ++ show (seType entry)
+
+requireSection :: Word32 -> [SectionEntry] -> Either String SectionEntry
+requireSection sectionType entries =
+  case filter ((== sectionType) . seType) entries of
+    [entry] -> Right entry
+    [] -> Left $ "missing required section type: " ++ show sectionType
+    _ -> Left $ "duplicate section type: " ++ show sectionType
+
+readAndVerifySection :: ByteString -> SectionEntry -> Either String ByteString
+readAndVerifySection bs entry = do
+  when (seCompression entry /= compressionNone) $
+    Left $ "unsupported compression codec in section " ++ show (seType entry)
+  when (seDigestAlgorithm entry /= digestSha256) $
+    Left $ "unsupported digest algorithm in section " ++ show (seType entry)
+  let offset = fromIntegral (seOffset entry)
+      len = fromIntegral (seLength entry)
+  when (offset < 0 || len < 0 || BS.length bs < offset + len) $
+    Left $ "section extends beyond bundle end: " ++ show (seType entry)
+  let sectionBytes = BS.take len $ BS.drop offset bs
+  when (sha256 sectionBytes /= seDigest entry) $
+    Left $ "section digest mismatch: " ++ show (seType entry)
+  Right sectionBytes
+
+decodePortableHeader :: ByteString -> Either String (Word16, Word16, Word32, Word64, Word64)
+decodePortableHeader bs
+  | BS.length bs < headerLength = Left "bundle too short for header"
+  | BS.take 8 bs /= bundleMagic = Left "invalid portable bundle magic"
+  | otherwise = do
+      (major, r1) <- decode16be "major_version" (BS.drop 8 bs)
+      (minor, r2) <- decode16be "minor_version" r1
+      (sectionCount, r3) <- decode32be "section_count" r2
+      (flags, r4) <- decode64be "flags" r3
+      (dirOffset, _) <- decode64be "directory_offset" r4
+      Right (major, minor, sectionCount, flags, dirOffset)
+
+decodeSectionEntries :: Word32 -> ByteString -> Either String [SectionEntry]
+decodeSectionEntries count bytes = reverse <$> go count bytes []
+  where
+    go 0 _ acc = Right acc
+    go n bs acc = do
+      when (BS.length bs < sectionEntryLength) $
+        Left "section directory truncated"
+      (sectionType, r1) <- decode32be "section_type" bs
+      (sectionVersion, r2) <- decode16be "section_version" r1
+      (sectionFlags, r3) <- decode16be "section_flags" r2
+      (compression, r4) <- decode16be "compression_codec" r3
+      (digAlg, r5) <- decode16be "digest_algorithm" r4
+      (offset, r6) <- decode64be "section_offset" r5
+      (len, r7) <- decode64be "section_length" r6
+      let (dig, rest) = BS.splitAt 32 r7
+      when (BS.length dig /= 32) $ Left "section digest truncated"
+      let entry = SectionEntry sectionType sectionVersion sectionFlags compression digAlg offset len dig
+      go (n - 1) rest (entry : acc)
+
+-- ---------------------------------------------------------------------------
+-- Manifest construction
+-- ---------------------------------------------------------------------------
+
+defaultManifest :: [(Text, MerkleHash)] -> Int -> BundleManifest
+defaultManifest namedRoots nodeCount = BundleManifest
+  { manifestSchema = "tricu.bundle.manifest.v1"
+  , manifestBundleType = "tree-calculus-executable-object"
+  , manifestTree = TreeSpec
+      { treeCalculus = "tree-calculus.v1"
+      , treeNodeHash = NodeHashSpec
+          { nodeHashAlgorithm = "sha256"
+          , nodeHashDomain = "tricu.merkle.node.v1"
+          }
+      , treeNodePayload = "tricu.merkle.payload.v1"
+      }
+  , manifestRuntime = RuntimeSpec
+      { runtimeSemantics = "tree-calculus.v1"
+      , runtimeEvaluation = "normal-order"
+      , runtimeAbi = "tricu.abi.tree.v1"
+      , runtimeCapabilities = []
+      }
+  , manifestClosure = ClosureComplete
+  , manifestRoots = zipWith mkRoot [0 :: Int ..] (map snd namedRoots)
+  , manifestExports = map mkExport namedRoots
+  , manifestImports = []
+  , manifestSections = object
+      [ "nodes" .= object
+          [ "count" .= nodeCount
+          , "payload" .= ("tricu.merkle.payload.v1" :: Text)
+          ]
+      ]
+  , manifestMetadata = BundleMetadata
+      { metadataPackage = Nothing
+      , metadataVersion = Nothing
+      , metadataDescription = Nothing
+      , metadataLicense = Nothing
+      , metadataCreatedBy = Just "tricu"
+      }
+  }
+  where
+    mkRoot 0 h = BundleRoot h "default"
+    mkRoot _ h = BundleRoot h "root"
+    mkExport (name, h) = BundleExport
+      { exportName = name
+      , exportRoot = h
+      , exportKind = "term"
+      , exportAbi = "tricu.abi.tree.v1"
+      , exportInput = Nothing
+      , exportOutput = Nothing
+      }
+
+-- ---------------------------------------------------------------------------
+-- Node section encoding / decoding
+-- ---------------------------------------------------------------------------
+
+encodeNodeSection :: Map MerkleHash ByteString -> ByteString
+encodeNodeSection nodes =
+  encode64 (fromIntegral $ Map.size nodes)
+    <> mconcat (map nodeEntryToBinary $ Map.toAscList nodes)
+
+-- | Encode a single (hash, canonical-payload) node entry.
+nodeEntryToBinary :: (MerkleHash, ByteString) -> ByteString
+nodeEntryToBinary (h, payload) =
+  merkleHashToRaw h
+    <> encode32 (fromIntegral $ BS.length payload)
+    <> payload
+
+decodeNodeSection :: ByteString -> Either String (Map MerkleHash ByteString)
+decodeNodeSection bs = do
+  (nodeCount, rest) <- decode64be "node_count" bs
+  decodeNodeEntries nodeCount rest
+
+-- | Decode a sequence of node entries.
+decodeNodeEntries :: Word64 -> ByteString -> Either String (Map MerkleHash ByteString)
+decodeNodeEntries count bs = go count bs Map.empty
+  where
+    go 0 rest acc
+      | BS.null rest = Right acc
+      | otherwise = Left "trailing bytes after node section"
+    go n bytes acc
+      | BS.length bytes < 36 =
+          Left "not enough bytes for node entry header (hash + length)"
+      | otherwise = do
+          let (hashBytes, rest) = BS.splitAt 32 bytes
+          (plen, rest') <- decode32be "payload_len" rest
+          let payloadLen = fromIntegral plen
+          if BS.length rest' < payloadLen
+            then Left "payload extends beyond node section end"
+            else do
+              let (payload, after) = BS.splitAt payloadLen rest'
+                  h = rawToMerkleHash hashBytes
+              when (Map.member h acc) $
+                Left $ "duplicate node entry: " ++ unpack h
+              go (n - 1) after (Map.insert h payload acc)
+
+-- ---------------------------------------------------------------------------
+-- Legacy bundle decoding (read-only compatibility)
+-- ---------------------------------------------------------------------------
+
+decodeLegacyBundle :: ByteString -> Either String Bundle
+decodeLegacyBundle bs
+  | BS.length bs < 14 = Left "bundle too short"
+  | BS.take 5 bs /= legacyMagic = Left "invalid legacy magic"
+  | BS.index bs 5 /= legacyWireVersion =
+      Left $ "unsupported legacy wire version: " ++ show (BS.index bs 5)
+  | otherwise = do
+      (rootCount, rest) <- decode32be "root_count" $ BS.drop 6 bs
+      (nodeCount, rest') <- decode32be "node_count" rest
+      let rootBytesLen = fromIntegral rootCount * 32
+      if BS.length rest' < rootBytesLen
+        then Left "bundle truncated in root hashes"
+        else do
+          let rawRoots = BS.take rootBytesLen rest'
+              afterRoots = BS.drop rootBytesLen rest'
+              roots =
+                [ rawToMerkleHash (BS.take 32 (BS.drop (i * 32) rawRoots))
+                | i <- [0 :: Int .. fromIntegral rootCount - 1]
+                ]
+              namedRoots = zip (defaultExportNames $ length roots) roots
+          nodes <- decodeLegacyNodeEntries nodeCount afterRoots
+          let manifest = defaultManifest namedRoots (Map.size nodes)
+          return Bundle
+            { bundleVersion = 1
+            , bundleRoots = roots
+            , bundleNodes = nodes
+            , bundleManifest = manifest
+            , bundleManifestBytes = BL.toStrict (encode manifest)
+            }
+
+decodeLegacyNodeEntries :: Word32 -> ByteString -> Either String (Map MerkleHash ByteString)
+decodeLegacyNodeEntries count bs = fst <$> go count bs Map.empty
+  where
+    go 0 rest acc = Right (acc, rest)
+    go n bytes acc
+      | BS.length bytes < 36 =
+          Left "not enough bytes for node entry header (hash + length)"
+      | otherwise = do
+          let (hashBytes, rest) = BS.splitAt 32 bytes
+          (plen, rest') <- decode32be "payload_len" rest
+          let payloadLen = fromIntegral plen
+          if BS.length rest' < payloadLen
+            then Left "payload extends beyond legacy bundle end"
+            else do
+              let (payload, after) = BS.splitAt payloadLen rest'
+                  h = rawToMerkleHash hashBytes
+              when (Map.member h acc) $
+                Left $ "duplicate node entry: " ++ unpack h
+              go (n - 1) after (Map.insert h payload acc)
+
+-- ---------------------------------------------------------------------------
+-- Bundle verification
+-- ---------------------------------------------------------------------------
+
+verifyBundle :: Bundle -> Either String ()
+verifyBundle bundle
+  | bundleVersion bundle < 1 = Left $ "unsupported bundle version: " ++ show (bundleVersion bundle)
+  | Map.null (bundleNodes bundle) = Left "bundle has no nodes"
+verifyBundle bundle = do
+  verifyManifest (bundleManifest bundle)
+  let nodeMap = bundleNodes bundle
+      rootSet = Set.fromList (bundleRoots bundle)
+      manifestRootSet = Set.fromList (map rootHash $ manifestRoots $ bundleManifest bundle)
+      exportRoots = map exportRoot $ manifestExports $ bundleManifest bundle
+  unless (rootSet == manifestRootSet) $
+    Left "bundle root list does not match manifest roots"
+  traverse_ (requirePresent "root hash missing from bundle") (bundleRoots bundle)
+  traverse_ (requirePresent "export root hash missing from bundle") exportRoots
+  decoded <- traverse verifyNodePayload (Map.toList nodeMap)
+  traverse_ (verifyChildrenPresent nodeMap) decoded
+  verifyCompleteClosure nodeMap (bundleRoots bundle)
+  where
+    requirePresent label h =
+      unless (Map.member h (bundleNodes bundle)) $
+        Left $ label ++ ": " ++ unpack h
+
+verifyManifest :: BundleManifest -> Either String ()
+verifyManifest manifest = do
+  when (manifestSchema manifest /= "tricu.bundle.manifest.v1") $
+    Left $ "unsupported manifest schema: " ++ unpack (manifestSchema manifest)
+  when (manifestBundleType manifest /= "tree-calculus-executable-object") $
+    Left $ "unsupported bundle type: " ++ unpack (manifestBundleType manifest)
+  let treeSpec = manifestTree manifest
+      hashSpec = treeNodeHash treeSpec
+      runtimeSpec = manifestRuntime manifest
+  when (treeCalculus treeSpec /= "tree-calculus.v1") $
+    Left $ "unsupported calculus: " ++ unpack (treeCalculus treeSpec)
+  when (nodeHashAlgorithm hashSpec /= "sha256") $
+    Left $ "unsupported node hash algorithm: " ++ unpack (nodeHashAlgorithm hashSpec)
+  when (nodeHashDomain hashSpec /= "tricu.merkle.node.v1") $
+    Left $ "unsupported node hash domain: " ++ unpack (nodeHashDomain hashSpec)
+  when (treeNodePayload treeSpec /= "tricu.merkle.payload.v1") $
+    Left $ "unsupported node payload: " ++ unpack (treeNodePayload treeSpec)
+  when (runtimeSemantics runtimeSpec /= "tree-calculus.v1") $
+    Left $ "unsupported runtime semantics: " ++ unpack (runtimeSemantics runtimeSpec)
+  when (runtimeAbi runtimeSpec /= "tricu.abi.tree.v1") $
+    Left $ "unsupported runtime ABI: " ++ unpack (runtimeAbi runtimeSpec)
+  unless (null $ runtimeCapabilities runtimeSpec) $
+    Left "host/runtime capabilities are not supported by bundle v1"
+  when (manifestClosure manifest /= ClosureComplete) $
+    Left "bundle v1 imports require closure = complete"
+  unless (null $ manifestImports manifest) $
+    Left "bundle v1 imports require an empty imports list"
+  when (null $ manifestRoots manifest) $
+    Left "manifest has no roots"
+  when (null $ manifestExports manifest) $
+    Left "manifest has no exports"
+  traverse_ verifyExport (manifestExports manifest)
+  where
+    verifyExport exported = do
+      when (T.null $ exportName exported) $
+        Left "manifest export has empty name"
+      when (T.null $ exportRoot exported) $
+        Left "manifest export has empty root"
+
+verifyNodePayload :: (MerkleHash, ByteString) -> Either String (MerkleHash, Node)
+verifyNodePayload (h, payload) = do
+  node <- safeDeserializeNode payload
+  let actual = nodeHash node
+  unless (actual == h) $
+    Left $ "node hash mismatch for " ++ unpack h ++ "; payload hashes to " ++ unpack actual
+  Right (h, node)
+
+verifyChildrenPresent :: Map MerkleHash ByteString -> (MerkleHash, Node) -> Either String ()
+verifyChildrenPresent nodeMap (h, node) =
+  case node of
+    NLeaf -> Right ()
+    NStem child -> requireChild h child
+    NFork left right -> requireChild h left >> requireChild h right
+  where
+    requireChild parent child =
+      unless (Map.member child nodeMap) $
+        Left $ "missing child node referenced by " ++ unpack parent ++ ": " ++ unpack child
+
+verifyCompleteClosure :: Map MerkleHash ByteString -> [MerkleHash] -> Either String ()
+verifyCompleteClosure nodeMap roots = do
+  _ <- foldM visit Set.empty roots
+  Right ()
+  where
+    visit seen h
+      | Set.member h seen = Right seen
+      | otherwise = do
+          payload <- case Map.lookup h nodeMap of
+            Nothing -> Left $ "closure missing node: " ++ unpack h
+            Just p -> Right p
+          node <- safeDeserializeNode payload
+          let seen' = Set.insert h seen
+          case node of
+            NLeaf -> Right seen'
+            NStem child -> visit seen' child
+            NFork left right -> visit seen' left >>= \seenL -> visit seenL right
+
+safeDeserializeNode :: ByteString -> Either String Node
+safeDeserializeNode payload =
+  case BS.uncons payload of
+    Just (0x00, rest)
+      | BS.null rest -> Right NLeaf
+      | otherwise -> Left "invalid leaf payload length"
+    Just (0x01, rest)
+      | BS.length rest == 32 -> Right $ NStem (rawToMerkleHash rest)
+      | otherwise -> Left "invalid stem payload length"
+    Just (0x02, rest)
+      | BS.length rest == 64 ->
+          let (left, right) = BS.splitAt 32 rest
+          in Right $ NFork (rawToMerkleHash left) (rawToMerkleHash right)
+      | otherwise -> Left "invalid fork payload length"
+    _ -> Left "invalid merkle node payload"
+
+-- ---------------------------------------------------------------------------
+-- Reachability traversal
+-- ---------------------------------------------------------------------------
+
+collectReachableNodes :: Connection -> MerkleHash -> IO [(MerkleHash, ByteString)]
+collectReachableNodes conn root = do
+  let go seen current = do
+        case Map.lookup current seen of
+          Just _ -> return seen
+          Nothing -> do
+            maybeNode <- getNodeMerkle conn current
+            case maybeNode of
+              Nothing -> error $ "exportBundle: missing Merkle node: " ++ unpack current
+              Just node -> do
+                let payload = serializeNode node
+                    seen' = Map.insert current payload seen
+                case node of
+                  NLeaf -> return seen'
+                  NStem childHash -> go seen' childHash
+                  NFork lHash rHash -> go seen' lHash >>= \seenL -> go seenL rHash
+  seen <- go Map.empty root
+  return $ Map.toAscList seen
+
+-- ---------------------------------------------------------------------------
+-- High-level export / import
+-- ---------------------------------------------------------------------------
+
+exportBundle :: Connection -> [MerkleHash] -> IO ByteString
+exportBundle conn hashes = exportNamedBundle conn (zip (defaultExportNames $ length hashes) hashes)
+
+exportNamedBundle :: Connection -> [(Text, MerkleHash)] -> IO ByteString
+exportNamedBundle conn namedHashes = do
+  let hashes = map snd namedHashes
+  entries <- concat <$> mapM (collectReachableNodes conn) hashes
+  let nodeMap = Map.fromList entries
+      manifest = defaultManifest namedHashes (Map.size nodeMap)
+      manifestBytes = BL.toStrict (encode manifest)
+      bundle = Bundle
+        { bundleVersion = bundleMajorVersion * 1000 + bundleMinorVersion
+        , bundleRoots = hashes
+        , bundleNodes = nodeMap
+        , bundleManifest = manifest
+        , bundleManifestBytes = manifestBytes
+        }
+  return $ encodeBundle bundle
+
+importBundle :: Connection -> ByteString -> IO [MerkleHash]
+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
+      traverse_ (\payload -> do
+        node <- deserializeForImport payload
+        putMerkleNode conn node
+        )
+        (Map.elems $ bundleNodes bundle)
+      registerBundleExports conn bundle
+      return $ bundleRoots bundle
+
+registerBundleExports :: Connection -> Bundle -> IO ()
+registerBundleExports conn bundle =
+  traverse_ registerExport (manifestExports $ bundleManifest bundle)
+  where
+    registerExport exported = do
+      maybeTree <- loadTree conn (exportRoot exported)
+      case maybeTree of
+        Nothing -> error $ "Wire.importBundle: export root missing after node import: " ++ unpack (exportRoot exported)
+        Just tree -> do
+          _ <- storeTerm conn [unpack $ exportName exported] tree
+          return ()
+
+-- ---------------------------------------------------------------------------
+-- Primitive binary helpers
+-- ---------------------------------------------------------------------------
+
+encode16 :: Word16 -> ByteString
+encode16 w = BS.pack
+  [ fromIntegral (shiftR w 8)
+  , fromIntegral w
+  ]
+
+encode32 :: Word32 -> ByteString
+encode32 w = BS.pack
+  [ fromIntegral (shiftR w 24)
+  , fromIntegral (shiftR w 16)
+  , fromIntegral (shiftR w 8)
+  , fromIntegral w
+  ]
+
+encode64 :: Word64 -> ByteString
+encode64 w = BS.pack
+  [ fromIntegral (shiftR w 56)
+  , fromIntegral (shiftR w 48)
+  , fromIntegral (shiftR w 40)
+  , fromIntegral (shiftR w 32)
+  , fromIntegral (shiftR w 24)
+  , fromIntegral (shiftR w 16)
+  , fromIntegral (shiftR w 8)
+  , fromIntegral w
+  ]
+
+decode16be :: String -> ByteString -> Either String (Word16, ByteString)
+decode16be label bs
+  | BS.length bs < 2 = Left (label ++ ": not enough bytes for u16")
+  | otherwise =
+      let b0 = fromIntegral (BS.index bs 0) :: Word16
+          b1 = fromIntegral (BS.index bs 1) :: Word16
+      in Right ((b0 `shiftL` 8) .|. b1, BS.drop 2 bs)
+
+-- | Decode a big-endian u32 from the head of a ByteString.
+decode32be :: String -> ByteString -> Either String (Word32, ByteString)
+decode32be label bs
+  | BS.length bs < 4 = Left (label ++ ": not enough bytes for u32")
+  | otherwise =
+      let b0 = fromIntegral (BS.index bs 0) :: Word32
+          b1 = fromIntegral (BS.index bs 1) :: Word32
+          b2 = fromIntegral (BS.index bs 2) :: Word32
+          b3 = fromIntegral (BS.index bs 3) :: Word32
+          val = (b0 `shiftL` 24) .|. (b1 `shiftL` 16)
+                .|. (b2 `shiftL` 8) .|. b3
+      in Right (val, BS.drop 4 bs)
+
+decode64be :: String -> ByteString -> Either String (Word64, ByteString)
+decode64be label bs
+  | BS.length bs < 8 = Left (label ++ ": not enough bytes for u64")
+  | otherwise =
+      let byte i = fromIntegral (BS.index bs i) :: Word64
+          val = (byte 0 `shiftL` 56) .|. (byte 1 `shiftL` 48)
+                .|. (byte 2 `shiftL` 40) .|. (byte 3 `shiftL` 32)
+                .|. (byte 4 `shiftL` 24) .|. (byte 5 `shiftL` 16)
+                .|. (byte 6 `shiftL` 8) .|. byte 7
+      in Right (val, BS.drop 8 bs)
+
+-- ---------------------------------------------------------------------------
+-- Hash conversion
+-- ---------------------------------------------------------------------------
+
+-- | Convert a hex MerkleHash to its raw 32-byte representation.
+merkleHashToRaw :: MerkleHash -> ByteString
+merkleHashToRaw h =
+  case Base16.decode (encodeUtf8 h) of
+    Left _ -> error $ "Wire.merkleHashToRaw: invalid hex: " ++ show h
+    Right bs
+      | BS.length bs == 32 -> bs
+      | otherwise -> error $ "Wire.merkleHashToRaw: expected 32 bytes: " ++ show h
+
+-- | Convert raw 32 bytes back to a hex MerkleHash.
+rawToMerkleHash :: ByteString -> MerkleHash
+rawToMerkleHash bs = decodeUtf8 (Base16.encode bs)
+
+sha256 :: ByteString -> ByteString
+sha256 bytes = convert ((hash bytes) :: Digest SHA256)
+
+defaultExportNames :: Int -> [Text]
+defaultExportNames n =
+  case n of
+    0 -> []
+    1 -> ["root"]
+    _ -> ["root" <> T.pack (show i) | i <- [0 :: Int .. n - 1]]
+
+deserializeForImport :: ByteString -> IO Node
+deserializeForImport payload = do
+  result <- try (evaluate $ deserializeNode payload) :: IO (Either SomeException Node)
+  case result of
+    Left err -> error $ "Wire.importBundle: invalid merkle node payload: " ++ show err
+    Right node -> return node

test/Spec.hs

@@ -6,16 +6,24 @@ import Lexer
 import Parser
 import REPL
 import Research
+import Wire
+import ContentStore
 
 import Control.Exception      (evaluate, try, SomeException)
 import Control.Monad.IO.Class (liftIO)
+import Data.Bits              (xor)
 import Data.List              (isInfixOf)
+import Data.Text              (Text, unpack)
+import Data.Word              (Word8)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Text.Megaparsec        (runParser)
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Database.SQLite.Simple (close, Connection)
 
 main :: IO ()
 main = defaultMain tests
@@ -32,8 +40,11 @@ tests = testGroup "Tricu Tests"
   , providedLibraries
   , fileEval
   , modules
---  , demos
+  , demos
   , decoding
+  , elimLambdaSingle
+  , stressElimLambda
+  , wireTests
   ]
 
 lexer :: TestTree
@@ -532,7 +543,7 @@ demos = testGroup "Test provided demo functionality"
       decodeResult res @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\""
   , testCase "Determining the size of functions" $ do
       res     <- liftIO $ evaluateFileResult "./demos/size.tri"
-      decodeResult res @?= "454"
+      decodeResult res @?= "321"
   , testCase "Level Order Traversal demo" $ do
       res     <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri"
       decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \""
@@ -569,3 +580,346 @@ decoding = testGroup "Decoding Tests"
       let input = ofList [ofList [ofString "nested"], ofString "string"]
       decodeResult input @?= "[[\"nested\"], \"string\"]"
   ]
+
+elimLambdaSingle :: TestTree
+elimLambdaSingle = testCase "elimLambda preserves eval, fires eta, and SDef binds" $ do
+  -- 1) eta reduction, purely structural and parsed from source
+  let [etaIn] = parseTricu "x : f x"
+      [fRef ] = parseTricu "f"
+  elimLambda etaIn @?= fRef
+
+  -- 2) SDef binds its own name and parameters
+  let [defFXY] = parseTricu "f x y : f x"
+      fv       = freeVars defFXY
+  assertBool "f should be bound in SDef" ("f" `Set.notMember` fv)
+  assertBool "x should be bound in SDef" ("x" `Set.notMember` fv)
+  assertBool "y should be bound in SDef" ("y" `Set.notMember` fv)
+
+  -- 3) semantics preserved on a small program that exercises compose and triage
+  let src =
+        unlines
+          [ "false = t"
+          , "_     = t"
+          , "true  = t t"
+          , "id    = a : a"
+          , "const = a b : a"
+          , "compose = f g x : f (g x)"
+          , "triage = leaf stem fork : t (t leaf stem) fork"
+          , "test   = triage \"Leaf\" (_ : \"Stem\") (_ _ : \"Fork\")"
+          , "main   = compose id id test"
+          ]
+      prog        = parseTricu src
+      progElim    = map elimLambda prog
+      evalBefore  = result (evalTricu Map.empty prog)
+      evalAfter   = result (evalTricu Map.empty progElim)
+  evalAfter @?= evalBefore
+
+stressElimLambda :: TestTree
+stressElimLambda = testCase "stress elimLambda on wide list under deep curried lambda" $ do
+  let numVars = 200
+      numBody = 800
+      vars    = [ "x" ++ show i | i <- [1..numVars] ]
+      body    = "(" ++ unwords (replicate numBody "t") ++ ")"
+      etaOne  = "h : f h"
+      etaTwo  = "k : id k"
+      defId   = "id = a : a"
+      lambda  = unwords vars ++ " : " ++ body
+      src     = unlines
+                  [ defId
+                  , etaOne
+                  , "compose = f g x : f (g x)"
+                  , "f = t t"
+                  , etaTwo
+                  , lambda
+                  , "main = compose id id (" ++ head vars ++ " : f " ++ head vars ++ ")"
+                  ]
+      prog    = parseTricu src
+
+  let out = map elimLambda prog
+  let noLambda term = case term of
+        SLambda _ _ -> False
+        SApp f g    -> noLambda f && noLambda g
+        SList xs    -> all noLambda xs
+        TFork l r   -> noLambda l && noLambda r
+        TStem u     -> noLambda u
+        _           -> True
+
+  assertBool "all lambdas eliminated" (all noLambda out)
+
+  let before = result (evalTricu Map.empty prog)
+      after  = result (evalTricu Map.empty out)
+  after @?= before
+
+-- --------------------------------------------------------------------------
+-- Wire module tests
+-- --------------------------------------------------------------------------
+
+-- | Helper: create a temporary file-backed DB, store a term, return the
+--   connection and the term (so callers can compare after round-trip).
+storeTermInTempDB :: String -> IO (Connection, Text, T)
+storeTermInTempDB src = do
+  conn <- newContentStore
+  let asts     = parseTricu src
+      finalEnv = evalTricu Map.empty asts
+      term     = result finalEnv
+  -- storeMerkleNodes returns MerkleHash as Text; storeTerm expects [String]
+  _ <- storeTerm conn [] term
+  return (conn, hashTerm term, term)
+
+-- | Load a term from a DB by its stored hash Text.
+loadTermByHash :: Connection -> Text -> IO T
+loadTermByHash conn h = do
+  maybeTerm <- loadTree conn h
+  case maybeTerm of
+    Just t  -> return t
+    Nothing -> errorWithoutStackTrace $ "hash not found in store: " ++ Data.Text.unpack h
+
+-- | Flip one byte in a ByteString at the given index.
+corruptByte :: ByteString -> Int -> ByteString
+corruptByte bs i = BS.take i bs <> BS.pack [(BS.index bs i `xor` 0x01)] <> BS.drop (i + 1) bs
+
+wireTests :: TestTree
+wireTests = testGroup "Wire Tests"
+  [ testCase "Portable bundle: header and manifest declare Tree Calculus object format" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "id = a : a"
+        , "main = id t"
+        ]
+      wireData <- exportBundle srcConn [termHash]
+      BS.take 8 wireData @?= BS.pack [0x54, 0x52, 0x49, 0x43, 0x55, 0x42, 0x4e, 0x44]
+      case decodeBundle wireData of
+        Left err -> assertFailure $ "decodeBundle failed: " ++ err
+        Right bundle -> do
+          let manifest = bundleManifest bundle
+              tree = manifestTree manifest
+              hashSpec = treeNodeHash tree
+              runtime = manifestRuntime manifest
+          manifestSchema manifest @?= "tricu.bundle.manifest.v1"
+          manifestBundleType manifest @?= "tree-calculus-executable-object"
+          manifestClosure manifest @?= ClosureComplete
+          treeCalculus tree @?= "tree-calculus.v1"
+          treeNodePayload tree @?= "tricu.merkle.payload.v1"
+          nodeHashAlgorithm hashSpec @?= "sha256"
+          nodeHashDomain hashSpec @?= "tricu.merkle.node.v1"
+          runtimeSemantics runtime @?= "tree-calculus.v1"
+          runtimeAbi runtime @?= "tricu.abi.tree.v1"
+          runtimeCapabilities runtime @?= []
+          bundleRoots bundle @?= [termHash]
+          map exportRoot (manifestExports manifest) @?= [termHash]
+      close srcConn
+
+  , testCase "Portable bundle: named exports are manifest aliases for Merkle roots" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "validateEmail = a : a"
+        , "main = validateEmail t"
+        ]
+      wireData <- exportNamedBundle srcConn [("validateEmail", termHash)]
+      case decodeBundle wireData of
+        Left err -> assertFailure $ "decodeBundle failed: " ++ err
+        Right bundle -> do
+          bundleRoots bundle @?= [termHash]
+          case manifestExports (bundleManifest bundle) of
+            [exported] -> do
+              exportName exported @?= "validateEmail"
+              exportRoot exported @?= termHash
+              exportKind exported @?= "term"
+              exportAbi exported @?= "tricu.abi.tree.v1"
+            exports -> assertFailure $ "Expected one export, got: " ++ show exports
+      close srcConn
+
+  , testCase "Portable bundle: renaming an export changes bundle bytes but not tree identity" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "f = a : a"
+        , "main = f t"
+        ]
+      mainBundleData <- exportNamedBundle srcConn [("main", termHash)]
+      renamedBundleData <- exportNamedBundle srcConn [("validate", termHash)]
+      assertBool "Renaming an export should change the manifest/bundle bytes"
+        (mainBundleData /= renamedBundleData)
+      case (decodeBundle mainBundleData, decodeBundle renamedBundleData) of
+        (Right mainBundle, Right renamedBundle) -> do
+          bundleRoots mainBundle @?= [termHash]
+          bundleRoots renamedBundle @?= [termHash]
+          map exportRoot (manifestExports $ bundleManifest mainBundle)
+            @?= map exportRoot (manifestExports $ bundleManifest renamedBundle)
+          map exportName (manifestExports $ bundleManifest mainBundle) @?= ["main"]
+          map exportName (manifestExports $ bundleManifest renamedBundle) @?= ["validate"]
+        (Left err, _) -> assertFailure $ "decodeBundle main failed: " ++ err
+        (_, Left err) -> assertFailure $ "decodeBundle renamed failed: " ++ err
+      close srcConn
+
+  , testCase "Portable bundle: exact byte export is deterministic" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "x = t t"
+        , "main = t x"
+        ]
+      first <- exportBundle srcConn [termHash]
+      second <- exportBundle srcConn [termHash]
+      first @?= second
+      close srcConn
+
+  , testCase "Portable bundle: raw section tampering is rejected by digest verification" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "x = t"
+        , "main = t x"
+        ]
+      wireData <- exportBundle srcConn [termHash]
+      let tampered = corruptByte wireData (BS.length wireData - 1)
+      case decodeBundle tampered of
+        Left err -> assertBool ("Expected section digest mismatch, got: " ++ err)
+          ("digest mismatch" `isInfixOf` err)
+        Right _ -> assertFailure "Expected decodeBundle to reject tampered section bytes"
+      close srcConn
+
+  , testCase "Portable bundle: unsupported manifest semantics are rejected" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "x = t"
+        , "main = t x"
+        ]
+      wireData <- exportBundle srcConn [termHash]
+      case decodeBundle wireData of
+        Left err -> assertFailure $ "decodeBundle failed: " ++ err
+        Right bundle -> do
+          let manifest = bundleManifest bundle
+              partialBundle = bundle
+                { bundleManifest = manifest { manifestClosure = ClosurePartial }
+                , bundleManifestBytes = BS.empty
+                }
+              capabilityBundle = bundle
+                { bundleManifest = manifest
+                    { manifestRuntime = (manifestRuntime manifest)
+                        { runtimeCapabilities = ["host.io"]
+                        }
+                    }
+                , bundleManifestBytes = BS.empty
+                }
+              wrongHashBundle = bundle
+                { bundleManifest = manifest
+                    { manifestTree = (manifestTree manifest)
+                        { treeNodeHash = (treeNodeHash $ manifestTree manifest)
+                            { nodeHashAlgorithm = "blake3" }
+                        }
+                    }
+                , bundleManifestBytes = BS.empty
+                }
+          case verifyBundle partialBundle of
+            Left err -> assertBool ("Expected closure error, got: " ++ err) ("closure = complete" `isInfixOf` err)
+            Right () -> assertFailure "Expected partial closure to be rejected"
+          case verifyBundle capabilityBundle of
+            Left err -> assertBool ("Expected capability error, got: " ++ err) ("capabilities" `isInfixOf` err)
+            Right () -> assertFailure "Expected runtime capabilities to be rejected"
+          case verifyBundle wrongHashBundle of
+            Left err -> assertBool ("Expected hash algorithm error, got: " ++ err) ("node hash algorithm" `isInfixOf` err)
+            Right () -> assertFailure "Expected unsupported node hash algorithm to be rejected"
+      close srcConn
+
+  , testCase "Portable bundle: import registers manifest export names in fresh content store" $ do
+      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
+        [ "validateEmail = a : a"
+        , "main = validateEmail t"
+        ]
+      wireData <- exportNamedBundle srcConn [("validateEmail", termHash)]
+      dstConn <- newContentStore
+      _ <- importBundle dstConn wireData
+      loadedByHash <- loadTermByHash dstConn termHash
+      loadedByName <- loadTerm dstConn "validateEmail"
+      loadedByHash @?= originalTerm
+      loadedByName @?= Just originalTerm
+      close srcConn
+      close dstConn
+
+  , testCase "Round-trip: store, export, import, load" $ do
+      -- Store a term
+      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
+        [ "x = t"
+        , "y = t x"
+        , "z = t y"
+        , "main = z"
+        ]
+      -- Export by root hash
+      wireData <- exportBundle srcConn [termHash]
+      -- Import into a fresh DB
+      dstConn <- newContentStore
+      _ <- importBundle dstConn wireData
+      -- Load the term back and compare
+      loadedTerm <- loadTermByHash dstConn termHash
+      loadedTerm @?= originalTerm
+      -- Cleanup
+      close srcConn
+      close dstConn
+
+  , testCase "Round-trip: evaluate from original, export, import, load root" $ do
+      (srcConn, termHash, originalTerm) <- storeTermInTempDB $ unlines
+        [ "add = a b : t (t a) b"
+        , "val = add (t t) (t)"
+        , "main = val"
+        ]
+      -- Export
+      wireData <- exportBundle srcConn [termHash]
+      -- Import into fresh DB
+      dstConn <- newContentStore
+      _ <- importBundle dstConn wireData
+      -- Load the root term by hash and compare
+      loadedTerm <- loadTermByHash dstConn termHash
+      loadedTerm @?= originalTerm
+      close srcConn
+      close dstConn
+
+  , testCase "Negative: corrupt payload byte causes import to fail" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "x = t"
+        , "y = t x"
+        , "z = t y"
+        , "main = z"
+        ]
+      wireData <- exportBundle srcConn [termHash]
+      -- Decode, mutate one node's payload byte, re-encode
+      case decodeBundle wireData of
+        Left err -> assertFailure $ "decodeBundle failed: " ++ err
+        Right bundle -> do
+          let (h, payload) =
+                head
+                  [ (h', p)
+                  | (h', p) <- Map.toList (bundleNodes bundle)
+                  , BS.length p > 0
+                  ]
+              payload' = BS.pack [(BS.head payload `xor` 0x01)] <> BS.tail payload
+              bundle' = bundle { bundleNodes = Map.insert h payload' (bundleNodes bundle) }
+              wireData' = encodeBundle bundle'
+          dstConn <- newContentStore
+          result <- try (importBundle dstConn wireData') :: IO (Either SomeException [MerkleHash])
+          case result of
+            Left e ->
+              assertBool ("Expected hash mismatch or invalid payload, got: " ++ show e)
+                $ "mismatch" `isInfixOf` show e || "invalid" `isInfixOf` show e
+            Right _ ->
+              assertFailure "Expected import to fail on corrupted payload"
+          close dstConn
+      close srcConn
+
+  , testCase "Negative: missing child node causes import to fail" $ do
+      (srcConn, termHash, _) <- storeTermInTempDB $ unlines
+        [ "x = t"
+        , "y = t x"
+        , "z = t y"
+        , "main = z"
+        ]
+      wireData <- exportBundle srcConn [termHash]
+      -- Decode, remove a node, re-encode
+      case decodeBundle wireData of
+        Left err -> assertFailure $ "decodeBundle failed: " ++ err
+        Right bundle -> do
+          let nodeList = Map.toList (bundleNodes bundle)
+              trimmed = Map.fromList (tail nodeList)
+              newBundle = bundle { bundleNodes = trimmed }
+              newWire = encodeBundle newBundle
+          dstConn <- newContentStore
+          result <- try (importBundle dstConn newWire) :: IO (Either SomeException [MerkleHash])
+          case result of
+            Left e ->
+              assertBool ("Expected verify error, got: " ++ show e) True
+            Right _ ->
+              assertFailure "Expected import to fail on missing child node"
+          close dstConn
+      close srcConn
+    ]

tricu.cabal

@@ -1,8 +1,8 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        1.0.0
+version:        1.1.0
-description:    A micro-language for exploring Tree Calculus
+description:    A language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co
 copyright:      James Eversole
@@ -15,18 +15,31 @@ extra-source-files:
 executable tricu
   main-is: Main.hs
   hs-source-dirs:
-      src
+    src
   default-extensions:
-      DeriveDataTypeable
+    DeriveDataTypeable
-      LambdaCase
+    LambdaCase
-      MultiWayIf
+    MultiWayIf
-      OverloadedStrings
+    OverloadedStrings
-      ScopedTypeVariables
+    ScopedTypeVariables
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
+  ghc-options: 
+    -Wall
+    -Wcompat
+    -Wunused-imports
+    -Wunused-top-binds
+    -Wunused-local-binds
+    -Wunused-matches
+    -Wredundant-constraints
+    -threaded 
+    -rtsopts 
+    -with-rtsopts=-N 
+    -optl-pthread 
+    -fPIC
   build-depends:
     base >=4.7
     , aeson
     , ansi-terminal
+    , base16-bytestring
     , base64-bytestring
     , bytestring
     , cereal
@@ -49,12 +62,15 @@ executable tricu
     , transformers
     , zlib
   other-modules:
+    ContentStore
     Eval
     FileEval
     Lexer
     Parser
+    Paths_tricu
     REPL
     Research
+    Wire
   default-language: Haskell2010
 
 test-suite tricu-tests
@@ -71,6 +87,7 @@ test-suite tricu-tests
     base >=4.7
     , aeson
     , ansi-terminal
+    , base16-bytestring
     , base64-bytestring
     , bytestring
     , cereal
@@ -94,9 +111,12 @@ test-suite tricu-tests
     , zlib
   default-language:    Haskell2010
   other-modules:
+    ContentStore
     Eval
     FileEval
     Lexer
     Parser
+    Paths_tricu
     REPL
     Research
+    Wire