packages feed

srtree-db 0.1.2.0 → 0.1.3.0

raw patch · 15 files changed

+713/−47 lines, 15 filesdep ~srtreePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: srtree

API changes (from Hackage documentation)

+ Algorithm.EqSat.Storage.Query: ancestorsOf :: SqlBackend db => db -> Int -> [EClassId] -> IO [EClassId]
+ Algorithm.EqSat.Storage.Query: parentsOf :: SqlBackend db => db -> EClassId -> IO [EClassId]
+ Algorithm.EqSat.Storage.Query: topNIn :: SqlBackend db => db -> Int -> Int -> [EClassId] -> IO [(EClassId, Double)]
+ Algorithm.EqSat.Storage.SQLite: createSchema :: SqlBackend db => db -> IO ()
+ Algorithm.EqSat.Storage.SQLite: createSchemaFit :: SqlBackend db => db -> IO ()
+ Algorithm.EqSat.Storage.SQLite: emptyPagedGraph :: SqlBackend db => db -> Int -> Int -> Int -> IO EGraph
+ Algorithm.EqSat.Storage.SQLite: loadGraphResident :: SqlBackend db => db -> IO (Either String EGraph)
- Algorithm.EqSat.Storage.Import: recordExpressionIndex :: SqlBackend db => db -> Int -> EClassId -> IO ()
+ Algorithm.EqSat.Storage.Import: recordExpressionIndex :: (SqlBackend eg, SqlBackend fit) => eg -> fit -> Int -> EClassId -> IO ()
- Algorithm.EqSat.Storage.SQLite: loadGraphLazy :: SqlBackend db => db -> Int -> IO (Either String EGraph)
+ Algorithm.EqSat.Storage.SQLite: loadGraphLazy :: SqlBackend db => db -> Int -> Int -> Int -> Int -> IO (Either String EGraph)

Files

ChangeLog.md view
@@ -1,5 +1,20 @@ # Changelog for srtree-db +## 0.1.3.0++- **New CLI subcommands**:+  - `export`: export fitted expressions as CSV (`expression,length,fitness`). Supports `--finite` flag to exclude NaN/invalid expressions.+  - `backfill-parents`: backfill `enode_parent` reverse index for existing DBs.+  - `random-sampler`: sample N random fitted expressions and print sorted by fitness.+- **Split-DB fixes**:+  - `DBInsert`: create egraph schema before first insert (fixes 'no such table: eclass_node' error).+  - `recordExpressionIndex`: correctly handle separate egraph and fit DB files.+  - `loadGraphLazy`: treat missing meta table as 'no e-graph stored' instead of error.+  - `emptyPagedGraph`: new function to seed a fresh DB on first out-of-core insert.+  - Export `createSchemaFit` for the DB-native import path.+- **Concurrency fixes**: fixed concurrency problems in fitting with separate DB structures.+- **Memory fixes**: `top` command no longer uses all memory on large datasets.+ ## 0.1.2.0  - **Split-DB architecture**: e-graph and per-dataset fit data now live in separate SQLite files to eliminate WAL bloat during fitting. Schema split into `egraphSchemaSQL` and `fitSchemaSQL`.
+ app/Backfill.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Backfill the @enode_parent@ reverse index for pre-existing databases.+--+-- The @enode_parent@ table is populated during import and eqsat write-through,+-- but databases created before this feature was added will have an empty table.+-- This command scans all @(eid, enode_key)@ pairs, parses each key to extract+-- children, and inserts the reverse-index rows.+module Backfill+  ( BackfillOpts+  , backfillParser+  , runBackfill+  ) where++import Control.Monad (forM_, foldM)+import qualified Data.IntMap as IntMap+import qualified Data.Text as T+import Options.Applicative+import Database.SQLite3 (Database, open, close)++import Algorithm.EqSat.Storage.Backend (SqlBackend, SqlValue(..), execDb, queryDb, runDb, sqlToInt, sqlToText)+import Algorithm.EqSat.Storage.SQLite ()  -- SqlBackend Database instance+import Algorithm.EqSat.Storage.Types (parseEnodeKey)+import Algorithm.EqSat.Egraph (ENode(..))++data BackfillOpts = BackfillOpts+  { backfillDb :: String+  } deriving (Show)++backfillParser :: Parser BackfillOpts+backfillParser = BackfillOpts+  <$> strOption (long "db" <> metavar "FILE" <> help "SQLite database file")++runBackfill :: BackfillOpts -> IO ()+runBackfill (BackfillOpts dbFile) = do+  putStrLn $ "Backfilling enode_parent for " ++ dbFile ++ "..."+  db <- open (T.pack dbFile)+  -- Ensure the table exists+  execDb db+    "CREATE TABLE IF NOT EXISTS enode_parent (\+    \ child_eid INTEGER NOT NULL,\+    \ enode_key TEXT NOT NULL,\+    \ parent_eid INTEGER NOT NULL,\+    \ PRIMARY KEY (child_eid, enode_key))"+  -- Count existing rows+  existing <- countRows db "enode_parent"+  putStrLn $ "  Existing enode_parent rows: " ++ show existing+  -- Scan all (eid, enode_key) pairs+  rows <- queryDb db "SELECT eid, enode_key FROM eclass_node" []+  let pairs = [ (sqlToInt eid, sqlToText key) | [eid, key] <- rows ]+  putStrLn $ "  Total eclass_node pairs: " ++ show (length pairs)+  -- For each pair, parse the key to extract children and insert parent rows+  execDb db "BEGIN"+  count <- foldM (\acc (eid, key) -> do+    case parseEnodeKey (T.unpack key) of+      Nothing -> pure acc+      Just en -> do+        let children = allChildren en+        forM_ children $ \childEid ->+          runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (?, ?, ?)"+            [ SqlInteger (fromIntegral childEid)+            , SqlText key+            , SqlInteger (fromIntegral eid) ]+        pure (acc + length children)) 0 pairs+  execDb db "COMMIT"+  putStrLn $ "  Inserted " ++ show count ++ " enode_parent rows"+  -- Count final rows+  final <- countRows db "enode_parent"+  putStrLn $ "  Final enode_parent rows: " ++ show final+  close db+  putStrLn "Done."++countRows :: SqlBackend db => db -> String -> IO Int+countRows db table = do+  rows <- queryDb db ("SELECT COUNT(*) FROM " <> T.pack table) []+  pure $ case rows of+    [[n]] -> sqlToInt n+    _     -> 0++allChildren :: ENode -> [Int]+allChildren (EUni _ c)   = [c]+allChildren (EBin _ l r) = [l, r]+allChildren (ENAry _ m)  = map fst $ IntMap.toList m+allChildren _            = []
app/EqSat.hs view
@@ -12,23 +12,27 @@ import qualified Data.IntMap.Strict as IntMap import qualified Data.Text as T import Options.Applicative+import System.CPUTime (getCPUTime)+import System.IO (hFlush, stdout)  import Data.SRTree (SRTree(..)) import Algorithm.EqSat (runEqSat) import Algorithm.EqSat.Egraph (EGraph(..), EClassPageStore(..))-import Algorithm.EqSat.Simplify (rewrites, rewritesParams, myCost)-import Algorithm.EqSat.Storage.Backend (SqlBackend)-import Algorithm.EqSat.Storage.SQLite (loadGraphLazy, saveGraph, flushStore)+import Algorithm.EqSat.Simplify (Rule, rewrites, rewritesParams, myCost)+import Algorithm.EqSat.Storage.Backend (SqlBackend(..), SqlValue(..), sqlToInt)+import Algorithm.EqSat.Storage.SQLite (loadGraphResident, loadGraphLazy, saveGraph, flushStore) import Algorithm.EqSat.Storage.Query (getOrCreateDataset)  import Database.SQLite3 (Database, open, close, exec)  -- | CLI options for the eqsat sub-command. data EqSatOpts = EqSatOpts-  { eqsatDb      :: String-  , eqsatDataset :: String-  , eqsatSteps   :: Int-  , eqsatRuleset :: String+  { eqsatDb         :: String+  , eqsatDataset    :: String+  , eqsatSteps      :: Int+  , eqsatRuleset    :: String+  , eqsatCacheCap   :: Int+  , eqsatBenchmark  :: Bool   } deriving (Show)  eqsatParser :: Parser EqSatOpts@@ -51,6 +55,15 @@       <> value "default"       <> metavar "RULESET"       <> help "Rule set: default or params" )+  <*> option auto+      ( long "cache-cap"+      <> value 50000+      <> metavar "N"+      <> help "Resident class cache capacity (default 50000, increase for large graphs)" )+  <*> switch+      ( long "benchmark"+      <> short 'b'+      <> help "Run benchmark comparing in-memory vs paged eqsat" )  -- | Run the eqsat sub-command. runEqSatCmd :: EqSatOpts -> IO ()@@ -59,30 +72,38 @@                 "params" -> rewritesParams                 _        -> rewrites +  if eqsatBenchmark+    then runBenchmark EqSatOpts{..} rules+    else runNormal EqSatOpts{..} rules++-- | Normal eqsat run (existing behavior).+runNormal :: EqSatOpts -> [Algorithm.EqSat.Simplify.Rule] -> IO ()+runNormal EqSatOpts{..} rules = do   putStrLn $ "Loading paged graph from " ++ eqsatDb ++ "..."   r <- withSQLite eqsatDb $ \db -> do     dsid <- getOrCreateDataset db eqsatDataset-    er <- loadGraphLazy db dsid+    totalRows <- queryDb db "SELECT COUNT(*) FROM eclass" []+    let totalBefore = case totalRows of { [[cnt]] -> sqlToInt cnt; _ -> 0 }+    er <- loadGraphLazy db dsid eqsatCacheCap (eqsatCacheCap * 2) (eqsatCacheCap * 2)     case er of       Left err -> pure (Left err)       Right eg -> do-        let classCount = IntMap.size (_eClass eg)-        putStrLn $ "Loaded " ++ show classCount ++ " e-classes"+        putStrLn $ "Loaded " ++ show totalBefore ++ " e-classes"         putStrLn $ "Running " ++ show eqsatSteps ++ " steps of eqsat with '"                  ++ eqsatRuleset ++ "' rules..."         let go g = execStateT (runEqSat myCost rules eqsatSteps) g         eg' <- go eg-        let classCount' = IntMap.size (_eClass eg')         flushStore eg'         saveResult <- saveGraph db dsid eg'         case saveResult of           Left err -> pure (Left ("saveGraph failed: " ++ err))           Right _  -> do-            -- clear frontier after full eqsat             case _classStore eg' of               Nothing -> pure ()               Just h  -> cpsEndFrontier h-            pure (Right (classCount, classCount'))+            totalRows' <- queryDb db "SELECT COUNT(*) FROM eclass" []+            let totalAfter = case totalRows' of { [[cnt]] -> sqlToInt cnt; _ -> 0 }+            pure (Right (totalBefore, totalAfter))    case r of     Left err -> putStrLn $ "eqsat failed: " ++ err@@ -90,6 +111,79 @@       putStrLn $ "After eqsat: " ++ show after ++ " e-classes ("                ++ show (after - before) ++ " change from " ++ show before ++ ")"       putStrLn $ "Saved to " ++ eqsatDb ++ " [dataset: " ++ eqsatDataset ++ "]"++-- | Benchmark: compare in-memory vs paged eqsat.+runBenchmark :: EqSatOpts -> [Algorithm.EqSat.Simplify.Rule] -> IO ()+runBenchmark EqSatOpts{..} rules = do+  putStrLn $ "=== Benchmark: in-memory vs paged eqsat ==="+  putStrLn $ "Database: " ++ eqsatDb+  putStrLn $ "Dataset: " ++ eqsatDataset+  putStrLn $ "Iterations: " ++ show eqsatSteps+  putStrLn $ "Ruleset: " ++ eqsatRuleset+  putStrLn $ "Cache cap: " ++ show eqsatCacheCap+  putStrLn ""++  withSQLite eqsatDb $ \db -> do+    dsid <- getOrCreateDataset db eqsatDataset+    totalRows <- queryDb db "SELECT COUNT(*) FROM eclass" []+    let totalEclasses = case totalRows of { [[cnt]] -> sqlToInt cnt; _ -> 0 }+    putStrLn $ "Total eclasses in DB: " ++ show totalEclasses+    putStrLn ""++    -- Benchmark 1: In-memory eqsat (loadGraphResident loads all pages, no store handle)+    putStrLn "--- Benchmark 1: In-memory eqsat (loadGraphResident) ---"+    t1_start <- getCPUTime+    r1 <- loadGraphResident db+    case r1 of+      Left err -> putStrLn $ "  loadGraph failed: " ++ err+      Right eg -> do+        let classCount = IntMap.size (_eClass eg)+        putStrLn $ "  Loaded " ++ show classCount ++ " e-classes into memory"+        hFlush stdout+        t1_loaded <- getCPUTime+        let loadTimeMs = fromIntegral (t1_loaded - t1_start) / (1e9 :: Double)+        putStrLn $ "  Load time: " ++ showFF2 loadTimeMs ++ " ms"+        hFlush stdout++        t1_eqsat_start <- getCPUTime+        let go g = execStateT (runEqSat myCost rules eqsatSteps) g+        eg' <- go eg+        t1_eqsat_end <- getCPUTime+        let eqsatTimeMs = fromIntegral (t1_eqsat_end - t1_eqsat_start) / (1e9 :: Double)+            finalClasses = IntMap.size (_eClass eg')+        putStrLn $ "  Eqsat time: " ++ showFF2 eqsatTimeMs ++ " ms"+        putStrLn $ "  Final eclasses: " ++ show finalClasses+        putStrLn ""++    -- Benchmark 2: Paged eqsat (loadGraphLazy, empty resident maps)+    putStrLn "--- Benchmark 2: Paged eqsat (loadGraphLazy) ---"+    t2_start <- getCPUTime+    r2 <- loadGraphLazy db dsid eqsatCacheCap (eqsatCacheCap * 2) (eqsatCacheCap * 2)+    case r2 of+      Left err -> putStrLn $ "  loadGraphLazy failed: " ++ err+      Right eg -> do+        let classCount = IntMap.size (_eClass eg)+        putStrLn $ "  Loaded " ++ show classCount ++ " e-classes (resident cache)"+        hFlush stdout+        t2_loaded <- getCPUTime+        let loadTimeMs = fromIntegral (t2_loaded - t2_start) / (1e9 :: Double)+        putStrLn $ "  Load time: " ++ showFF2 loadTimeMs ++ " ms"+        hFlush stdout++        t2_eqsat_start <- getCPUTime+        let go g = execStateT (runEqSat myCost rules eqsatSteps) g+        eg' <- go eg+        t2_eqsat_end <- getCPUTime+        let eqsatTimeMs = fromIntegral (t2_eqsat_end - t2_eqsat_start) / (1e9 :: Double)+            finalClasses = IntMap.size (_eClass eg')+        putStrLn $ "  Eqsat time: " ++ showFF2 eqsatTimeMs ++ " ms"+        putStrLn $ "  Final eclasses: " ++ show finalClasses+        putStrLn ""++    putStrLn "=== Benchmark complete ==="++showFF2 :: Double -> String+showFF2 x = show (fromIntegral (round (x * 100) :: Int) / 100 :: Double)  -- | Open a SQLite database, run an action, and close it. withSQLite :: String -> (Database -> IO a) -> IO a
+ app/Export.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Export+  ( ExportOpts(..)+  , exportParser+  , runExport+  ) where++import qualified Data.Text as T+import Options.Applicative+import System.IO (hPutStrLn, hFlush, stdout, stderr)++import Data.SRTree.Print (showExpr)+import Algorithm.EqSat.Storage.Backend (SqlBackend(..), SqlValue(..), sqlToInt, sqlToMaybeDouble)+import Algorithm.EqSat.Storage.Extract (extractBestFromDB)+import Algorithm.EqSat.Storage.Schema (createSchemaFit)+import Algorithm.EqSat.Storage.SQLite ()+import Database.SQLite3 (Database, open, close, exec)+import Control.Exception (bracket)+import Control.Monad (forM_)++data ExportOpts = ExportOpts+  { exportEgraph  :: String+  , exportFitdb   :: String+  , exportDataset :: String+  , exportFinite  :: Bool+  } deriving (Show)++exportParser :: Parser ExportOpts+exportParser = ExportOpts+  <$> strOption+      ( long "egraph"+      <> metavar "FILE"+      <> help "Path to e-graph database" )+  <*> strOption+      ( long "fitdb"+      <> metavar "FILE"+      <> help "Path to fit database" )+  <*> strOption+      ( long "dataset"+      <> metavar "NAME"+      <> help "Dataset name" )+  <*> switch+      ( long "finite"+      <> short 'f'+      <> help "Only export expressions with finite (non-NaN) fitness" )++runExport :: ExportOpts -> IO ()+runExport ExportOpts{..} = do+  withSQLite exportFitdb $ \fitDb -> do+    createSchemaFit fitDb+    -- Look up dataset id (don't create if missing)+    dsRows <- queryDb fitDb "SELECT id FROM dataset WHERE name = ?"+      [SqlText (T.pack exportDataset)]+    case dsRows of+      [] -> do+        hPutStrLn stderr $ "Dataset '" ++ exportDataset ++ "' not found."+        hFlush stderr+      [[dsIdVal]] -> do+        let dsid = sqlToInt dsIdVal+        withSQLite exportEgraph $ \egDb -> do+          -- Query fit rows+          let fitQuery+                | exportFinite =+                    "SELECT eid, fitness, size FROM dataset_fit \+                    \WHERE dataset_id = ? AND fitness IS NOT NULL \+                    \ORDER BY eid"+                | otherwise =+                    "SELECT eid, fitness, size FROM dataset_fit \+                    \WHERE dataset_id = ? \+                    \ORDER BY eid"+          rows <- queryDb fitDb fitQuery [SqlInteger (fromIntegral dsid)]++          -- Print header+          putStrLn "expression,length,fitness"+          hFlush stdout++          -- Process each row+          forM_ rows (processRow egDb)++          let total = length rows+              label = if exportFinite then " (finite)" else ""+          hPutStrLn stderr $ "Exported " ++ show total ++ " expressions" ++ label ++ " from dataset '" ++ exportDataset ++ "'"+          hFlush stderr++      _ -> do+        hPutStrLn stderr $ "Dataset '" ++ exportDataset ++ "' query returned unexpected result."+        hFlush stderr++  where+    processRow egDb [eidVal, fitVal, szVal] = do+      let eid  = sqlToInt eidVal+          sz   = sqlToInt szVal+          mfit = sqlToMaybeDouble fitVal+      mTree <- extractBestFromDB egDb eid+      case mTree of+        Nothing -> do+          hPutStrLn stderr $ "WARNING: could not reconstruct expression for eid=" ++ show eid+          hFlush stderr+        Just tree -> do+          let expr = showExpr tree+              fitStr = case mfit of+                Nothing -> "NaN"+                Just f  -> show f+          putStrLn $ expr ++ "," ++ show sz ++ "," ++ fitStr+          hFlush stdout+    processRow _ _ = pure ()++withSQLite :: String -> (Database -> IO a) -> IO a+withSQLite path f = bracket openDb close f+  where+    openDb = do+      db <- open (T.pack path)+      exec db "PRAGMA busy_timeout = 5000"+      pure db
app/FitData.hs view
@@ -144,18 +144,29 @@                 let batchIds = IntSet.fromList batch                 batchPages <- loadPagesBulk egDb (IntSet.toList batchIds)                 let !cache0 = batchPages-                let expandLoop !cache = do-                      let needed = foldl' (\s eid -> s `IntSet.union` expandTreeIds cache eid) IntSet.empty batch-                          missing = IntSet.toList (IntSet.difference needed (IntSet.fromList (IntMap.keys cache)))+                -- BFS: only walk newly-loaded pages to discover their children,+                -- instead of re-walking all cached pages every iteration.+                -- Track "unavailable" IDs (non-canonical eclasses with no page)+                -- to avoid infinite loops.+                let expandLoop !cache !toExplore !unavailable = do+                      let newNeeded = IntSet.unions+                            [ expandTreeIds cache eid | eid <- IntSet.toList toExplore ]+                          missing = IntSet.toList+                            (IntSet.difference (IntSet.difference newNeeded (IntSet.fromList (IntMap.keys cache))) unavailable)                       if null missing-                        then pure (cache, needed)+                        then pure cache                         else do-                          putStrLn $ "  Loading " ++ show (length missing) ++ " sub-expression pages..."-                          hFlush stdout                           newPages <- loadPagesBulk egDb missing+                          let loaded = IntMap.keysSet newPages+                              failed = IntSet.fromList [ eid | eid <- missing, IntSet.notMember eid loaded ]                           expandLoop (cache `IntMap.union` newPages)-                (cache1, needed) <- expandLoop cache0+                                     (IntSet.fromList missing `IntSet.difference` failed)+                                     (unavailable `IntSet.union` failed)+                cache1 <- expandLoop cache0 batchIds IntSet.empty +                -- Collect all reachable IDs (for job building)+                let needed = foldl' (\s eid -> s `IntSet.union` expandTreeIds cache1 eid) IntSet.empty batch+                 -- Phase 2: build jobs (reconstruct, handle cache misses)                 let toFit = IntSet.toList needed                 mjobs <- mapM (buildJobNoWrite cache1 nNoiseParams counter pendingRef) toFit@@ -416,7 +427,7 @@   batchRef <- newIORef ([] :: [EClassId])   countRef <- newIORef (0 :: Int)   foldQueryDb egDb-    "SELECT eid FROM eclass ORDER BY eid"+    "SELECT eid FROM eclass WHERE canonical = eid ORDER BY eid"     []     ()     (\() cols -> case cols of
app/Main.hs view
@@ -7,8 +7,11 @@ import EqSat  (EqSatOpts, eqsatParser, runEqSatCmd) import FitData (FitDataOpts, fitdataParser, runFitData, runRefit) import Status (StatusOpts, statusParser, runStatus)+import Export (ExportOpts, exportParser, runExport)+import Backfill (BackfillOpts, backfillParser, runBackfill)+import RandomSampler (RandomSamplerOpts, randomSamplerParser, runRandomSampler) -data Cmd = Ingest IngestOpts | EqSat EqSatOpts | FitData FitDataOpts | Refit FitDataOpts | Status StatusOpts+data Cmd = Ingest IngestOpts | EqSat EqSatOpts | FitData FitDataOpts | Refit FitDataOpts | Status StatusOpts | ExportCmd ExportOpts | BackfillCmd BackfillOpts | RandomSamplerCmd RandomSamplerOpts  main :: IO () main = execParser cmdParser >>= dispatch@@ -22,6 +25,9 @@       <> command "fitdata" (FitData <$> info (fitdataParser <**> helper) (progDesc "Fit expressions to dataset"))       <> command "refit"   (Refit   <$> info (fitdataParser <**> helper) (progDesc "Clear fit data and re-fit all expressions"))       <> command "status"  (Status  <$> info (statusParser <**> helper) (progDesc "Show fit status for a dataset"))+      <> command "export"  (ExportCmd <$> info (exportParser <**> helper) (progDesc "Export fitted expressions as CSV"))+      <> command "backfill-parents" (BackfillCmd <$> info (backfillParser <**> helper) (progDesc "Backfill enode_parent reverse index for existing DBs"))+      <> command "random-sampler" (RandomSamplerCmd <$> info (randomSamplerParser <**> helper) (progDesc "Sample N random fitted expressions and print sorted by fitness"))       )  dispatch :: Cmd -> IO ()@@ -30,3 +36,6 @@ dispatch (FitData opts) = runFitData opts dispatch (Refit   opts) = runRefit opts dispatch (Status  opts) = runStatus opts+dispatch (ExportCmd opts) = runExport opts+dispatch (BackfillCmd opts) = runBackfill opts+dispatch (RandomSamplerCmd opts) = runRandomSampler opts
+ app/RandomSampler.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module RandomSampler+  ( RandomSamplerOpts(..)+  , randomSamplerParser+  , runRandomSampler+  ) where++import qualified Data.Text as T+import Options.Applicative+import System.IO (hPutStrLn, hFlush, stdout, stderr)++import Data.SRTree.Print (showExpr)+import Algorithm.EqSat.Storage.Backend (SqlBackend(..), SqlValue(..), sqlToInt, sqlToMaybeDouble)+import Algorithm.EqSat.Storage.Extract (extractBestFromDB)+import Algorithm.EqSat.Storage.Schema (createSchemaFit)+import Algorithm.EqSat.Storage.SQLite ()+import Database.SQLite3 (Database, open, close, exec)+import Control.Exception (bracket)+import Control.Monad (forM_, when)+import Data.List (sortBy)+import Data.Ord (Down(..), comparing)++data RandomSamplerOpts = RandomSamplerOpts+  { rsEgraph  :: String+  , rsFitdb   :: String+  , rsDataset :: String+  , rsN       :: Int+  , rsFinite  :: Bool+  } deriving (Show)++randomSamplerParser :: Parser RandomSamplerOpts+randomSamplerParser = RandomSamplerOpts+  <$> strOption+      ( long "egraph"+      <> metavar "FILE"+      <> help "Path to e-graph database" )+  <*> strOption+      ( long "fitdb"+      <> metavar "FILE"+      <> help "Path to fit database" )+  <*> strOption+      ( long "dataset"+      <> metavar "NAME"+      <> help "Dataset name" )+  <*> option auto+      ( long "n"+      <> short 'n'+      <> metavar "INT"+      <> help "Number of expressions to sample" )+  <*> switch+      ( long "finite"+      <> short 'f'+      <> help "Only sample expressions with finite (non-NaN) fitness" )++runRandomSampler :: RandomSamplerOpts -> IO ()+runRandomSampler RandomSamplerOpts{..} = do+  when (rsN <= 0) $ do+    hPutStrLn stderr "Error: --n must be a positive integer."+    hFlush stderr+    fail "--n must be positive"++  withSQLite rsFitdb $ \fitDb -> do+    createSchemaFit fitDb+    dsRows <- queryDb fitDb "SELECT id FROM dataset WHERE name = ?"+      [SqlText (T.pack rsDataset)]+    case dsRows of+      [] -> do+        hPutStrLn stderr $ "Dataset '" ++ rsDataset ++ "' not found."+        hFlush stderr+      [[dsIdVal]] -> do+        let dsid = sqlToInt dsIdVal+            fitQuery+              | rsFinite =+                  "SELECT eid, fitness FROM dataset_fit \+                  \WHERE dataset_id = ? AND fitness IS NOT NULL \+                  \AND fitness * 0 = 0 \+                  \ORDER BY RANDOM() LIMIT ?"+              | otherwise =+                  "SELECT eid, fitness FROM dataset_fit \+                  \WHERE dataset_id = ? \+                  \ORDER BY RANDOM() LIMIT ?"+        rows <- queryDb fitDb fitQuery+          [SqlInteger (fromIntegral dsid), SqlInteger (fromIntegral rsN)]++        when (null rows) $ do+          hPutStrLn stderr $ "No fitted expressions found for dataset '" ++ rsDataset ++ "'."+          hFlush stderr++        let sampled = [ (sqlToInt eid, sqlToMaybeDouble fit)+                      | [eid, fit] <- rows+                      ]++        let sorted = sortBy (comparing (Down . snd)) sampled++        withSQLite rsEgraph $ \egDb -> do+          putStrLn "eid,fitness,expression"+          hFlush stdout+          forM_ sorted $ \(eid, mfit) -> do+            mTree <- extractBestFromDB egDb eid+            case mTree of+              Nothing -> do+                hPutStrLn stderr $ "WARNING: could not reconstruct expression for eid=" ++ show eid+                hFlush stderr+              Just tree -> do+                let expr = showExpr tree+                    fitStr = case mfit of+                      Nothing -> "NaN"+                      Just f  -> show f+                putStrLn $ show eid ++ "," ++ fitStr ++ "," ++ expr+                hFlush stdout++          let total = length sorted+              label = if rsFinite then " (finite)" else ""+          hPutStrLn stderr $ "Sampled " ++ show total ++ " expressions" ++ label ++ " from dataset '" ++ rsDataset ++ "'"+          hFlush stderr++      _ -> do+        hPutStrLn stderr $ "Dataset '" ++ rsDataset ++ "' query returned unexpected result."+        hFlush stderr++withSQLite :: String -> (Database -> IO a) -> IO a+withSQLite path f = bracket openDb close f+  where+    openDb = do+      db <- open (T.pack path)+      exec db "PRAGMA busy_timeout = 5000"+      pure db
src/Algorithm/EqSat/Storage/ClassStore.hs view
@@ -67,7 +67,7 @@ import Algorithm.EqSat.Storage.Types   ( enodeKey, enodeOpTag, enodeOpDetail, opDetailOf ) import Algorithm.EqSat.Egraph-  ( EClass, EClassPageStore(..), ENode(..), _eClassId )+  ( EClass, EClassId, EClassPageStore(..), ENode(..), _eClassId )  -- --------------------------------------------------------------------------- -- LRU page cache@@ -249,6 +249,10 @@       forM_ (naryChildren en) $ \(c, n) ->         insertIgnore db "enode_child (enode_key, child_eid, cnt) VALUES (?, ?, ?)"           [ SqlText key, SqlInteger (fromIntegral c), SqlInteger (fromIntegral n) ]+      -- enode_parent rows for ALL node types (reverse index for parent walks)+      forM_ (allChildren en) $ \c ->+        insertIgnore db "enode_parent (child_eid, enode_key, parent_eid) VALUES (?, ?, ?)"+          [ SqlInteger (fromIntegral c), SqlText key, SqlInteger (fromIntegral eid) ]     execDb db "COMMIT"     modifyIORef' (psNodes ps) (const Set.empty) @@ -257,6 +261,13 @@ naryChildren (ENAry _ m) = IM.toList m naryChildren _           = [] +-- | All children of any node type (for enode_parent population).+allChildren :: ENode -> [Int]+allChildren (EUni _ c)   = [c]+allChildren (EBin _ l r) = [l, r]+allChildren (ENAry _ m)  = IM.keys m+allChildren _            = []+ -- | Flush any pending canonical rows (recorded via 'cpsRecordCanonical') into -- @eclass.canonical@ (idempotent upsert), so the streaming canonical lookup -- ('cpsCanonicalOf') reflects merges and new classes. Runs in its own@@ -367,12 +378,35 @@ openClassStore :: SqlBackend db => db -> Int -> Int -> IO (PageStore db) openClassStore db cap flushEvery' = newPageStore db classStoreTable cap flushEvery' +-- | Bulk-load pages for multiple eclasses in one SQL query.+-- Splits into chunks of 500 to respect SQLite parameter limits.+bulkLoadPages :: SqlBackend db => PageStore db -> [EClassId] -> IO (IM.IntMap EClass)+bulkLoadPages _ [] = pure IM.empty+bulkLoadPages ps eids = do+  let chunks = chunkList 500 eids+  IM.unions <$> mapM loadChunk chunks+  where+    chunkList _ [] = []+    chunkList n xs = let (h, t) = Prelude.splitAt n xs in h : chunkList n t++    loadChunk ids = do+      let placeholders = T.intercalate "," (map (const "?") ids)+          params = map (SqlInteger . fromIntegral) ids+      rows <- queryDb (psDb ps)+        ("SELECT key, blob FROM " <> classStoreTable <> " WHERE key IN (" <> placeholders <> ")")+        params+      pure $ IM.fromList+        [ (sqlToInt k, decode (BL.fromStrict (sqlToBlob b)))+        | [k, b] <- rows+        ]+ -- | Adapt a 'PageStore' into the 'EClassPageStore' handle an 'EGraph' carries: -- e-class blobs are 'Binary'-serialized pages. The store is authoritative; -- the graph's resident map mirrors insertions and is consulted first on reads. classStoreHandle :: SqlBackend db => PageStore db -> EClassPageStore classStoreHandle ps = EClassPageStore   { cpsLookup = \eid -> fmap (fmap (decode . BL.fromStrict)) (readPage ps eid)+  , cpsBulkLookup = bulkLoadPages ps   , cpsInsert = \ec -> writePage ps (_eClassId ec) (BL.toStrict (encode ec))   , cpsDelete = \eid -> deletePage ps eid   , cpsFlush  = writeback ps >> flushFrontier ps >> pure ()
src/Algorithm/EqSat/Storage/Extract.hs view
@@ -19,6 +19,7 @@ import qualified Data.HashSet as Set import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet+import Control.Monad (foldM)  import Data.SRTree (Fix(..), SRTree(..), Op(..), Function(..)) import Algorithm.EqSat.Egraph (EClassId, EClass(..), EClassData(..), ENode(..), NOp(..), toOp)@@ -312,3 +313,5 @@       in go seen' (n + 1) r     expandNode seen n (ENAry _ m) =       foldl' (\s (cid, _) -> go s (n + 1) cid) seen (IntMap.toAscList m)++
src/Algorithm/EqSat/Storage/Import.hs view
@@ -208,6 +208,12 @@       [ SqlText (T.pack key)       , SqlInteger (fromIntegral c)       , SqlInteger (fromIntegral n) ]+  -- enode_parent rows for ALL node types (reverse index for parent walks)+  forM_ children $ \(c, _, _) ->+    runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (?, ?, ?)"+      [ SqlInteger (fromIntegral c)+      , SqlText (T.pack key)+      , SqlInteger (fromIntegral eid) ]   -- Write the class page inline (O(1) per new class, no post-pass needed)   let parents = HashSet.fromList         [ (c, fromMaybe (error "importEqs: bad parent key in page write") (parseEnodeKey key))@@ -256,11 +262,15 @@ -- dataset's graph, so "was this expression already tested?" is answerable per -- dataset. Used by the delta-insert path ('dbInsert') to keep @expression_index@ -- live for newly-added expressions.-recordExpressionIndex :: SqlBackend db => db -> Int -> EClassId -> IO ()-recordExpressionIndex db dsid eid = do-  mroot <- lookupClassNode db eid+-- | Record that an expression (by its canonical root e-node) was seen in a+-- dataset's graph. The node lookup hits the egraph tables (@eclass_node@, which+-- lives in the egraph DB), while the @expression_index@ row is written to the+-- dataset/fit DB. In the single-DB case both handles point at the same file.+recordExpressionIndex :: (SqlBackend eg, SqlBackend fit) => eg -> fit -> Int -> EClassId -> IO ()+recordExpressionIndex egDb fitDb dsid eid = do+  mroot <- lookupClassNode egDb eid   forM_ mroot $ \en ->-    runDb db+    runDb fitDb       "INSERT OR REPLACE INTO expression_index (expression_key, eclass, dataset_id) VALUES (?, ?, ?)"       [ SqlText (T.pack (enodeKey en))       , SqlInteger (fromIntegral eid)
src/Algorithm/EqSat/Storage/Query.hs view
@@ -14,6 +14,7 @@   , writeDatasetFit   , readDatasetFit   , topN+  , topNIn   , pareto   , paretoBySize   , distributionCounts@@ -21,6 +22,8 @@   , expressionEclass   , testedOnDataset   , versionsOf+  , parentsOf+  , ancestorsOf   ) where  import Data.Maybe (catMaybes)@@ -194,3 +197,42 @@   pure $ case rows of     row : _ | [n] <- row -> sqlToInt n     _                    -> 0++-- | Direct parents of an eclass via the @enode_parent@ reverse index.+parentsOf :: SqlBackend db => db -> EClassId -> IO [EClassId]+parentsOf db childEid = do+  rows <- queryDb db+    "SELECT DISTINCT parent_eid FROM enode_parent WHERE child_eid = ?"+    [SqlInteger (fromIntegral childEid)]+  pure [ sqlToInt eid | [eid] <- rows ]++-- | All ancestors of the given eclasses, using a SQL recursive CTE.+-- Bounded by @maxDepth@ levels of parent traversal.+ancestorsOf :: SqlBackend db => db -> Int -> [EClassId] -> IO [EClassId]+ancestorsOf _ _ [] = pure []+ancestorsOf db maxDepth seeds = do+  let seedClause = T.intercalate "," (map (T.pack . show) seeds)+      cte = "WITH RECURSIVE ancestors(eid, depth) AS (\+            \ SELECT eid, 0 FROM eclass WHERE eid IN (" <> seedClause <> ")\+            \ UNION\+            \ SELECT ep.parent_eid, a.depth + 1\+            \ FROM enode_parent ep\+            \ JOIN ancestors a ON ep.child_eid = a.eid\+            \ WHERE a.depth < " <> T.pack (show maxDepth) <> "\+            \) SELECT DISTINCT eid FROM ancestors"+  rows <- queryDb db cte []+  pure [ sqlToInt eid | [eid] <- rows ]++-- | Top @n@ e-classes by fitness from a set of candidate IDs.+topNIn :: SqlBackend db => db -> Int -> Int -> [EClassId] -> IO [(EClassId, Double)]+topNIn _ _ _ [] = pure []+topNIn db ds n eids = do+  let inClause = T.intercalate "," (map (T.pack . show) eids)+      sql = "SELECT eid, fitness FROM dataset_fit\+            \ WHERE dataset_id = ? AND fitness IS NOT NULL\+            \ AND eid IN (" <> inClause <> ")\+            \ ORDER BY fitness DESC LIMIT ?"+  rows <- queryDb db sql [SqlInteger (fromIntegral ds), SqlInteger (fromIntegral n)]+  pure [ (sqlToInt eid, f)+       | [eid, f] <- rows+       , Just f   <- [sqlToMaybeDouble f] ]
src/Algorithm/EqSat/Storage/SQLite.hs view
@@ -21,12 +21,16 @@ module Algorithm.EqSat.Storage.SQLite   ( saveGraph   , loadGraph+  , loadGraphResident   , loadGraphLazy   , pushFit   , refreshFitness   , query   , flushStore   , loadPagesBulk+  , emptyPagedGraph+  , createSchema+  , createSchemaFit   ) where  import Control.Monad (forM, forM_, when, foldM)@@ -344,6 +348,53 @@             Left err  -> pure (Left err)             Right eg  -> pure (Right eg { _classStore = Just (classStoreHandle ps) }) +-- | Load a fully resident graph (no paged store). All classes are in the+-- resident map, the pattern trie is built, and no I/O occurs during eqsat.+-- Used for benchmarking in-memory vs paged performance.+-- Note: if some eclasses are referenced by nodes but don't have pages+-- (e.g. created during eqsat but not flushed), this will skip them.+loadGraphResident :: SqlBackend db => db -> IO (Either String EGraph)+loadGraphResident db = do+  m <- readMeta db+  case m of+    Nothing -> pure (Left "srtree-db: no e-graph stored in this database")+    Just (nextId, trackDBs) -> do+      enodes <- readNodes db+      ecLst  <- readClasses db+      mdsid <- firstDatasetId db+      fit    <- case mdsid of+                  Nothing -> pure []+                  Just ds -> do+                    rows <- readDatasetFit db ds+                    pure [ (eid, (f, d, sz, parseTheta (T.unpack th)))+                         | (eid, (f, d, sz, th)) <- rows ]+      let canon     = IntMap.fromList [ (eid, c) | (eid, c, _) <- ecLst ]+          nodeToEClass = HashMap.fromList enodes+      ps <- openClassStore db defaultClassCap 1000+      pages <- allPages ps+      if null pages+        then do+          let classes = buildClasses canon nodeToEClass IntMap.empty (IntMap.fromList fit) (IntMap.fromList [ (eid, h) | (eid, _, h) <- ecLst ])+              rows    = GraphRows canon nodeToEClass classes nextId trackDBs+          pure (importEGraph rows)+        else do+          let fitMap = IntMap.fromList fit+              applyFit eid ec =+                case IntMap.lookup eid fitMap of+                  Nothing -> ec+                  Just (f, d, s, th) ->+                    ec { _info = (_info ec){ _fitness = f, _dl = d, _size = s, _theta = th } }+              classes  = IntMap.mapWithKey applyFit+                           (IntMap.fromList [ (eid, decode (BL.fromStrict page)) | (eid, page) <- pages ])+              -- Filter nodeToEClass to only reference eclasses that have pages+              validEids = IntMap.keysSet classes+              nodeToEClass' = HashMap.filter (`IntSet.member` validEids) nodeToEClass+              toRow eid ec = EClassRow (_eNodes ec) (_parents ec) (_height ec) (_info ec)+              rows = GraphRows canon nodeToEClass' (IntMap.mapWithKey toRow classes) nextId trackDBs+          -- Note: _classStore = Nothing, so the Identity/State instance is used+          -- (no I/O during eqsat, pure IntMap/HashMap lookups)+          pure (importEGraph rows)+ -- | Write back any pending dirty e-class pages when the graph carries a -- paged store (a no-op on a fully resident graph). Call this at durable -- commit points (e.g. rewrite-loop iteration boundaries).@@ -404,9 +455,13 @@ seedEDBPaged   :: Int -> Bool   -> HashMap.HashMap ENode EClassId+  -> Int    -- ^ resident class cache capacity+  -> Int    -- ^ node-to-class cache capacity+  -> Int    -- ^ canonical map cache capacity   -> EGraphDB-seedEDBPaged nextId trackDBs _nodeToEClass =-  (emptyDB){ _nextId = nextId, _trackDBs = trackDBs }+seedEDBPaged nextId trackDBs _nodeToEClass residentCap nodeCap canonicalCap =+  (emptyDB){ _nextId = nextId, _trackDBs = trackDBs+           , _residentCap = residentCap, _nodeCap = nodeCap, _canonicalCap = canonicalCap }  -- | Reconstruct an e-graph for out-of-core use: like 'loadGraph' but the -- resident e-class map is left empty and an 'EClassPageStore' handle is@@ -422,9 +477,13 @@ -- (bounded caches): canonical/node lookups fall back to the live relational -- tables ('cpsCanonicalOf'/'cpsNodeToClass'), which the write-through keeps -- current, so nothing O(nodes) is materialized at load.-loadGraphLazy :: SqlBackend db => db -> Int -> IO (Either String EGraph)-loadGraphLazy db dsid = do-  m <- readMeta db+loadGraphLazy :: SqlBackend db => db -> Int -> Int -> Int -> Int -> IO (Either String EGraph)+--                              db   dsid  residentCap nodeCap canonicalCap+loadGraphLazy db dsid residentCap nodeCap canonicalCap = do+  m <- readMeta db `catch` \(_ :: SomeException) -> do+         -- The egraph tables may not exist yet on a fresh database (e.g. first+         -- insert); treat that as "no e-graph stored" rather than crashing.+         pure Nothing   case m of     Nothing -> pure (Left "srtree-db: no e-graph stored in this database")     Just (nextId, trackDBs) -> do@@ -458,9 +517,19 @@           let base = classStoreHandle ps               h    = base { cpsLookup = \eid ->                               fmap (fmap (applyDsFit fitSlim eid)) (cpsLookup base eid) }-              eDB  = seedEDBPaged nextId trackDBs HashMap.empty+              eDB  = seedEDBPaged nextId trackDBs HashMap.empty residentCap nodeCap canonicalCap               eg   = EGraph IntMap.empty HashMap.empty IntMap.empty eDB (Just h)           pure (Right eg)++-- | An empty out-of-core paged graph (no classes yet) with the given cache+-- capacities. Used to seed a fresh database on the first 'DBInsert', so+-- inserting into an empty DB works instead of failing with "no e-graph stored".+emptyPagedGraph :: SqlBackend db => db -> Int -> Int -> Int -> IO EGraph+emptyPagedGraph db residentCap nodeCap canonicalCap = do+  ps <- openClassStore db defaultClassCap 1000+  let eDB = seedEDBPaged 0 True HashMap.empty residentCap nodeCap canonicalCap+      eg  = EGraph IntMap.empty HashMap.empty IntMap.empty eDB (Just (classStoreHandle ps))+  pure eg  -- | Apply a dataset's fitness metadata to a class read from the structural page -- store (fitness/dl/size are dataset-specific, so they are attached on read
src/Algorithm/EqSat/Storage/Schema.hs view
@@ -41,6 +41,11 @@     <> " child_eid INTEGER NOT NULL,"     <> " cnt INTEGER NOT NULL DEFAULT 1,"     <> " PRIMARY KEY (enode_key, child_eid))"+  , "CREATE TABLE IF NOT EXISTS enode_parent ("+    <> " child_eid INTEGER NOT NULL,"+    <> " enode_key TEXT NOT NULL,"+    <> " parent_eid INTEGER NOT NULL,"+    <> " PRIMARY KEY (child_eid, enode_key))"   , "CREATE TABLE IF NOT EXISTS eclass ("     <> " eid INTEGER PRIMARY KEY,"     <> " canonical INTEGER NOT NULL,"
srtree-db.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          srtree-db-version:       0.1.2.0+version:       0.1.3.0 synopsis:      SQL persistence and querying for srtree e-graphs description:   Reusable storage layer for srtree multiset e-graphs:                a driver-neutral serialization of the Algorithm.EqSat.Store@@ -43,7 +43,7 @@     , text >=1.2 && <2.2     , direct-sqlite >=2.3 && <2.4     , postgresql-libpq >=0.10 && <0.12-    , srtree >=3.0.0.3 && <3.1+    , srtree >=3.0.0.4 && <3.1     , vector >=0.12 && <0.14     , mtl >=2.2 && <2.4   default-language: Haskell2010@@ -62,20 +62,20 @@     , directory >=1.3 && <1.4     , direct-sqlite >=2.3 && <2.4     , postgresql-libpq >=0.10 && <0.12-    , srtree >=3.0.0.3 && <3.1+    , srtree >=3.0.0.4 && <3.1     , srtree-db >=0.1 && <0.2   default-language: Haskell2010  executable srtree-db   hs-source-dirs:   app   main-is:          Main.hs-  other-modules:    Ingest, EqSat, FitData, Status+  other-modules:    Ingest, EqSat, FitData, Status, Export, Backfill, RandomSampler   ghc-options:      -O2 -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.14 && <5     , optparse-applicative >=0.17 && <0.19     , srtree-db >=0.1 && <0.2-    , srtree >=3.0.0.3 && <3.1+    , srtree >=3.0.0.4 && <3.1     , bytestring >=0.10 && <0.13     , binary >=0.8 && <0.9     , containers >=0.6 && <0.9@@ -105,7 +105,7 @@     , text >=1.2 && <2.2     , direct-sqlite >=2.3 && <2.4     , postgresql-libpq >=0.10 && <0.12-    , srtree >=3.0.0.3 && <3.1+    , srtree >=3.0.0.4 && <3.1     , srtree-db >=0.1 && <0.2     , vector >=0.12 && <0.14     , mtl >=2.2 && <2.4
test/Main.hs view
@@ -36,7 +36,7 @@ import Algorithm.EqSat.Storage.ClassStore import Algorithm.EqSat.Storage.SQLite import Algorithm.EqSat.Storage.Query (getOrCreateDataset)-import Algorithm.EqSat.Storage.Backend (SqlBackend)+import Algorithm.EqSat.Storage.Backend (SqlBackend, queryDb, execDb, runDb) import Algorithm.EqSat.Storage.Postgres () import qualified Algorithm.EqSat.Storage.Query as Q @@ -302,7 +302,7 @@   db <- openDb   (eg, eidAdd, eidP2, _) <- buildGraph   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg' -> do@@ -350,7 +350,7 @@         _ <- fromTree myCost (var 0 / var 0)         pure ()   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg' -> do@@ -389,7 +389,7 @@         insertFitness eidAdd 0.9 []         pure (eidP, eidXx, eidAdd)   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg0 -> do@@ -409,7 +409,7 @@         (case ecRows of [[v]] -> sqlToInt v > 0; _ -> False)       _ <- saveGraphTest db g1       -- reload a fresh lazy graph-      obj2 <- loadGraphLazy db 1+      obj2 <- loadGraphLazy db 1 50000 100000 100000       case obj2 of         Left err2 -> assertFailure ("reload failed: " <> err2)         Right eg2 -> do@@ -437,7 +437,7 @@   db <- openDb   (eg, eidAdd, _, _) <- buildGraph   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg0 -> do@@ -464,7 +464,7 @@         eidD <- fromTree myCost (var 1 ** 2)      -- x1**2         pure (eidA, eidB, eidC, eidD)   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg0 -> case _classStore eg0 of@@ -515,7 +515,7 @@   assertBool   "in-mem: pairs distinct" (mA /= mC)   -- --- DB/paged path ---   _ <- saveGraphTest db eg-  obj <- loadGraphLazy db 1+  obj <- loadGraphLazy db 1 50000 100000 100000   case obj of     Left err -> assertFailure ("loadGraphLazy failed: " <> err)     Right eg0 -> do@@ -542,11 +542,56 @@   , TestLabel (tag <> " equiv-inmem-db")    (testEquivInMemDB openDb closeDb)   ] +-- | Test enode_parent reverse index: parentsOf and ancestorsOf+testEnodeParent :: SqlBackend db => (IO db, db -> IO ()) -> Test+testEnodeParent (openDb, closeDb) = TestLabel "enode-parent" $ TestCase $ do+  -- Build graph: x0 + x1 (eidAdd), x0 * (x0 + x1) (eidMul)+  let ((eidAdd, eidMul), eg0) = runIn emptyGraph $ do+        _ <- fromTree myCost (var 0)+        _ <- fromTree myCost (var 1)+        eidAdd <- fromTree myCost (var 0 + var 1)+        eidMul <- fromTree myCost ((var 0 + var 1) * var 2)+        pure (eidAdd, eidMul)+  -- Save to DB+  db <- openDb+  saveGraphTest db eg0+  -- Manually populate enode_parent (saveGraph doesn't do this; importEqs and flushNodes do)+  -- Query actual enode keys from the DB+  addKey <- queryDb db "SELECT enode_key FROM eclass_node WHERE eid = ?" [SqlInteger (fromIntegral eidAdd)]+  let addKeyStr = case addKey of [[SqlText k]] -> T.unpack k; _ -> "Bin Add 0 1"+  mulKey <- queryDb db "SELECT enode_key FROM eclass_node WHERE eid = ?" [SqlInteger (fromIntegral eidMul)]+  let mulKeyStr = case mulKey of [[SqlText k]] -> T.unpack k; _ -> "Bin Mul 0 2"+  -- Insert parent rows for Add's children (x0=0, x1=1)+  runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (0, ?, ?)"+    [SqlText (T.pack addKeyStr), SqlInteger (fromIntegral eidAdd)]+  runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (1, ?, ?)"+    [SqlText (T.pack addKeyStr), SqlInteger (fromIntegral eidAdd)]+  -- Insert parent rows for Mul's children (Add class, x2=2)+  runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (?, ?, ?)"+    [SqlInteger (fromIntegral eidAdd), SqlText (T.pack mulKeyStr), SqlInteger (fromIntegral eidMul)]+  runDb db "INSERT OR IGNORE INTO enode_parent (child_eid, enode_key, parent_eid) VALUES (2, ?, ?)"+    [SqlText (T.pack mulKeyStr), SqlInteger (fromIntegral eidMul)]+  -- Verify enode_parent rows exist+  rows <- queryDb db "SELECT COUNT(*) FROM enode_parent" []+  let count = case rows of [[n]] -> sqlToInt n; _ -> 0+  assertBool ("enode_parent should have rows, got " ++ show count) (count > 0)+  -- Test parentsOf: x0's parent should be the Add class+  parents <- Q.parentsOf db 0  -- x0 is eid 0+  assertBool "x0 should have parents" (not (null parents))+  assertBool "x0's parent should include the Add class" (eidAdd `elem` parents)+  -- Test ancestorsOf: ancestors of x0 should include Add and Mul+  ancestors <- Q.ancestorsOf db 10 [0]+  assertBool "x0 should have ancestors" (not (null ancestors))+  assertBool "ancestors should include Add" (eidAdd `elem` ancestors)+  assertBool "ancestors should include Mul" (eidMul `elem` ancestors)+  closeDb db+ runSuite :: SqlBackend db => String -> (IO db, db -> IO ()) -> [Test] runSuite tag (openDb, closeDb) =   [ TestLabel (tag <> " save-load-roundtrip") (testSaveLoadRT openDb closeDb)   , TestLabel (tag <> " queries")             (testQueries openDb closeDb)   , TestLabel (tag <> " sync")                (testSync openDb closeDb)+  , TestLabel (tag <> " enode-parent")        (testEnodeParent (openDb, closeDb))   ]     <> runStoreSuite tag (openDb, closeDb)