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 +15/−0
- app/Backfill.hs +84/−0
- app/EqSat.hs +107/−13
- app/Export.hs +116/−0
- app/FitData.hs +19/−8
- app/Main.hs +10/−1
- app/RandomSampler.hs +129/−0
- src/Algorithm/EqSat/Storage/ClassStore.hs +35/−1
- src/Algorithm/EqSat/Storage/Extract.hs +3/−0
- src/Algorithm/EqSat/Storage/Import.hs +14/−4
- src/Algorithm/EqSat/Storage/Query.hs +42/−0
- src/Algorithm/EqSat/Storage/SQLite.hs +75/−6
- src/Algorithm/EqSat/Storage/Schema.hs +5/−0
- srtree-db.cabal +6/−6
- test/Main.hs +53/−8
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)