From 4a036161cd232e68c5bcd2dee16cc32bf6bd5f03 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Thu, 2 Jul 2026 20:50:18 +0200 Subject: [PATCH 1/2] Typecheck-cache PoC (native): Merkle keys, binary dumps, on-disk reuse A proof of concept for content-addressed caching of per-module typecheck results, so unchanged modules (notably std) are reused across compiles instead of being re-typechecked. - TypecheckCache: a Merkle cache key per module = keccak(content hash ++ sorted reference keys ++ typecheck-relevant flags), folded in dependency order. Editing a module changes exactly its key and its transitive dependents' (transitiveDependents), giving precise invalidation. -g is folded in only for contract-bearing modules, so library keys stay stable as -g toggles. - TcCacheSerialize: binary serialization of the checked module (typed CompUnit + its typeTable; other env fields restored as loud error thunks, proven unread). A magic + version header makes a stale or foreign dump degrade to a cache miss rather than a wrong result. Location instances added for current main's AST. - SolcorePipeline: compileGraphWithCache / typeCheckLoadedModulesWithCache reuse any cached module instead of re-checking it; the existing compile path is unchanged (empty cache). - Keccak: pure-Haskell keccak-256 for the content hashes. - poc/Main.hs (exe tc-cache-poc): demonstrates and asserts the Merkle keys, the invalidation property, deterministic keying, the on-disk binary round-trip and its format guard, and that warm/hit/disk runs reproduce the cold hull exactly. Assisted-By: Claude Opus 4.8 --- poc/Main.hs | 174 ++++++++++++ sol-core.cabal | 15 ++ src/Solcore/Pipeline/SolcorePipeline.hs | 49 +++- src/Solcore/Pipeline/TcCacheSerialize.hs | 324 +++++++++++++++++++++++ src/Solcore/Pipeline/TypecheckCache.hs | 126 +++++++++ src/Solcore/Util/Keccak.hs | 143 ++++++++++ test/KeccakTests.hs | 29 ++ test/Main.hs | 4 +- 8 files changed, 852 insertions(+), 12 deletions(-) create mode 100644 poc/Main.hs create mode 100644 src/Solcore/Pipeline/TcCacheSerialize.hs create mode 100644 src/Solcore/Pipeline/TypecheckCache.hs create mode 100644 src/Solcore/Util/Keccak.hs create mode 100644 test/KeccakTests.hs diff --git a/poc/Main.hs b/poc/Main.hs new file mode 100644 index 000000000..d44233695 --- /dev/null +++ b/poc/Main.hs @@ -0,0 +1,174 @@ +-- | PoC harness for the typecheck cache. +-- +-- Phase 1 (caching seam): reusing a previously-computed 'CheckedModule' instead +-- of re-typechecking yields byte-identical downstream output, and saves the +-- typecheck time. No serialization yet — the cache is an in-process 'Map'. +-- +-- Phase 2 (Merkle keying): a content-addressed key per module drives cache +-- reuse. We check keying determinism, the precise-invalidation property (editing +-- a module invalidates exactly it plus its transitive dependents), and use the +-- keys to select which modules to reuse when the entry module is "edited". +module Main where + +import Control.Monad (forM_, unless) +import Control.Monad.Except (ExceptT (..), runExceptT) +import Control.Monad.IO.Class (liftIO) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BL +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Maybe (isNothing) +import Data.Set qualified as Set +import Language.Hull qualified as Hull +import Solcore.Frontend.Module.Identity qualified as Mod +import Solcore.Frontend.Module.Loader (LoadedModule (..), ModuleGraph (..), loadModuleGraph) +import Solcore.Frontend.TypeInference.TcModule (CheckedModule) +import Solcore.Pipeline.Options (Option (..), emptyOption) +import Solcore.Pipeline.SolcorePipeline (compileDiagnosticsText, compileGraphWithCache, parseExternalLibSpecs, parseStdRoot) +import Solcore.Pipeline.TcCacheSerialize (decodeCache, encodeCache, fromCachedModule, toCachedModule) +import Solcore.Pipeline.TypecheckCache + ( TcCacheKey (..), + moduleCacheKeys, + moduleCacheKeysWith, + moduleHasContracts, + transitiveDependents, + ) +import System.Directory (getTemporaryDirectory, makeAbsolute) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.FilePath (()) +import System.TimeIt (timeItT) +import Text.Printf (printf) + +main :: IO () +main = do + args <- getArgs + let file = case args of + (f : _) -> f + [] -> "test/examples/dispatch/counter.solc" + opts = (emptyOption file) {optTiming = True} + putStrLn ("PoC file: " ++ file) + graph <- loadGraph opts file + let order = moduleOrder graph + entry = entryModule graph + display = Mod.moduleIdDisplay + hasContracts m = moduleHasContracts (loadedCompUnit (modules graph Map.! m)) + printf "modules in graph: %d (entry: %s)\n" (length order) (display entry) + + keys <- orDie (moduleCacheKeys opts graph) + + -- Cache keys ---------------------------------------------------------------- + section "cache keys (Merkle: source + reference keys + flags)" + forM_ order $ \m -> + printf " %-42s key=%s contracts=%s\n" (display m) (shortKey (keys Map.! m)) (show (hasContracts m)) + + -- Keying is deterministic across a fresh load of the same sources. + graph2 <- loadGraph opts file + keys2 <- orDie (moduleCacheKeys opts graph2) + assert "keys are stable across a reload" (keys == keys2) + + -- Precise invalidation: editing a module changes the key of exactly that + -- module plus every module that (transitively) references it. + section "invalidation property (edit M -> which modules must be rechecked)" + forM_ order $ \m -> do + edited <- orDie (moduleCacheKeysWith (bump m) opts graph) + let changed = Set.fromList [x | x <- order, Map.lookup x keys /= Map.lookup x edited] + expected = transitiveDependents graph m + printf + " edit %-42s -> %d recheck(s): %s\n" + (display m) + (Set.size changed) + (unwords (map display (Set.toList changed))) + assert ("invalidation set matches dependents for " ++ display m) (changed == expected) + + -- Correctness + timing ------------------------------------------------------ + section "compile runs (cold / key-driven warm / full hit)" + (hull0, checked0, t0) <- runPipeline "cold (empty cache)" opts graph Map.empty + + -- Simulate the IDE editing the entry module: reuse every module whose key is + -- unchanged by that edit. That set is computed purely from the keys. + editedKeys <- orDie (moduleCacheKeysWith (bump entry) opts graph) + let reusable = Set.fromList [m | m <- order, Map.lookup m keys == Map.lookup m editedKeys] + stdCache = Map.restrictKeys checked0 reusable + printf "entry edit reuses %d/%d modules by key\n" (Set.size reusable) (length order) + (hull1, _, t1) <- runPipeline "warm (key-driven: entry edited)" opts graph stdCache + + (hull2, _, t2) <- runPipeline "hit (all modules cached)" opts graph checked0 + + -- Phase 3: serialize the cold-checked modules (keyed by Merkle key), round + -- trip through disk with binary, and compile again reusing the decoded cache. + section "serialization round-trip (binary, on disk)" + tmp <- getTemporaryDirectory + let cacheFile = tmp "solcore-tc-cache.bin" + keyed = Map.fromList [(keys Map.! m, toCachedModule cm) | (m, cm) <- Map.toList checked0] + BL.writeFile cacheFile (encodeCache keyed) + blob <- BL.readFile cacheFile + decoded <- + maybe + (putStrLn "cache decode failed (bad header/version)" >> exitFailure) + pure + (decodeCache blob) + let fromDisk = + Map.fromList + [ (m, fromCachedModule opts cm) + | m <- order, + Just cm <- [Map.lookup (keys Map.! m) decoded] + ] + printf "encoded %d modules -> %s (%d bytes)\n" (Map.size decoded) cacheFile (BL.length blob) + -- Format guard: a blob with a corrupted header is rejected (miss, not crash). + assert + "tampered/foreign dump is rejected by the version guard" + (isNothing (decodeCache (BL.cons 0xff (BL.drop 1 blob)))) + putStrLn "format guard: tampered dump correctly rejected (would recompute)" + (hullD, _, tD) <- runPipeline "disk (all modules from on-disk cache)" opts graph fromDisk + + let render = map show :: [Hull.Object] -> [String] + ok = all (== render hull0) [render hull1, render hull2, render hullD] + printf + "\nobjects: %d | cold %.2fs | warm %.2fs | hit %.2fs | disk %.2fs\n" + (length hull0) + t0 + t1 + t2 + tD + if ok + then putStrLn "RESULT: OK — in-process and on-disk caches both reproduce the cold run" + else putStrLn "RESULT: MISMATCH — a cached run differs from the cold run" >> exitFailure + +-- | Perturb one module's content hash, to simulate an edit to it. +bump :: Mod.ModuleId -> Mod.ModuleId -> BS.ByteString -> BS.ByteString +bump target moduleId h = if moduleId == target then h <> "EDIT" else h + +shortKey :: TcCacheKey -> String +shortKey (TcCacheKey bs) = concatMap (printf "%02x") (BS.unpack (BS.take 6 bs)) + +section :: String -> IO () +section title = putStrLn ("\n== " ++ title ++ " ==") + +assert :: String -> Bool -> IO () +assert msg cond = unless cond (putStrLn ("FAIL: " ++ msg) >> exitFailure) + +orDie :: Either String a -> IO a +orDie = either (\err -> putStrLn err >> exitFailure) pure + +loadGraph :: Option -> FilePath -> IO ModuleGraph +loadGraph opts file = do + result <- runExceptT $ do + mainRoot <- liftIO (makeAbsolute (optRootDir opts)) + stdRoot <- ExceptT (pure (parseStdRoot (optImportDirs opts))) + externalLibs <- ExceptT (pure (parseExternalLibSpecs (optExternalLibs opts))) + ExceptT (loadModuleGraph mainRoot stdRoot externalLibs file) + orDie result + +runPipeline :: + String -> + Option -> + ModuleGraph -> + Map Mod.ModuleId CheckedModule -> + IO ([Hull.Object], Map Mod.ModuleId CheckedModule, Double) +runPipeline label opts graph cache = do + printf "\n-- %s: %d cached --\n" label (Map.size cache) + (elapsed, result) <- timeItT (runExceptT (compileGraphWithCache opts graph cache)) + case result of + Left err -> putStrLn ("compile error: " ++ compileDiagnosticsText err) >> exitFailure + Right (hull, checked) -> pure (hull, checked, elapsed) diff --git a/sol-core.cabal b/sol-core.cabal index fe5f047dd..c1a14ba14 100644 --- a/sol-core.cabal +++ b/sol-core.cabal @@ -19,6 +19,7 @@ common common-opts build-depends: base >= 4.19.0.0 , mtl + , binary , bytestring , containers , cryptonite @@ -114,6 +115,9 @@ library Solcore.Frontend.TypeInference.TcUnify Solcore.Pipeline.Options Solcore.Pipeline.SolcorePipeline + Solcore.Pipeline.TypecheckCache + Solcore.Pipeline.TcCacheSerialize + Solcore.Util.Keccak Solcore.Primitives.Primitives Language.Hull Language.Hull.Compress @@ -151,6 +155,16 @@ executable sol-core ghc-options: -O1 -rtsopts +-- Typecheck-cache PoC harness: demonstrates Merkle cache keys, precise +-- invalidation, and binary dump + on-disk reuse (see poc/Main.hs). +executable tc-cache-poc + import: common-opts + main-is: Main.hs + hs-source-dirs: poc + build-depends: sol-core, timeit + ghc-options: + -O1 -rtsopts + executable yule import: common-opts main-is: Main.hs @@ -189,6 +203,7 @@ test-suite sol-core-tests DiagnosticCliTests DiagnosticTests HullCases + KeccakTests LocationTests MatchCompilerTests ModuleTypeCheckTests diff --git a/src/Solcore/Pipeline/SolcorePipeline.hs b/src/Solcore/Pipeline/SolcorePipeline.hs index 1e76c4c95..06a863936 100644 --- a/src/Solcore/Pipeline/SolcorePipeline.hs +++ b/src/Solcore/Pipeline/SolcorePipeline.hs @@ -106,19 +106,32 @@ compile opts = compileWithDiagnostics :: Option -> IO (Either CompileDiagnostics [Hull.Object]) compileWithDiagnostics opts = runExceptT $ do - let verbose = optVerbose opts - noMatchCompiler = optNoMatchCompiler opts - noIfDesugar = optNoIfDesugar opts - timeItNamed :: String -> IO a -> IO a - timeItNamed = optTimeItNamed opts - file = fileName opts + let file = fileName opts mainRoot <- liftIO $ makeAbsolute (optRootDir opts) stdRoot <- liftEitherDiagnostic emptySourceMap (parseStdRoot (optImportDirs opts)) externalLibs <- liftEitherDiagnostic emptySourceMap (parseExternalLibSpecs (optExternalLibs opts)) -- Parsing and import loading graph <- liftEitherDiagnosticIO emptySourceMap (loadModuleGraph mainRoot stdRoot externalLibs file) - let sources = moduleSourceMap graph + fst <$> compileGraphWithCache opts graph Map.empty + +-- | Cache-aware pipeline over an already-loaded module graph (typecheck-cache +-- PoC). Modules present in the supplied cache are reused verbatim instead of +-- being re-typechecked; every other module is typechecked as usual. Returns the +-- hull together with the full set of checked modules, so a caller can seed a +-- later run's cache. +compileGraphWithCache :: + Option -> + ModuleGraph -> + Map Mod.ModuleId CheckedModule -> + ExceptT CompileDiagnostics IO ([Hull.Object], Map Mod.ModuleId CheckedModule) +compileGraphWithCache opts graph cache = do + let verbose = optVerbose opts + noMatchCompiler = optNoMatchCompiler opts + noIfDesugar = optNoIfDesugar opts + timeItNamed :: String -> IO a -> IO a + timeItNamed = optTimeItNamed opts + sources = moduleSourceMap graph -- Validate each module against only its own direct imports. forM_ (moduleOrder graph) $ \moduleId -> do @@ -143,7 +156,7 @@ compileWithDiagnostics opts = runExceptT $ do liftCompilerDiagnosticIO sources ( timeItNamed "Typecheck modules" $ - runExceptT (typeCheckLoadedModules opts graph) + runExceptT (typeCheckLoadedModulesWithCache opts graph cache) ) checkedAssembly <- liftEitherDiagnostic sources (assembleCheckedModules graph checkedModules) let typed = checkedAssemblyCompUnit checkedAssembly @@ -180,7 +193,7 @@ compileWithDiagnostics opts = runExceptT $ do -- Specialization & Hull Generation if optNoSpec opts - then pure [] + then pure ([], checkedModules) else do specialized <- liftIO $ @@ -224,7 +237,7 @@ compileWithDiagnostics opts = runExceptT $ do putStrLn "> Hull contract(s):" forM_ hull (putStrLn . pretty) - pure hull + pure (hull, checkedModules) renderCompileDiagnostics :: Option -> CompileDiagnostics -> String renderCompileDiagnostics opts diagnostics = @@ -714,7 +727,21 @@ ensureSourcePath sources path typeCheckLoadedModules :: Option -> ModuleGraph -> ExceptT CompilerError IO (Map Mod.ModuleId CheckedModule) typeCheckLoadedModules opts graph = - Map.fromList <$> mapM (typeCheckModuleFromGraph opts graph) (moduleOrder graph) + typeCheckLoadedModulesWithCache opts graph Map.empty + +-- Typecheck every module in graph order, reusing any module already present in +-- the cache instead of re-checking it (typecheck-cache PoC). +typeCheckLoadedModulesWithCache :: + Option -> + ModuleGraph -> + Map Mod.ModuleId CheckedModule -> + ExceptT CompilerError IO (Map Mod.ModuleId CheckedModule) +typeCheckLoadedModulesWithCache opts graph cache = + Map.fromList <$> mapM checkOrReuse (moduleOrder graph) + where + checkOrReuse moduleId = case Map.lookup moduleId cache of + Just cm -> pure (moduleId, cm) + Nothing -> typeCheckModuleFromGraph opts graph moduleId typeCheckModuleFromGraph :: Option -> diff --git a/src/Solcore/Pipeline/TcCacheSerialize.hs b/src/Solcore/Pipeline/TcCacheSerialize.hs new file mode 100644 index 000000000..24448b7c1 --- /dev/null +++ b/src/Solcore/Pipeline/TcCacheSerialize.hs @@ -0,0 +1,324 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Serialization for the typecheck cache (Phase 3). +-- +-- All @Generic@/@Binary@ instances live here as standalone deriving, so the +-- @Syntax.*@ modules stay untouched. We use @binary@ (a GHC boot library, pure +-- Haskell, no dependency tail) so the same code cross-compiles to the JS +-- backend; the format is confined behind 'encodeCache' / 'decodeCache' and can +-- be swapped without touching the rest of the pipeline. +-- +-- A cached module carries only what the assembly step actually reads back from a +-- non-entry module: its typed 'CompUnit' and the @typeTable@ of its 'TcEnv' +-- (see 'mergeCheckedModuleEnvs', which takes every other env field from the +-- never-cached entry module). The dropped 'CheckedModule' fields are restored as +-- loud error thunks: proven unread, so never forced, but failing clearly if that +-- assumption is ever violated. +module Solcore.Pipeline.TcCacheSerialize + ( CachedModule (..), + toCachedModule, + fromCachedModule, + encodeCache, + decodeCache, + ) +where + +import Data.Binary (Binary, get, put) +import Data.Binary.Get (runGetOrFail) +import Data.Binary.Put (runPut) +import Data.ByteString.Lazy qualified as BL +import Data.Map (Map) +import Data.Word (Word32) +import GHC.Generics (Generic) +import Language.Yul (YLiteral (..), YulExp (..), YulStmt (..)) +import Solcore.Diagnostics (SourceSpan (..)) +import Solcore.Frontend.Module.Identity +import Solcore.Frontend.Syntax.Contract +import Solcore.Frontend.Syntax.Location (NodeLocation (..), NodeOrigin (..)) +import Solcore.Frontend.Syntax.Name +import Solcore.Frontend.Syntax.Stmt +import Solcore.Frontend.Syntax.Ty +import Solcore.Frontend.TypeInference.Id +import Solcore.Frontend.TypeInference.TcEnv (TcEnv (..), TypeInfo (..), initTcEnv) +import Solcore.Frontend.TypeInference.TcModule (CheckedModule (..)) +import Solcore.Pipeline.Options (Option) +import Solcore.Pipeline.TypecheckCache (TcCacheKey (..)) + +-- Source locations (carried throughout the AST on current main) ------------- +deriving stock instance Generic SourceSpan + +deriving anyclass instance Binary SourceSpan + +deriving stock instance Generic NodeOrigin + +deriving anyclass instance Binary NodeOrigin + +deriving stock instance Generic NodeLocation + +deriving anyclass instance Binary NodeLocation + +-- Names / identifiers ------------------------------------------------------- +deriving stock instance Generic Name + +deriving anyclass instance Binary Name + +deriving stock instance Generic Id + +deriving anyclass instance Binary Id + +deriving stock instance Generic LibraryId + +deriving anyclass instance Binary LibraryId + +deriving stock instance Generic ModuleId + +deriving anyclass instance Binary ModuleId + +-- Types --------------------------------------------------------------------- +deriving stock instance Generic Tyvar + +deriving anyclass instance Binary Tyvar + +deriving stock instance Generic Ty + +deriving anyclass instance Binary Ty + +deriving stock instance Generic MetaTv + +deriving anyclass instance Binary MetaTv + +deriving stock instance Generic Pred + +deriving anyclass instance Binary Pred + +deriving stock instance Generic (Qual t) + +deriving anyclass instance (Binary t) => Binary (Qual t) + +deriving stock instance Generic Scheme + +deriving anyclass instance Binary Scheme + +deriving stock instance Generic TypeInfo + +deriving anyclass instance Binary TypeInfo + +-- Top level ----------------------------------------------------------------- +deriving stock instance Generic (CompUnit a) + +deriving anyclass instance (Binary a) => Binary (CompUnit a) + +deriving stock instance Generic (TopDecl a) + +deriving anyclass instance (Binary a) => Binary (TopDecl a) + +deriving stock instance Generic (Contract a) + +deriving anyclass instance (Binary a) => Binary (Contract a) + +deriving stock instance Generic (ContractDecl a) + +deriving anyclass instance (Binary a) => Binary (ContractDecl a) + +deriving stock instance Generic (Field a) + +deriving anyclass instance (Binary a) => Binary (Field a) + +deriving stock instance Generic (Constructor a) + +deriving anyclass instance (Binary a) => Binary (Constructor a) + +deriving stock instance Generic (FunDef a) + +deriving anyclass instance (Binary a) => Binary (FunDef a) + +deriving stock instance Generic (Signature a) + +deriving anyclass instance (Binary a) => Binary (Signature a) + +deriving stock instance Generic (Class a) + +deriving anyclass instance (Binary a) => Binary (Class a) + +deriving stock instance Generic (Instance a) + +deriving anyclass instance (Binary a) => Binary (Instance a) + +deriving stock instance Generic DataTy + +deriving anyclass instance Binary DataTy + +deriving stock instance Generic Constr + +deriving anyclass instance Binary Constr + +deriving stock instance Generic TySym + +deriving anyclass instance Binary TySym + +deriving stock instance Generic TopDeclKey + +deriving anyclass instance Binary TopDeclKey + +-- Modules / imports / exports ---------------------------------------------- +deriving stock instance Generic Import + +deriving anyclass instance Binary Import + +deriving stock instance Generic ModulePath + +deriving anyclass instance Binary ModulePath + +deriving stock instance Generic Export + +deriving anyclass instance Binary Export + +deriving stock instance Generic ExportSpec + +deriving anyclass instance Binary ExportSpec + +deriving stock instance Generic ExportSelector + +deriving anyclass instance Binary ExportSelector + +deriving stock instance Generic ExportSelectorEntry + +deriving anyclass instance Binary ExportSelectorEntry + +deriving stock instance Generic ConstructorSelector + +deriving anyclass instance Binary ConstructorSelector + +deriving stock instance Generic ItemSelector + +deriving anyclass instance Binary ItemSelector + +deriving stock instance Generic ItemSelectorEntry + +deriving anyclass instance Binary ItemSelectorEntry + +-- Pragmas ------------------------------------------------------------------- +deriving stock instance Generic Pragma + +deriving anyclass instance Binary Pragma + +deriving stock instance Generic PragmaType + +deriving anyclass instance Binary PragmaType + +deriving stock instance Generic PragmaStatus + +deriving anyclass instance Binary PragmaStatus + +-- Statements / expressions / patterns -------------------------------------- +deriving stock instance Generic (Stmt a) + +deriving anyclass instance (Binary a) => Binary (Stmt a) + +deriving stock instance Generic (Param a) + +deriving anyclass instance (Binary a) => Binary (Param a) + +deriving stock instance Generic (Exp a) + +deriving anyclass instance (Binary a) => Binary (Exp a) + +deriving stock instance Generic (Pat a) + +deriving anyclass instance (Binary a) => Binary (Pat a) + +deriving stock instance Generic Literal + +deriving anyclass instance Binary Literal + +-- Inline Yul (reachable from the typed AST via @Asm YulBlock@) --------------- +deriving stock instance Generic YulStmt + +deriving anyclass instance Binary YulStmt + +deriving stock instance Generic YulExp + +deriving anyclass instance Binary YulExp + +deriving stock instance Generic YLiteral + +deriving anyclass instance Binary YLiteral + +-- Cache key ----------------------------------------------------------------- +deriving stock instance Generic TcCacheKey + +deriving anyclass instance Binary TcCacheKey + +-- Payload ------------------------------------------------------------------- + +-- | The serialized form of a typechecked module: exactly what the assembly step +-- reads back from a non-entry module. +data CachedModule + = CachedModule + { cachedModuleId :: ModuleId, + cachedTyped :: CompUnit Id, + cachedTypeTable :: Map Name TypeInfo + } + deriving stock (Generic) + deriving anyclass (Binary) + +toCachedModule :: CheckedModule -> CachedModule +toCachedModule cm = + CachedModule + { cachedModuleId = checkedModuleId cm, + cachedTyped = checkedModuleTyped cm, + cachedTypeTable = typeTable (checkedModuleEnv cm) + } + +-- | Rebuild a 'CheckedModule' from its cached payload. The env is @initTcEnv@ +-- with the cached @typeTable@ spliced in — the only env field read back from a +-- non-entry module. The two unread fields are loud error thunks. +fromCachedModule :: Option -> CachedModule -> CheckedModule +fromCachedModule opts cached = + CheckedModule + { checkedModuleId = cachedModuleId cached, + checkedModuleTyped = cachedTyped cached, + checkedModuleEnv = (initTcEnv opts) {typeTable = cachedTypeTable cached}, + checkedModuleInput = error "tc-cache: checkedModuleInput not restored from cache", + checkedModuleNoDesugar = error "tc-cache: checkedModuleNoDesugar not restored from cache" + } + +-- | Magic number identifying a typecheck-cache blob ("STC" ++ 0x01). +tcCacheMagic :: Word32 +tcCacheMagic = 0x53544301 + +-- | Format version. BUMP THIS whenever any serialized type changes shape (a +-- constructor or field added, removed, or reordered), so a dump written by an +-- incompatible build is rejected rather than misread. A rejected dump degrades +-- to a cache miss (recompute) — never a wrong result. +tcCacheFormatVersion :: Word32 +tcCacheFormatVersion = 1 + +-- | Encode the keyed cache behind a magic + version header. +encodeCache :: Map TcCacheKey CachedModule -> BL.ByteString +encodeCache cache = + runPut (put tcCacheMagic >> put tcCacheFormatVersion >> put cache) + +-- | Decode a cache blob, returning 'Nothing' if the header is absent or does +-- not match (foreign format, wrong version, or corruption). The payload is only +-- parsed once the header matches, so a version mismatch can never crash while +-- decoding stale bytes. +decodeCache :: BL.ByteString -> Maybe (Map TcCacheKey CachedModule) +decodeCache blob = + case runGetOrFail getChecked blob of + Right (_, _, result) -> result + Left _ -> Nothing + where + getChecked = do + magic <- get + version <- get + if magic == tcCacheMagic && version == tcCacheFormatVersion + then Just <$> get + else pure Nothing diff --git a/src/Solcore/Pipeline/TypecheckCache.hs b/src/Solcore/Pipeline/TypecheckCache.hs new file mode 100644 index 000000000..3be236b2e --- /dev/null +++ b/src/Solcore/Pipeline/TypecheckCache.hs @@ -0,0 +1,126 @@ +-- | Merkle cache keys for the typecheck cache (Phase 2). +-- +-- A module's typechecked output is a pure function of its own source, the +-- public interfaces of the modules it references, and the compile flags that +-- reach the typecheck phase. We capture that as a content-addressed key: +-- +-- @ +-- key(M) = H( contentHash(M) +-- ++ sorted [ key(R) | R <- references(M) ] +-- ++ flagComponent(M) ) +-- @ +-- +-- folded over the graph in dependency order. Two modules with equal keys are +-- guaranteed to typecheck to the same result, so a cache indexed by key is +-- sound; editing a module changes its key and, transitively, the keys of every +-- module that references it — and nothing else. +-- +-- The content hash is taken over the /parsed/ compilation unit (which the graph +-- already holds), so it is insensitive to comments and whitespace for free. +module Solcore.Pipeline.TypecheckCache + ( TcCacheKey (..), + moduleHasContracts, + moduleCacheKeys, + moduleCacheKeysWith, + transitiveDependents, + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as BC +import Data.List (sort) +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Set (Set) +import Data.Set qualified as Set +import Solcore.Frontend.Module.Identity qualified as Mod +import Solcore.Frontend.Module.Loader +import Solcore.Frontend.Syntax.SyntaxTree (CompUnit (..), TopDecl (..)) +import Solcore.Pipeline.Options (Option (..)) +import Solcore.Util.Keccak (keccak256) + +-- | A content-addressed typecheck-cache key (a keccak digest). +newtype TcCacheKey = TcCacheKey ByteString + deriving (Eq, Ord, Show) + +-- | Does this module define any contracts? Only contract-bearing modules are +-- affected by dispatch generation, so only they fold the -g flag into their +-- key — keeping library (std) keys stable across -g toggles in the UI. +moduleHasContracts :: CompUnit -> Bool +moduleHasContracts unit = any isContract (contracts unit) + where + isContract (TContr _) = True + isContract _ = False + +-- | The compile flags reaching the typecheck phase, serialized for the key. +-- -g (dispatch) is only included for contract-bearing modules. +flagComponent :: Option -> Bool -> ByteString +flagComponent opts hasContracts = + BC.pack + ( "s=" + ++ show (optNoDesugarCalls opts) + ++ (if hasContracts then ";g=" ++ show (optNoGenDispatch opts) else "") + ) + +-- | Compute the Merkle cache key of every module in the graph. +moduleCacheKeys :: Option -> ModuleGraph -> Either String (Map Mod.ModuleId TcCacheKey) +moduleCacheKeys = moduleCacheKeysWith (\_ h -> h) + +-- | 'moduleCacheKeys' with a hook to perturb a module's content hash — used to +-- simulate edits (bump the edited module's content and observe which keys move) +-- without touching disk or re-typechecking. +-- +-- Modules are folded in dependency order ('moduleOrder' lists dependencies +-- before dependents), so each module's reference keys are already known when it +-- is processed. A missing reference key means a cyclic import group, which this +-- PoC does not yet handle (SCC-group keying is deferred); we fail loudly. +moduleCacheKeysWith :: + (Mod.ModuleId -> ByteString -> ByteString) -> + Option -> + ModuleGraph -> + Either String (Map Mod.ModuleId TcCacheKey) +moduleCacheKeysWith perturb opts graph = + foldl step (Right Map.empty) (moduleOrder graph) + where + step (Left err) _ = Left err + step (Right keys) moduleId = + case mapM (lookupKey keys) refs of + Left err -> Left err + Right refKeys -> + let material = + BS.concat + ( contentHash moduleId + : sort [k | TcCacheKey k <- refKeys] + ++ [flagComponent opts (moduleHasContracts (unitOf moduleId))] + ) + in Right (Map.insert moduleId (TcCacheKey (keccak256 material)) keys) + where + refs = Map.findWithDefault [] moduleId (referenceDependencies graph) + + lookupKey keys ref = + maybe + (Left ("cyclic import group at " ++ Mod.moduleIdDisplay ref ++ " (SCC keying not yet implemented)")) + Right + (Map.lookup ref keys) + + unitOf moduleId = loadedCompUnit (modules graph Map.! moduleId) + contentHash moduleId = perturb moduleId (keccak256 (BC.pack (show (unitOf moduleId)))) + +-- | Every module whose key depends on the given module: the module itself plus +-- everything that transitively references it. Exactly the set that must be +-- re-typechecked when the given module is edited. +transitiveDependents :: ModuleGraph -> Mod.ModuleId -> Set Mod.ModuleId +transitiveDependents graph target = go (Set.singleton target) [target] + where + revAdj = + Map.fromListWith + (++) + [ (ref, [moduleId]) + | (moduleId, refs) <- Map.toList (referenceDependencies graph), + ref <- refs + ] + go seen [] = seen + go seen (x : xs) = + let next = filter (`Set.notMember` seen) (Map.findWithDefault [] x revAdj) + in go (foldr Set.insert seen next) (next ++ xs) diff --git a/src/Solcore/Util/Keccak.hs b/src/Solcore/Util/Keccak.hs new file mode 100644 index 000000000..a3aaff0a2 --- /dev/null +++ b/src/Solcore/Util/Keccak.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE BangPatterns #-} + +-- | A pure-Haskell Keccak-256 (the Ethereum variant, i.e. original Keccak +-- padding with the 0x01 domain byte, not FIPS-202 SHA3-256's 0x06). +-- +-- This replaces the C-based cryptonite dependency so the compiler can be +-- cross-compiled to JavaScript with the GHC JS backend. It is only used at +-- compile time to evaluate @keccakLit@, so performance is not a concern. +module Solcore.Util.Keccak + ( keccak256, + ) +where + +import Data.Array.Unboxed (UArray, listArray, (!), (//)) +import Data.Array.Unboxed qualified as A +import Data.Bits (complement, rotateL, shiftL, shiftR, xor, (.&.), (.|.)) +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.List qualified as L +import Data.Word (Word64) + +-- | Keccak-256 digest (32 bytes) of a byte string. +keccak256 :: ByteString -> ByteString +keccak256 = squeeze . L.foldl' absorbBlock initialState . chunksOf rateBytes . pad rateBytes + +rateBytes :: Int +rateBytes = 136 -- 1088-bit rate for Keccak-256 (17 lanes) + +type State = UArray Int Word64 + +initialState :: State +initialState = listArray (0, 24) (replicate 25 0) + +-- Lane index for the 5x5 state, column-major so that idx x y = x + 5*y. +idx :: Int -> Int -> Int +idx x y = x + 5 * y + +-- Multi-rate padding pad10*1 with Keccak's 0x01 domain byte. +pad :: Int -> ByteString -> ByteString +pad rate msg = msg <> padding + where + q = rate - (BS.length msg `mod` rate) + padding + | q == 1 = BS.singleton 0x81 + | otherwise = BS.singleton 0x01 <> BS.replicate (q - 2) 0x00 <> BS.singleton 0x80 + +chunksOf :: Int -> ByteString -> [ByteString] +chunksOf n bs + | BS.null bs = [] + | otherwise = BS.take n bs : chunksOf n (BS.drop n bs) + +-- Read 8 little-endian bytes at byte offset (8*lane) of a rate block. +laneAt :: ByteString -> Int -> Word64 +laneAt block lane = + L.foldl' (\ !acc k -> acc .|. (fromIntegral (BS.index block (base + k)) `shiftL` (8 * k))) 0 [0 .. 7] + where + base = 8 * lane + +absorbBlock :: State -> ByteString -> State +absorbBlock st block = keccakF (st // [(i, (st ! i) `xor` laneAt block i) | i <- [0 .. 16]]) + +squeeze :: State -> ByteString +squeeze st = + BS.pack + [fromIntegral ((st ! lane) `shiftR` (8 * byte)) | lane <- [0 .. 3], byte <- [0 .. 7]] + +keccakF :: State -> State +keccakF s0 = L.foldl' applyRound s0 roundConstants + where + applyRound a rc = + let cs = listArray (0, 4) [L.foldl' xor 0 [a ! idx x y | y <- [0 .. 4]] | x <- [0 .. 4]] :: UArray Int Word64 + ds = listArray (0, 4) [(cs ! ((x + 4) `mod` 5)) `xor` rotateL (cs ! ((x + 1) `mod` 5)) 1 | x <- [0 .. 4]] :: UArray Int Word64 + theta = A.array (0, 24) [(idx x y, (a ! idx x y) `xor` (ds ! x)) | x <- [0 .. 4], y <- [0 .. 4]] :: UArray Int Word64 + b = + A.array + (0, 24) + [(idx y ((2 * x + 3 * y) `mod` 5), rotateL (theta ! idx x y) (rhoOffsets ! idx x y)) | x <- [0 .. 4], y <- [0 .. 4]] :: + UArray Int Word64 + chi = + A.array + (0, 24) + [(idx x y, (b ! idx x y) `xor` (complement (b ! idx ((x + 1) `mod` 5) y) .&. (b ! idx ((x + 2) `mod` 5) y))) | x <- [0 .. 4], y <- [0 .. 4]] :: + UArray Int Word64 + in chi // [(0, (chi ! 0) `xor` rc)] + +rhoOffsets :: UArray Int Int +rhoOffsets = + listArray + (0, 24) + [ 0, + 1, + 62, + 28, + 27, + 36, + 44, + 6, + 55, + 20, + 3, + 10, + 43, + 25, + 39, + 41, + 45, + 15, + 21, + 8, + 18, + 2, + 61, + 56, + 14 + ] + +roundConstants :: [Word64] +roundConstants = + [ 0x0000000000000001, + 0x0000000000008082, + 0x800000000000808A, + 0x8000000080008000, + 0x000000000000808B, + 0x0000000080000001, + 0x8000000080008081, + 0x8000000000008009, + 0x000000000000008A, + 0x0000000000000088, + 0x0000000080008009, + 0x000000008000000A, + 0x000000008000808B, + 0x800000000000008B, + 0x8000000000008089, + 0x8000000000008003, + 0x8000000000008002, + 0x8000000000000080, + 0x000000000000800A, + 0x800000008000000A, + 0x8000000080008081, + 0x8000000000008080, + 0x0000000080000001, + 0x8000000080008008 + ] diff --git a/test/KeccakTests.hs b/test/KeccakTests.hs new file mode 100644 index 000000000..8c8a64863 --- /dev/null +++ b/test/KeccakTests.hs @@ -0,0 +1,29 @@ +module KeccakTests where + +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as C8 +import Numeric (showHex) +import Solcore.Util.Keccak (keccak256) +import Test.Tasty +import Test.Tasty.HUnit + +hexOf :: BS.ByteString -> String +hexOf = concatMap byte . BS.unpack + where + byte b = let h = showHex b "" in if length h == 1 then '0' : h else h + +-- Canonical, independently-published Keccak-256 (Ethereum variant) vectors. +-- These cover the single-block absorb path, which is the only one the compiler +-- exercises (keccakLit hashes short function-signature strings). +keccakTests :: TestTree +keccakTests = + testGroup + "Keccak-256" + [ testCase "empty string" $ + hexOf (keccak256 (C8.pack "")) @?= "c5d2460186f7233c927e7db2dcc703c0e500b653ca82273b7bfad8045d85a470", + testCase "abc" $ + hexOf (keccak256 (C8.pack "abc")) @?= "4e03657aea45a94fc7d47ba826c8d667c0d1e6e33a64a036ec44f58fa12d6c45", + testCase "pangram" $ + hexOf (keccak256 (C8.pack "The quick brown fox jumps over the lazy dog")) + @?= "4d741b6f1eb29cb2a9b9911c82f56fa8d73b04959d3d9d222895df6c0b28aa15" + ] diff --git a/test/Main.hs b/test/Main.hs index f5385765c..6ca048321 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -5,6 +5,7 @@ import ContractAbiTests import DiagnosticCliTests import DiagnosticTests import HullCases +import KeccakTests import LocationTests import MatchCompilerTests import ModuleTypeCheckTests @@ -37,5 +38,6 @@ tests = matchTests, yulEvalTests, hullTests, - specialiseTests + specialiseTests, + keccakTests ] From db357fc2baea258ae60503b0bfd6bf89de839647 Mon Sep 17 00:00:00 2001 From: Marcin Benke Date: Thu, 2 Jul 2026 20:50:18 +0200 Subject: [PATCH 2/2] docs: typecheck-cache PoC writeup Conceptual description for review: motivation, Merkle keying, binary dump + on-disk reuse, results, and scope/limitations. Assisted-By: Claude Opus 4.8 --- docs/typecheck-cache-poc.md | 128 ++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 docs/typecheck-cache-poc.md diff --git a/docs/typecheck-cache-poc.md b/docs/typecheck-cache-poc.md new file mode 100644 index 000000000..133202020 --- /dev/null +++ b/docs/typecheck-cache-poc.md @@ -0,0 +1,128 @@ +# Typecheck cache — proof of concept + +## Motivation + +Every compile re-typechecks the whole module graph from scratch, including the +standard library. For the edit–recompile loop (and especially the browser IDE) +the std typecheck dominates wall-clock time even though std never changes. This +PoC shows we can **type-check each module once, persist the result to disk, and +reuse it** on later compiles whenever the module (and everything it depends on) +is unchanged — without affecting the compiler's output. + +## The idea + +Type-checking a module is a pure function of: + +1. the module's own source, +2. the public interfaces of the modules it references, and +3. the compile flags that reach the type-checker. + +So we give every module a **content-addressed Merkle key**: + +``` +key(M) = keccak( contentHash(M) + ++ sorted [ key(R) | R <- references(M) ] + ++ flagComponent(M) ) +``` + +folded over the graph in dependency order. Two modules with equal keys are +guaranteed to type-check to the same result, so a cache indexed by key is sound. +Editing a module changes its key and, transitively, the key of every module that +references it — **and nothing else**. That gives precise invalidation: edit +`std.dispatch` and only `std.dispatch` + its dependents are rechecked; `std` and +`std.opcodes` are reused. + +The type-checked result of each module is serialized to a **binary blob on +disk**, keyed by its Merkle key. On the next compile we recompute the keys +(cheap — parsing + hashing) and, for every key already on disk, load the checked +module instead of re-type-checking it. + +## What's in this PR + +| File | Role | +|------|------| +| `src/Solcore/Pipeline/TypecheckCache.hs` | Merkle cache keys; precise-invalidation helper (`transitiveDependents`) | +| `src/Solcore/Pipeline/TcCacheSerialize.hs` | `binary` serialization of a checked module; magic + version header | +| `src/Solcore/Pipeline/SolcorePipeline.hs` | `compileGraphWithCache` — reuse cached modules instead of re-checking | +| `src/Solcore/Util/Keccak.hs` | pure-Haskell keccak-256 used for the content hashes | +| `poc/Main.hs` | `tc-cache-poc` harness that demonstrates and checks all of the above | + +### Cache keys (`TypecheckCache.hs`) + +- `contentHash` is taken over the **parsed** compilation unit, so it's + insensitive to comments/whitespace for free. +- Reference keys are folded in dependency order and sorted, so the key is + independent of import order. +- `flagComponent` records only the flags that affect type-checking + (`--no-desugar-calls`); `-g`/dispatch generation is folded in **only for + modules that contain contracts**, so library keys stay stable as the UI + toggles `-g`. + +### Serialization (`TcCacheSerialize.hs`) + +- A cached module carries only what the assembly step reads back from a + non-entry module: its typed `CompUnit` and the `typeTable` of its environment. + The other environment fields are restored as loud error thunks — proven + unread, so never forced, but failing clearly if that assumption is violated. +- Every blob is prefixed with a **magic number + format version**. A dump + written by an incompatible build (or a corrupted/foreign file) is rejected and + degrades to a cache miss (recompute) — never a wrong result. +- We use `binary` (a GHC boot library, pure Haskell) rather than a JSON/aeson + stack: compact, no dependency tail, and the format is confined behind + `encodeCache` / `decodeCache` so it can be swapped without touching the rest. + +### Pipeline seam (`SolcorePipeline.hs`) + +`compileGraphWithCache opts graph cache` runs the normal pipeline but reuses any +module present in `cache` (keyed by `ModuleId`) instead of type-checking it, and +returns the full set of checked modules so a caller can seed the next run. The +existing `compile` path is unchanged (it calls this with an empty cache). + +## Results + +`cabal run tc-cache-poc -- test/examples/dispatch/counter.solc` demonstrates, on +a 4-module graph (`std`, `std.opcodes`, `std.dispatch`, `counter`): + +- **Merkle keys** printed per module. +- **Invalidation property** (checked as an assertion): editing `std.opcodes` + rechecks all 4; `std` → 3; `std.dispatch` → 2; `counter` → 1 — exactly the + transitive-dependent set. +- **Determinism**: keys are stable across a reload of the same sources. +- **On-disk round-trip**: the cold-checked modules are written to + `solcore-tc-cache.bin`, read back, decoded, and used to compile again. +- **Format guard**: a blob with a corrupted header is rejected. +- **Correctness**: the in-process warm/hit runs and the on-disk run all produce + **byte-identical hull** to the cold run. + +Representative timing (type-check phase is the part the cache elides): + +``` +objects: 1 | cold 3.74s | warm 1.05s | hit 0.20s | disk 0.19s +``` + +i.e. reusing the std subset from disk turns a ~3.7s cold compile into ~0.2s, +reproducing the cold output exactly. The on-disk dump for this 4-module graph is +~3.3 MB (see the note on location data below). + +## Scope / limitations (deliberate, for review) + +- **Type-check only.** Specialization is whole-program (monomorphization across + the entire program) and is *not* cached — it re-runs every compile. The cache + elides the per-module type-check, which is the dominant cost for std. +- **No cyclic import groups yet.** Modules in an import cycle share an SCC; + SCC-group keying is not implemented, and the PoC fails loudly if it hits one. +- **Harness, not CLI integration.** The disk cache is exercised by `tc-cache-poc` + to validate the concept; wiring it into the `sol-core` CLI (cache directory, + eviction, invalidation on flag change) is the natural next step. +- **Native only.** A browser/session variant (in-memory + IndexedDB) exists on a + separate branch and is out of scope here. +- **Blob size.** The typed AST now carries a source location on every node, so + the serialized modules are larger than they need to be (~3.3 MB for the 4 + above). Since node equality already ignores locations, a real integration + would likely drop or normalize them before serializing. + +## How to run + +```bash +cabal run tc-cache-poc -- test/examples/dispatch/counter.solc +```