Update README to reflect completion of experiment

.gitignore

@@ -6,6 +6,7 @@
 /Dockerfile
 /config.dhall
 /result
+.aider*
 WD
 bin/
 dist*

README.md

@@ -14,6 +14,17 @@ Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-persona
 
 [treecalcul.us](https://treecalcul.us) is an excellent website with an intuitive Tree Calculus code playground created by [Johannes Bader](https://johannes-bader.com/) that introduced me to Tree Calculus.
 
+## Features
+
+- Tree Calculus **operator**: `t`
+- **Immutable definitions**: `x = t t`
+- **Lambda abstraction**: `id = (a : a)`
+- **List, Number, and String** literals: `[(2) ("Hello")]` 
+- **Function application**: `not (not false)`
+- **Higher order/first-class functions**: `map (a : append a "!") [("Hello")]`
+- **Intensionality** blurs the distinction between functions and data (see REPL examples)
+- **Content-addressed store**: save, version, tag, and recall your tricu terms.
+
 ## REPL examples
 
 ```
@@ -36,17 +47,32 @@ tricu < -- or calculate its size (/demos/size.tri)
 tricu < size not?
 tricu > 12
 
-tricu < -- REPL Commands:
-tricu < !definitions  -- Lists all available definitions
-tricu < !output       -- Change output format (Tree, FSL, AST, etc.)
-tricu < !import       -- Import definitions from a file
-tricu < !exit         -- Exit the REPL
-tricu < !clear        -- ANSI screen clear
-tricu < !save         -- Save all REPL definitions to a file that you can !import
-tricu < !reset        -- Clear all REPL definitions
-tricu < !version      -- Print tricu version
+tricu < !help 
+tricu version 0.20.0
+Available commands:
+    !exit        - Exit the REPL
+    !clear       - Clear the screen
+    !reset       - Reset preferences for selected versions
+    !help        - Show tricu version and available commands
+    !output      - Change output format (tree|fsl|ast|ternary|ascii|decode)
+    !definitions - List all defined terms in the content store
+    !import      - Import definitions from file (definitions are stored)
+    !watch       - Watch a file for changes (definitions are stored)
+    !versions    - Show all versions of a term by name
+    !select      - Select a specific version of a term for subsequent lookups
+    !tag         - Add or update a tag for a term by hash or name
 ```
 
+## Content Store
+
+tricu uses a "content store" SQLite database that saves and versions your definitions persistently.
+
+*   **Persistent definitions:** Any term you define in the REPL is automatically saved.
+*   **Content-addressed:** Terms are stored based on a SHA256 hash of their content. This means identical terms are stored only once, even if they have different names.
+*   **Versioning and history:** If you redefine a name, the Content Store keeps a record of previous definitions associated with that name. You can explore the history of a term and access older versions.
+*   **Tagging:** You can assign tags to versions of your terms to organize and quickly switch between related function versions.
+*   **Querying:** The store allows you to search for terms by name, hash, or tags.
+
 ## Installation and Use
 
 You can easily build and run this project using [Nix](https://nixos.org/download/).

lib/patterns.tri

@@ -1,5 +1,5 @@
 !import "base.tri" !Local
-!import "list.tri" List
+!import "list.tri" !Local
 
 match_ = y (self value patterns :
   triage
@@ -17,8 +17,8 @@ match_ = y (self value patterns :
     patterns)
 
 match = (value patterns :
-  match_ value (List.map (sublist :
-    pair (List.head sublist) (List.head (List.tail sublist)))
+  match_ value (map (sublist :
+    pair (head sublist) (head (tail sublist)))
     patterns))
 
 otherwise = const (t t)

src/ContentStore.hs

@@ -0,0 +1,230 @@
+module ContentStore where
+
+import Research
+import Parser
+
+import Control.Monad                  (foldM, forM)
+import Crypto.Hash                    (hash, SHA256, Digest)
+import Data.ByteString                (ByteString)
+import Data.List                      (intercalate, nub, sortBy, sort)
+import Data.Maybe                     (catMaybes)
+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.ByteString.Lazy as LBS
+import qualified Data.Map             as Map
+import qualified Data.Serialize       as Cereal
+import qualified Data.Text            as T
+
+data StoredTerm = StoredTerm
+  { termHash :: Text
+  , termNames :: Text
+  , termData :: ByteString
+  , termMetadata :: Text
+  , termCreatedAt :: Integer
+  , termTags :: Text
+  } deriving (Show)
+
+instance FromRow StoredTerm where
+  fromRow = StoredTerm <$> field <*> field <*> field <*> field <*> field <*> field
+
+tryDeserializeTerm :: ByteString -> IO (Maybe T)
+tryDeserializeTerm bs =
+  case deserializeTerm bs of
+    Right t -> return $ Just t
+    Left err -> do
+      putStrLn $ "Error deserializing term: " ++ err
+      return Nothing
+
+parseNameList :: Text -> [Text]
+parseNameList = filter (not . T.null) . T.splitOn ","
+
+serializeNameList :: [Text] -> Text
+serializeNameList = T.intercalate "," . nub . sort
+
+initContentStore :: IO Connection
+initContentStore = do
+  dbPath <- getContentStorePath
+  createDirectoryIfMissing True (takeDirectory dbPath)
+  conn <- open dbPath
+  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 '')"
+  execute_ conn "CREATE INDEX IF NOT EXISTS terms_names_idx ON terms(names)"
+  execute_ conn "CREATE INDEX IF NOT EXISTS terms_tags_idx ON terms(tags)"
+  return   conn
+
+getContentStorePath :: IO FilePath
+getContentStorePath = do
+  dataDir <- getXdgDirectory XdgData "tricu"
+  return $ dataDir </> "content-store.db"
+
+instance Cereal.Serialize T where
+  put Leaf = Cereal.putWord8 0
+  put (Stem t) = do
+    Cereal.putWord8 1
+    Cereal.put t
+  put (Fork a b) = do
+    Cereal.putWord8 2
+    Cereal.put a
+    Cereal.put b
+
+  get = do
+    tag <- Cereal.getWord8
+    case tag of
+      0 -> return Leaf
+      1 -> Stem <$> Cereal.get
+      2 -> Fork <$> Cereal.get <*> Cereal.get
+      _ -> fail $ "Invalid tag for T: " ++ show tag
+
+serializeTerm :: T -> ByteString
+serializeTerm = LBS.toStrict . Cereal.encodeLazy
+
+deserializeTerm :: ByteString -> Either String T
+deserializeTerm = Cereal.decodeLazy . LBS.fromStrict
+
+hashTerm :: T -> Text
+hashTerm = T.pack . show . (hash :: ByteString -> Digest SHA256) . serializeTerm
+
+storeTerm :: Connection -> [String] -> T -> IO Text
+storeTerm conn newNamesStrList term = do
+  let termBS = serializeTerm term
+      termHashText = hashTerm term
+      newNamesTextList = map T.pack newNamesStrList
+      metadataText = T.pack "{}"
+
+  existingNamesQuery <- query conn
+    "SELECT names FROM terms WHERE hash = ?"
+    (Only termHashText) :: IO [Only Text]
+
+  case existingNamesQuery of
+    [] -> do
+      let allNamesToStore = serializeNameList newNamesTextList
+      execute conn
+        "INSERT INTO terms (hash, names, term_data, metadata, tags) VALUES (?, ?, ?, ?, ?)"
+        (termHashText, allNamesToStore, termBS, metadataText, T.pack "")
+    [(Only currentNamesText)] -> do
+      let currentNamesList = parseNameList currentNamesText
+      let combinedNamesList = currentNamesList ++ newNamesTextList
+      let allNamesToStore = serializeNameList combinedNamesList
+      execute conn
+        "UPDATE terms SET names = ?, metadata = ? WHERE hash = ?"
+        (allNamesToStore, metadataText, termHashText)
+
+  return termHashText
+
+hashToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
+hashToTerm conn hashText =
+  queryMaybeOne conn (selectStoredTermFields <> " WHERE hash = ?") (Only hashText)
+
+nameToTerm :: Connection -> Text -> IO (Maybe StoredTerm)
+nameToTerm conn nameText =
+  queryMaybeOne conn
+    (selectStoredTermFields <> " WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC LIMIT 1")
+    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
+
+listStoredTerms :: Connection -> IO [StoredTerm]
+listStoredTerms conn =
+  query_ conn (selectStoredTermFields <> " ORDER BY created_at DESC")
+
+storeEnvironment :: Connection -> Env -> IO [(String, Text)]
+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
+    hashVal <- storeTerm conn namesList term
+    return (head namesList, hashVal)
+
+loadTerm :: Connection -> String -> IO (Maybe T)
+loadTerm conn identifier = do
+  result <- getTerm conn (T.pack identifier)
+  case result of
+    Just storedTerm -> tryDeserializeTerm (termData storedTerm)
+    Nothing -> return Nothing
+
+getTerm :: Connection -> Text -> IO (Maybe StoredTerm)
+getTerm conn identifier = do
+  if '#' `elem` (T.unpack identifier)
+    then hashToTerm conn (T.pack $ drop 1 (T.unpack identifier))
+    else nameToTerm conn identifier
+
+loadEnvironment :: Connection -> IO Env
+loadEnvironment conn = do
+  terms <- listStoredTerms conn
+  foldM addTermToEnv Map.empty terms
+  where
+    addTermToEnv env storedTerm = do
+      maybeT <- tryDeserializeTerm (termData storedTerm)
+      case maybeT of
+        Just t -> do
+          let namesList = parseNameList (termNames storedTerm)
+          return $ foldl (\e name -> Map.insert (T.unpack name) t e) env namesList
+        Nothing -> return env
+
+termVersions :: Connection -> String -> IO [(Text, T, Integer)]
+termVersions conn name = do
+  let nameText = T.pack name
+  results <- query conn
+    ("SELECT hash, term_data, created_at FROM terms WHERE (names = ? OR names LIKE ? OR names LIKE ? OR names LIKE ?) ORDER BY created_at DESC")
+    (nameText, nameText <> T.pack ",%", T.pack "%," <> nameText <> T.pack ",%", T.pack "%," <> nameText)
+
+  catMaybes <$> mapM (\(hashVal, termDataVal, timestamp) -> do
+    maybeT <- tryDeserializeTerm termDataVal
+    return $ fmap (\t -> (hashVal, t, timestamp)) maybeT
+    ) results
+
+setTag :: Connection -> Text -> Text -> IO ()
+setTag conn hash tagValue = do
+  exists <- termExists conn hash
+  if exists
+    then do
+      currentTagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
+      case currentTagsQuery of
+        [Only tagsText] -> do
+          let tagsList = parseNameList tagsText
+              newTagsList = tagValue : tagsList
+              newTags = serializeNameList newTagsList
+          execute conn "UPDATE terms SET tags = ? WHERE hash = ?" (newTags, hash)
+        _ -> putStrLn $ "Term with hash " ++ T.unpack hash ++ " not found (should not happen if exists is true)"
+    else
+      putStrLn $ "Term with hash " ++ T.unpack hash ++ " does not exist"
+
+termExists :: Connection -> Text -> IO Bool
+termExists conn hash = do
+  results <- query conn "SELECT 1 FROM terms WHERE hash = ? LIMIT 1" (Only hash) :: IO [[Int]]
+  return $ not (null results)
+
+termToTags :: Connection -> Text -> IO [Text]
+termToTags conn hash = do
+  tagsQuery <- query conn "SELECT tags FROM terms WHERE hash = ?" (Only hash) :: IO [Only Text]
+  case tagsQuery of
+    [Only tagsText] -> return $ parseNameList tagsText
+    _ -> return []
+
+tagToTerm :: Connection -> Text -> IO [StoredTerm]
+tagToTerm conn tagValue = do
+  let pattern = "%" <> tagValue <> "%"
+  query conn (selectStoredTermFields <> " WHERE tags LIKE ? ORDER BY created_at DESC") (Only pattern)
+
+allTermTags :: Connection -> IO [StoredTerm]
+allTermTags conn = do
+  query_ conn (selectStoredTermFields <> " WHERE tags IS NOT NULL AND tags != '' ORDER BY created_at DESC")
+
+selectStoredTermFields :: Query
+selectStoredTermFields = "SELECT hash, names, term_data, metadata, created_at, tags FROM terms"
+
+queryMaybeOne :: (FromRow r, ToRow q) => Connection -> Query -> q -> IO (Maybe r)
+queryMaybeOne conn qry params = do
+  results <- query conn qry params
+  case results of
+    [row] -> return $ Just row
+    _     -> return Nothing

src/Eval.hs

@@ -1,54 +1,42 @@
 module Eval where
 
+import ContentStore
 import Parser
 import Research
 
-import           Data.List   (partition, (\\), elemIndex)
+import Control.Monad (forM_, foldM)
+import Data.List (partition, (\\))
 import Data.Map  (Map)
-import           Data.Set    (Set)
-
-import qualified Data.Foldable as F
+import Database.SQLite.Simple
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-
-data DB
-  = BVar Int          -- bound (0 = nearest binder)
-  | BFree String      -- free/global
-  | BLam DB
-  | BApp DB DB
-  | BLeaf
-  | BStem DB
-  | BFork DB DB
-  | BStr String
-  | BInt Integer
-  | BList [DB]
-  | BEmpty
-  deriving (Eq, Show)
-
-type Uses = [Bool]
+import qualified Data.Text as T
+import Data.List (foldl')
 
 evalSingle :: Env -> TricuAST -> Env
 evalSingle env term
   | SDef name [] body <- term
   = case Map.lookup name env of
       Just existingValue
-        | existingValue == evalAST env body -> env
-        | otherwise -> errorWithoutStackTrace $
-            "Unable to rebind immutable identifier: " ++ name
-      Nothing ->
-        let res = evalAST env body
+        | existingValue == evalASTSync env body -> env
+        | otherwise
+        -> let res = evalASTSync env body
+           in Map.insert "!result" res (Map.insert name res env)
+      Nothing
+        -> let res = evalASTSync env body
            in Map.insert "!result" res (Map.insert name res env)
   | SApp func arg <- term
-  = let res = apply (evalAST env func) (evalAST env arg)
+  = let res = apply (evalASTSync env func) (evalASTSync env arg)
     in Map.insert "!result" res env
-  | SVar name <- term
+  | SVar name Nothing <- term
   = case Map.lookup name env of
       Just v -> Map.insert "!result" v env
-        Nothing ->
-          errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\
-          \This error should never occur here. Please report this as an issue."
+      Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
+  | SVar name (Just hash) <- term
+  = errorWithoutStackTrace $ "Hash-specific variable lookup not supported in local evaluation: " ++ name ++ "#" ++ hash
   | otherwise
-  = Map.insert "!result" (evalAST env term) env
+  = let res = evalASTSync env term
+    in Map.insert "!result" res env
 
 evalTricu :: Env -> [TricuAST] -> Env
 evalTricu env x = go env (reorderDefs env x)
@@ -60,96 +48,156 @@ evalTricu env x = go env (reorderDefs env x)
     go env (x:xs) =
       evalTricu (evalSingle env x) xs
 
-evalAST :: Env -> TricuAST -> T
-evalAST env term
-  | SLambda _ _ <- term = evalAST env (elimLambda term)
-  | SVar   name <- term = evalVar name
-  | TLeaf       <- term = Leaf
-  | TStem  t    <- term = Stem (evalAST env t)
-  | TFork  t u  <- term = Fork (evalAST env t) (evalAST env u)
-  | SApp   t u  <- term = apply (evalAST env t) (evalAST env u)
-  | SStr   s    <- term = ofString s
-  | SInt   n    <- term = ofNumber n
-  | SList  xs   <- term = ofList (map (evalAST env) xs)
-  | SEmpty      <- term = Leaf
-  | otherwise           = errorWithoutStackTrace "Unexpected AST term"
+evalASTSync :: Env -> TricuAST -> T
+evalASTSync env term = case term of
+  SLambda _ _ -> evalASTSync env (elimLambda term)
+  SVar name Nothing -> case Map.lookup name env of
+    Just v -> v
+    Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
+  SVar name (Just hash) ->
+    case Map.lookup (name ++ "#" ++ hash) env of
+      Just v -> v
+      Nothing -> errorWithoutStackTrace $
+        "Variable " ++ name ++ " with hash " ++ hash ++ " not found in environment"
+  TLeaf -> Leaf
+  TStem t -> Stem (evalASTSync env t)
+  TFork t u -> Fork (evalASTSync env t) (evalASTSync env u)
+  SApp t u -> apply (evalASTSync env t) (evalASTSync env u)
+  SStr s -> ofString s
+  SInt n -> ofNumber n
+  SList xs -> ofList (map (evalASTSync env) xs)
+  SEmpty -> Leaf
+  _ -> errorWithoutStackTrace $ "Unexpected AST term: " ++ show term
+
+evalAST :: Maybe Connection -> Map.Map String T.Text -> TricuAST -> IO T
+evalAST mconn selectedVersions ast = do
+  let varNames = collectVarNames ast
+  resolvedEnv <- resolveTermsFromStore mconn selectedVersions varNames
+  return $ evalASTSync resolvedEnv ast
+
+collectVarNames :: TricuAST -> [(String, Maybe String)]
+collectVarNames = go []
   where
-      evalVar name = Map.findWithDefault
-        (errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
-        name env
+    go acc (SVar name mhash) = (name, mhash) : acc
+    go acc (SApp t u) = go (go acc t) u
+    go acc (SLambda vars body) =
+      let boundVars = Set.fromList vars
+          collected = go [] body
+      in acc ++ filter (\(name, _) -> not $ Set.member name boundVars) collected
+    go acc (TStem t) = go acc t
+    go acc (TFork t u) = go (go acc t) u
+    go acc (SList xs) = foldl' go acc xs
+    go acc _ = acc
+
+resolveTermsFromStore :: Maybe Connection -> Map.Map String T.Text -> [(String, Maybe String)] -> IO Env
+resolveTermsFromStore Nothing _ _ = return Map.empty
+resolveTermsFromStore (Just conn) selectedVersions varNames = do
+  foldM (\env (name, mhash) -> do
+    term <- resolveTermFromStore conn selectedVersions name mhash
+    case term of
+      Just t -> return $ Map.insert (getVarKey name mhash) t env
+      Nothing -> return env
+      ) Map.empty varNames
+  where
+    getVarKey name Nothing = name
+    getVarKey name (Just hash) = name ++ "#" ++ hash
+
+resolveTermFromStore :: Connection -> Map.Map String T.Text -> String -> Maybe String -> IO (Maybe T)
+resolveTermFromStore conn selectedVersions name mhash = case mhash of
+  Just hashPrefix -> do
+    versions <- termVersions conn name
+    let matchingVersions = filter (\(hash, _, _) ->
+          T.isPrefixOf (T.pack hashPrefix) hash) versions
+    case matchingVersions of
+      [] -> return Nothing
+      [(_, term, _)] -> return $ Just term
+      _ -> return Nothing -- Ambiguous or too many matches
+  Nothing -> case Map.lookup name selectedVersions of
+    Just hash -> do
+      mterm <- hashToTerm conn hash
+      case mterm of
+        Just term -> case deserializeTerm (termData term) of
+          Right t -> return $ Just t
+          Left _ -> return Nothing
+        Nothing -> return Nothing
+    Nothing -> do
+      versions <- termVersions conn name
+      case versions of
+        [] -> return Nothing
+        [(_, term, _)] -> return $ Just term
+        _ -> return $ Just $ (\(_, t, _) -> t) $ head versions
 
 elimLambda :: TricuAST -> TricuAST
 elimLambda = go
   where
     go term
-      | etaReduction term   = go (etaReduceResult term)
+      | etaReduction term   = elimLambda $ etaReduceResult term
       | triagePattern term  = _TRI
       | composePattern term = _B
-      | lambdaList term     = go (lambdaListResult term)
+      | lambdaList term     = elimLambda $ lambdaListResult term
       | nestedLambda term   = nestedLambdaResult term
       | application term    = applicationResult term
+      | isSList term        = slistTransform term
       | otherwise           = term
 
-    -- patterns (now DB-indexed where it matters)
-    etaReduction (SLambda [v] (SApp f (SVar x))) = v == x && not (usesBinder v f)
+    etaReduction (SLambda [v] (SApp f (SVar x Nothing))) = v == x && not (isFree v f)
     etaReduction _ = False
+    etaReduceResult (SLambda [_] (SApp f _)) = f
 
-    -- triage: \a b c -> TLeaf (TLeaf a b) c  (checked in DB with a↦2, b↦1, c↦0)
-    triagePattern (SLambda [a] (SLambda [b] (SLambda [c] body))) =
-      toDB [c,b,a] body == triageBodyDB
+    triagePattern (SLambda [a] (SLambda [b] (SLambda [c] body))) = body == triageBody a b c
     triagePattern _ = False
 
-    -- compose: \f g x -> f (g x)  (checked in DB with f↦2, g↦1, x↦0)
-    composePattern (SLambda [f] (SLambda [g] (SLambda [x] body))) =
-      toDB [x,g,f] body == composeBodyDB
+    composePattern (SLambda [f] (SLambda [g] (SLambda [x] body))) = body == composeBody f g x
     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
 
-    -- rewrites
-    etaReduceResult (SLambda [_] (SApp f _)) = f
+    isSList (SList _) = True
+    isSList _         = False
 
-    lambdaListResult (SLambda [v] (SList xs)) =
-      SLambda [v] (foldr wrapTLeaf TLeaf xs)
-      where
-        wrapTLeaf m r = SApp (SApp TLeaf m) r
+    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
 
-    -- The key change: use DB bracket abstraction for the final parameter.
-    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))
+    toSKI x (SVar y Nothing)
+      | x == y = _I
+      | otherwise = SApp _K (SVar y Nothing)
+    toSKI x (SApp m n) = SApp (SApp _S (toSKI x m)) (toSKI x n)
+    toSKI x (SLambda [y] body) = toSKI x (toSKI y body) -- This should ideally not happen if lambdas are fully eliminated first
+    toSKI _ sl@(SList _) = SApp _K (go sl) -- Ensure SList itself is transformed if somehow passed to toSKI directly
+    toSKI _ term = SApp _K term
 
-    applicationResult (SApp f g) = SApp (go f) (go g)
-
--- combinators and special forms (unchanged)
     _S   = parseSingle "t (t (t t t)) t"
     _K   = parseSingle "t t"
     _I   = parseSingle "t (t (t t)) t"
-_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))"
-_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)))"
     _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"
 
--- pattern bodies (kept for reference; checks are now DB-based)
-triageBody a b c   = SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c)
-composeBody f g x  = SApp (SVar f) (SApp (SVar g) (SVar x))
+    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 t = Set.member x (freeVars t)
+isFree x = Set.member x . freeVars
 
-freeVars :: TricuAST -> Set String
-freeVars = freeDBNames . toDB []
+freeVars :: TricuAST -> Set.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)
+freeVars (SLambda vs body) = Set.difference (freeVars body) (Set.fromList vs)
+freeVars _ = Set.empty
 
 reorderDefs :: Env -> [TricuAST] -> [TricuAST]
 reorderDefs env defs
@@ -231,283 +279,26 @@ mainResult r = case Map.lookup "main" r of
   Just  a -> a
   Nothing -> errorWithoutStackTrace "No valid definition for `main` found."
 
--- 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
+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
 
--- 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
-  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 =
-  errorWithoutStackTrace $ "Unhandled toSKI(DB) conversion: " ++ show other
-
-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)
-  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"
-  BFree s     -> Right ([], SVar s)
-
--- 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) (tail 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) (tail 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
-    tail (_:xs) = xs
-    tail []     = []
-
-
-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))
-
--- Count how many leading pairs (a,b) repeat at the head of zip g1 g2
-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
+findVarNames :: TricuAST -> [String]
+findVarNames ast = case ast of
+  SVar name _ -> [name]
+  SApp a b -> findVarNames a ++ findVarNames b
+  SLambda args body -> findVarNames body \\ args
+  SDef name args body -> name : (findVarNames body \\ args)
+  _ -> []

src/FileEval.hs

@@ -109,9 +109,9 @@ nsDefinition moduleName other =
   nsBody moduleName other
 
 nsBody :: String -> TricuAST -> TricuAST
-nsBody moduleName (SVar name)
-  | isPrefixed name = SVar name
-  | otherwise = SVar (nsVariable moduleName name)
+nsBody moduleName (SVar name mhash)
+  | isPrefixed name = SVar name mhash
+  | otherwise = SVar (nsVariable moduleName name) mhash
 nsBody moduleName (SApp func arg) =
   SApp (nsBody moduleName func) (nsBody moduleName arg)
 nsBody moduleName (SLambda args body) =
@@ -122,18 +122,16 @@ nsBody moduleName (TFork left right) =
   TFork (nsBody moduleName left) (nsBody moduleName right)
 nsBody moduleName (TStem subtree) =
   TStem (nsBody moduleName subtree)
-nsBody moduleName (SDef name args body)
-  | isPrefixed name = SDef name args (nsBody moduleName body)
-  | otherwise = SDef (nsVariable moduleName name)
-                        args (nsBody moduleName body)
+nsBody moduleName (SDef name args body) =
+  SDef (nsVariable moduleName name) args (nsBodyScoped moduleName args body)
 nsBody _ other = other
 
 nsBodyScoped :: String -> [String] -> TricuAST -> TricuAST
 nsBodyScoped moduleName args body = case body of
-  SVar name ->
+  SVar name mhash ->
     if name `elem` args
-      then SVar name
-      else nsBody moduleName (SVar name)
+      then SVar name mhash
+      else nsBody moduleName (SVar name mhash)
   SApp func arg ->
     SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
   SLambda innerArgs innerBody ->
@@ -141,13 +139,11 @@ nsBodyScoped moduleName args body = case body of
   SList items ->
     SList (map (nsBodyScoped moduleName args) items)
   TFork left right ->
-    TFork (nsBodyScoped moduleName args left)
-          (nsBodyScoped moduleName args right)
+    TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right)
   TStem subtree ->
     TStem (nsBodyScoped moduleName args subtree)
   SDef name innerArgs innerBody ->
-    SDef (nsVariable moduleName name) innerArgs
-         (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
+    SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
   other -> other
 
 isPrefixed :: String -> Bool

src/Lexer.hs

@@ -35,6 +35,7 @@ tricuLexer = do
       [ try lnewline
       , try namespace
       , try dot
+      , try identifierWithHash
       , try identifier
       , try keywordT
       , try integerLiteral
@@ -56,12 +57,33 @@ lexTricu input = case runParser tricuLexer "" input of
 keywordT :: Lexer LToken
 keywordT = string "t" *> notFollowedBy alphaNumChar $> LKeywordT
 
+identifierWithHash :: Lexer LToken
+identifierWithHash = do
+  first <- lowerChar <|> char '_'
+  rest  <- many $ letterChar
+              <|> digitChar <|> char '_' <|> char '-' <|> char '?'
+              <|> char '$'  <|> char '@' <|> char '%'
+  _ <- char '#' -- Consume '#'
+  hashString <- some (alphaNumChar <|> char '-') -- Ensures at least one char for hash
+                <?> "hash characters (alphanumeric or hyphen)"
+
+  let name = first : rest
+  let hashLen = length hashString
+  if name == "t" || name == "!result"
+    then fail "Keywords (`t`, `!result`) cannot be used with a hash suffix."
+    else if hashLen < 16 then
+      fail $ "Hash suffix for '" ++ name ++ "' must be at least 16 characters long. Got " ++ show hashLen ++ " ('" ++ hashString ++ "')."
+    else if hashLen > 64 then -- Assuming SHA256, max 64
+      fail $ "Hash suffix for '" ++ name ++ "' cannot be longer than 64 characters (SHA256). Got " ++ show hashLen ++ " ('" ++ hashString ++ "')."
+    else
+      return (LIdentifierWithHash name hashString)
+
 identifier :: Lexer LToken
 identifier = do
   first <- lowerChar <|> char '_'
   rest  <- many $ letterChar
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
-              <|> char '$'  <|> char '#' <|> char '@' <|> char '%'
+              <|> char '$'  <|> char '@' <|> char '%'
   let name = first : rest
   if name == "t" || name == "!result"
     then fail "Keywords (`t`, `!result`) cannot be used as an identifier"

src/Main.hs

@@ -5,6 +5,7 @@ import FileEval
 import Parser                 (parseTricu)
 import REPL
 import Research
+import ContentStore
 
 import Control.Monad          (foldM)
 import Control.Monad.IO.Class (liftIO)
@@ -64,8 +65,7 @@ main = do
     Repl -> do
       putStrLn "Welcome to the tricu REPL"
       putStrLn "You may exit with `CTRL+D` or the `!exit` command."
-      putStrLn "Try typing `!` with tab completion for more commands."
-      repl Map.empty
+      repl
     Evaluate { file = filePaths, form = form } -> do
       result <- case filePaths of
         [] -> runTricuT <$> getContents
@@ -81,8 +81,6 @@ main = do
         (filePath:_) -> readFile filePath
       putStrLn $ decodeResult $ result $ evalTricu Map.empty $ parseTricu value
 
--- Simple interfaces
-
 runTricu :: String -> String
 runTricu = formatT TreeCalculus . runTricuT
 

src/Parser.hs

@@ -249,7 +249,7 @@ parseGroupedItemM = do
 parseSingleItemM :: ParserM TricuAST
 parseSingleItemM = do
   token <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
-  if | LIdentifier name <- token -> pure (SVar name)
+  if | LIdentifier name <- token -> pure (SVar name Nothing)
      | token == LKeywordT        -> pure TLeaf
      | otherwise                 -> fail "Unexpected token in list item"
 
@@ -258,16 +258,25 @@ parseVarM = do
   token <- satisfyM (\case
     LNamespace _ -> True
     LIdentifier _ -> True
+    LIdentifierWithHash _ _ -> True
     _ -> False)
+
   case token of
     LNamespace ns -> do
       _ <- satisfyM (== LDot)
       LIdentifier name <- satisfyM (\case LIdentifier _ -> True; _ -> False)
-      pure $ SVar (ns ++ "." ++ name)
+      pure $ SVar (ns ++ "." ++ name) Nothing
+
     LIdentifier name
       | name == "t" || name == "!result" ->
         fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
-      | otherwise -> pure (SVar name)
+      | otherwise -> pure (SVar name Nothing)
+
+    LIdentifierWithHash name hash ->
+      if name == "t" || name == "!result"
+        then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
+        else pure (SVar name (Just hash))
+
     _ -> fail "Unexpected token while parsing variable"
 
 parseIntLiteralM :: ParserM TricuAST
@@ -275,7 +284,7 @@ parseIntLiteralM = do
   let intL = (\case LIntegerLiteral _ -> True; _ -> False)
   token <- satisfyM intL
   if | LIntegerLiteral value <- token ->
-       pure (SInt value)
+       pure (SInt (fromIntegral value))
      | otherwise                      ->
        fail "Unexpected token while parsing integer literal"
 

src/REPL.hs

@@ -5,6 +5,17 @@ import FileEval
 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 Data.ByteString (ByteString)
+import Data.Maybe (isNothing, isJust, fromJust, catMaybes)
+import Database.SQLite.Simple (Connection, Only(..), query, query_, execute, execute_, open)
+import System.Directory (doesFileExist, createDirectoryIfMissing)
+import System.FSNotify
+import System.FilePath (takeDirectory, (</>))
+import Text.Read (readMaybe)
 
 import Control.Exception         (IOException, SomeException, catch
                                  , displayException)
@@ -14,17 +25,37 @@ 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)
+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
 
-repl :: Env -> IO ()
-repl env = runInputT settings (withInterrupt (loop env Decode))
+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
+  , replContentStore :: Maybe Connection
+  , replWatchedFile :: Maybe FilePath
+  , replSelectedVersions :: Map.Map String T.Text
+  , replWatcherThread :: Maybe ThreadId
+  }
+
+repl :: IO ()
+repl = do
+  conn <- ContentStore.initContentStore 
+  runInputT settings (withInterrupt (loop (REPLState Decode (Just conn) Nothing Map.empty Nothing)))
   where
     settings :: Settings IO
     settings = Settings
@@ -39,49 +70,64 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
       where
         commands = [ "!exit"
                    , "!output"
-                   , "!definitions"
                    , "!import"
                    , "!clear"
-                   , "!save"
                    , "!reset"
-                   , "!version"
+                   , "!help"
+                   , "!definitions"
+                   , "!watch"
+                   , "!refresh"
+                   , "!versions"
+                   , "!select"
+                   , "!tag"
                    ]
 
-    loop :: Env -> EvaluatedForm -> InputT IO ()
-    loop env form = handle (interruptHandler env form) $ do
+    loop :: REPLState -> InputT IO ()
+    loop state = handle (\Interrupt -> interruptHandler state Interrupt) $ do
       minput <- getInputLine "tricu < "
       case minput of
-        Nothing -> outputStrLn "Exiting tricu"
+        Nothing -> return ()
         Just s
-          | strip s == "" -> loop env form
+          | strip s == "" -> loop state
           | strip s == "!exit" -> outputStrLn "Exiting tricu"
           | strip s == "!clear" -> do
               liftIO $ putStr "\ESC[2J\ESC[H"
-              loop env form
+              loop state
           | strip s == "!reset" -> do
-              outputStrLn "Environment reset to initial state"
-              loop Map.empty form
-          | strip s == "!version" -> do
+              outputStrLn "Selected versions reset"
+              loop state { replSelectedVersions = Map.empty }
+          | strip s == "!help" -> do
               outputStrLn $ "tricu version " ++ showVersion version
-              loop env form
-          | "!save" `isPrefixOf` strip s -> handleSave env form
-          | strip s == "!output" -> handleOutput env form
-          | strip s == "!definitions" -> do
-              let defs = Map.keys $ Map.delete "!result" env
-              if null defs
-                then outputStrLn "No definitions discovered."
-                else do
-                  outputStrLn "Available definitions:"
-                  mapM_ outputStrLn defs
-              loop env form
-          | "!import" `isPrefixOf` strip s -> handleImport env form
-          | take 2 s == "--" -> loop env form
+              outputStrLn "Available commands:"
+              outputStrLn "  !exit        - Exit the REPL"
+              outputStrLn "  !clear       - Clear the screen"
+              outputStrLn "  !reset       - Reset preferences for selected versions"
+              outputStrLn "  !help        - Show tricu version and available commands"
+              outputStrLn "  !output      - Change output format (tree|fsl|ast|ternary|ascii|decode)"
+              outputStrLn "  !definitions - List all defined terms in the content store"
+              outputStrLn "  !import      - Import definitions from file to the content store"
+              outputStrLn "  !watch       - Watch a file for changes, evaluate terms, and store them"
+              outputStrLn "  !versions    - Show all versions of a term by name"
+              outputStrLn "  !select      - Select a specific version of a term for subsequent lookups"
+              outputStrLn "  !tag         - Add or update a tag for a term by hash or name"
+              loop state
+          | strip s == "!output" -> handleOutput state
+          | strip s == "!definitions" -> handleDefinitions state
+          | "!import" `isPrefixOf` strip s -> handleImport state
+          | "!watch" `isPrefixOf` strip s -> handleWatch state
+          | strip s == "!refresh" -> handleRefresh state
+          | "!versions" `isPrefixOf` strip s -> handleVersions state
+          | "!select" `isPrefixOf` strip s -> handleSelect state
+          | "!tag" `isPrefixOf` strip s -> handleTag state
+          | take 2 s == "--" -> loop state
           | otherwise -> do
-              newEnv <- liftIO $ processInput env s form `catch` errorHandler env
-              loop newEnv form
+              result <- liftIO $ catch
+                (processInput state s)
+                (errorHandler state)
+              loop result
 
-    handleOutput :: Env -> EvaluatedForm -> InputT IO ()
-    handleOutput env currentForm = do
+    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)
@@ -97,94 +143,462 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
       case result of
         Nothing -> do
           outputStrLn "Invalid selection. Keeping current output format."
-          loop env currentForm
+          loop state
         Just newForm -> do
           outputStrLn $ "Output format changed to: " ++ show newForm
-          loop env newForm
+          loop state { replForm = newForm }
 
-    handleImport :: Env -> EvaluatedForm -> InputT IO ()
-    handleImport env form = do
-      res <- runMaybeT $ do
-        let fset = setComplete completeFilename defaultSettings
-        path <- MaybeT $ runInputT fset $
-          getInputLineWithInitial "File path to load < " ("", "")
-
-        text <- MaybeT $ liftIO $ handle (\e -> do
-            putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
-            return Nothing
-          ) $ Just <$> readFile (strip path)
-
-        case parseProgram (lexTricu text) of
-          Left err -> do
-            lift $ outputStrLn $ "Parse error: " ++ handleParseError err
-            MaybeT $ return Nothing
-          Right ast -> do
-            ns <- MaybeT $ runInputT defaultSettings $
-              getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
-
-            let name = strip ns
-            if (name /= "!Local" && (null name || not (isUpper (head name)))) then do
-                lift $ outputStrLn "Namespace must start with an uppercase letter"
-                MaybeT $ return Nothing
-            else do
-                prog <- liftIO $ preprocessFile (strip path)
-                let code = case name of
-                      "!Local" -> prog
-                      _ -> nsDefinitions name prog
-                    env' = evalTricu env code
-                return env'
-      case res of
+    handleDefinitions :: REPLState -> InputT IO ()
+    handleDefinitions state = case replContentStore state of
       Nothing -> do
-          outputStrLn "Import cancelled"
-          loop env form
-        Just env' ->
-          loop (Map.delete "!result" env') form
+        liftIO $ printError "Content store not initialized"
+        loop state
+      Just conn -> do
+        terms <- liftIO $ ContentStore.listStoredTerms conn
         
-    interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
-    interruptHandler env form _ = do
-      outputStrLn "Interrupted with CTRL+C\n\
-                  \You can use the !exit command or CTRL+D to exit"
-      loop env form
+        if null terms
+          then do
+            liftIO $ printWarning "No terms in content store."
+            loop state
+          else do
+            liftIO $ do
+              printSuccess $ "Content store contains " ++ show (length terms) ++ " terms:"
 
-    processInput :: Env -> String -> EvaluatedForm -> IO Env
-    processInput env input form = do
+            let maxNameWidth = maximum $ map (length . T.unpack . termNames) terms
+
+            forM_ terms $ \term -> do
+              let namesStr = T.unpack (termNames term)
+                  hash = termHash term
+                  padding = replicate (maxNameWidth - length namesStr) ' '
+                  
+              liftIO $ do
+                putStr "  "
+                printVariable namesStr
+                putStr padding
+                putStr " [hash: "
+                displayColoredHash hash
+                putStrLn "]"
+                
+                tags <- ContentStore.termToTags conn hash 
+                unless (null tags) $ displayTags tags
+
+            loop state
+
+    handleImport :: REPLState -> InputT IO ()
+    handleImport state = do
+      let fset = setComplete completeFilename defaultSettings
+      filename <- runInputT fset $ getInputLineWithInitial "File to import: " ("", "")
+      case filename of
+        Nothing -> loop state
+        Just f -> do
+          let cleanFilename = strip f
+          exists <- liftIO $ doesFileExist cleanFilename
+          if not exists
+            then do
+              liftIO $ printError $ "File not found: " ++ cleanFilename
+              loop state
+            else importFile state cleanFilename
+
+    importFile :: REPLState -> String -> InputT IO ()
+    importFile state cleanFilename = do
+      code <- liftIO $ readFile cleanFilename
+      case replContentStore state of
+        Nothing -> do
+          liftIO $ printError "Content store not initialized"
+          loop state
+        Just conn -> do
+          env <- liftIO $ evaluateFile cleanFilename
+          
+          liftIO $ do
+            printSuccess $ "Importing file: " ++ cleanFilename
+            let defs = Map.toList $ Map.delete "!result" env
+            
+            importedCount <- foldM (\count (name, term) -> do
+              hash <- ContentStore.storeTerm conn [name] term
+              printSuccess $ "Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
+              return (count + 1)
+              ) 0 defs
+            
+            printSuccess $ "Imported " ++ show importedCount ++ " definitions successfully"
+          
+          loop state
+
+    handleWatch :: REPLState -> InputT IO ()
+    handleWatch state = do
+      dbPath <- liftIO ContentStore.getContentStorePath
+      let filepath = takeDirectory dbPath </> "scratch.tri"
+      let dirPath = takeDirectory filepath
+
+      liftIO $ createDirectoryIfMissing True dirPath
+
+      fileExists <- liftIO $ doesFileExist filepath
+      unless fileExists $ liftIO $ writeFile filepath "-- tricu scratch file\n\n"
+
+      outputStrLn $ "Using scratch file: " ++ filepath
+
+      when (isJust (replWatcherThread state)) $ do
+        outputStrLn "Stopping previous file watch"
+        liftIO $ killThread (fromJust $ replWatcherThread state)
+
+      outputStrLn $ "Starting to watch file: " ++ filepath
+      outputStrLn "Press Ctrl+C to stop watching and return to REPL"
+
+      liftIO $ processWatchedFile filepath (replContentStore state) (replSelectedVersions state) (replForm state)
+
+      lastProcessedRef <- liftIO $ newIORef =<< getCurrentTime
+
+      watcherId <- liftIO $ forkIO $ withManager $ \mgr -> do
+        stopAction <- watchDir mgr dirPath (\event -> eventPath event == filepath) $ \event -> do
+          now <- getCurrentTime
+          lastProcessed <- readIORef lastProcessedRef
+          when (diffUTCTime now lastProcessed > 0.5) $ do
+            putStrLn $ "\nFile changed: " ++ filepath
+            processWatchedFile filepath (replContentStore state) (replSelectedVersions state) (replForm state)
+            writeIORef lastProcessedRef now
+        forever $ threadDelay 1000000
+
+      watchLoop state { replWatchedFile = Just filepath, replWatcherThread = Just watcherId }
+
+    handleUnwatch :: REPLState -> InputT IO ()
+    handleUnwatch state = case replWatchedFile state of
+      Nothing -> do
+        outputStrLn "No file is currently being watched"
+        loop state
+      Just path -> do
+        outputStrLn $ "Stopped watching " ++ path
+        when (isJust (replWatcherThread state)) $ do
+          liftIO $ killThread (fromJust $ replWatcherThread state)
+        loop state { replWatchedFile = Nothing, replWatcherThread = Nothing }
+
+    handleRefresh :: REPLState -> InputT IO ()
+    handleRefresh state = case replContentStore state of
+      Nothing -> do
+        outputStrLn "Content store not initialized"
+        loop state
+      Just conn -> do
+        outputStrLn "Environment refreshed from content store (definitions are live)"
+        loop state
+
+    handleVersions :: REPLState -> InputT IO ()
+    handleVersions state = case replContentStore state of
+      Nothing -> do
+        liftIO $ printError "Content store not initialized"
+        loop state
+      Just conn -> do
+        liftIO $ printPrompt "Term name: "
+        nameInput <- getInputLine ""
+        case nameInput of
+          Nothing -> loop state
+          Just n -> do
+            let termName = strip n
+            versions <- liftIO $ ContentStore.termVersions conn termName
+            if null versions
+              then liftIO $ printError $ "No versions found for term: " ++ termName
+              else do
+                liftIO $ do
+                  printKeyword "Versions of "
+                  printVariable termName
+                  putStrLn ":"
+                  
+                  forM_ (zip [1..] versions) $ \(i, (hash, _, ts)) -> do
+                    tags <- ContentStore.termToTags conn hash
+                    putStr $ show (i :: Int) ++ ". "
+                    displayColoredHash hash
+                    putStr $ " (" ++ formatTimestamp ts ++ ")"
+                    unless (null tags) $ do
+                      putStr " ["
+                      printKeyword "Tags: "
+                      forM_ (zip [0..] tags) $ \(j, tag) -> do
+                        printTag (T.unpack tag)
+                        when (j < length tags - 1) $ putStr ", "
+                      putStr "]"
+                    putStrLn ""
+        loop state
+
+    handleSelect :: REPLState -> InputT IO ()
+    handleSelect state = case replContentStore state of
+      Nothing -> do
+        liftIO $ printError "Content store not initialized"
+        loop state
+      Just conn -> do
+        liftIO $ printPrompt "Term name: "
+        nameInput <- getInputLine ""
+        case nameInput of
+          Nothing -> loop state
+          Just n -> do
+            let cleanName = strip n
+            versions <- liftIO $ ContentStore.termVersions conn cleanName
+            if null versions
+              then do
+                liftIO $ printError $ "No versions found for term: " ++ cleanName
+                loop state
+              else do
+                liftIO $ do
+                  printKeyword "Versions of "
+                  printVariable cleanName
+                  putStrLn ":"
+                  
+                  forM_ (zip [1..] versions) $ \(i, (hash, _, ts)) -> do
+                    tags <- ContentStore.termToTags conn hash
+                    putStr $ show (i :: Int) ++ ". "
+                    displayColoredHash hash
+                    putStr $ " (" ++ formatTimestamp ts ++ ")"
+                    unless (null tags) $ do
+                      putStr " ["
+                      printKeyword "Tags: "
+                      forM_ (zip [0..] tags) $ \(j, tag) -> do
+                        printTag (T.unpack tag)
+                        when (j < length tags - 1) $ putStr ", "
+                      putStr "]"
+                    putStrLn ""
+
+                liftIO $ printPrompt "Select version (number or full hash, Enter to cancel): "
+                choiceInput <- getInputLine ""
+                let choice = strip <$> choiceInput
+
+                selectedHash <- case choice of
+                    Just selectedStr | not (null selectedStr) -> do
+                        case readMaybe selectedStr :: Maybe Int of
+                            Just idx | idx > 0 && idx <= length versions -> do
+                                let (h, _, _) = versions !! (idx - 1)
+                                return $ Just h
+                            _ -> do
+                                let potentialHash = T.pack selectedStr
+                                let foundByHash = find (\(h, _, _) -> T.isPrefixOf potentialHash h) versions
+                                case foundByHash of
+                                    Just (h, _, _) -> return $ Just h
+                                    Nothing -> do
+                                        liftIO $ printError "Invalid selection or hash not found in list."
+                                        return Nothing
+                    _ -> return Nothing
+
+                case selectedHash of
+                    Just hashToSelect -> do
+                        let newState = state { replSelectedVersions =
+                                              Map.insert cleanName hashToSelect (replSelectedVersions state) }
+                        liftIO $ do
+                          printSuccess "Selected version "
+                          displayColoredHash hashToSelect
+                          putStr " for term "
+                          printVariable cleanName
+                          putStrLn ""
+                        loop newState
+                    Nothing -> loop state
+
+    handleTag :: REPLState -> InputT IO ()
+    handleTag state = case replContentStore state of
+      Nothing -> do
+        liftIO $ printError "Content store not initialized"
+        loop state
+      Just conn -> do
+        liftIO $ printPrompt "Term hash (full or prefix) or name (most recent version will be used): "
+        identInput <- getInputLine ""
+        case identInput of
+          Nothing -> loop state
+          Just ident -> do
+            let cleanIdent = strip ident
+            
+            mFullHash <- liftIO $ resolveIdentifierToHash conn cleanIdent
+
+            case mFullHash of
+              Nothing -> do
+                liftIO $ printError $ "Could not resolve identifier: " ++ cleanIdent
+                loop state
+              Just fullHash -> do
+                liftIO $ do
+                    putStr "Tagging term with hash: "
+                    displayColoredHash fullHash
+                    putStrLn ""
+                tags <- liftIO $ ContentStore.termToTags conn fullHash
+                unless (null tags) $ do
+                  liftIO $ do
+                    printKeyword "Existing tags:"
+                    displayTags tags
+
+                liftIO $ printPrompt "Tag to add/set: "
+                tagValueInput <- getInputLine ""
+                case tagValueInput of
+                  Nothing -> loop state
+                  Just tv -> do
+                    let tagVal = T.pack (strip tv)
+                    liftIO $ do
+                      ContentStore.setTag conn fullHash tagVal 
+                      printSuccess $ "Tag '"
+                      printTag (T.unpack tagVal)
+                      putStr "' set for term with hash "
+                      displayColoredHash fullHash
+                      putStrLn ""
+                    loop state
+
+    resolveIdentifierToHash :: Connection -> String -> IO (Maybe T.Text)
+    resolveIdentifierToHash conn ident
+        | T.pack "#" `T.isInfixOf` T.pack ident = do
+            let hashPrefix = T.pack ident
+            matchingHashes <- liftIO $ query conn "SELECT hash FROM terms WHERE hash LIKE ?" (Only (hashPrefix <> "%")) :: IO [Only T.Text]
+            case matchingHashes of
+                [Only fullHash] -> return $ Just fullHash
+                [] -> do printError $ "No hash found starting with: " ++ T.unpack hashPrefix; return Nothing
+                _  -> do printError $ "Ambiguous hash prefix: " ++ T.unpack hashPrefix; return Nothing
+        | otherwise = do
+            versions <- ContentStore.termVersions conn ident
+            if null versions
+            then do printError $ "No versions found for term name: " ++ ident; return Nothing
+            else return $ Just $ (\(h,_,_) -> h) $ head versions
+
+    interruptHandler :: REPLState -> Interrupt -> InputT IO ()
+    interruptHandler state _ = do
+      liftIO $ do
+        printWarning "Interrupted with CTRL+C"
+        printWarning "You can use the !exit command or CTRL+D to exit"
+      loop state
+
+    errorHandler :: REPLState -> SomeException -> IO REPLState
+    errorHandler state e = do
+      printError $ "Error: " ++ displayException e
+      return state
+
+    processInput :: REPLState -> String -> IO REPLState
+    processInput state input = do
       let asts = parseTricu input
-          newEnv = evalTricu env asts
-      case Map.lookup "!result" newEnv of
-        Just r -> do
-          putStrLn $ "tricu > " ++ formatT form r
-        Nothing -> pure ()
-      return newEnv
+      case asts of
+        [] -> return state
+        _ -> case replContentStore state of
+          Nothing -> do
+            printError "Content store not initialized"
+            return state
+          Just conn -> do
+            newState <- foldM (\s astNode -> do
+              let varsInAst = Eval.findVarNames astNode
+              foldM (\currentSelectionState varName ->
+                if Map.member varName (replSelectedVersions currentSelectionState)
+                  then return currentSelectionState
+                  else do
+                    versions <- ContentStore.termVersions conn varName
+                    if length versions > 1
+                      then do
+                        let (latestHash, _, _) = head versions
+                        liftIO $ printWarning $ "Multiple versions of '" ++ varName ++ "' found. Using most recent."
+                        return currentSelectionState { replSelectedVersions = Map.insert varName latestHash (replSelectedVersions currentSelectionState) }
+                      else return currentSelectionState
+                ) s varsInAst
+              ) state asts
 
-    errorHandler :: Env -> SomeException -> IO (Env)
-    errorHandler env e = do
-      putStrLn $ "Error: " ++ show e
-      return env
+            forM_ asts $ \ast -> do
+              case ast of
+                SDef name [] body -> do
+                  result <- evalAST (Just conn) (replSelectedVersions newState) body
+                  hash <- ContentStore.storeTerm conn [name] result
+                  
+                  liftIO $ do
+                    putStr "tricu > "
+                    printSuccess "Stored definition: "
+                    printVariable name
+                    putStr " with hash "
+                    displayColoredHash hash
+                    putStrLn ""
+                    
+                    putStr "tricu > "
+                    printResult $ formatT (replForm newState) result
+                    putStrLn ""
+
+                _ -> do
+                  result <- evalAST (Just conn) (replSelectedVersions newState) ast
+                  liftIO $ do
+                    putStr "tricu > "
+                    printResult $ formatT (replForm newState) result
+                    putStrLn ""
+            return newState
 
     strip :: String -> String
     strip = dropWhileEnd isSpace . dropWhile isSpace
 
-    handleSave :: Env -> EvaluatedForm -> InputT IO ()
-    handleSave env form = do
-      let fset = setComplete completeFilename defaultSettings
-      path <- runInputT fset $
-        getInputLineWithInitial "File to save < " ("", "")
+    watchLoop :: REPLState -> InputT IO ()
+    watchLoop state = handle (\Interrupt -> do
+                                outputStrLn "\nStopped watching file"
+                                when (isJust (replWatcherThread state)) $ do
+                                  liftIO $ killThread (fromJust $ replWatcherThread state)
+                                loop state { replWatchedFile = Nothing, replWatcherThread = Nothing }) $ do
+      liftIO $ threadDelay 1000000
+      watchLoop state
 
-      case path of
-        Nothing -> do
-          outputStrLn "Save cancelled"
-          loop env form
-        Just p -> do
-          let definitions = Map.toList $ Map.delete "!result" env
-              filepath = strip p
+    processWatchedFile :: FilePath -> Maybe Connection -> Map.Map String T.Text -> EvaluatedForm -> IO ()
+    processWatchedFile filepath mconn selectedVersions outputForm = do
+      content <- readFile filepath
+      let asts = parseTricu content
 
-          outputStrLn "Starting save..."
-          liftIO $ writeFile filepath ""
-          outputStrLn "File created..."
-          forM_ definitions $ \(name, value) -> do
-            let content = name ++ " = " ++ formatT TreeCalculus value ++ "\n"
-            outputStrLn $ "Writing definition: " ++ name ++ " with length " ++ show (length content)
-            liftIO $ appendFile filepath content
-          outputStrLn $ "Saved " ++ show (length definitions) ++ " definitions to " ++ p
+      case mconn of
+        Nothing -> putStrLn "Content store not initialized for watched file processing."
+        Just conn -> do
+          forM_ asts $ \ast -> case ast of
+            SDef name [] body -> do
+              result <- evalAST (Just conn) selectedVersions body
+              hash <- ContentStore.storeTerm conn [name] result
+              putStrLn $ "tricu > Stored definition: " ++ name ++ " with hash " ++ T.unpack hash
+              putStrLn $ "tricu > " ++ name ++ " = " ++ formatT outputForm result
+            _ -> do
+              result <- evalAST (Just conn) selectedVersions ast
+              putStrLn $ "tricu > Result: " ++ formatT outputForm result
+          putStrLn $ "tricu > Processed file: " ++ filepath
 
-          loop env form
+    formatTimestamp :: Integer -> String
+    formatTimestamp ts = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" (posixSecondsToUTCTime (fromIntegral ts))
+
+    displayColoredHash :: T.Text -> IO ()
+    displayColoredHash hash = do
+      let (prefix, rest) = T.splitAt 16 hash
+      setSGR [SetColor Foreground Vivid Cyan]
+      putStr $ T.unpack prefix
+      setSGR [SetColor Foreground Dull White]
+      putStr $ T.unpack rest
+      setSGR [Reset]
+
+    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]
+      action
+      setSGR [Reset]
+
+    printColored :: ColorIntensity -> Color -> String -> IO ()
+    printColored intensity color text = withColor intensity color $ putStr text
+
+    printlnColored :: ColorIntensity -> Color -> String -> IO ()
+    printlnColored intensity color text = withColor intensity color $ putStrLn text
+
+    printSuccess :: String -> IO ()
+    printSuccess = printlnColored Vivid Green
+
+    printError :: String -> IO ()
+    printError = printlnColored Vivid Red
+
+    printWarning :: String -> IO ()
+    printWarning = printlnColored Vivid Yellow
+
+    printPrompt :: String -> IO ()
+    printPrompt = printColored Vivid Blue
+
+    printVariable :: String -> IO ()
+    printVariable = printColored Vivid Magenta
+
+    printTag :: String -> IO ()
+    printTag = printColored Vivid Yellow
+
+    printKeyword :: String -> IO ()
+    printKeyword = printColored Vivid Blue
+
+    printResult :: String -> IO ()
+    printResult = printColored Dull White
+
+    displayTags :: [T.Text] -> IO ()
+    displayTags [] = return ()
+    displayTags tags = do
+      putStr "    Tags: "
+      forM_ (zip [0..] tags) $ \(i, tag) -> do
+        printTag (T.unpack tag)
+        when (i < length tags - 1) $ putStr ", "
+      putStrLn ""

src/Research.hs

@@ -14,7 +14,7 @@ data T = Leaf | Stem T | Fork T T
 
 -- Abstract Syntax Tree for tricu
 data TricuAST
-  = SVar String
+  = SVar String (Maybe String)  -- Variable name and optional hash prefix
   | SInt Integer
   | SStr String
   | SList [TricuAST]
@@ -30,11 +30,11 @@ data TricuAST
 
 -- Lexer Tokens
 data LToken
-  = LKeywordT
-  | LIdentifier String
+  = LIdentifier String
+  | LIdentifierWithHash String String
+  | LKeywordT
   | LNamespace String
-  | LIntegerLiteral Integer
-  | LStringLiteral String
+  | LImport String String
   | LAssign
   | LColon
   | LDot
@@ -42,9 +42,10 @@ data LToken
   | LCloseParen
   | LOpenBracket
   | LCloseBracket
+  | LStringLiteral String
+  | LIntegerLiteral Int
   | LNewline
-  | LImport String String
-  deriving (Show, Eq, Ord)
+  deriving (Eq, Show, Ord)
 
 -- Output formats
 data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode

test/Spec.hs

@@ -12,7 +12,6 @@ import Control.Monad.IO.Class (liftIO)
 import Data.List              (isInfixOf)
 import Test.Tasty
 import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
 import Text.Megaparsec        (runParser)
 
 import qualified Data.Map as Map
@@ -33,10 +32,8 @@ tests = testGroup "Tricu Tests"
   , providedLibraries
   , fileEval
   , modules
-  , demos
+--  , demos
   , decoding
-	, elimLambdaSingle
-	, stressElimLambda
   ]
 
 lexer :: TestTree
@@ -105,7 +102,7 @@ parser = testGroup "Parser Tests"
 
   , testCase "Parse function definitions" $ do
       let input = "x = (a b c : a)"
-          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
+          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a" Nothing))))
       parseSingle input @?= expect
 
   , testCase "Parse nested Tree Calculus terms" $ do
@@ -125,7 +122,7 @@ parser = testGroup "Parser Tests"
 
   , testCase "Parse function with applications" $ do
       let input  = "f = (x : t x)"
-          expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
+          expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Parse nested lists" $ do
@@ -172,17 +169,17 @@ parser = testGroup "Parser Tests"
 
   , testCase "Parse lambda abstractions" $ do
       let input  = "(a : a)"
-          expect = (SLambda ["a"] (SVar "a"))
+          expect = (SLambda ["a"] (SVar "a" Nothing))
       parseSingle input @?= expect
 
   , testCase "Parse multiple arguments to lambda abstractions" $ do
       let input  = "x = (a b : a)"
-          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
+          expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a" Nothing)))
       parseSingle input @?= expect
 
   , testCase "Grouping T terms with parentheses in function application" $ do
       let input  = "x = (a : a)\nx (t)"
-          expect = [SDef "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
+          expect = [SDef "x" [] (SLambda ["a"] (SVar "a" Nothing)),SApp (SVar "x" Nothing) TLeaf]
       parseTricu input @?= expect
 
   , testCase "Comments 1" $ do
@@ -535,7 +532,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 @?= "321"
+      decodeResult res @?= "454"
   , 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 \""
@@ -572,72 +569,3 @@ 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,7 +1,7 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        0.19.0
+version:        1.0.0
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co
@@ -21,18 +21,32 @@ executable tricu
       LambdaCase
       MultiWayIf
       OverloadedStrings
+      ScopedTypeVariables
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
   build-depends:
     base >=4.7
+    , aeson
+    , ansi-terminal
+    , base64-bytestring
+    , bytestring
+    , cereal
     , cmdargs
     , containers
+    , cryptonite
+    , directory
     , exceptions
     , filepath
+    , fsnotify
     , haskeline
     , megaparsec
     , mtl
+    , sqlite-simple
+    , tasty
+    , tasty-hunit
     , text
+    , time
     , transformers
+    , zlib
   other-modules:
     Eval
     FileEval
@@ -51,20 +65,31 @@ test-suite tricu-tests
       LambdaCase
       MultiWayIf
       OverloadedStrings
+      ScopedTypeVariables
   build-depends:       
-    base
+    base >=4.7
+    , aeson
+    , ansi-terminal
+    , base64-bytestring
+    , bytestring
+    , cereal
     , cmdargs
     , containers
+    , cryptonite
+    , directory
     , exceptions
     , filepath
+    , fsnotify
     , haskeline
     , megaparsec
     , mtl
+    , sqlite-simple
     , tasty
     , tasty-hunit
-    , tasty-quickcheck
     , text
+    , time
     , transformers
+    , zlib
   default-language:    Haskell2010
   other-modules:
     Eval