Zero Warnings Plan

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

AGENTS.md

@@ -0,0 +1,177 @@
+# AGENTS.md — tricu Project Guide
+
+> For AI agents and contributors working in this repository.
+
+## 1. Build & Test
+
+**`nix build .#` always runs tests.** This is the primary and only way to build and validate.
+
+```bash
+# Full build + tests (this is the default)
+nix build .#
+
+# Build only (skip tests)
+nix build .#package
+
+# Build the test-specific variant with doCheck enforced
+nix build .#test
+nix flake check
+
+# Dev shell (includes ghcid, cabal-install, ghc, upx)
+nix develop .#
+```
+
+### ⚠️ Never call `cabal` directly
+
+This project uses a Nix flake that wraps `callCabal2nix` to produce the cabal package. All compilation, linking, and test execution are driven through Nix. Running `cabal build`, `cabal test`, `cabal repl`, or `cabal install` directly will use the system GHC (or `.stack-work`) and can produce artifacts that differ from the Nix-built ones — especially regarding `megaparsec` which is a project dependency.
+
+> **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.
+
+tricu is Lojban for "tree".
+
+### 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 |
+
+### Adding tests
+
+1. Append a `testCase "Description" $ do ...` block to the appropriate test group in `test/Spec.hs`.
+2. Import any modules you need (lexer/parser are available via `runParser` from `Text.Megapparsec`; evaluation via `evalTricu`, `parseTricu`, `result`).
+3. Run `nix flake check` to verify.
+
+> The test-suite in `tricu.cabal` pulls in `src/` as `hs-source-dirs`, so tests import modules directly (e.g., `import Eval`, `import Lexer`). This is intentional — tests exercise the full pipeline end-to-end.
+
+## 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
+|- block 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
+
+- **Quick iteration:** `nix develop` then `ghcid` (provided in the devShell) watches files and re-runs.
+- **REPL:** `nix run .#` starts the interactive 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
 
@@ -47,7 +44,6 @@ initContentStore = 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 '')"
@@ -83,8 +79,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,12 +88,13 @@ 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 :: Connection -> MerkleHash -> IO (Maybe T)
 loadTree conn h
   | h == nodeHash NLeaf = return (Just Leaf)  -- NLeaf is implicit, not stored
   | otherwise = do
@@ -107,12 +104,13 @@ loadTree conn h
         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.
@@ -161,14 +159,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,18 @@
 module Main where
 
+import ContentStore ()
 import Eval                   (evalTricu, mainResult, result)
 import FileEval
 import Parser                 (parseTricu)
 import REPL
 import Research
-import ContentStore
 
 import Control.Monad          (foldM)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class ()
 import Data.Version           (showVersion)
-import Text.Megaparsec        (runParser)
 import Paths_tricu            (version)
 import System.Console.CmdArgs
+import Text.Megaparsec        ()
 
 import qualified Data.Map as Map
 
@@ -56,24 +56,24 @@ decodeMode = TDecode
 main :: IO ()
 main = do
   let versionStr = "tricu Evaluator and REPL " ++ showVersion version
-  args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
+  cmdArgsParsed <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
     &= 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

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,41 @@
 module REPL where
 
+import ContentStore
 import Eval
 import FileEval
-import Lexer
+import Lexer ()
 import Parser
 import Research
-import ContentStore
 
 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 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
@@ -121,26 +114,26 @@ repl = do
           | "!tag" `isPrefixOf` strip s -> handleTag 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 +194,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 +209,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 +241,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 +252,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 +268,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
 
@@ -486,8 +479,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 +491,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 +524,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 +545,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 []

test/Spec.hs

@@ -32,8 +32,10 @@ tests = testGroup "Tricu Tests"
   , providedLibraries
   , fileEval
   , modules
---  , demos
+  , demos
   , decoding
+  , elimLambdaSingle
+  , stressElimLambda
   ]
 
 lexer :: TestTree
@@ -532,7 +534,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 +571,72 @@ 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

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,10 +62,12 @@ executable tricu
     , transformers
     , zlib
   other-modules:
+    ContentStore
     Eval
     FileEval
     Lexer
     Parser
+    Paths_tricu
     REPL
     Research
   default-language: Haskell2010
@@ -71,6 +86,7 @@ test-suite tricu-tests
     base >=4.7
     , aeson
     , ansi-terminal
+    , base16-bytestring
     , base64-bytestring
     , bytestring
     , cereal
@@ -94,9 +110,11 @@ test-suite tricu-tests
     , zlib
   default-language:    Haskell2010
   other-modules:
+    ContentStore
     Eval
     FileEval
     Lexer
     Parser
+    Paths_tricu
     REPL
     Research