From 038d31adceb19bb5b80db16014d489ea9740a734 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Fri, 30 Jan 2026 21:10:09 +0100 Subject: [PATCH 001/150] proof of concept of of div-encoding --- cli/cli.hs | 3 + hevm.cabal | 1 + src/EVM/Effects.hs | 2 + src/EVM/SMT.hs | 229 ++++++++++++++++------------ src/EVM/SMT/DivEncoding.hs | 88 +++++++++++ src/EVM/SMT/Types.hs | 6 + src/EVM/Solvers.hs | 27 +++- test/contracts/fail/arith.sol | 22 +++ test/contracts/fail/math.sol | 16 ++ test/contracts/fail/signedArith.sol | 53 +++++++ test/contracts/pass/arith.sol | 51 +++++++ test/contracts/pass/math.sol | 14 ++ test/contracts/pass/signedArith.sol | 57 +++++++ test/test.hs | 30 +++- 14 files changed, 500 insertions(+), 99 deletions(-) create mode 100644 src/EVM/SMT/DivEncoding.hs create mode 100644 test/contracts/fail/arith.sol create mode 100644 test/contracts/fail/math.sol create mode 100644 test/contracts/fail/signedArith.sol create mode 100644 test/contracts/pass/arith.sol create mode 100644 test/contracts/pass/math.sol create mode 100644 test/contracts/pass/signedArith.sol diff --git a/cli/cli.hs b/cli/cli.hs index f9260a151..5990e04d4 100644 --- a/cli/cli.hs +++ b/cli/cli.hs @@ -102,6 +102,7 @@ data CommonOptions = CommonOptions , cacheDir ::Maybe String , earlyAbort ::Bool , mergeMaxBudget :: Int + , abstractArith ::Bool } commonOptions :: Parser CommonOptions @@ -133,6 +134,7 @@ commonOptions = CommonOptions <*> (optional $ strOption $ long "cache-dir" <> help "Directory to save and load RPC cache") <*> (switch $ long "early-abort" <> help "Stop exploration immediately upon finding the first counterexample") <*> (option auto $ long "merge-max-budget" <> showDefault <> value 100 <> help "Max instructions for speculative merge exploration during path merging") + <*> (switch $ long "abstract-arith" <> help "Use uninterpreted functions for div/mod in SMT queries (Halmos-style two-phase solving)") data CommonExecOptions = CommonExecOptions { address ::Maybe Addr @@ -377,6 +379,7 @@ main = do , onlyDeployed = cOpts.onlyDeployed , earlyAbort = cOpts.earlyAbort , mergeMaxBudget = cOpts.mergeMaxBudget + , abstractArith = cOpts.abstractArith } } diff --git a/hevm.cabal b/hevm.cabal index 1069c3784..b80abce5e 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -121,6 +121,7 @@ library EVM.Effects, other-modules: EVM.CheatsTH, + EVM.SMT.DivEncoding, EVM.SMT.Types, EVM.SMT.SMTLIB, Paths_hevm diff --git a/src/EVM/Effects.hs b/src/EVM/Effects.hs index 8360ad897..49db60569 100644 --- a/src/EVM/Effects.hs +++ b/src/EVM/Effects.hs @@ -48,6 +48,7 @@ data Config = Config , onlyDeployed :: Bool , earlyAbort :: Bool , mergeMaxBudget :: Int -- ^ Max instructions for speculative merge exploration + , abstractArith :: Bool } deriving (Show, Eq) @@ -69,6 +70,7 @@ defaultConfig = Config , onlyDeployed = False , earlyAbort = False , mergeMaxBudget = 100 + , abstractArith = False } -- Write to the console diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index cfd5ce948..17001035a 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -12,11 +12,16 @@ module EVM.SMT formatSMT2, declareIntermediates, assertProps, + assertPropsHelperWith, + decompose, exprToSMT, + exprToSMTWith, encodeConcreteStore, zero, one, + sp, propToSMT, + propToSMTWith, parseVar, parseEAddr, parseBlockCtx, @@ -93,7 +98,10 @@ formatSMT2 (SMT2 (SMTScript entries) _ ps) = expr <> smt2 -- | Reads all intermediate variables from the builder state and produces SMT declaring them as constants declareIntermediates :: BufEnv -> StoreEnv -> Err [SMTEntry] -declareIntermediates bufs stores = do +declareIntermediates = declareIntermediatesWith ConcreteDivision + +declareIntermediatesWith :: DivEncoding -> BufEnv -> StoreEnv -> Err [SMTEntry] +declareIntermediatesWith enc bufs stores = do let encSs = Map.mapWithKey encodeStore stores encBs = Map.mapWithKey encodeBuf bufs snippets <- sequence $ Map.elems $ encSs <> encBs @@ -101,14 +109,14 @@ declareIntermediates bufs stores = do pure $ (SMTComment "intermediate buffers & stores") : decls where encodeBuf n expr = do - buf <- exprToSMT expr + buf <- exprToSMTWith enc expr bufLen <- encodeBufLen n expr pure [SMTCommand ("(define-fun buf" <> (Data.Text.Lazy.Builder.Int.decimal n) <> "() Buf " <> buf <> ")\n"), bufLen] encodeBufLen n expr = do - bufLen <- exprToSMT (bufLengthEnv bufs True expr) + bufLen <- exprToSMTWith enc (bufLengthEnv bufs True expr) pure $ SMTCommand ("(define-fun buf" <> (Data.Text.Lazy.Builder.Int.decimal n) <>"_length () (_ BitVec 256) " <> bufLen <> ")") encodeStore n expr = do - storage <- exprToSMT expr + storage <- exprToSMTWith enc expr pure [SMTCommand ("(define-fun store" <> (Data.Text.Lazy.Builder.Int.decimal n) <> " () Storage " <> storage <> ")")] -- simplify to rewrite sload/sstore combos @@ -117,25 +125,27 @@ declareIntermediates bufs stores = do assertProps :: Config -> [Prop] -> Err SMT2 assertProps conf ps = if not conf.simp then assertPropsHelper False ps - else assertPropsHelper True (decompose ps) - where - decompose :: [Prop] -> [Prop] - decompose props = if conf.decomposeStorage && safeExprs && safeProps - then fromMaybe props (mapM (mapPropM Expr.decomposeStorage) props) - else props - where - -- All in these lists must be a `Just ()` or we cannot decompose - safeExprs = all (isJust . mapPropM_ Expr.safeToDecompose) props - safeProps = all Expr.safeToDecomposeProp props + else assertPropsHelper True (decompose conf ps) +decompose :: Config -> [Prop] -> [Prop] +decompose conf props = if conf.decomposeStorage && safeExprs && safeProps + then fromMaybe props (mapM (mapPropM Expr.decomposeStorage) props) + else props + where + -- All in these lists must be a `Just ()` or we cannot decompose + safeExprs = all (isJust . mapPropM_ Expr.safeToDecompose) props + safeProps = all Expr.safeToDecomposeProp props -- Note: we need a version that does NOT call simplify, -- because we make use of it to verify the correctness of our simplification -- passes through property-based testing. assertPropsHelper :: Bool -> [Prop] -> Err SMT2 -assertPropsHelper simp psPreConc = do - encs <- mapM propToSMT psElim - intermediates <- declareIntermediates bufs stores +assertPropsHelper = assertPropsHelperWith ConcreteDivision + +assertPropsHelperWith :: DivEncoding -> Bool -> [Prop] -> Err SMT2 +assertPropsHelperWith divEnc simp psPreConc = do + encs <- mapM (propToSMTWith divEnc) psElim + intermediates <- declareIntermediatesWith divEnc bufs stores readAssumes' <- readAssumes keccakAssertions' <- keccakAssertions frameCtxs <- (declareFrameContext . nubOrd $ foldl' (<>) [] frameCtx) @@ -181,13 +191,13 @@ assertPropsHelper simp psPreConc = do keccAssump = keccakAssumptions $ Set.toList allKeccaks keccComp = [(PEq (Lit l) (Keccak buf)) | (buf, l) <- Set.toList concreteKecc] keccakAssertions = do - assumps <- mapM assertSMT keccAssump - comps <- mapM assertSMT keccComp + assumps <- mapM (assertSMTWith divEnc) keccAssump + comps <- mapM (assertSMTWith divEnc) keccComp pure $ ((SMTComment "keccak assumptions") : assumps) <> ((SMTComment "keccak computations") : comps) -- assert that reads beyond size of buffer & storage is zero readAssumes = do - assumps <- mapM assertSMT $ assertReads psElim bufs stores + assumps <- mapM (assertSMTWith divEnc) $ assertReads psElim bufs stores pure (SMTComment "read assumptions" : assumps) cexInfo :: StorageReads -> CexVars @@ -402,8 +412,11 @@ declareBlockContext names = do cexvars = (mempty :: CexVars){ blockContext = fmap (toLazyText . fst) names } assertSMT :: Prop -> Either String SMTEntry -assertSMT p = do - p' <- propToSMT p +assertSMT = assertSMTWith ConcreteDivision + +assertSMTWith :: DivEncoding -> Prop -> Either String SMTEntry +assertSMTWith enc p = do + p' <- propToSMTWith enc p pure $ SMTCommand ("(assert " <> p' <> ")") wordAsBV :: forall a. Integral a => a -> Builder @@ -413,7 +426,10 @@ byteAsBV :: Word8 -> Builder byteAsBV b = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal b <> " 8)" exprToSMT :: Expr a -> Err Builder -exprToSMT = \case +exprToSMT = exprToSMTWith ConcreteDivision + +exprToSMTWith :: DivEncoding -> Expr a -> Err Builder +exprToSMTWith enc = \case Lit w -> pure $ wordAsBV w Var s -> pure $ fromText s GVar (BufVar n) -> pure $ fromString $ "buf" <> (show n) @@ -423,7 +439,7 @@ exprToSMT = \case eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty twentyone twentytwo twentythree twentyfour twentyfive twentysix twentyseven twentyeight twentynine thirty thirtyone - -> concatBytes [ + -> concatBytesWith enc [ z, o, two, three, four, five, six, seven , eight, nine, ten, eleven, twelve, thirteen, fourteen, fifteen , sixteen, seventeen, eighteen, nineteen, twenty, twentyone, twentytwo, twentythree @@ -434,23 +450,23 @@ exprToSMT = \case Mul a b -> op2 "bvmul" a b Exp a b -> case a of Lit 0 -> do - benc <- exprToSMT b + benc <- exprToSMTWith enc b pure $ "(ite (= " <> benc `sp` zero <> " ) " <> one `sp` zero <> ")" Lit 1 -> pure one Lit 2 -> do - benc <- exprToSMT b + benc <- exprToSMTWith enc b pure $ "(bvshl " <> one `sp` benc <> ")" _ -> case b of -- b is limited below, otherwise SMT query will be huge, and eventually Haskell stack overflows - Lit b' | b' < 1000 -> expandExp a b' + Lit b' | b' < 1000 -> expandExpWith enc a b' _ -> Left $ "Cannot encode symbolic exponent into SMT. Offending symbolic value: " <> show b Min a b -> do - aenc <- exprToSMT a - benc <- exprToSMT b + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b pure $ "(ite (bvule " <> aenc `sp` benc <> ") " <> aenc `sp` benc <> ")" Max a b -> do - aenc <- exprToSMT a - benc <- exprToSMT b + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b pure $ "(max " <> aenc `sp` benc <> ")" LT a b -> do cond <- op2 "bvult" a b @@ -490,23 +506,23 @@ exprToSMT = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> op2CheckZero "bvudiv" a b - SDiv a b -> op2CheckZero "bvsdiv" a b - Mod a b -> op2CheckZero "bvurem" a b - SMod a b -> op2CheckZero "bvsrem" a b + Div a b -> divOp "bvudiv" "evm_bvudiv" a b + SDiv a b -> divOp "bvsdiv" "evm_bvsdiv" a b + Mod a b -> divOp "bvurem" "evm_bvurem" a b + SMod a b -> divOp "bvsrem" "evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do - aExp <- exprToSMT a - bExp <- exprToSMT b - cExp <- exprToSMT c + aExp <- exprToSMTWith enc a + bExp <- exprToSMTWith enc b + cExp <- exprToSMTWith enc c let aLift = "((_ zero_extend 256) " <> aExp <> ")" bLift = "((_ zero_extend 256) " <> bExp <> ")" cLift = "((_ zero_extend 256) " <> cExp <> ")" pure $ "(ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 256) ((_ extract 255 0) (bvurem (bvmul " <> aLift `sp` bLift <> ")" <> cLift <> ")))" AddMod a b c -> do - aExp <- exprToSMT a - bExp <- exprToSMT b - cExp <- exprToSMT c + aExp <- exprToSMTWith enc a + bExp <- exprToSMTWith enc b + cExp <- exprToSMTWith enc c let aLift = "((_ zero_extend 1) " <> aExp <> ")" bLift = "((_ zero_extend 1) " <> bExp <> ")" cLift = "((_ zero_extend 1) " <> cExp <> ")" @@ -515,20 +531,20 @@ exprToSMT = \case cond <- op2 "=" a b pure $ "(ite " <> cond `sp` one `sp` zero <> ")" Keccak a -> do - enc <- exprToSMT a - sz <- exprToSMT $ Expr.bufLength a - pure $ "(keccak " <> enc <> " " <> sz <> ")" + e <- exprToSMTWith enc a + sz <- exprToSMTWith enc $ Expr.bufLength a + pure $ "(keccak " <> e <> " " <> sz <> ")" TxValue -> pure $ fromString "txvalue" Balance a -> pure $ fromString "balance_" <> formatEAddr a Origin -> pure "origin" BlockHash a -> do - enc <- exprToSMT a - pure $ "(blockhash " <> enc <> ")" + e <- exprToSMTWith enc a + pure $ "(blockhash " <> e <> ")" CodeSize a -> do - enc <- exprToSMT a - pure $ "(codesize " <> enc <> ")" + e <- exprToSMTWith enc a + pure $ "(codesize " <> e <> ")" Coinbase -> pure "coinbase" Timestamp -> pure "timestamp" BlockNumber -> pure "blocknumber" @@ -539,48 +555,48 @@ exprToSMT = \case a@(SymAddr _) -> pure $ formatEAddr a WAddr(a@(SymAddr _)) -> do - wa <- exprToSMT a + wa <- exprToSMTWith enc a pure $ "((_ zero_extend 96)" `sp` wa `sp` ")" LitByte b -> pure $ byteAsBV b IndexWord idx w -> case idx of Lit n -> if n >= 0 && n < 32 then do - enc <- exprToSMT w - pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` enc <> ")" - else exprToSMT (LitByte 0) + e <- exprToSMTWith enc w + pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` e <> ")" + else exprToSMTWith enc (LitByte 0) _ -> op2 "indexWord" idx w ReadByte idx src -> op2 "select" src idx ConcreteBuf "" -> pure "((as const Buf) #b00000000)" - ConcreteBuf bs -> writeBytes bs mempty + ConcreteBuf bs -> writeBytesWith enc bs mempty AbstractBuf s -> pure $ fromText s ReadWord idx prev -> op2 "readWord" idx prev BufLength (AbstractBuf b) -> pure $ fromText b <> "_length" BufLength (GVar (BufVar n)) -> pure $ fromLazyText $ "buf" <> (T.pack . show $ n) <> "_length" - BufLength b -> exprToSMT (bufLength b) + BufLength b -> exprToSMTWith enc (bufLength b) WriteByte idx val prev -> do - encIdx <- exprToSMT idx - encVal <- exprToSMT val - encPrev <- exprToSMT prev + encIdx <- exprToSMTWith enc idx + encVal <- exprToSMTWith enc val + encPrev <- exprToSMTWith enc prev pure $ "(store " <> encPrev `sp` encIdx `sp` encVal <> ")" WriteWord idx val prev -> do - encIdx <- exprToSMT idx - encVal <- exprToSMT val - encPrev <- exprToSMT prev + encIdx <- exprToSMTWith enc idx + encVal <- exprToSMTWith enc val + encPrev <- exprToSMTWith enc prev pure $ "(writeWord " <> encIdx `sp` encVal `sp` encPrev <> ")" CopySlice srcIdx dstIdx size src dst -> do - srcSMT <- exprToSMT src - dstSMT <- exprToSMT dst - copySlice srcIdx dstIdx size srcSMT dstSMT + srcSMT <- exprToSMTWith enc src + dstSMT <- exprToSMTWith enc dst + copySliceWith enc srcIdx dstIdx size srcSMT dstSMT -- we need to do a bit of processing here. ConcreteStore s -> encodeConcreteStore s AbstractStore a idx -> pure $ storeName a idx SStore idx val prev -> do - encIdx <- exprToSMT idx - encVal <- exprToSMT val - encPrev <- exprToSMT prev + encIdx <- exprToSMTWith enc idx + encVal <- exprToSMTWith enc val + encPrev <- exprToSMTWith enc prev pure $ "(store" `sp` encPrev `sp` encIdx `sp` encVal <> ")" SLoad idx store -> op2 "select" store idx LitAddr n -> pure $ fromLazyText $ "(_ bv" <> T.pack (show (into n :: Integer)) <> " 160)" @@ -589,17 +605,24 @@ exprToSMT = \case a -> internalError $ "TODO: implement: " <> show a where + op1 :: Builder -> Expr x -> Err Builder op1 op a = do - enc <- exprToSMT a - pure $ "(" <> op `sp` enc <> ")" + e <- exprToSMTWith enc a + pure $ "(" <> op `sp` e <> ")" + op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do - aenc <- exprToSMT a - benc <- exprToSMT b + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b pure $ "(" <> op `sp` aenc `sp` benc <> ")" + op2CheckZero :: Builder -> Expr x -> Expr y -> Err Builder op2CheckZero op a b = do - aenc <- exprToSMT a - benc <- exprToSMT b + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" + divOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder + divOp concreteOp abstractOp a b = case enc of + ConcreteDivision -> op2CheckZero concreteOp a b + AbstractDivision -> op2 abstractOp a b sp :: Builder -> Builder -> Builder a `sp` b = a <> (fromText " ") <> b @@ -611,32 +634,36 @@ one :: Builder one = "(_ bv1 256)" propToSMT :: Prop -> Err Builder -propToSMT = \case +propToSMT = propToSMTWith ConcreteDivision + +propToSMTWith :: DivEncoding -> Prop -> Err Builder +propToSMTWith enc = \case PEq a b -> op2 "=" a b PLT a b -> op2 "bvult" a b PGT a b -> op2 "bvugt" a b PLEq a b -> op2 "bvule" a b PGEq a b -> op2 "bvuge" a b PNeg a -> do - enc <- propToSMT a - pure $ "(not " <> enc <> ")" + e <- propToSMTWith enc a + pure $ "(not " <> e <> ")" PAnd a b -> do - aenc <- propToSMT a - benc <- propToSMT b + aenc <- propToSMTWith enc a + benc <- propToSMTWith enc b pure $ "(and " <> aenc <> " " <> benc <> ")" POr a b -> do - aenc <- propToSMT a - benc <- propToSMT b + aenc <- propToSMTWith enc a + benc <- propToSMTWith enc b pure $ "(or " <> aenc <> " " <> benc <> ")" PImpl a b -> do - aenc <- propToSMT a - benc <- propToSMT b + aenc <- propToSMTWith enc a + benc <- propToSMTWith enc b pure $ "(=> " <> aenc <> " " <> benc <> ")" PBool b -> pure $ if b then "true" else "false" where + op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do - aenc <- exprToSMT a - benc <- exprToSMT b + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b pure $ "(" <> op <> " " <> aenc <> " " <> benc <> ")" @@ -646,7 +673,10 @@ propToSMT = \case -- | Stores a region of src into dst copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder -copySlice srcOffset dstOffset (Lit size) src dst = do +copySlice = copySliceWith ConcreteDivision + +copySliceWith :: DivEncoding -> Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder +copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do sz <- internal size pure $ "(let ((src " <> src <> ")) " <> sz <> ")" where @@ -659,38 +689,47 @@ copySlice srcOffset dstOffset (Lit size) src dst = do pure $ "(store " <> child `sp` encDstOff `sp` "(select src " <> encSrcOff <> "))" offset :: W256 -> Expr EWord -> Err Builder offset o (Lit b) = pure $ wordAsBV $ o + b - offset o e = exprToSMT $ Expr.add (Lit o) e -copySlice _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query" + offset o e = exprToSMTWith divEnc $ Expr.add (Lit o) e +copySliceWith _ _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query" -- | Unrolls an exponentiation into a series of multiplications expandExp :: Expr EWord -> W256 -> Err Builder -expandExp base expnt +expandExp = expandExpWith ConcreteDivision + +expandExpWith :: DivEncoding -> Expr EWord -> W256 -> Err Builder +expandExpWith divEnc base expnt -- in EVM, anything (including 0) to the power of 0 is 1 | expnt == 0 = pure one - | expnt == 1 = exprToSMT base + | expnt == 1 = exprToSMTWith divEnc base | otherwise = do - b <- exprToSMT base - n <- expandExp base (expnt - 1) + b <- exprToSMTWith divEnc base + n <- expandExpWith divEnc base (expnt - 1) pure $ "(bvmul " <> b `sp` n <> ")" -- | Concatenates a list of bytes into a larger bitvector concatBytes :: [Expr Byte] -> Err Builder -concatBytes bytes = do +concatBytes = concatBytesWith ConcreteDivision + +concatBytesWith :: DivEncoding -> [Expr Byte] -> Err Builder +concatBytesWith divEnc bytes = do case List.uncons $ reverse bytes of Nothing -> Left "unexpected empty bytes" Just (h, t) -> do - a2 <- exprToSMT h + a2 <- exprToSMTWith divEnc h foldM wrap a2 t where wrap :: Builder -> Expr a -> Err Builder wrap inner byte = do - byteSMT <- exprToSMT byte + byteSMT <- exprToSMTWith divEnc byte pure $ "(concat " <> byteSMT `sp` inner <> ")" -- | Concatenates a list of bytes into a larger bitvector writeBytes :: ByteString -> Expr Buf -> Err Builder -writeBytes bytes buf = do - smtText <- exprToSMT buf +writeBytes = writeBytesWith ConcreteDivision + +writeBytesWith :: DivEncoding -> ByteString -> Expr Buf -> Err Builder +writeBytesWith divEnc bytes buf = do + smtText <- exprToSMTWith divEnc buf let ret = BS.foldl wrap (0, smtText) bytes pure $ snd ret where diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs new file mode 100644 index 000000000..7ca8cbe9c --- /dev/null +++ b/src/EVM/SMT/DivEncoding.hs @@ -0,0 +1,88 @@ +{- | + Module: EVM.SMT.DivEncoding + Description: Abstract division/modulo encoding for two-phase SMT solving (Halmos-style) +-} +module EVM.SMT.DivEncoding + ( divModAbstractDecls + , divModRefinedDefs + , divModBounds + , assertPropsAbstract + , assertPropsRefined + ) where + +import Data.Text.Lazy.Builder + +import EVM.Effects +import EVM.SMT +import EVM.Traversals +import EVM.Types + + +-- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). +divModAbstractDecls :: [SMTEntry] +divModAbstractDecls = + [ SMTComment "abstract division/modulo (uninterpreted functions)" + , SMTCommand "(declare-fun evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + ] + +-- | Exact function definitions for div/mod with EVM semantics (Phase 2 refinement). +-- These define-fun replace the declare-fun from Phase 1, giving concrete semantics: +-- division by zero returns zero (matching EVM behavior). +divModRefinedDefs :: [SMTEntry] +divModRefinedDefs = + [ SMTComment "refined division/modulo (exact EVM semantics)" + , SMTCommand "(define-fun evm_bvudiv ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvudiv x y)))" + , SMTCommand "(define-fun evm_bvsdiv ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvsdiv x y)))" + , SMTCommand "(define-fun evm_bvurem ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvurem x y)))" + , SMTCommand "(define-fun evm_bvsrem ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvsrem x y)))" + ] + +-- | Generate bounds constraints for abstract div/mod operations. +-- These help the solver prune impossible models without full bitvector division reasoning. +divModBounds :: [Prop] -> Err [SMTEntry] +divModBounds props = do + let allBounds = concatMap (foldProp collectBounds []) props + if null allBounds then pure [] + else do + assertions <- mapM mkAssertion allBounds + pure $ (SMTComment "division/modulo bounds") : assertions + where + collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] + collectBounds = \case + Div a b -> [("evm_bvudiv", a, b)] + Mod a b -> [("evm_bvurem", a, b)] + _ -> [] + + mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry + mkAssertion (fname, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let result = "(" <> fname `sp` aenc `sp` benc <> ")" + if fname == "evm_bvudiv" + -- (x / y) <= x + then pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" + -- (x % y) <= y (ULE not ULT because y could be 0 and 0 % 0 = 0) + else pure $ SMTCommand $ "(assert (bvule " <> result `sp` benc <> "))" + +-- | Encode props using uninterpreted functions for div/mod (Phase 1 of two-phase solving) +assertPropsAbstract :: Config -> [Prop] -> Err SMT2 +assertPropsAbstract conf ps = do + base <- if not conf.simp then assertPropsHelperWith AbstractDivision False ps + else assertPropsHelperWith AbstractDivision True (decompose conf ps) + bounds <- divModBounds ps + pure $ SMT2 (SMTScript divModAbstractDecls) mempty mempty + <> base + <> SMT2 (SMTScript bounds) mempty mempty + +-- | Encode props using exact div/mod definitions (Phase 2 refinement) +assertPropsRefined :: Config -> [Prop] -> Err SMT2 +assertPropsRefined conf ps = do + base <- if not conf.simp then assertPropsHelperWith AbstractDivision False ps + else assertPropsHelperWith AbstractDivision True (decompose conf ps) + bounds <- divModBounds ps + pure $ SMT2 (SMTScript divModRefinedDefs) mempty mempty + <> base + <> SMT2 (SMTScript bounds) mempty mempty diff --git a/src/EVM/SMT/Types.hs b/src/EVM/SMT/Types.hs index 57b9f95a1..1ad309c18 100644 --- a/src/EVM/SMT/Types.hs +++ b/src/EVM/SMT/Types.hs @@ -11,6 +11,12 @@ import EVM.Types type MaybeIO = MaybeT IO +-- | Controls how division/modulo operations are encoded into SMT. +-- 'ConcreteDivision' uses inline ite-check-zero with real SMT ops (existing behavior). +-- 'AbstractDivision' uses uninterpreted functions (evm_bvudiv, etc.) for performance. +data DivEncoding = ConcreteDivision | AbstractDivision + deriving (Show, Eq) + data SMTEntry = SMTCommand Builder | SMTComment Builder deriving (Eq) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index e2938acfb..d3996a41b 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -51,6 +51,7 @@ import EVM.Expr (simplifyProps) import EVM.Keccak qualified as Keccak (concreteKeccaks) import EVM.SMT +import EVM.SMT.DivEncoding import EVM.Types @@ -128,9 +129,29 @@ checkSatWithProps sg props = do if psSimp == [PBool False] then pure Qed else do let concreteKeccaks = fmap (\(buf,val) -> PEq (Lit val) (Keccak buf)) (toList $ Keccak.concreteKeccaks props) - let smt2 = assertProps conf (if conf.simp then psSimp <> concreteKeccaks else psSimp) - if isLeft smt2 then pure $ Error $ getError smt2 - else liftIO $ checkSat sg (Just props) smt2 + let allProps = if conf.simp then psSimp <> concreteKeccaks else psSimp + if not conf.abstractArith then do + -- Original path: direct encoding with concrete division semantics + let smt2 = assertProps conf allProps + if isLeft smt2 then pure $ Error $ getError smt2 + else liftIO $ checkSat sg (Just props) smt2 + else do + -- Two-phase solving with abstract division + -- Phase 1: Use uninterpreted functions (overapproximation) + let smt2Abstract = assertPropsAbstract conf allProps + if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract + else do + phase1 <- liftIO $ checkSat sg (Just props) smt2Abstract + case phase1 of + Qed -> pure Qed -- UNSAT with abstractions => truly UNSAT (sound) + Error e -> pure (Error e) + Unknown u -> pure (Unknown u) + Cex _ -> do + -- Phase 2: Refine with exact definitions to validate counterexample + when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." + let smt2Refined = assertPropsRefined conf allProps + if isLeft smt2Refined then pure $ Error $ getError smt2Refined + else liftIO $ checkSat sg (Just props) smt2Refined -- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult diff --git a/test/contracts/fail/arith.sol b/test/contracts/fail/arith.sol new file mode 100644 index 000000000..7b7392c43 --- /dev/null +++ b/test/contracts/fail/arith.sol @@ -0,0 +1,22 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +/// Adapted from halmos tests/regression/test/Arith.t.sol +/// Division failure case: y == 0 is a valid counterexample +contract ArithFailTest { + function unchecked_div(uint x, uint y) public pure returns (uint ret) { + assembly { + ret := div(x, y) + } + } + + function prove_Div_fail(uint x, uint y) public pure { + require(x > y); + + uint q = unchecked_div(x, y); + + // note: since x > y, q can be zero only when y == 0, + // due to the division-by-zero semantics in the EVM + assert(q != 0); // counterexample: y == 0 + } +} diff --git a/test/contracts/fail/math.sol b/test/contracts/fail/math.sol new file mode 100644 index 000000000..7aa459b2d --- /dev/null +++ b/test/contracts/fail/math.sol @@ -0,0 +1,16 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +/// Adapted from halmos tests/solver/test/Math.t.sol +/// Deposit/mint ratio test - counterexamples exist for mint case +contract MathFailTest { + function prove_mint(uint s, uint A1, uint S1) public pure { + uint a = (s * A1) / S1; + + uint A2 = A1 + a; + uint S2 = S1 + s; + + // (A1 / S1 <= A2 / S2) + assert(A1 * S2 <= A2 * S1); // counterexamples exist + } +} diff --git a/test/contracts/fail/signedArith.sol b/test/contracts/fail/signedArith.sol new file mode 100644 index 000000000..4f11b7ae1 --- /dev/null +++ b/test/contracts/fail/signedArith.sol @@ -0,0 +1,53 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +import "forge-std/Test.sol"; + +/// Adapted from halmos tests/solver/test/SignedDiv.t.sol +/// Tests signed wadMul edge case (bad implementation - should find counterexample) +/// Counterexample: x = -1, y = type(int256).min + +interface WadMul { + function wadMul(int256 x, int256 y) external pure returns (int256); +} + +contract SolmateBadWadMul is WadMul { + function wadMul(int256 x, int256 y) public pure override returns (int256 r) { + assembly { + r := mul(x, y) + if iszero(or(iszero(x), eq(sdiv(r, x), y))) { revert(0, 0) } + r := sdiv(r, 1000000000000000000) + } + } +} + +contract SolidityWadMul is WadMul { + function wadMul(int256 x, int256 y) public pure override returns (int256) { + return (x * y) / 1e18; + } +} + +contract TestBadWadMul is Test { + WadMul wadMulImpl; + SolidityWadMul solidityWadMul; + + function setUp() public { + wadMulImpl = new SolmateBadWadMul(); + solidityWadMul = new SolidityWadMul(); + } + + function prove_wadMul_solEquivalent(int256 x, int256 y) external { + bytes memory encodedCall = abi.encodeWithSelector(WadMul.wadMul.selector, x, y); + + (bool succ1, bytes memory retbytes1) = address(solidityWadMul).call(encodedCall); + (bool succ2, bytes memory retbytes2) = address(wadMulImpl).call(encodedCall); + + assertEq(succ1, succ2); + + if (succ1 && succ2) { + int256 result1 = abi.decode(retbytes1, (int256)); + int256 result2 = abi.decode(retbytes2, (int256)); + assertEq(result1, result2); + } + } +} diff --git a/test/contracts/pass/arith.sol b/test/contracts/pass/arith.sol new file mode 100644 index 000000000..bbfded6dc --- /dev/null +++ b/test/contracts/pass/arith.sol @@ -0,0 +1,51 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +/// Adapted from halmos tests/regression/test/Arith.t.sol +/// Tests division/modulo/exponentiation properties +contract ArithTest { + function unchecked_div(uint x, uint y) public pure returns (uint ret) { + assembly { + ret := div(x, y) + } + } + + function unchecked_mod(uint x, uint y) public pure returns (uint ret) { + assembly { + ret := mod(x, y) + } + } + + function prove_Mod(uint x, uint y, address addr) public pure { + unchecked { + assert(unchecked_mod(x, 0) == 0); // compiler rejects `x % 0` + assert(x % 1 == 0); + assert(x % 2 < 2); + assert(x % 4 < 4); + + uint x_mod_y = unchecked_mod(x, y); + assert(x_mod_y <= y); + + assert(uint256(uint160(addr)) % (2**160) == uint256(uint160(addr))); + } + } + + function prove_Exp(uint x) public pure { + unchecked { + assert(x ** 0 == 1); // 0 ** 0 == 1 + assert(x ** 1 == x); + assert(x ** 2 == x * x); + assert((x ** 2) ** 2 == x * x * x * x); + assert(((x ** 2) ** 2) ** 2 == (x**2) * (x**2) * (x**2) * (x**2)); + } + } + + function prove_Div_pass(uint x, uint y) public pure { + require(x > y); + require(y > 0); + + uint q = unchecked_div(x, y); + + assert(q != 0); // pass + } +} diff --git a/test/contracts/pass/math.sol b/test/contracts/pass/math.sol new file mode 100644 index 000000000..63c356f96 --- /dev/null +++ b/test/contracts/pass/math.sol @@ -0,0 +1,14 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +/// Adapted from halmos tests/solver/test/Math.t.sol +/// Tests average computation equivalence +contract MathTest { + function prove_Avg(uint a, uint b) public pure { + unchecked { + uint r1 = (a & b) + (a ^ b) / 2; + uint r2 = (a + b) / 2; + assert(r1 == r2); + } + } +} diff --git a/test/contracts/pass/signedArith.sol b/test/contracts/pass/signedArith.sol new file mode 100644 index 000000000..f63c75bdb --- /dev/null +++ b/test/contracts/pass/signedArith.sol @@ -0,0 +1,57 @@ +// SPDX-License-Identifier: AGPL-3.0 +pragma solidity >=0.8.0 <0.9.0; + +import "forge-std/Test.sol"; + +/// Adapted from halmos tests/solver/test/SignedDiv.t.sol +/// Tests signed wadMul equivalence (good implementation) + +interface WadMul { + function wadMul(int256 x, int256 y) external pure returns (int256); +} + +contract SolmateGoodWadMul is WadMul { + function wadMul(int256 x, int256 y) public pure override returns (int256 r) { + assembly { + r := mul(x, y) + if iszero( + and( + or(iszero(x), eq(sdiv(r, x), y)), + or(lt(x, not(0)), sgt(y, 0x8000000000000000000000000000000000000000000000000000000000000000)) + ) + ) { revert(0, 0) } + r := sdiv(r, 1000000000000000000) + } + } +} + +contract SolidityWadMul is WadMul { + function wadMul(int256 x, int256 y) public pure override returns (int256) { + return (x * y) / 1e18; + } +} + +contract TestGoodWadMul is Test { + WadMul wadMulImpl; + SolidityWadMul solidityWadMul; + + function setUp() public { + wadMulImpl = new SolmateGoodWadMul(); + solidityWadMul = new SolidityWadMul(); + } + + function prove_wadMul_solEquivalent(int256 x, int256 y) external { + bytes memory encodedCall = abi.encodeWithSelector(WadMul.wadMul.selector, x, y); + + (bool succ1, bytes memory retbytes1) = address(solidityWadMul).call(encodedCall); + (bool succ2, bytes memory retbytes2) = address(wadMulImpl).call(encodedCall); + + assertEq(succ1, succ2); + + if (succ1 && succ2) { + int256 result1 = abi.decode(retbytes1, (int256)); + int256 result2 = abi.decode(retbytes2, (int256)); + assertEq(result1, result2); + } + } +} diff --git a/test/test.hs b/test/test.hs index b955b7084..36d312565 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE TypeAbstractions #-} module Main where @@ -105,6 +104,10 @@ testNoSimplify :: TestName -> ReaderT Env IO () -> TestTree testNoSimplify a b = let testEnvNoSimp = Env { config = testEnv.config { simp = False } } in testCase a $ runEnv testEnvNoSimp b +testAbstractArith :: TestName -> ReaderT Env IO () -> TestTree +testAbstractArith a b = let testEnvAbstract = Env { config = testEnv.config { abstractArith = True } } + in testCase a $ runEnv testEnvAbstract b + prop :: Testable prop => ReaderT Env IO prop -> Property prop a = ioProperty $ runEnv testEnv a @@ -1213,6 +1216,13 @@ tests = testGroup "hevm" , ("test/contracts/pass/etch.sol", "prove_etch.*", (True, True)) , ("test/contracts/pass/etch.sol", "prove_deal.*", (True, True)) , ("test/contracts/fail/etchFail.sol", "prove_etch_fail.*", (False, True)) + -- halmos-adapted arith tests + , ("test/contracts/pass/arith.sol", "prove_Mod", (True, True)) + , ("test/contracts/pass/arith.sol", "prove_Exp", (True, True)) + , ("test/contracts/pass/arith.sol", "prove_Div_pass", (True, True)) + , ("test/contracts/fail/arith.sol", "prove_Div_fail", (False, True)) + , ("test/contracts/pass/math.sol", "prove_Avg", (True, True)) + , ("test/contracts/fail/math.sol", "prove_mint", (False, True)) ] forM_ cases $ \(testFile, match, expected) -> do actual <- runForgeTestCustom testFile match Nothing Nothing False Fetch.noRpc @@ -1272,6 +1282,24 @@ tests = testGroup "hevm" let testFile = "test/contracts/pass/keccak.sol" runForgeTest testFile "prove_access" >>= assertEqualM "test result" (True, True) ] + , testGroup "Abstract-Arith" + -- Tests adapted from halmos (tests/regression/test/Arith.t.sol, tests/solver/test/SignedDiv.t.sol, tests/solver/test/Math.t.sol) + -- Run with abstractArith = True to exercise two-phase solving + [ testAbstractArith "Arith-Pass" $ do + let testFile = "test/contracts/pass/arith.sol" + runForgeTest testFile "prove_Mod" >>= assertEqualM "prove_Mod" (True, True) + runForgeTest testFile "prove_Exp" >>= assertEqualM "prove_Exp" (True, True) + runForgeTest testFile "prove_Div_pass" >>= assertEqualM "prove_Div_pass" (True, True) + , testAbstractArith "Arith-Fail" $ do + let testFile = "test/contracts/fail/arith.sol" + runForgeTest testFile "prove_Div_fail" >>= assertEqualM "prove_Div_fail" (False, True) + , testAbstractArith "Math-Pass" $ do + let testFile = "test/contracts/pass/math.sol" + runForgeTest testFile "prove_Avg" >>= assertEqualM "prove_Avg" (True, True) + , testAbstractArith "Math-Fail" $ do + let testFile = "test/contracts/fail/math.sol" + runForgeTest testFile "prove_mint" >>= assertEqualM "prove_mint" (False, True) + ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do Just c <- solcRuntime "C" From 536e06351f91de291e5d1358996e6bb9181a4dc8 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Sat, 31 Jan 2026 10:54:55 +0100 Subject: [PATCH 002/150] axioms --- src/EVM/SMT.hs | 39 ++++- src/EVM/SMT/DivEncoding.hs | 334 ++++++++++++++++++++++++++++++++++--- src/EVM/Solvers.hs | 19 ++- 3 files changed, 364 insertions(+), 28 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 17001035a..9d86bffe8 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -140,10 +140,10 @@ decompose conf props = if conf.decomposeStorage && safeExprs && safeProps -- because we make use of it to verify the correctness of our simplification -- passes through property-based testing. assertPropsHelper :: Bool -> [Prop] -> Err SMT2 -assertPropsHelper = assertPropsHelperWith ConcreteDivision +assertPropsHelper simp = assertPropsHelperWith ConcreteDivision simp [] -assertPropsHelperWith :: DivEncoding -> Bool -> [Prop] -> Err SMT2 -assertPropsHelperWith divEnc simp psPreConc = do +assertPropsHelperWith :: DivEncoding -> Bool -> [SMTEntry] -> [Prop] -> Err SMT2 +assertPropsHelperWith divEnc simp extraDecls psPreConc = do encs <- mapM (propToSMTWith divEnc) psElim intermediates <- declareIntermediatesWith divEnc bufs stores readAssumes' <- readAssumes @@ -151,6 +151,7 @@ assertPropsHelperWith divEnc simp psPreConc = do frameCtxs <- (declareFrameContext . nubOrd $ foldl' (<>) [] frameCtx) blockCtxs <- (declareBlockContext . nubOrd $ foldl' (<>) [] blockCtx) pure $ prelude + <> SMT2 (SMTScript extraDecls) mempty mempty <> SMT2 (SMTScript (declareAbstractStores abstractStores)) mempty mempty <> declareConstrainAddrs addresses <> (declareBufs toDeclarePsElim bufs stores) @@ -507,9 +508,9 @@ exprToSMTWith enc = \case CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b Div a b -> divOp "bvudiv" "evm_bvudiv" a b - SDiv a b -> divOp "bvsdiv" "evm_bvsdiv" a b + SDiv a b -> sdivOp "evm_bvsdiv" a b Mod a b -> divOp "bvurem" "evm_bvurem" a b - SMod a b -> divOp "bvsrem" "evm_bvsrem" a b + SMod a b -> smodOp "evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do aExp <- exprToSMTWith enc a @@ -623,6 +624,34 @@ exprToSMTWith enc = \case divOp concreteOp abstractOp a b = case enc of ConcreteDivision -> op2CheckZero concreteOp a b AbstractDivision -> op2 abstractOp a b + -- | Encode SDiv using bvudiv with abs-value decomposition. + -- bitwuzla cannot solve UNSAT queries with bvsdiv at 256-bit, + -- but handles bvudiv efficiently. + sdivOp :: Builder -> Expr x -> Expr y -> Err Builder + sdivOp abstractOp a b = case enc of + AbstractDivision -> op2 abstractOp a b + ConcreteDivision -> do + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b + let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" + absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" + udiv = "(bvudiv" `sp` absa `sp` absb <> ")" + sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" `sp` "(bvslt" `sp` benc `sp` zero <> "))" + pure $ "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` + "(ite" `sp` sameSign `sp` udiv `sp` "(bvsub" `sp` zero `sp` udiv <> ")))" + -- | Encode SMod using bvurem with abs-value decomposition. + -- EVM SMOD: result has the sign of the dividend (a). + smodOp :: Builder -> Expr x -> Expr y -> Err Builder + smodOp abstractOp a b = case enc of + AbstractDivision -> op2 abstractOp a b + ConcreteDivision -> do + aenc <- exprToSMTWith enc a + benc <- exprToSMTWith enc b + let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" + absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" + urem = "(bvurem" `sp` absa `sp` absb <> ")" + pure $ "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` + "(ite (bvsge" `sp` aenc `sp` zero <> ")" `sp` urem `sp` "(bvsub" `sp` zero `sp` urem <> ")))" sp :: Builder -> Builder -> Builder a `sp` b = a <> (fromText " ") <> b diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 7ca8cbe9c..15ac7e411 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -4,12 +4,15 @@ -} module EVM.SMT.DivEncoding ( divModAbstractDecls - , divModRefinedDefs , divModBounds , assertPropsAbstract , assertPropsRefined + , assertPropsShiftBounds ) where +import Data.Bits ((.&.), countTrailingZeros) +import Data.List (nubBy, groupBy, sortBy) +import Data.Ord (comparing) import Data.Text.Lazy.Builder import EVM.Effects @@ -28,18 +31,6 @@ divModAbstractDecls = , SMTCommand "(declare-fun evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] --- | Exact function definitions for div/mod with EVM semantics (Phase 2 refinement). --- These define-fun replace the declare-fun from Phase 1, giving concrete semantics: --- division by zero returns zero (matching EVM behavior). -divModRefinedDefs :: [SMTEntry] -divModRefinedDefs = - [ SMTComment "refined division/modulo (exact EVM semantics)" - , SMTCommand "(define-fun evm_bvudiv ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvudiv x y)))" - , SMTCommand "(define-fun evm_bvsdiv ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvsdiv x y)))" - , SMTCommand "(define-fun evm_bvurem ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvurem x y)))" - , SMTCommand "(define-fun evm_bvsrem ((x (_ BitVec 256)) (y (_ BitVec 256))) (_ BitVec 256) (ite (= y (_ bv0 256)) (_ bv0 256) (bvsrem x y)))" - ] - -- | Generate bounds constraints for abstract div/mod operations. -- These help the solver prune impossible models without full bitvector division reasoning. divModBounds :: [Prop] -> Err [SMTEntry] @@ -70,19 +61,318 @@ divModBounds props = do -- | Encode props using uninterpreted functions for div/mod (Phase 1 of two-phase solving) assertPropsAbstract :: Config -> [Prop] -> Err SMT2 assertPropsAbstract conf ps = do - base <- if not conf.simp then assertPropsHelperWith AbstractDivision False ps - else assertPropsHelperWith AbstractDivision True (decompose conf ps) + let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) bounds <- divModBounds ps - pure $ SMT2 (SMTScript divModAbstractDecls) mempty mempty - <> base + pure $ base <> SMT2 (SMTScript bounds) mempty mempty --- | Encode props using exact div/mod definitions (Phase 2 refinement) +-- | Encode props using exact div/mod definitions (Phase 2 refinement). +-- Keeps declare-fun (uninterpreted) for sharing, but adds ground-instance +-- axioms with CSE'd bvudiv/bvurem intermediates. Signed division operations +-- that differ only in divisor sign share the same bvudiv result since +-- |x| = |-x|. assertPropsRefined :: Config -> [Prop] -> Err SMT2 assertPropsRefined conf ps = do - base <- if not conf.simp then assertPropsHelperWith AbstractDivision False ps - else assertPropsHelperWith AbstractDivision True (decompose conf ps) + let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) + bounds <- divModBounds ps + axioms <- divModGroundAxioms ps + pure $ base + <> SMT2 (SMTScript bounds) mempty mempty + <> SMT2 (SMTScript axioms) mempty mempty + +-- DivOp kind: 0=Div, 1=SDiv, 2=Mod, 3=SMod +-- We track (kind, dividend, divisor) +type DivOp = (Int, Expr EWord, Expr EWord) + +-- | Canonical key for grouping operations that share the same bvudiv/bvurem core. +-- For unsigned: (show a, show b, False) +-- For signed: (show a, canonicalAbs b, True) where canonicalAbs normalizes negations +type AbsKey = (String, String, Bool) + +-- | Normalize an expression for absolute value canonicalization. +-- |Sub(Lit 0, x)| = |x|, so we strip the negation wrapper. +canonicalAbs :: Expr EWord -> String +canonicalAbs (Sub (Lit 0) x) = show x +canonicalAbs x = show x + +absKey :: DivOp -> AbsKey +absKey (kind, a, b) + | kind == 0 || kind == 2 = (show a, show b, False) -- unsigned: exact operands + | otherwise = (canonicalAbs a, canonicalAbs b, True) -- signed: normalize abs + +-- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. +-- For each group of div/mod ops sharing the same (|a|, |b|), generates: +-- - declare-const for abs_a, abs_b, and the bvudiv/bvurem result +-- - axioms expressing each evm_bvXdiv call in terms of the shared result +divModGroundAxioms :: [Prop] -> Err [SMTEntry] +divModGroundAxioms props = do + let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props + if null allDivs then pure [] + else do + let groups = groupBy (\a b -> absKey a == absKey b) + $ sortBy (comparing absKey) allDivs + indexedGroups = zip [0..] groups + entries <- concat <$> mapM (uncurry mkGroupAxioms) indexedGroups + let links = mkCongruenceLinks indexedGroups + pure $ (SMTComment "division/modulo ground-instance axioms (CSE'd)") : entries <> links + where + collectDivOps :: forall a . Expr a -> [DivOp] + collectDivOps = \case + Div a b -> [(0, a, b)] + SDiv a b -> [(1, a, b)] + Mod a b -> [(2, a, b)] + SMod a b -> [(3, a, b)] + _ -> [] + + eqDivOp :: DivOp -> DivOp -> Bool + eqDivOp (k1, a1, b1) (k2, a2, b2) = + k1 == k2 && show a1 == show a2 && show b1 == show b2 + + -- | Generate axioms for a group of ops sharing the same bvudiv/bvurem core. + mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] + mkGroupAxioms groupIdx ops = do + -- The first op determines the dividend/divisor encoding + let (firstKind, firstA, firstB) = head ops + isDiv = firstKind == 0 || firstKind == 1 -- div vs mod + isSigned = firstKind == 1 || firstKind == 3 + prefix = if isDiv then "udiv" else "urem" + coreName = fromString $ prefix <> "_" <> show groupIdx + + if not isSigned then do + -- Unsigned: simple axioms, one bvudiv/bvurem per op (no abs-value needed) + mapM (mkUnsignedAxiom coreName) ops + else do + -- Signed: create shared intermediates for abs values and bvudiv/bvurem result + let absAName = fromString $ "abs_a_" <> show groupIdx + absBName = fromString $ "abs_b_" <> show groupIdx + -- Use the canonical (non-negated) form for abs value encoding + let canonA = stripNeg firstA + canonB = stripNeg firstB + canonAenc <- exprToSMTWith AbstractDivision canonA + canonBenc <- exprToSMTWith AbstractDivision canonB + let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" + `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" + absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" + `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" + coreEnc = if isDiv + then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero + `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" + else "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero + `sp` "(bvurem" `sp` absAName `sp` absBName <> "))" + let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" + , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" + , SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" + ] + axioms <- mapM (mkSignedAxiom coreName) ops + pure $ decls <> axioms + + stripNeg :: Expr EWord -> Expr EWord + stripNeg (Sub (Lit 0) x) = x + stripNeg x = x + + mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkUnsignedAxiom _coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == 0 then "evm_bvudiv" else "evm_bvurem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + op = if kind == 0 then "bvudiv" else "bvurem" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(" <> op `sp` aenc `sp` benc <> "))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + + mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkSignedAxiom coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == 1 then "evm_bvsdiv" else "evm_bvsrem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + if kind == 1 then do + -- SDiv: result sign depends on whether operand signs match + let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" + `sp` "(bvslt" `sp` benc `sp` zero <> "))" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite" `sp` sameSign `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + else do + -- SMod: result sign matches dividend + let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" + `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + +-- | For each pair of signed groups with the same operation type (udiv/urem), +-- emit a congruence lemma: if abs inputs are equal, results are equal. +-- This is a sound tautology (function congruence for bvudiv/bvurem) that +-- helps bitwuzla avoid independent reasoning about multiple bvudiv terms. +mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] +mkCongruenceLinks indexedGroups = + let signedDivGroups = [(i, ops) | (i, ops) <- indexedGroups + , let k = fst3 (head ops), k == 1] -- SDiv groups + signedModGroups = [(i, ops) | (i, ops) <- indexedGroups + , let k = fst3 (head ops), k == 3] -- SMod groups + in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) + <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) + where + fst3 (a, _, _) = a + allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] + mkPairLinks prefix' ((i, _), (j, _)) = + let absAI = fromString $ "abs_a_" <> show i + absBi = fromString $ "abs_b_" <> show i + absAJ = fromString $ "abs_a_" <> show j + absBJ = fromString $ "abs_b_" <> show j + coreI = fromString $ prefix' <> "_" <> show i + coreJ = fromString $ prefix' <> "_" <> show j + in [ SMTCommand $ "(assert (=> (and (=" `sp` absAI `sp` absAJ <> ") (=" + `sp` absBi `sp` absBJ <> ")) (=" `sp` coreI `sp` coreJ <> ")))" ] + +-- | Phase 3: Encode props with shift-based quotient bounds instead of bvudiv. +-- When the dividend of a signed division has the form SHL(k, x), we know that +-- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): +-- if |y| >= 2^k then q <= bvlshr(|a|, k) +-- if |y| < 2^k then q >= bvlshr(|a|, k) +-- This avoids bvudiv entirely, which bitwuzla struggles with at 256 bits. +assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 +assertPropsShiftBounds conf ps = do + let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) bounds <- divModBounds ps - pure $ SMT2 (SMTScript divModRefinedDefs) mempty mempty - <> base + axioms <- divModShiftBoundAxioms ps + pure $ base <> SMT2 (SMTScript bounds) mempty mempty + <> SMT2 (SMTScript axioms) mempty mempty + +-- | Generate shift-based bound axioms (no bvudiv/bvurem). +-- For each group of signed div/mod ops, if the dividend has a SHL(k, _) structure, +-- generates bounds using bvlshr instead of bvudiv. +divModShiftBoundAxioms :: [Prop] -> Err [SMTEntry] +divModShiftBoundAxioms props = do + let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props + if null allDivs then pure [] + else do + let groups = groupBy (\a b -> absKey a == absKey b) + $ sortBy (comparing absKey) allDivs + indexedGroups = zip [0..] groups + entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups + let links = mkCongruenceLinks indexedGroups + pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links + where + collectDivOps :: forall a . Expr a -> [DivOp] + collectDivOps = \case + Div a b -> [(0, a, b)] + SDiv a b -> [(1, a, b)] + Mod a b -> [(2, a, b)] + SMod a b -> [(3, a, b)] + _ -> [] + + eqDivOp :: DivOp -> DivOp -> Bool + eqDivOp (k1, a1, b1) (k2, a2, b2) = + k1 == k2 && show a1 == show a2 && show b1 == show b2 + + -- | Extract shift amount from a dividend expression. + -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), + -- or if it is a literal that is an exact power of 2 (Lit 2^k). + extractShift :: Expr EWord -> Maybe Int + extractShift (SHL (Lit k) _) = Just (fromIntegral k) + extractShift (Sub (Lit 0) x) = extractShift x + extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (countTrailingZeros n) + extractShift _ = Nothing + + mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] + mkGroupShiftAxioms groupIdx ops = do + let (firstKind, firstA, firstB) = head ops + isDiv = firstKind == 0 || firstKind == 1 + isSigned = firstKind == 1 || firstKind == 3 + prefix = if isDiv then "udiv" else "urem" + coreName = fromString $ prefix <> "_" <> show groupIdx + + if not isSigned then do + -- Unsigned: fall back to full bvudiv axiom (these are usually fast) + mapM (mkUnsignedAxiom coreName) ops + else do + let absAName = fromString $ "abs_a_" <> show groupIdx + absBName = fromString $ "abs_b_" <> show groupIdx + canonA = stripNeg firstA + canonB = stripNeg firstB + canonAenc <- exprToSMTWith AbstractDivision canonA + canonBenc <- exprToSMTWith AbstractDivision canonB + let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" + `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" + absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" + `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" + let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" + , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" + ] + -- Generate shift bounds or fall back to bvudiv + let shiftBounds = case extractShift canonA of + Just k -> + let kLit = fromString $ show k + threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" + shifted = "(bvlshr" `sp` absAName `sp` "(_ bv" <> kLit <> " 256))" + in [ -- q = 0 when b = 0 + SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" + , -- q <= abs_a (always true) + SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + , -- if |b| >= 2^k then q <= |a| >> k + SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" + , -- if |b| < 2^k then q >= |a| >> k + SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" + ] + Nothing -> + -- No shift structure: use full bvudiv definition + let coreEnc = if isDiv + then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero + `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" + else "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero + `sp` "(bvurem" `sp` absAName `sp` absBName <> "))" + in [ SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" ] + axioms <- mapM (mkSignedAxiom coreName) ops + pure $ decls <> shiftBounds <> axioms + + stripNeg :: Expr EWord -> Expr EWord + stripNeg (Sub (Lit 0) x) = x + stripNeg x = x + + mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkUnsignedAxiom _coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == 0 then "evm_bvudiv" else "evm_bvurem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + op = if kind == 0 then "bvudiv" else "bvurem" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(" <> op `sp` aenc `sp` benc <> "))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + + mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkSignedAxiom coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == 1 then "evm_bvsdiv" else "evm_bvsrem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + if kind == 1 then do + let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" + `sp` "(bvslt" `sp` benc `sp` zero <> "))" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite" `sp` sameSign `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + else do + let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" + `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index d3996a41b..7225ff5f7 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -151,7 +151,24 @@ checkSatWithProps sg props = do when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." let smt2Refined = assertPropsRefined conf allProps if isLeft smt2Refined then pure $ Error $ getError smt2Refined - else liftIO $ checkSat sg (Just props) smt2Refined + else do + when conf.dumpQueries $ liftIO $ writeSMT2File (getNonError smt2Refined) "." "refined" + phase2 <- liftIO $ checkSat sg (Just props) smt2Refined + case phase2 of + Unknown _ -> do + -- Phase 3: Try shift-based bounds (avoids bvudiv entirely). + -- This is an overapproximation: only UNSAT results are sound. + -- SAT/Unknown results are discarded (fall back to phase2 Unknown). + when conf.debug $ liftIO $ putStrLn "Phase 2 unknown, trying shift-based bounds..." + let smt2Shift = assertPropsShiftBounds conf allProps + if isLeft smt2Shift then pure phase2 + else do + when conf.dumpQueries $ liftIO $ writeSMT2File (getNonError smt2Shift) "." "shift-bounds" + phase3 <- liftIO $ checkSat sg (Just props) smt2Shift + case phase3 of + Qed -> pure Qed -- UNSAT with shift bounds => truly UNSAT + _ -> pure phase2 -- SAT/Unknown from shift bounds is not reliable + _ -> pure phase2 -- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult From 0513779265183cd9f3d3167029e6a71db90314a6 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Sat, 31 Jan 2026 11:12:27 +0100 Subject: [PATCH 003/150] avoid unsoundness --- src/EVM/SMT/DivEncoding.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 15ac7e411..1f3b2b264 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -89,9 +89,9 @@ assertPropsRefined conf ps = do type DivOp = (Int, Expr EWord, Expr EWord) -- | Canonical key for grouping operations that share the same bvudiv/bvurem core. --- For unsigned: (show a, show b, False) --- For signed: (show a, canonicalAbs b, True) where canonicalAbs normalizes negations -type AbsKey = (String, String, Bool) +-- For unsigned: (show a, show b, False, isMod) +-- For signed: (canonicalAbs a, canonicalAbs b, True, isMod) where canonicalAbs normalizes negations +type AbsKey = (String, String, Bool, Bool) -- | Normalize an expression for absolute value canonicalization. -- |Sub(Lit 0, x)| = |x|, so we strip the negation wrapper. @@ -101,8 +101,8 @@ canonicalAbs x = show x absKey :: DivOp -> AbsKey absKey (kind, a, b) - | kind == 0 || kind == 2 = (show a, show b, False) -- unsigned: exact operands - | otherwise = (canonicalAbs a, canonicalAbs b, True) -- signed: normalize abs + | kind == 0 || kind == 2 = (show a, show b, False, kind >= 2) -- unsigned: exact operands + | otherwise = (canonicalAbs a, canonicalAbs b, True, kind >= 2) -- signed: normalize abs -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: @@ -317,8 +317,8 @@ divModShiftBoundAxioms props = do , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" ] -- Generate shift bounds or fall back to bvudiv - let shiftBounds = case extractShift canonA of - Just k -> + let shiftBounds = case (isDiv, extractShift canonA) of + (True, Just k) -> let kLit = fromString $ show k threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" shifted = "(bvlshr" `sp` absAName `sp` "(_ bv" <> kLit <> " 256))" @@ -331,8 +331,8 @@ divModShiftBoundAxioms props = do , -- if |b| < 2^k then q >= |a| >> k SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" ] - Nothing -> - -- No shift structure: use full bvudiv definition + _ -> + -- No shift structure or it's a modulo op: use full bvudiv/bvurem definition let coreEnc = if isDiv then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" From b687ca8f1cba78a6b9cf9f6e94f24297142be822 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Sat, 31 Jan 2026 13:44:43 +0100 Subject: [PATCH 004/150] fixes and tests --- src/EVM/SMT.hs | 12 -- src/EVM/SMT/DivEncoding.hs | 13 +- test/test.hs | 258 +++++++++++++++++++++++++++++++++++++ 3 files changed, 264 insertions(+), 19 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 9d86bffe8..f7b128940 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -700,9 +700,6 @@ propToSMTWith enc = \case -- ** Helpers ** --------------------------------------------------------------------------------- --- | Stores a region of src into dst -copySlice :: Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder -copySlice = copySliceWith ConcreteDivision copySliceWith :: DivEncoding -> Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do @@ -721,9 +718,6 @@ copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do offset o e = exprToSMTWith divEnc $ Expr.add (Lit o) e copySliceWith _ _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query" --- | Unrolls an exponentiation into a series of multiplications -expandExp :: Expr EWord -> W256 -> Err Builder -expandExp = expandExpWith ConcreteDivision expandExpWith :: DivEncoding -> Expr EWord -> W256 -> Err Builder expandExpWith divEnc base expnt @@ -735,9 +729,6 @@ expandExpWith divEnc base expnt n <- expandExpWith divEnc base (expnt - 1) pure $ "(bvmul " <> b `sp` n <> ")" --- | Concatenates a list of bytes into a larger bitvector -concatBytes :: [Expr Byte] -> Err Builder -concatBytes = concatBytesWith ConcreteDivision concatBytesWith :: DivEncoding -> [Expr Byte] -> Err Builder concatBytesWith divEnc bytes = do @@ -752,9 +743,6 @@ concatBytesWith divEnc bytes = do byteSMT <- exprToSMTWith divEnc byte pure $ "(concat " <> byteSMT `sp` inner <> ")" --- | Concatenates a list of bytes into a larger bitvector -writeBytes :: ByteString -> Expr Buf -> Err Builder -writeBytes = writeBytesWith ConcreteDivision writeBytesWith :: DivEncoding -> ByteString -> Expr Buf -> Err Builder writeBytesWith divEnc bytes buf = do diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 1f3b2b264..002181844 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -332,13 +332,12 @@ divModShiftBoundAxioms props = do SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" ] _ -> - -- No shift structure or it's a modulo op: use full bvudiv/bvurem definition - let coreEnc = if isDiv - then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero - `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" - else "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero - `sp` "(bvurem" `sp` absAName `sp` absBName <> "))" - in [ SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" ] + -- No shift structure or it's a modulo op: use abstract bounds only. + -- This avoids bvudiv entirely, making the encoding an overapproximation. + -- Only UNSAT results are sound (checked by caller). + [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" + , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + ] axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> shiftBounds <> axioms diff --git a/test/test.hs b/test/test.hs index 36d312565..ec67483b1 100644 --- a/test/test.hs +++ b/test/test.hs @@ -125,6 +125,9 @@ withCVC5Solver = withSolvers CVC5 3 Nothing defMemLimit withBitwuzlaSolver :: App m => (SolverGroup -> m a) -> m a withBitwuzlaSolver = withSolvers Bitwuzla 3 Nothing defMemLimit +withShortBitwuzlaSolver :: App m => (SolverGroup -> m a) -> m a +withShortBitwuzlaSolver = withSolvers Bitwuzla 3 (Just 5) defMemLimit + main :: IO () main = defaultMain tests @@ -4004,6 +4007,261 @@ tests = testGroup "hevm" Nothing -> assertBoolM "Address missing from storage reads" False Just storeReads -> assertBoolM "Did not collect all abstract reads!" $ (Set.size storeReads) == 2 ] + , testGroup "Arithmetic Soundness" + [ testAbstractArith "sdiv-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_one(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, 1) } + assert(result == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "sdiv-by-neg-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_neg_one(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, sub(0, 1)) } + if (a == -170141183460469231731687303715884105728 * 2**128) { // type(int256).min + assert(result == a); + } else { + assert(result == -a); + } + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "sdiv-intmin-by-two" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_intmin_by_two() external pure { + int256 result; + assembly { + let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 + result := sdiv(intmin, 2) + } + // -2**254 is 0xc000...0000 + assert(result == -0x4000000000000000000000000000000000000000000000000000000000000000); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_by_zero(int256 a) external pure { + int256 result; + assembly { result := smod(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "smod-intmin-by-three" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_intmin_by_three() external pure { + int256 result; + assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 3) } + assert(result == -2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , expectFail $ testAbstractArith "div-mod-identity" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_div_mod_identity(int256 a, int256 b) external pure { + if (b == 0) return; + int256 q; + int256 r; + assembly { + q := sdiv(a, b) + r := smod(a, b) + } + int256 reconstructed; + // using unchecked because SDiv(min, -1) * -1 + 0 = min in EVM (wraps) + unchecked { + reconstructed = q * b + r; + } + assert(reconstructed == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_by_one(uint256 a) external pure { + uint256 result; + assembly { result := div(a, 1) } + assert(result == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "umod-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_umod_by_zero(uint256 a) external pure { + uint256 result; + assembly { result := mod(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_zero(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-zero-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_zero_dividend(int256 b) external pure { + int256 result; + assembly { result := sdiv(0, b) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-truncation" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_truncation() external pure { + int256 result; + assembly { result := sdiv(sub(0, 7), 2) } + assert(result == -3); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-sign-symmetry" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_sign_symmetry(int256 a, int256 b) external pure { + if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == 0) return; + int256 r1; + int256 r2; + assembly { + r1 := sdiv(a, b) + r2 := sdiv(sub(0, a), sub(0, b)) + } + assert(r1 == r2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-sign-antisymmetry" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_sign_antisymmetry(int256 a, int256 b) external pure { + if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == 0) return; + int256 r1; + int256 r2; + assembly { + r1 := sdiv(a, b) + r2 := sdiv(sub(0, a), b) + } + assert(r1 == -r2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_by_one(int256 a) external pure { + int256 r1; + int256 r2; + assembly { + r1 := smod(a, 1) + r2 := smod(a, sub(0, 1)) + } + assert(r1 == 0); + assert(r2 == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-zero-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_zero_dividend(int256 b) external pure { + int256 result; + assembly { result := smod(0, b) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-sign-matches-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_sign_matches_dividend(int256 a, int256 b) external pure { + if (b == 0 || a == 0) return; + int256 result; + assembly { result := smod(a, b) } + if (result != 0) { + assert((a > 0 && result > 0) || (a < 0 && result < 0)); + } + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-intmin" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_intmin() external pure { + int256 result; + assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 2) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "unsigned-div-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_unsigned_div_by_zero(uint256 a) external pure { + uint256 result; + assembly { result := div(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , expectFail $ testAbstractArith "unsigned-div-mod-identity" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_unsigned_div_mod_identity(uint256 a, uint256 b) external pure { + if (b == 0) return; + uint256 q; + uint256 r; + assembly { + q := div(a, b) + r := mod(a, b) + } + assert(q * b + r == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + ] ] where (===>) = assertSolidityComputation From 113a25a5a0478b3487d7936b7539773dd3fd927f Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Sat, 31 Jan 2026 20:20:11 +0100 Subject: [PATCH 005/150] fixes --- test/contracts/fail/arith.sol | 4 +++- test/contracts/fail/math.sol | 4 +++- test/contracts/pass/arith.sol | 4 +++- test/contracts/pass/math.sol | 5 ++++- 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/test/contracts/fail/arith.sol b/test/contracts/fail/arith.sol index 7b7392c43..133843004 100644 --- a/test/contracts/fail/arith.sol +++ b/test/contracts/fail/arith.sol @@ -1,9 +1,11 @@ // SPDX-License-Identifier: AGPL-3.0 pragma solidity >=0.8.0 <0.9.0; +import {Test} from "forge-std/Test.sol"; + /// Adapted from halmos tests/regression/test/Arith.t.sol /// Division failure case: y == 0 is a valid counterexample -contract ArithFailTest { +contract ArithFailTest is Test { function unchecked_div(uint x, uint y) public pure returns (uint ret) { assembly { ret := div(x, y) diff --git a/test/contracts/fail/math.sol b/test/contracts/fail/math.sol index 7aa459b2d..8361e777f 100644 --- a/test/contracts/fail/math.sol +++ b/test/contracts/fail/math.sol @@ -1,9 +1,11 @@ // SPDX-License-Identifier: AGPL-3.0 pragma solidity >=0.8.0 <0.9.0; +import {Test} from "forge-std/Test.sol"; + /// Adapted from halmos tests/solver/test/Math.t.sol /// Deposit/mint ratio test - counterexamples exist for mint case -contract MathFailTest { +contract MathFailTest is Test { function prove_mint(uint s, uint A1, uint S1) public pure { uint a = (s * A1) / S1; diff --git a/test/contracts/pass/arith.sol b/test/contracts/pass/arith.sol index bbfded6dc..80129a494 100644 --- a/test/contracts/pass/arith.sol +++ b/test/contracts/pass/arith.sol @@ -1,9 +1,11 @@ // SPDX-License-Identifier: AGPL-3.0 pragma solidity >=0.8.0 <0.9.0; +import {Test} from "forge-std/Test.sol"; + /// Adapted from halmos tests/regression/test/Arith.t.sol /// Tests division/modulo/exponentiation properties -contract ArithTest { +contract ArithTest is Test { function unchecked_div(uint x, uint y) public pure returns (uint ret) { assembly { ret := div(x, y) diff --git a/test/contracts/pass/math.sol b/test/contracts/pass/math.sol index 63c356f96..5169a770d 100644 --- a/test/contracts/pass/math.sol +++ b/test/contracts/pass/math.sol @@ -1,10 +1,13 @@ // SPDX-License-Identifier: AGPL-3.0 pragma solidity >=0.8.0 <0.9.0; +import {Test} from "forge-std/Test.sol"; + /// Adapted from halmos tests/solver/test/Math.t.sol /// Tests average computation equivalence -contract MathTest { +contract MathTest is Test { function prove_Avg(uint a, uint b) public pure { + require(a + b >= a); // no overflow unchecked { uint r1 = (a & b) + (a ^ b) / 2; uint r2 = (a + b) / 2; From f3e103e6a5786be773086cf6f505e9941ec2ef56 Mon Sep 17 00:00:00 2001 From: "Mate Soos @ Argot" Date: Mon, 2 Feb 2026 15:14:50 +0100 Subject: [PATCH 006/150] Update src/EVM/SMT/DivEncoding.hs --- src/EVM/SMT/DivEncoding.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 002181844..3f2de7019 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -65,8 +65,7 @@ assertPropsAbstract conf ps = do base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) bounds <- divModBounds ps - pure $ base - <> SMT2 (SMTScript bounds) mempty mempty + pure $ base <> SMT2 (SMTScript bounds) mempty mempty -- | Encode props using exact div/mod definitions (Phase 2 refinement). -- Keeps declare-fun (uninterpreted) for sharing, but adds ground-instance From 3d995eda1304f25b08a19ff2bb31f43258511253 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 2 Feb 2026 18:06:50 +0100 Subject: [PATCH 007/150] fixes --- src/EVM/SMT.hs | 83 ++++++++++++++++-------------- src/EVM/SMT/DivEncoding.hs | 103 ++++++++++++++++++++----------------- src/EVM/Solvers.hs | 4 +- 3 files changed, 101 insertions(+), 89 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index f7b128940..494f7e992 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -451,23 +451,23 @@ exprToSMTWith enc = \case Mul a b -> op2 "bvmul" a b Exp a b -> case a of Lit 0 -> do - benc <- exprToSMTWith enc b + benc <- toSMT b pure $ "(ite (= " <> benc `sp` zero <> " ) " <> one `sp` zero <> ")" Lit 1 -> pure one Lit 2 -> do - benc <- exprToSMTWith enc b + benc <- toSMT b pure $ "(bvshl " <> one `sp` benc <> ")" _ -> case b of -- b is limited below, otherwise SMT query will be huge, and eventually Haskell stack overflows Lit b' | b' < 1000 -> expandExpWith enc a b' _ -> Left $ "Cannot encode symbolic exponent into SMT. Offending symbolic value: " <> show b Min a b -> do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b pure $ "(ite (bvule " <> aenc `sp` benc <> ") " <> aenc `sp` benc <> ")" Max a b -> do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b pure $ "(max " <> aenc `sp` benc <> ")" LT a b -> do cond <- op2 "bvult" a b @@ -513,17 +513,17 @@ exprToSMTWith enc = \case SMod a b -> smodOp "evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do - aExp <- exprToSMTWith enc a - bExp <- exprToSMTWith enc b - cExp <- exprToSMTWith enc c + aExp <- toSMT a + bExp <- toSMT b + cExp <- toSMT c let aLift = "((_ zero_extend 256) " <> aExp <> ")" bLift = "((_ zero_extend 256) " <> bExp <> ")" cLift = "((_ zero_extend 256) " <> cExp <> ")" pure $ "(ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 256) ((_ extract 255 0) (bvurem (bvmul " <> aLift `sp` bLift <> ")" <> cLift <> ")))" AddMod a b c -> do - aExp <- exprToSMTWith enc a - bExp <- exprToSMTWith enc b - cExp <- exprToSMTWith enc c + aExp <- toSMT a + bExp <- toSMT b + cExp <- toSMT c let aLift = "((_ zero_extend 1) " <> aExp <> ")" bLift = "((_ zero_extend 1) " <> bExp <> ")" cLift = "((_ zero_extend 1) " <> cExp <> ")" @@ -532,8 +532,8 @@ exprToSMTWith enc = \case cond <- op2 "=" a b pure $ "(ite " <> cond `sp` one `sp` zero <> ")" Keccak a -> do - e <- exprToSMTWith enc a - sz <- exprToSMTWith enc $ Expr.bufLength a + e <- toSMT a + sz <- toSMT $ Expr.bufLength a pure $ "(keccak " <> e <> " " <> sz <> ")" TxValue -> pure $ fromString "txvalue" @@ -541,10 +541,10 @@ exprToSMTWith enc = \case Origin -> pure "origin" BlockHash a -> do - e <- exprToSMTWith enc a + e <- toSMT a pure $ "(blockhash " <> e <> ")" CodeSize a -> do - e <- exprToSMTWith enc a + e <- toSMT a pure $ "(codesize " <> e <> ")" Coinbase -> pure "coinbase" Timestamp -> pure "timestamp" @@ -556,16 +556,16 @@ exprToSMTWith enc = \case a@(SymAddr _) -> pure $ formatEAddr a WAddr(a@(SymAddr _)) -> do - wa <- exprToSMTWith enc a + wa <- toSMT a pure $ "((_ zero_extend 96)" `sp` wa `sp` ")" LitByte b -> pure $ byteAsBV b IndexWord idx w -> case idx of Lit n -> if n >= 0 && n < 32 then do - e <- exprToSMTWith enc w + e <- toSMT w pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` e <> ")" - else exprToSMTWith enc (LitByte 0) + else toSMT (LitByte 0) _ -> op2 "indexWord" idx w ReadByte idx src -> op2 "select" src idx @@ -575,29 +575,29 @@ exprToSMTWith enc = \case ReadWord idx prev -> op2 "readWord" idx prev BufLength (AbstractBuf b) -> pure $ fromText b <> "_length" BufLength (GVar (BufVar n)) -> pure $ fromLazyText $ "buf" <> (T.pack . show $ n) <> "_length" - BufLength b -> exprToSMTWith enc (bufLength b) + BufLength b -> toSMT (bufLength b) WriteByte idx val prev -> do - encIdx <- exprToSMTWith enc idx - encVal <- exprToSMTWith enc val - encPrev <- exprToSMTWith enc prev + encIdx <- toSMT idx + encVal <- toSMT val + encPrev <- toSMT prev pure $ "(store " <> encPrev `sp` encIdx `sp` encVal <> ")" WriteWord idx val prev -> do - encIdx <- exprToSMTWith enc idx - encVal <- exprToSMTWith enc val - encPrev <- exprToSMTWith enc prev + encIdx <- toSMT idx + encVal <- toSMT val + encPrev <- toSMT prev pure $ "(writeWord " <> encIdx `sp` encVal `sp` encPrev <> ")" CopySlice srcIdx dstIdx size src dst -> do - srcSMT <- exprToSMTWith enc src - dstSMT <- exprToSMTWith enc dst + srcSMT <- toSMT src + dstSMT <- toSMT dst copySliceWith enc srcIdx dstIdx size srcSMT dstSMT -- we need to do a bit of processing here. ConcreteStore s -> encodeConcreteStore s AbstractStore a idx -> pure $ storeName a idx SStore idx val prev -> do - encIdx <- exprToSMTWith enc idx - encVal <- exprToSMTWith enc val - encPrev <- exprToSMTWith enc prev + encIdx <- toSMT idx + encVal <- toSMT val + encPrev <- toSMT prev pure $ "(store" `sp` encPrev `sp` encIdx `sp` encVal <> ")" SLoad idx store -> op2 "select" store idx LitAddr n -> pure $ fromLazyText $ "(_ bv" <> T.pack (show (into n :: Integer)) <> " 160)" @@ -606,19 +606,22 @@ exprToSMTWith enc = \case a -> internalError $ "TODO: implement: " <> show a where + -- Local alias to avoid repeating 'enc' at every recursive call + toSMT :: Expr x -> Err Builder + toSMT = exprToSMTWith enc op1 :: Builder -> Expr x -> Err Builder op1 op a = do - e <- exprToSMTWith enc a + e <- toSMT a pure $ "(" <> op `sp` e <> ")" op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b pure $ "(" <> op `sp` aenc `sp` benc <> ")" op2CheckZero :: Builder -> Expr x -> Expr y -> Err Builder op2CheckZero op a b = do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" divOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder divOp concreteOp abstractOp a b = case enc of @@ -631,8 +634,8 @@ exprToSMTWith enc = \case sdivOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b ConcreteDivision -> do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" udiv = "(bvudiv" `sp` absa `sp` absb <> ")" @@ -645,8 +648,8 @@ exprToSMTWith enc = \case smodOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b ConcreteDivision -> do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- toSMT a + benc <- toSMT b let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" urem = "(bvurem" `sp` absa `sp` absb <> ")" diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 3f2de7019..0918a087f 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -83,25 +83,38 @@ assertPropsRefined conf ps = do <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript axioms) mempty mempty --- DivOp kind: 0=Div, 1=SDiv, 2=Mod, 3=SMod +-- | Kind of division/modulo operation +data DivOpKind = UDiv | USDiv | UMod | USMod + deriving (Eq, Ord) + -- We track (kind, dividend, divisor) -type DivOp = (Int, Expr EWord, Expr EWord) +type DivOp = (DivOpKind, Expr EWord, Expr EWord) -- | Canonical key for grouping operations that share the same bvudiv/bvurem core. --- For unsigned: (show a, show b, False, isMod) +-- For unsigned: (a, b, False, isMod) -- For signed: (canonicalAbs a, canonicalAbs b, True, isMod) where canonicalAbs normalizes negations -type AbsKey = (String, String, Bool, Bool) +type AbsKey = (Expr EWord, Expr EWord, Bool, Bool) -- | Normalize an expression for absolute value canonicalization. -- |Sub(Lit 0, x)| = |x|, so we strip the negation wrapper. -canonicalAbs :: Expr EWord -> String -canonicalAbs (Sub (Lit 0) x) = show x -canonicalAbs x = show x +canonicalAbs :: Expr EWord -> Expr EWord +canonicalAbs (Sub (Lit 0) x) = x +canonicalAbs x = x + +isSigned :: DivOpKind -> Bool +isSigned USDiv = True +isSigned USMod = True +isSigned _ = False + +isMod :: DivOpKind -> Bool +isMod UMod = True +isMod USMod = True +isMod _ = False absKey :: DivOp -> AbsKey absKey (kind, a, b) - | kind == 0 || kind == 2 = (show a, show b, False, kind >= 2) -- unsigned: exact operands - | otherwise = (canonicalAbs a, canonicalAbs b, True, kind >= 2) -- signed: normalize abs + | not (isSigned kind) = (a, b, False, isMod kind) -- unsigned: exact operands + | otherwise = (canonicalAbs a, canonicalAbs b, True, isMod kind) -- signed: normalize abs -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: @@ -121,27 +134,25 @@ divModGroundAxioms props = do where collectDivOps :: forall a . Expr a -> [DivOp] collectDivOps = \case - Div a b -> [(0, a, b)] - SDiv a b -> [(1, a, b)] - Mod a b -> [(2, a, b)] - SMod a b -> [(3, a, b)] + Div a b -> [(UDiv, a, b)] + SDiv a b -> [(USDiv, a, b)] + Mod a b -> [(UMod, a, b)] + SMod a b -> [(USMod, a, b)] _ -> [] eqDivOp :: DivOp -> DivOp -> Bool eqDivOp (k1, a1, b1) (k2, a2, b2) = - k1 == k2 && show a1 == show a2 && show b1 == show b2 + k1 == k2 && a1 == a2 && b1 == b2 -- | Generate axioms for a group of ops sharing the same bvudiv/bvurem core. mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] - mkGroupAxioms groupIdx ops = do - -- The first op determines the dividend/divisor encoding - let (firstKind, firstA, firstB) = head ops - isDiv = firstKind == 0 || firstKind == 1 -- div vs mod - isSigned = firstKind == 1 || firstKind == 3 - prefix = if isDiv then "udiv" else "urem" + mkGroupAxioms _ [] = pure [] + mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do + let isDiv' = not (isMod firstKind) + prefix = if isDiv' then "udiv" else "urem" coreName = fromString $ prefix <> "_" <> show groupIdx - if not isSigned then do + if not (isSigned firstKind) then do -- Unsigned: simple axioms, one bvudiv/bvurem per op (no abs-value needed) mapM (mkUnsignedAxiom coreName) ops else do @@ -157,7 +168,7 @@ divModGroundAxioms props = do `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" - coreEnc = if isDiv + coreEnc = if isDiv' then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" else "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero @@ -180,9 +191,9 @@ divModGroundAxioms props = do mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTWith AbstractDivision a benc <- exprToSMTWith AbstractDivision b - let fname = if kind == 0 then "evm_bvudiv" else "evm_bvurem" + let fname = if kind == UDiv then "evm_bvudiv" else "evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == 0 then "bvudiv" else "bvurem" + op = if kind == UDiv then "bvudiv" else "bvurem" concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` "(" <> op `sp` aenc `sp` benc <> "))" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" @@ -191,9 +202,9 @@ divModGroundAxioms props = do mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTWith AbstractDivision a benc <- exprToSMTWith AbstractDivision b - let fname = if kind == 1 then "evm_bvsdiv" else "evm_bvsrem" + let fname = if kind == USDiv then "evm_bvsdiv" else "evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - if kind == 1 then do + if kind == USDiv then do -- SDiv: result sign depends on whether operand signs match let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" `sp` "(bvslt" `sp` benc `sp` zero <> "))" @@ -215,14 +226,13 @@ divModGroundAxioms props = do -- helps bitwuzla avoid independent reasoning about multiple bvudiv terms. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops) <- indexedGroups - , let k = fst3 (head ops), k == 1] -- SDiv groups - signedModGroups = [(i, ops) | (i, ops) <- indexedGroups - , let k = fst3 (head ops), k == 3] -- SMod groups + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups + , k == USDiv] -- SDiv groups + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups + , k == USMod] -- SMod groups in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where - fst3 (a, _, _) = a allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] mkPairLinks prefix' ((i, _), (j, _)) = let absAI = fromString $ "abs_a_" <> show i @@ -268,15 +278,15 @@ divModShiftBoundAxioms props = do where collectDivOps :: forall a . Expr a -> [DivOp] collectDivOps = \case - Div a b -> [(0, a, b)] - SDiv a b -> [(1, a, b)] - Mod a b -> [(2, a, b)] - SMod a b -> [(3, a, b)] + Div a b -> [(UDiv, a, b)] + SDiv a b -> [(USDiv, a, b)] + Mod a b -> [(UMod, a, b)] + SMod a b -> [(USMod, a, b)] _ -> [] eqDivOp :: DivOp -> DivOp -> Bool eqDivOp (k1, a1, b1) (k2, a2, b2) = - k1 == k2 && show a1 == show a2 && show b1 == show b2 + k1 == k2 && a1 == a2 && b1 == b2 -- | Extract shift amount from a dividend expression. -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), @@ -288,14 +298,13 @@ divModShiftBoundAxioms props = do extractShift _ = Nothing mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] - mkGroupShiftAxioms groupIdx ops = do - let (firstKind, firstA, firstB) = head ops - isDiv = firstKind == 0 || firstKind == 1 - isSigned = firstKind == 1 || firstKind == 3 - prefix = if isDiv then "udiv" else "urem" + mkGroupShiftAxioms _ [] = pure [] + mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do + let isDiv' = not (isMod firstKind) + prefix = if isDiv' then "udiv" else "urem" coreName = fromString $ prefix <> "_" <> show groupIdx - if not isSigned then do + if not (isSigned firstKind) then do -- Unsigned: fall back to full bvudiv axiom (these are usually fast) mapM (mkUnsignedAxiom coreName) ops else do @@ -316,7 +325,7 @@ divModShiftBoundAxioms props = do , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" ] -- Generate shift bounds or fall back to bvudiv - let shiftBounds = case (isDiv, extractShift canonA) of + let shiftBounds = case (isDiv', extractShift canonA) of (True, Just k) -> let kLit = fromString $ show k threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" @@ -348,9 +357,9 @@ divModShiftBoundAxioms props = do mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTWith AbstractDivision a benc <- exprToSMTWith AbstractDivision b - let fname = if kind == 0 then "evm_bvudiv" else "evm_bvurem" + let fname = if kind == UDiv then "evm_bvudiv" else "evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == 0 then "bvudiv" else "bvurem" + op = if kind == UDiv then "bvudiv" else "bvurem" concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` "(" <> op `sp` aenc `sp` benc <> "))" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" @@ -359,9 +368,9 @@ divModShiftBoundAxioms props = do mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTWith AbstractDivision a benc <- exprToSMTWith AbstractDivision b - let fname = if kind == 1 then "evm_bvsdiv" else "evm_bvsrem" + let fname = if kind == USDiv then "evm_bvsdiv" else "evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - if kind == 1 then do + if kind == USDiv then do let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" `sp` "(bvslt" `sp` benc `sp` zero <> "))" concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 7225ff5f7..24c16c83a 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -144,8 +144,8 @@ checkSatWithProps sg props = do phase1 <- liftIO $ checkSat sg (Just props) smt2Abstract case phase1 of Qed -> pure Qed -- UNSAT with abstractions => truly UNSAT (sound) - Error e -> pure (Error e) - Unknown u -> pure (Unknown u) + e@(Error _) -> pure e + u@(Unknown _) -> pure u Cex _ -> do -- Phase 2: Refine with exact definitions to validate counterexample when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." From 21cd7539fb09cfe3ab1a5c7817467ce86cc56513 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 14:54:09 +0100 Subject: [PATCH 008/150] Remove warning --- src/EVM/SMT/DivEncoding.hs | 142 ------------------------------------- src/EVM/Solvers.hs | 39 +++------- test/test.hs | 1 + 3 files changed, 11 insertions(+), 171 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 0918a087f..2a472ba31 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -7,10 +7,8 @@ module EVM.SMT.DivEncoding , divModBounds , assertPropsAbstract , assertPropsRefined - , assertPropsShiftBounds ) where -import Data.Bits ((.&.), countTrailingZeros) import Data.List (nubBy, groupBy, sortBy) import Data.Ord (comparing) import Data.Text.Lazy.Builder @@ -243,143 +241,3 @@ mkCongruenceLinks indexedGroups = coreJ = fromString $ prefix' <> "_" <> show j in [ SMTCommand $ "(assert (=> (and (=" `sp` absAI `sp` absAJ <> ") (=" `sp` absBi `sp` absBJ <> ")) (=" `sp` coreI `sp` coreJ <> ")))" ] - --- | Phase 3: Encode props with shift-based quotient bounds instead of bvudiv. --- When the dividend of a signed division has the form SHL(k, x), we know that --- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): --- if |y| >= 2^k then q <= bvlshr(|a|, k) --- if |y| < 2^k then q >= bvlshr(|a|, k) --- This avoids bvudiv entirely, which bitwuzla struggles with at 256 bits. -assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 -assertPropsShiftBounds conf ps = do - let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls - base <- if not conf.simp then mkBase False ps - else mkBase True (decompose conf ps) - bounds <- divModBounds ps - axioms <- divModShiftBoundAxioms ps - pure $ base - <> SMT2 (SMTScript bounds) mempty mempty - <> SMT2 (SMTScript axioms) mempty mempty - --- | Generate shift-based bound axioms (no bvudiv/bvurem). --- For each group of signed div/mod ops, if the dividend has a SHL(k, _) structure, --- generates bounds using bvlshr instead of bvudiv. -divModShiftBoundAxioms :: [Prop] -> Err [SMTEntry] -divModShiftBoundAxioms props = do - let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props - if null allDivs then pure [] - else do - let groups = groupBy (\a b -> absKey a == absKey b) - $ sortBy (comparing absKey) allDivs - indexedGroups = zip [0..] groups - entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups - let links = mkCongruenceLinks indexedGroups - pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links - where - collectDivOps :: forall a . Expr a -> [DivOp] - collectDivOps = \case - Div a b -> [(UDiv, a, b)] - SDiv a b -> [(USDiv, a, b)] - Mod a b -> [(UMod, a, b)] - SMod a b -> [(USMod, a, b)] - _ -> [] - - eqDivOp :: DivOp -> DivOp -> Bool - eqDivOp (k1, a1, b1) (k2, a2, b2) = - k1 == k2 && a1 == a2 && b1 == b2 - - -- | Extract shift amount from a dividend expression. - -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), - -- or if it is a literal that is an exact power of 2 (Lit 2^k). - extractShift :: Expr EWord -> Maybe Int - extractShift (SHL (Lit k) _) = Just (fromIntegral k) - extractShift (Sub (Lit 0) x) = extractShift x - extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (countTrailingZeros n) - extractShift _ = Nothing - - mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] - mkGroupShiftAxioms _ [] = pure [] - mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do - let isDiv' = not (isMod firstKind) - prefix = if isDiv' then "udiv" else "urem" - coreName = fromString $ prefix <> "_" <> show groupIdx - - if not (isSigned firstKind) then do - -- Unsigned: fall back to full bvudiv axiom (these are usually fast) - mapM (mkUnsignedAxiom coreName) ops - else do - let absAName = fromString $ "abs_a_" <> show groupIdx - absBName = fromString $ "abs_b_" <> show groupIdx - canonA = stripNeg firstA - canonB = stripNeg firstB - canonAenc <- exprToSMTWith AbstractDivision canonA - canonBenc <- exprToSMTWith AbstractDivision canonB - let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" - `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" - absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" - `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" - let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" - , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" - , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" - ] - -- Generate shift bounds or fall back to bvudiv - let shiftBounds = case (isDiv', extractShift canonA) of - (True, Just k) -> - let kLit = fromString $ show k - threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" - shifted = "(bvlshr" `sp` absAName `sp` "(_ bv" <> kLit <> " 256))" - in [ -- q = 0 when b = 0 - SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" - , -- q <= abs_a (always true) - SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" - , -- if |b| >= 2^k then q <= |a| >> k - SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" - , -- if |b| < 2^k then q >= |a| >> k - SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" - ] - _ -> - -- No shift structure or it's a modulo op: use abstract bounds only. - -- This avoids bvudiv entirely, making the encoding an overapproximation. - -- Only UNSAT results are sound (checked by caller). - [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" - , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" - ] - axioms <- mapM (mkSignedAxiom coreName) ops - pure $ decls <> shiftBounds <> axioms - - stripNeg :: Expr EWord -> Expr EWord - stripNeg (Sub (Lit 0) x) = x - stripNeg x = x - - mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkUnsignedAxiom _coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b - let fname = if kind == UDiv then "evm_bvudiv" else "evm_bvurem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == UDiv then "bvudiv" else "bvurem" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(" <> op `sp` aenc `sp` benc <> "))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - - mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkSignedAxiom coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b - let fname = if kind == USDiv then "evm_bvsdiv" else "evm_bvsrem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - if kind == USDiv then do - let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" - `sp` "(bvslt" `sp` benc `sp` zero <> "))" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite" `sp` sameSign `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - else do - let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" - `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 24c16c83a..116266db0 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -140,35 +140,16 @@ checkSatWithProps sg props = do -- Phase 1: Use uninterpreted functions (overapproximation) let smt2Abstract = assertPropsAbstract conf allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract - else do - phase1 <- liftIO $ checkSat sg (Just props) smt2Abstract - case phase1 of - Qed -> pure Qed -- UNSAT with abstractions => truly UNSAT (sound) - e@(Error _) -> pure e - u@(Unknown _) -> pure u - Cex _ -> do - -- Phase 2: Refine with exact definitions to validate counterexample - when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." - let smt2Refined = assertPropsRefined conf allProps - if isLeft smt2Refined then pure $ Error $ getError smt2Refined - else do - when conf.dumpQueries $ liftIO $ writeSMT2File (getNonError smt2Refined) "." "refined" - phase2 <- liftIO $ checkSat sg (Just props) smt2Refined - case phase2 of - Unknown _ -> do - -- Phase 3: Try shift-based bounds (avoids bvudiv entirely). - -- This is an overapproximation: only UNSAT results are sound. - -- SAT/Unknown results are discarded (fall back to phase2 Unknown). - when conf.debug $ liftIO $ putStrLn "Phase 2 unknown, trying shift-based bounds..." - let smt2Shift = assertPropsShiftBounds conf allProps - if isLeft smt2Shift then pure phase2 - else do - when conf.dumpQueries $ liftIO $ writeSMT2File (getNonError smt2Shift) "." "shift-bounds" - phase3 <- liftIO $ checkSat sg (Just props) smt2Shift - case phase3 of - Qed -> pure Qed -- UNSAT with shift bounds => truly UNSAT - _ -> pure phase2 -- SAT/Unknown from shift bounds is not reliable - _ -> pure phase2 + else liftIO $ checkSat sg (Just props) smt2Abstract >>= \case + Qed -> pure Qed -- UNSAT with abstractions => truly UNSAT (sound) + e@(Error _) -> pure e + u@(Unknown _) -> pure u + Cex _ -> do + -- Phase 2: Refine with exact definitions to validate counterexample + when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." + let smt2Refined = assertPropsRefined conf allProps + if isLeft smt2Refined then pure $ Error $ getError smt2Refined + else liftIO $ checkSat sg (Just props) smt2Refined -- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult diff --git a/test/test.hs b/test/test.hs index ec67483b1..dc0f2f9a2 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE TypeAbstractions #-} module Main where From e73af5a102eb520f666549fa1d9f74c237bfd4d3 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 16:32:49 +0100 Subject: [PATCH 009/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 2a472ba31..9dd93b9c6 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -29,6 +29,9 @@ divModAbstractDecls = , SMTCommand "(declare-fun evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] +exprToSMTAbs :: Expr a -> Err Builder +exprToSMTAbs = exprToSMTWith AbstractDivision + -- | Generate bounds constraints for abstract div/mod operations. -- These help the solver prune impossible models without full bitvector division reasoning. divModBounds :: [Prop] -> Err [SMTEntry] @@ -47,8 +50,8 @@ divModBounds props = do mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry mkAssertion (fname, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b + aenc <- exprToSMTAbs a + benc <- exprToSMTAbs b let result = "(" <> fname `sp` aenc `sp` benc <> ")" if fname == "evm_bvudiv" -- (x / y) <= x @@ -160,8 +163,8 @@ divModGroundAxioms props = do -- Use the canonical (non-negated) form for abs value encoding let canonA = stripNeg firstA canonB = stripNeg firstB - canonAenc <- exprToSMTWith AbstractDivision canonA - canonBenc <- exprToSMTWith AbstractDivision canonB + canonAenc <- exprToSMTAbs canonA + canonBenc <- exprToSMTAbs canonB let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" @@ -187,8 +190,8 @@ divModGroundAxioms props = do mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b + aenc <- exprToSMTAbs a + benc <- exprToSMTAbs b let fname = if kind == UDiv then "evm_bvudiv" else "evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" @@ -198,8 +201,8 @@ divModGroundAxioms props = do mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b + aenc <- exprToSMTAbs a + benc <- exprToSMTAbs b let fname = if kind == USDiv then "evm_bvsdiv" else "evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" if kind == USDiv then do From 45b71c5de4c5384d50b88d7dce403f1630305ae2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 16:32:53 +0100 Subject: [PATCH 010/150] Cleanup --- src/EVM/SMT.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 494f7e992..707c5a474 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -606,7 +606,6 @@ exprToSMTWith enc = \case a -> internalError $ "TODO: implement: " <> show a where - -- Local alias to avoid repeating 'enc' at every recursive call toSMT :: Expr x -> Err Builder toSMT = exprToSMTWith enc op1 :: Builder -> Expr x -> Err Builder @@ -628,8 +627,6 @@ exprToSMTWith enc = \case ConcreteDivision -> op2CheckZero concreteOp a b AbstractDivision -> op2 abstractOp a b -- | Encode SDiv using bvudiv with abs-value decomposition. - -- bitwuzla cannot solve UNSAT queries with bvsdiv at 256-bit, - -- but handles bvudiv efficiently. sdivOp :: Builder -> Expr x -> Expr y -> Err Builder sdivOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b From 8716a51824a4191078ef95a677ec95ef68a38a21 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 16:47:49 +0100 Subject: [PATCH 011/150] Rename, lineup --- src/EVM/SMT.hs | 14 +++++++------- src/EVM/SMT/DivEncoding.hs | 18 +++++++++--------- src/EVM/SMT/Types.hs | 2 +- src/EVM/Solvers.hs | 1 - 4 files changed, 17 insertions(+), 18 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 707c5a474..3f42a9dad 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -507,10 +507,10 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> divOp "bvudiv" "evm_bvudiv" a b - SDiv a b -> sdivOp "evm_bvsdiv" a b - Mod a b -> divOp "bvurem" "evm_bvurem" a b - SMod a b -> smodOp "evm_bvsrem" a b + Div a b -> divOp "bvudiv" "evm_evm_div" a b + SDiv a b -> sdivOp "abst_evm_sdiv" a b + Mod a b -> divOp "bvurem" "abst_evm_mod" a b + SMod a b -> smodOp "abst_evm_smod" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do aExp <- toSMT a @@ -626,7 +626,7 @@ exprToSMTWith enc = \case divOp concreteOp abstractOp a b = case enc of ConcreteDivision -> op2CheckZero concreteOp a b AbstractDivision -> op2 abstractOp a b - -- | Encode SDiv using bvudiv with abs-value decomposition. + -- | Encode SDiv using bvudiv with abs-value decomposition sdivOp :: Builder -> Expr x -> Expr y -> Err Builder sdivOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b @@ -639,8 +639,8 @@ exprToSMTWith enc = \case sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" `sp` "(bvslt" `sp` benc `sp` zero <> "))" pure $ "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` "(ite" `sp` sameSign `sp` udiv `sp` "(bvsub" `sp` zero `sp` udiv <> ")))" - -- | Encode SMod using bvurem with abs-value decomposition. - -- EVM SMOD: result has the sign of the dividend (a). + -- | Encode SMod using bvurem with abs-value decomposition + -- EVM SMOD: result has the sign of the dividend (a) smodOp :: Builder -> Expr x -> Expr y -> Err Builder smodOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 9dd93b9c6..bc9780bc4 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -23,10 +23,10 @@ import EVM.Types divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun evm_evm_div ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_sdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_mod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_smod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] exprToSMTAbs :: Expr a -> Err Builder @@ -44,8 +44,8 @@ divModBounds props = do where collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] collectBounds = \case - Div a b -> [("evm_bvudiv", a, b)] - Mod a b -> [("evm_bvurem", a, b)] + Div a b -> [("evm_evm_div", a, b)] + Mod a b -> [("abst_evm_mod", a, b)] _ -> [] mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry @@ -53,7 +53,7 @@ divModBounds props = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b let result = "(" <> fname `sp` aenc `sp` benc <> ")" - if fname == "evm_bvudiv" + if fname == "evm_evm_div" -- (x / y) <= x then pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" -- (x % y) <= y (ULE not ULT because y could be 0 and 0 % 0 = 0) @@ -192,7 +192,7 @@ divModGroundAxioms props = do mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b - let fname = if kind == UDiv then "evm_bvudiv" else "evm_bvurem" + let fname = if kind == UDiv then "evm_evm_div" else "abst_evm_mod" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero @@ -203,7 +203,7 @@ divModGroundAxioms props = do mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b - let fname = if kind == USDiv then "evm_bvsdiv" else "evm_bvsrem" + let fname = if kind == USDiv then "abst_evm_sdiv" else "abst_evm_smod" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" if kind == USDiv then do -- SDiv: result sign depends on whether operand signs match diff --git a/src/EVM/SMT/Types.hs b/src/EVM/SMT/Types.hs index 1ad309c18..11fa3a7a8 100644 --- a/src/EVM/SMT/Types.hs +++ b/src/EVM/SMT/Types.hs @@ -13,7 +13,7 @@ type MaybeIO = MaybeT IO -- | Controls how division/modulo operations are encoded into SMT. -- 'ConcreteDivision' uses inline ite-check-zero with real SMT ops (existing behavior). --- 'AbstractDivision' uses uninterpreted functions (evm_bvudiv, etc.) for performance. +-- 'AbstractDivision' uses uninterpreted functions (evm_evm_div, etc.) for performance. data DivEncoding = ConcreteDivision | AbstractDivision deriving (Show, Eq) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 116266db0..ce9535320 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -131,7 +131,6 @@ checkSatWithProps sg props = do let concreteKeccaks = fmap (\(buf,val) -> PEq (Lit val) (Keccak buf)) (toList $ Keccak.concreteKeccaks props) let allProps = if conf.simp then psSimp <> concreteKeccaks else psSimp if not conf.abstractArith then do - -- Original path: direct encoding with concrete division semantics let smt2 = assertProps conf allProps if isLeft smt2 then pure $ Error $ getError smt2 else liftIO $ checkSat sg (Just props) smt2 From f4d7fdf65b42b27f2c13897a1043ed461e08d7d9 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 18:01:02 +0100 Subject: [PATCH 012/150] Fix code repetition --- src/EVM/SMT.hs | 2 +- src/EVM/SMT/DivEncoding.hs | 12 ++++-------- src/EVM/SMT/Types.hs | 2 +- 3 files changed, 6 insertions(+), 10 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 3f42a9dad..cb4f1f700 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -507,7 +507,7 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> divOp "bvudiv" "evm_evm_div" a b + Div a b -> divOp "bvudiv" "abst_evm_div" a b SDiv a b -> sdivOp "abst_evm_sdiv" a b Mod a b -> divOp "bvurem" "abst_evm_mod" a b SMod a b -> smodOp "abst_evm_smod" a b diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index bc9780bc4..33ab1974f 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -23,7 +23,7 @@ import EVM.Types divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun evm_evm_div ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_div ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_sdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_mod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_smod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" @@ -44,7 +44,7 @@ divModBounds props = do where collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] collectBounds = \case - Div a b -> [("evm_evm_div", a, b)] + Div a b -> [("abst_evm_div", a, b)] Mod a b -> [("abst_evm_mod", a, b)] _ -> [] @@ -53,11 +53,7 @@ divModBounds props = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b let result = "(" <> fname `sp` aenc `sp` benc <> ")" - if fname == "evm_evm_div" - -- (x / y) <= x - then pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" - -- (x % y) <= y (ULE not ULT because y could be 0 and 0 % 0 = 0) - else pure $ SMTCommand $ "(assert (bvule " <> result `sp` benc <> "))" + pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" -- | Encode props using uninterpreted functions for div/mod (Phase 1 of two-phase solving) assertPropsAbstract :: Config -> [Prop] -> Err SMT2 @@ -192,7 +188,7 @@ divModGroundAxioms props = do mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b - let fname = if kind == UDiv then "evm_evm_div" else "abst_evm_mod" + let fname = if kind == UDiv then "abst_evm_div" else "abst_evm_mod" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero diff --git a/src/EVM/SMT/Types.hs b/src/EVM/SMT/Types.hs index 11fa3a7a8..70ec62003 100644 --- a/src/EVM/SMT/Types.hs +++ b/src/EVM/SMT/Types.hs @@ -13,7 +13,7 @@ type MaybeIO = MaybeT IO -- | Controls how division/modulo operations are encoded into SMT. -- 'ConcreteDivision' uses inline ite-check-zero with real SMT ops (existing behavior). --- 'AbstractDivision' uses uninterpreted functions (evm_evm_div, etc.) for performance. +-- 'AbstractDivision' uses uninterpreted functions (abst_evm_div, etc.) for performance. data DivEncoding = ConcreteDivision | AbstractDivision deriving (Show, Eq) From e60173a68ba7aa1a62e7272a9ee5fd36a33c61ef Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 18:41:52 +0100 Subject: [PATCH 013/150] Cleanup --- src/EVM/SMT.hs | 28 +++++------------------ src/EVM/SMT/Common.hs | 47 ++++++++++++++++++++++++++++++++++++++ src/EVM/SMT/DivEncoding.hs | 25 +++++--------------- 3 files changed, 59 insertions(+), 41 deletions(-) create mode 100644 src/EVM/SMT/Common.hs diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index cb4f1f700..bebea43a4 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -6,6 +6,7 @@ module EVM.SMT ( module EVM.SMT.Types, module EVM.SMT.SMTLIB, + module EVM.SMT.Common, collapse, getVar, @@ -17,9 +18,6 @@ module EVM.SMT exprToSMT, exprToSMTWith, encodeConcreteStore, - zero, - one, - sp, propToSMT, propToSMTWith, parseVar, @@ -69,6 +67,7 @@ import EVM.Keccak (keccakAssumptions, concreteKeccaks, findKeccakPropsExprs) import EVM.Traversals import EVM.Types import EVM.Effects +import EVM.SMT.Common import EVM.SMT.Types import EVM.SMT.SMTLIB @@ -633,12 +632,8 @@ exprToSMTWith enc = \case ConcreteDivision -> do aenc <- toSMT a benc <- toSMT b - let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" - absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" - udiv = "(bvudiv" `sp` absa `sp` absb <> ")" - sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" `sp` "(bvslt" `sp` benc `sp` zero <> "))" - pure $ "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` - "(ite" `sp` sameSign `sp` udiv `sp` "(bvsub" `sp` zero `sp` udiv <> ")))" + let udiv = "(bvudiv" `sp` smtAbs aenc `sp` smtAbs benc <> ")" + pure $ smtSdivResult aenc benc udiv -- | Encode SMod using bvurem with abs-value decomposition -- EVM SMOD: result has the sign of the dividend (a) smodOp :: Builder -> Expr x -> Expr y -> Err Builder @@ -647,20 +642,9 @@ exprToSMTWith enc = \case ConcreteDivision -> do aenc <- toSMT a benc <- toSMT b - let absa = "(ite (bvsge " <> aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" - absb = "(ite (bvsge " <> benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" - urem = "(bvurem" `sp` absa `sp` absb <> ")" - pure $ "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` - "(ite (bvsge" `sp` aenc `sp` zero <> ")" `sp` urem `sp` "(bvsub" `sp` zero `sp` urem <> ")))" + let urem = "(bvurem" `sp` smtAbs aenc `sp` smtAbs benc <> ")" + pure $ smtSmodResult aenc benc urem -sp :: Builder -> Builder -> Builder -a `sp` b = a <> (fromText " ") <> b - -zero :: Builder -zero = "(_ bv0 256)" - -one :: Builder -one = "(_ bv1 256)" propToSMT :: Prop -> Err Builder propToSMT = propToSMTWith ConcreteDivision diff --git a/src/EVM/SMT/Common.hs b/src/EVM/SMT/Common.hs new file mode 100644 index 000000000..490386058 --- /dev/null +++ b/src/EVM/SMT/Common.hs @@ -0,0 +1,47 @@ +module EVM.SMT.Common where + +import Data.Text.Lazy.Builder + +-- | Space-separated concatenation of two builders +sp :: Builder -> Builder -> Builder +a `sp` b = a <> " " <> b + +-- | Zero constant for 256-bit bitvectors +zero :: Builder +zero = "(_ bv0 256)" + +-- | One constant for 256-bit bitvectors +one :: Builder +one = "(_ bv1 256)" + +-- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) +smtAbs :: Builder -> Builder +smtAbs x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" + +-- | Encode negation: -x = (bvsub 0 x) +smtNeg :: Builder -> Builder +smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" + +-- | Check if two values have the same sign (both negative or both non-negative) +smtSameSign :: Builder -> Builder -> Builder +smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" + +-- | Check if value is non-negative: x >= 0 +smtIsNonNeg :: Builder -> Builder +smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" + +-- | Encode SDiv result given the unsigned division of absolute values. +-- SDiv semantics: result sign depends on whether operand signs match. +-- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) +smtSdivResult :: Builder -> Builder -> Builder -> Builder +smtSdivResult aenc benc udivResult = + "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` + "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> "))" + +-- | Encode SMod result given the unsigned remainder of absolute values. +-- SMod semantics: result sign matches the dividend (a). +-- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) +smtSmodResult :: Builder -> Builder -> Builder -> Builder +smtSmodResult aenc benc uremResult = + "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` + "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> "))" diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 33ab1974f..acac2b204 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -161,10 +161,8 @@ divModGroundAxioms props = do canonB = stripNeg firstB canonAenc <- exprToSMTAbs canonA canonBenc <- exprToSMTAbs canonB - let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" - `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" - absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" - `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" + let absAEnc = smtAbs canonAenc + absBEnc = smtAbs canonBenc coreEnc = if isDiv' then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" @@ -201,21 +199,10 @@ divModGroundAxioms props = do benc <- exprToSMTAbs b let fname = if kind == USDiv then "abst_evm_sdiv" else "abst_evm_smod" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - if kind == USDiv then do - -- SDiv: result sign depends on whether operand signs match - let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" - `sp` "(bvslt" `sp` benc `sp` zero <> "))" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite" `sp` sameSign `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - else do - -- SMod: result sign matches dividend - let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" - `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + concrete = if kind == USDiv + then smtSdivResult aenc benc coreName + else smtSmodResult aenc benc coreName + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | For each pair of signed groups with the same operation type (udiv/urem), -- emit a congruence lemma: if abs inputs are equal, results are equal. From df399c6662bab44d9db3bd49890ba81cce0e2375 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 18:58:48 +0100 Subject: [PATCH 014/150] Waaay cleaner setup --- test/contracts/fail/arith.sol | 24 ------- test/contracts/fail/math.sol | 18 ----- test/contracts/fail/signedArith.sol | 53 -------------- test/contracts/pass/arith.sol | 53 -------------- test/contracts/pass/math.sol | 17 ----- test/contracts/pass/signedArith.sol | 57 --------------- test/test.hs | 107 ++++++++++++++++++++++------ 7 files changed, 86 insertions(+), 243 deletions(-) delete mode 100644 test/contracts/fail/arith.sol delete mode 100644 test/contracts/fail/math.sol delete mode 100644 test/contracts/fail/signedArith.sol delete mode 100644 test/contracts/pass/arith.sol delete mode 100644 test/contracts/pass/math.sol delete mode 100644 test/contracts/pass/signedArith.sol diff --git a/test/contracts/fail/arith.sol b/test/contracts/fail/arith.sol deleted file mode 100644 index 133843004..000000000 --- a/test/contracts/fail/arith.sol +++ /dev/null @@ -1,24 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import {Test} from "forge-std/Test.sol"; - -/// Adapted from halmos tests/regression/test/Arith.t.sol -/// Division failure case: y == 0 is a valid counterexample -contract ArithFailTest is Test { - function unchecked_div(uint x, uint y) public pure returns (uint ret) { - assembly { - ret := div(x, y) - } - } - - function prove_Div_fail(uint x, uint y) public pure { - require(x > y); - - uint q = unchecked_div(x, y); - - // note: since x > y, q can be zero only when y == 0, - // due to the division-by-zero semantics in the EVM - assert(q != 0); // counterexample: y == 0 - } -} diff --git a/test/contracts/fail/math.sol b/test/contracts/fail/math.sol deleted file mode 100644 index 8361e777f..000000000 --- a/test/contracts/fail/math.sol +++ /dev/null @@ -1,18 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import {Test} from "forge-std/Test.sol"; - -/// Adapted from halmos tests/solver/test/Math.t.sol -/// Deposit/mint ratio test - counterexamples exist for mint case -contract MathFailTest is Test { - function prove_mint(uint s, uint A1, uint S1) public pure { - uint a = (s * A1) / S1; - - uint A2 = A1 + a; - uint S2 = S1 + s; - - // (A1 / S1 <= A2 / S2) - assert(A1 * S2 <= A2 * S1); // counterexamples exist - } -} diff --git a/test/contracts/fail/signedArith.sol b/test/contracts/fail/signedArith.sol deleted file mode 100644 index 4f11b7ae1..000000000 --- a/test/contracts/fail/signedArith.sol +++ /dev/null @@ -1,53 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import "forge-std/Test.sol"; - -/// Adapted from halmos tests/solver/test/SignedDiv.t.sol -/// Tests signed wadMul edge case (bad implementation - should find counterexample) -/// Counterexample: x = -1, y = type(int256).min - -interface WadMul { - function wadMul(int256 x, int256 y) external pure returns (int256); -} - -contract SolmateBadWadMul is WadMul { - function wadMul(int256 x, int256 y) public pure override returns (int256 r) { - assembly { - r := mul(x, y) - if iszero(or(iszero(x), eq(sdiv(r, x), y))) { revert(0, 0) } - r := sdiv(r, 1000000000000000000) - } - } -} - -contract SolidityWadMul is WadMul { - function wadMul(int256 x, int256 y) public pure override returns (int256) { - return (x * y) / 1e18; - } -} - -contract TestBadWadMul is Test { - WadMul wadMulImpl; - SolidityWadMul solidityWadMul; - - function setUp() public { - wadMulImpl = new SolmateBadWadMul(); - solidityWadMul = new SolidityWadMul(); - } - - function prove_wadMul_solEquivalent(int256 x, int256 y) external { - bytes memory encodedCall = abi.encodeWithSelector(WadMul.wadMul.selector, x, y); - - (bool succ1, bytes memory retbytes1) = address(solidityWadMul).call(encodedCall); - (bool succ2, bytes memory retbytes2) = address(wadMulImpl).call(encodedCall); - - assertEq(succ1, succ2); - - if (succ1 && succ2) { - int256 result1 = abi.decode(retbytes1, (int256)); - int256 result2 = abi.decode(retbytes2, (int256)); - assertEq(result1, result2); - } - } -} diff --git a/test/contracts/pass/arith.sol b/test/contracts/pass/arith.sol deleted file mode 100644 index 80129a494..000000000 --- a/test/contracts/pass/arith.sol +++ /dev/null @@ -1,53 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import {Test} from "forge-std/Test.sol"; - -/// Adapted from halmos tests/regression/test/Arith.t.sol -/// Tests division/modulo/exponentiation properties -contract ArithTest is Test { - function unchecked_div(uint x, uint y) public pure returns (uint ret) { - assembly { - ret := div(x, y) - } - } - - function unchecked_mod(uint x, uint y) public pure returns (uint ret) { - assembly { - ret := mod(x, y) - } - } - - function prove_Mod(uint x, uint y, address addr) public pure { - unchecked { - assert(unchecked_mod(x, 0) == 0); // compiler rejects `x % 0` - assert(x % 1 == 0); - assert(x % 2 < 2); - assert(x % 4 < 4); - - uint x_mod_y = unchecked_mod(x, y); - assert(x_mod_y <= y); - - assert(uint256(uint160(addr)) % (2**160) == uint256(uint160(addr))); - } - } - - function prove_Exp(uint x) public pure { - unchecked { - assert(x ** 0 == 1); // 0 ** 0 == 1 - assert(x ** 1 == x); - assert(x ** 2 == x * x); - assert((x ** 2) ** 2 == x * x * x * x); - assert(((x ** 2) ** 2) ** 2 == (x**2) * (x**2) * (x**2) * (x**2)); - } - } - - function prove_Div_pass(uint x, uint y) public pure { - require(x > y); - require(y > 0); - - uint q = unchecked_div(x, y); - - assert(q != 0); // pass - } -} diff --git a/test/contracts/pass/math.sol b/test/contracts/pass/math.sol deleted file mode 100644 index 5169a770d..000000000 --- a/test/contracts/pass/math.sol +++ /dev/null @@ -1,17 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import {Test} from "forge-std/Test.sol"; - -/// Adapted from halmos tests/solver/test/Math.t.sol -/// Tests average computation equivalence -contract MathTest is Test { - function prove_Avg(uint a, uint b) public pure { - require(a + b >= a); // no overflow - unchecked { - uint r1 = (a & b) + (a ^ b) / 2; - uint r2 = (a + b) / 2; - assert(r1 == r2); - } - } -} diff --git a/test/contracts/pass/signedArith.sol b/test/contracts/pass/signedArith.sol deleted file mode 100644 index f63c75bdb..000000000 --- a/test/contracts/pass/signedArith.sol +++ /dev/null @@ -1,57 +0,0 @@ -// SPDX-License-Identifier: AGPL-3.0 -pragma solidity >=0.8.0 <0.9.0; - -import "forge-std/Test.sol"; - -/// Adapted from halmos tests/solver/test/SignedDiv.t.sol -/// Tests signed wadMul equivalence (good implementation) - -interface WadMul { - function wadMul(int256 x, int256 y) external pure returns (int256); -} - -contract SolmateGoodWadMul is WadMul { - function wadMul(int256 x, int256 y) public pure override returns (int256 r) { - assembly { - r := mul(x, y) - if iszero( - and( - or(iszero(x), eq(sdiv(r, x), y)), - or(lt(x, not(0)), sgt(y, 0x8000000000000000000000000000000000000000000000000000000000000000)) - ) - ) { revert(0, 0) } - r := sdiv(r, 1000000000000000000) - } - } -} - -contract SolidityWadMul is WadMul { - function wadMul(int256 x, int256 y) public pure override returns (int256) { - return (x * y) / 1e18; - } -} - -contract TestGoodWadMul is Test { - WadMul wadMulImpl; - SolidityWadMul solidityWadMul; - - function setUp() public { - wadMulImpl = new SolmateGoodWadMul(); - solidityWadMul = new SolidityWadMul(); - } - - function prove_wadMul_solEquivalent(int256 x, int256 y) external { - bytes memory encodedCall = abi.encodeWithSelector(WadMul.wadMul.selector, x, y); - - (bool succ1, bytes memory retbytes1) = address(solidityWadMul).call(encodedCall); - (bool succ2, bytes memory retbytes2) = address(wadMulImpl).call(encodedCall); - - assertEq(succ1, succ2); - - if (succ1 && succ2) { - int256 result1 = abi.decode(retbytes1, (int256)); - int256 result2 = abi.decode(retbytes2, (int256)); - assertEq(result1, result2); - } - } -} diff --git a/test/test.hs b/test/test.hs index dc0f2f9a2..eaa13a545 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1220,13 +1220,6 @@ tests = testGroup "hevm" , ("test/contracts/pass/etch.sol", "prove_etch.*", (True, True)) , ("test/contracts/pass/etch.sol", "prove_deal.*", (True, True)) , ("test/contracts/fail/etchFail.sol", "prove_etch_fail.*", (False, True)) - -- halmos-adapted arith tests - , ("test/contracts/pass/arith.sol", "prove_Mod", (True, True)) - , ("test/contracts/pass/arith.sol", "prove_Exp", (True, True)) - , ("test/contracts/pass/arith.sol", "prove_Div_pass", (True, True)) - , ("test/contracts/fail/arith.sol", "prove_Div_fail", (False, True)) - , ("test/contracts/pass/math.sol", "prove_Avg", (True, True)) - , ("test/contracts/fail/math.sol", "prove_mint", (False, True)) ] forM_ cases $ \(testFile, match, expected) -> do actual <- runForgeTestCustom testFile match Nothing Nothing False Fetch.noRpc @@ -1289,20 +1282,92 @@ tests = testGroup "hevm" , testGroup "Abstract-Arith" -- Tests adapted from halmos (tests/regression/test/Arith.t.sol, tests/solver/test/SignedDiv.t.sol, tests/solver/test/Math.t.sol) -- Run with abstractArith = True to exercise two-phase solving - [ testAbstractArith "Arith-Pass" $ do - let testFile = "test/contracts/pass/arith.sol" - runForgeTest testFile "prove_Mod" >>= assertEqualM "prove_Mod" (True, True) - runForgeTest testFile "prove_Exp" >>= assertEqualM "prove_Exp" (True, True) - runForgeTest testFile "prove_Div_pass" >>= assertEqualM "prove_Div_pass" (True, True) - , testAbstractArith "Arith-Fail" $ do - let testFile = "test/contracts/fail/arith.sol" - runForgeTest testFile "prove_Div_fail" >>= assertEqualM "prove_Div_fail" (False, True) - , testAbstractArith "Math-Pass" $ do - let testFile = "test/contracts/pass/math.sol" - runForgeTest testFile "prove_Avg" >>= assertEqualM "prove_Avg" (True, True) - , testAbstractArith "Math-Fail" $ do - let testFile = "test/contracts/fail/math.sol" - runForgeTest testFile "prove_mint" >>= assertEqualM "prove_mint" (False, True) + [ testAbstractArith "arith-mod" $ do + Just c <- solcRuntime "C" [i| + contract C { + function unchecked_mod(uint x, uint y) internal pure returns (uint ret) { + assembly { ret := mod(x, y) } + } + function prove_Mod(uint x, uint y, address addr) external pure { + unchecked { + assert(unchecked_mod(x, 0) == 0); + assert(x % 1 == 0); + assert(x % 2 < 2); + assert(x % 4 < 4); + uint x_mod_y = unchecked_mod(x, y); + assert(x_mod_y <= y); + assert(uint256(uint160(addr)) % (2**160) == uint256(uint160(addr))); + } + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "arith-exp" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Exp(uint x) external pure { + unchecked { + assert(x ** 0 == 1); + assert(x ** 1 == x); + assert(x ** 2 == x * x); + assert((x ** 2) ** 2 == x * x * x * x); + assert(((x ** 2) ** 2) ** 2 == (x**2) * (x**2) * (x**2) * (x**2)); + } + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "arith-div-pass" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_pass(uint x, uint y) external pure { + require(x > y); + require(y > 0); + uint q; + assembly { q := div(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "arith-div-fail" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_fail(uint x, uint y) external pure { + require(x > y); + uint q; + assembly { q := div(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) + , testAbstractArith "math-avg" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Avg(uint a, uint b) external pure { + require(a + b >= a); + unchecked { + uint r1 = (a & b) + (a ^ b) / 2; + uint r2 = (a + b) / 2; + assert(r1 == r2); + } + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "math-mint-fail" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_mint(uint s, uint A1, uint S1) external pure { + uint a = (s * A1) / S1; + uint A2 = A1 + a; + uint S2 = S1 + s; + assert(A1 * S2 <= A2 * S1); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 81d2690f3b2590bb92b99dd3da50fffbf16da09e Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 9 Feb 2026 18:59:33 +0100 Subject: [PATCH 015/150] Update cabal --- hevm.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/hevm.cabal b/hevm.cabal index b80abce5e..b784b3bda 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -121,6 +121,7 @@ library EVM.Effects, other-modules: EVM.CheatsTH, + EVM.SMT.Common, EVM.SMT.DivEncoding, EVM.SMT.Types, EVM.SMT.SMTLIB, From e03cd05a1758c218d94223e9747e3d74d678a946 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 10:19:06 +0100 Subject: [PATCH 016/150] Less obvious comments --- src/EVM/SMT/Types.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/EVM/SMT/Types.hs b/src/EVM/SMT/Types.hs index 70ec62003..b69252d29 100644 --- a/src/EVM/SMT/Types.hs +++ b/src/EVM/SMT/Types.hs @@ -11,9 +11,6 @@ import EVM.Types type MaybeIO = MaybeT IO --- | Controls how division/modulo operations are encoded into SMT. --- 'ConcreteDivision' uses inline ite-check-zero with real SMT ops (existing behavior). --- 'AbstractDivision' uses uninterpreted functions (abst_evm_div, etc.) for performance. data DivEncoding = ConcreteDivision | AbstractDivision deriving (Show, Eq) From 1c48980beff6c13bdbfdea7220d8ebc366a0f424 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 10:28:52 +0100 Subject: [PATCH 017/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index acac2b204..55f6ec01f 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -55,30 +55,21 @@ divModBounds props = do let result = "(" <> fname `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" --- | Encode props using uninterpreted functions for div/mod (Phase 1 of two-phase solving) +-- | Phase 1: Encode props using uninterpreted functions for div/mod assertPropsAbstract :: Config -> [Prop] -> Err SMT2 assertPropsAbstract conf ps = do - let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + let mkBase simp = assertPropsHelperWith AbstractDivision simp divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) bounds <- divModBounds ps pure $ base <> SMT2 (SMTScript bounds) mempty mempty --- | Encode props using exact div/mod definitions (Phase 2 refinement). --- Keeps declare-fun (uninterpreted) for sharing, but adds ground-instance --- axioms with CSE'd bvudiv/bvurem intermediates. Signed division operations --- that differ only in divisor sign share the same bvudiv result since --- |x| = |-x|. +-- | Phase 2: Add ground-instance axioms for div/mod operations assertPropsRefined :: Config -> [Prop] -> Err SMT2 assertPropsRefined conf ps = do - let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls - base <- if not conf.simp then mkBase False ps - else mkBase True (decompose conf ps) - bounds <- divModBounds ps - axioms <- divModGroundAxioms ps - pure $ base - <> SMT2 (SMTScript bounds) mempty mempty - <> SMT2 (SMTScript axioms) mempty mempty + abst <- assertPropsAbstract conf ps + refine <- divModGroundAxioms ps + pure $ abst <> SMT2 (SMTScript refine) mempty mempty -- | Kind of division/modulo operation data DivOpKind = UDiv | USDiv | UMod | USMod From 1dad96c183a3c80bac7ee06956dcef7a46936150 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 10:38:52 +0100 Subject: [PATCH 018/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 55f6ec01f..127b294a5 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -71,17 +71,15 @@ assertPropsRefined conf ps = do refine <- divModGroundAxioms ps pure $ abst <> SMT2 (SMTScript refine) mempty mempty --- | Kind of division/modulo operation data DivOpKind = UDiv | USDiv | UMod | USMod deriving (Eq, Ord) --- We track (kind, dividend, divisor) type DivOp = (DivOpKind, Expr EWord, Expr EWord) --- | Canonical key for grouping operations that share the same bvudiv/bvurem core. --- For unsigned: (a, b, False, isMod) --- For signed: (canonicalAbs a, canonicalAbs b, True, isMod) where canonicalAbs normalizes negations -type AbsKey = (Expr EWord, Expr EWord, Bool, Bool) +data AbsKey + = UnsignedAbsKey (Expr EWord) (Expr EWord) Bool -- ^ (dividend, divisor, isMod) - raw operands + | SignedAbsKey (Expr EWord) (Expr EWord) Bool -- ^ (dividend, divisor, isMod) - canonicalAbs normalized + deriving (Eq, Ord) -- | Normalize an expression for absolute value canonicalization. -- |Sub(Lit 0, x)| = |x|, so we strip the negation wrapper. @@ -101,8 +99,8 @@ isMod _ = False absKey :: DivOp -> AbsKey absKey (kind, a, b) - | not (isSigned kind) = (a, b, False, isMod kind) -- unsigned: exact operands - | otherwise = (canonicalAbs a, canonicalAbs b, True, isMod kind) -- signed: normalize abs + | not (isSigned kind) = UnsignedAbsKey a b (isMod kind) + | otherwise = SignedAbsKey (canonicalAbs a) (canonicalAbs b) (isMod kind) -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: From c3112cd8e1a1db268db6f4da491d74fc2b037b70 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 10:42:52 +0100 Subject: [PATCH 019/150] Cleaner --- src/EVM/SMT/DivEncoding.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 127b294a5..ac80c5a70 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -97,6 +97,11 @@ isMod UMod = True isMod USMod = True isMod _ = False +isDiv :: DivOpKind -> Bool +isDiv UDiv = True +isDiv USDiv = True +isDiv _ = False + absKey :: DivOp -> AbsKey absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (isMod kind) @@ -134,7 +139,7 @@ divModGroundAxioms props = do mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] mkGroupAxioms _ [] = pure [] mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do - let isDiv' = not (isMod firstKind) + let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" coreName = fromString $ prefix <> "_" <> show groupIdx From 40bd88c7ddaf79699ffcc6621f420725e4d3c0d3 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 10:47:47 +0100 Subject: [PATCH 020/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index ac80c5a70..627079d1d 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -71,14 +71,17 @@ assertPropsRefined conf ps = do refine <- divModGroundAxioms ps pure $ abst <> SMT2 (SMTScript refine) mempty mempty +data DivModOp = IsDiv | IsMod + deriving (Eq, Ord) + data DivOpKind = UDiv | USDiv | UMod | USMod deriving (Eq, Ord) type DivOp = (DivOpKind, Expr EWord, Expr EWord) data AbsKey - = UnsignedAbsKey (Expr EWord) (Expr EWord) Bool -- ^ (dividend, divisor, isMod) - raw operands - | SignedAbsKey (Expr EWord) (Expr EWord) Bool -- ^ (dividend, divisor, isMod) - canonicalAbs normalized + = UnsignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - raw operands + | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - canonicalAbs normalized deriving (Eq, Ord) -- | Normalize an expression for absolute value canonicalization. @@ -92,20 +95,18 @@ isSigned USDiv = True isSigned USMod = True isSigned _ = False -isMod :: DivOpKind -> Bool -isMod UMod = True -isMod USMod = True -isMod _ = False - isDiv :: DivOpKind -> Bool isDiv UDiv = True isDiv USDiv = True isDiv _ = False +divModOp :: DivOpKind -> DivModOp +divModOp k = if isDiv k then IsDiv else IsMod + absKey :: DivOp -> AbsKey absKey (kind, a, b) - | not (isSigned kind) = UnsignedAbsKey a b (isMod kind) - | otherwise = SignedAbsKey (canonicalAbs a) (canonicalAbs b) (isMod kind) + | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) + | otherwise = SignedAbsKey (canonicalAbs a) (canonicalAbs b) (divModOp kind) -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: @@ -143,9 +144,7 @@ divModGroundAxioms props = do prefix = if isDiv' then "udiv" else "urem" coreName = fromString $ prefix <> "_" <> show groupIdx - if not (isSigned firstKind) then do - -- Unsigned: simple axioms, one bvudiv/bvurem per op (no abs-value needed) - mapM (mkUnsignedAxiom coreName) ops + if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do -- Signed: create shared intermediates for abs values and bvudiv/bvurem result let absAName = fromString $ "abs_a_" <> show groupIdx From d9c50894da63196bd79de3af39df9607035615bb Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 12:58:01 +0100 Subject: [PATCH 021/150] Cleanup --- src/EVM/SMT.hs | 1 - src/EVM/SMT/Common.hs | 14 ++++++++++---- src/EVM/SMT/DivEncoding.hs | 12 ++++-------- test/test.hs | 2 +- 4 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index bebea43a4..e6f9fae1c 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -6,7 +6,6 @@ module EVM.SMT ( module EVM.SMT.Types, module EVM.SMT.SMTLIB, - module EVM.SMT.Common, collapse, getVar, diff --git a/src/EVM/SMT/Common.hs b/src/EVM/SMT/Common.hs index 490386058..1032cf1ba 100644 --- a/src/EVM/SMT/Common.hs +++ b/src/EVM/SMT/Common.hs @@ -14,6 +14,12 @@ zero = "(_ bv0 256)" one :: Builder one = "(_ bv1 256)" +-- | Guard against division by zero: if divisor is zero return zero, else use the given result. +-- Produces: (ite (= divisor 0) 0 nonZeroResult) +smtZeroGuard :: Builder -> Builder -> Builder +smtZeroGuard divisor nonZeroResult = + "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" + -- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) smtAbs :: Builder -> Builder smtAbs x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" @@ -35,13 +41,13 @@ smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" -- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) smtSdivResult :: Builder -> Builder -> Builder -> Builder smtSdivResult aenc benc udivResult = - "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` - "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> "))" + smtZeroGuard benc $ + "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" -- | Encode SMod result given the unsigned remainder of absolute values. -- SMod semantics: result sign matches the dividend (a). -- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) smtSmodResult :: Builder -> Builder -> Builder -> Builder smtSmodResult aenc benc uremResult = - "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero `sp` - "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> "))" + smtZeroGuard benc $ + "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 627079d1d..bdecb9f86 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -17,6 +17,7 @@ import EVM.Effects import EVM.SMT import EVM.Traversals import EVM.Types +import EVM.SMT.Common -- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). @@ -146,7 +147,6 @@ divModGroundAxioms props = do if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do - -- Signed: create shared intermediates for abs values and bvudiv/bvurem result let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx -- Use the canonical (non-negated) form for abs value encoding @@ -156,11 +156,8 @@ divModGroundAxioms props = do canonBenc <- exprToSMTAbs canonB let absAEnc = smtAbs canonAenc absBEnc = smtAbs canonBenc - coreEnc = if isDiv' - then "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero - `sp` "(bvudiv" `sp` absAName `sp` absBName <> "))" - else "(ite (=" `sp` absBName `sp` zero <> ")" `sp` zero - `sp` "(bvurem" `sp` absAName `sp` absBName <> "))" + op = if isDiv' then "bvudiv" else "bvurem" + coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" @@ -182,8 +179,7 @@ divModGroundAxioms props = do let fname = if kind == UDiv then "abst_evm_div" else "abst_evm_mod" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(" <> op `sp` aenc `sp` benc <> "))" + concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry diff --git a/test/test.hs b/test/test.hs index eaa13a545..6c7c72d2e 100644 --- a/test/test.hs +++ b/test/test.hs @@ -54,7 +54,7 @@ import EVM.Fetch qualified as Fetch import EVM.Format (hexText) import EVM.Precompiled import EVM.RLP -import EVM.SMT hiding (one) +import EVM.SMT import EVM.Solidity import EVM.Solvers import EVM.Stepper qualified as Stepper From d1f53337799d8e2b44d70aa9acf5e6accc0c6dcb Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 13:06:42 +0100 Subject: [PATCH 022/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index bdecb9f86..8d2191b1a 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -118,8 +118,7 @@ divModGroundAxioms props = do let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props if null allDivs then pure [] else do - let groups = groupBy (\a b -> absKey a == absKey b) - $ sortBy (comparing absKey) allDivs + let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivs indexedGroups = zip [0..] groups entries <- concat <$> mapM (uncurry mkGroupAxioms) indexedGroups let links = mkCongruenceLinks indexedGroups @@ -196,23 +195,22 @@ divModGroundAxioms props = do -- | For each pair of signed groups with the same operation type (udiv/urem), -- emit a congruence lemma: if abs inputs are equal, results are equal. -- This is a sound tautology (function congruence for bvudiv/bvurem) that --- helps bitwuzla avoid independent reasoning about multiple bvudiv terms. +-- helps solvers avoid independent reasoning about multiple bvudiv terms. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups - , k == USDiv] -- SDiv groups - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups - , k == USMod] -- SMod groups + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USDiv] -- SDiv groups + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USMod] -- SMod groups in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] mkPairLinks prefix' ((i, _), (j, _)) = - let absAI = fromString $ "abs_a_" <> show i + let absAi = fromString $ "abs_a_" <> show i absBi = fromString $ "abs_b_" <> show i - absAJ = fromString $ "abs_a_" <> show j - absBJ = fromString $ "abs_b_" <> show j + absAj = fromString $ "abs_a_" <> show j + absBj = fromString $ "abs_b_" <> show j coreI = fromString $ prefix' <> "_" <> show i coreJ = fromString $ prefix' <> "_" <> show j - in [ SMTCommand $ "(assert (=> (and (=" `sp` absAI `sp` absAJ <> ") (=" - `sp` absBi `sp` absBJ <> ")) (=" `sp` coreI `sp` coreJ <> ")))" ] + in [ SMTCommand $ "(assert (=> " + <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" + <> "(=" `sp` coreI `sp` coreJ <> ")))" ] From d24dfddf1cadda19837cc8789ecb766482fac0fd Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 14:30:20 +0100 Subject: [PATCH 023/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 8d2191b1a..13ed380b4 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -200,7 +200,7 @@ mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USDiv] -- SDiv groups signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USMod] -- SMod groups - in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) + in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] From 755479549a18536871de0b780feccc14f053e0ed Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 14:32:38 +0100 Subject: [PATCH 024/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 13ed380b4..b0ae34c73 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -122,7 +122,7 @@ divModGroundAxioms props = do indexedGroups = zip [0..] groups entries <- concat <$> mapM (uncurry mkGroupAxioms) indexedGroups let links = mkCongruenceLinks indexedGroups - pure $ (SMTComment "division/modulo ground-instance axioms (CSE'd)") : entries <> links + pure $ (SMTComment "division/modulo ground-instance axioms") : entries <> links where collectDivOps :: forall a . Expr a -> [DivOp] collectDivOps = \case From ce537e1292a0768dafec37b76c92735a32d9a9ec Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 10 Feb 2026 14:41:45 +0100 Subject: [PATCH 025/150] Update --- src/EVM/SMT/DivEncoding.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index b0ae34c73..8cb61cbaa 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -9,7 +9,8 @@ module EVM.SMT.DivEncoding , assertPropsRefined ) where -import Data.List (nubBy, groupBy, sortBy) +import Data.Containers.ListUtils (nubOrd) +import Data.List (groupBy, sortBy) import Data.Ord (comparing) import Data.Text.Lazy.Builder @@ -115,7 +116,7 @@ absKey (kind, a, b) -- - axioms expressing each evm_bvXdiv call in terms of the shared result divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do - let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props + let allDivs = nubOrd $ concatMap (foldProp collect []) props if null allDivs then pure [] else do let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivs @@ -124,18 +125,14 @@ divModGroundAxioms props = do let links = mkCongruenceLinks indexedGroups pure $ (SMTComment "division/modulo ground-instance axioms") : entries <> links where - collectDivOps :: forall a . Expr a -> [DivOp] - collectDivOps = \case + collect :: forall a . Expr a -> [DivOp] + collect = \case Div a b -> [(UDiv, a, b)] SDiv a b -> [(USDiv, a, b)] Mod a b -> [(UMod, a, b)] SMod a b -> [(USMod, a, b)] _ -> [] - eqDivOp :: DivOp -> DivOp -> Bool - eqDivOp (k1, a1, b1) (k2, a2, b2) = - k1 == k2 && a1 == a2 && b1 == b2 - -- | Generate axioms for a group of ops sharing the same bvudiv/bvurem core. mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] mkGroupAxioms _ [] = pure [] From d20beebc9bc23a965cd3387fb4095415c4d5db25 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 11 Feb 2026 17:11:05 +0100 Subject: [PATCH 026/150] Cleanup --- src/EVM/SMT.hs | 64 +++++++++++++++++++++++++++++++++++++- src/EVM/SMT/Common.hs | 53 ------------------------------- src/EVM/SMT/DivEncoding.hs | 1 - 3 files changed, 63 insertions(+), 55 deletions(-) delete mode 100644 src/EVM/SMT/Common.hs diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index e6f9fae1c..617dab35c 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -17,6 +17,16 @@ module EVM.SMT exprToSMT, exprToSMTWith, encodeConcreteStore, + sp, + zero, + one, + smtZeroGuard, + smtAbs, + smtNeg, + smtSameSign, + smtIsNonNeg, + smtSdivResult, + smtSmodResult, propToSMT, propToSMTWith, parseVar, @@ -66,7 +76,6 @@ import EVM.Keccak (keccakAssumptions, concreteKeccaks, findKeccakPropsExprs) import EVM.Traversals import EVM.Types import EVM.Effects -import EVM.SMT.Common import EVM.SMT.Types import EVM.SMT.SMTLIB @@ -645,6 +654,59 @@ exprToSMTWith enc = \case pure $ smtSmodResult aenc benc urem +-- ** SMT builder helpers ** ----------------------------------------------------------------------- + +-- | Space-separated concatenation of two builders +sp :: Builder -> Builder -> Builder +a `sp` b = a <> " " <> b + +-- | Zero constant for 256-bit bitvectors +zero :: Builder +zero = "(_ bv0 256)" + +-- | One constant for 256-bit bitvectors +one :: Builder +one = "(_ bv1 256)" + +-- | Guard against division by zero: if divisor is zero return zero, else use the given result. +-- Produces: (ite (= divisor 0) 0 nonZeroResult) +smtZeroGuard :: Builder -> Builder -> Builder +smtZeroGuard divisor nonZeroResult = + "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" + +-- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) +smtAbs :: Builder -> Builder +smtAbs x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" + +-- | Encode negation: -x = (bvsub 0 x) +smtNeg :: Builder -> Builder +smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" + +-- | Check if two values have the same sign (both negative or both non-negative) +smtSameSign :: Builder -> Builder -> Builder +smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" + +-- | Check if value is non-negative: x >= 0 +smtIsNonNeg :: Builder -> Builder +smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" + +-- | Encode SDiv result given the unsigned division of absolute values. +-- SDiv semantics: result sign depends on whether operand signs match. +-- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) +smtSdivResult :: Builder -> Builder -> Builder -> Builder +smtSdivResult aenc benc udivResult = + smtZeroGuard benc $ + "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" + +-- | Encode SMod result given the unsigned remainder of absolute values. +-- SMod semantics: result sign matches the dividend (a). +-- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) +smtSmodResult :: Builder -> Builder -> Builder -> Builder +smtSmodResult aenc benc uremResult = + smtZeroGuard benc $ + "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" + + propToSMT :: Prop -> Err Builder propToSMT = propToSMTWith ConcreteDivision diff --git a/src/EVM/SMT/Common.hs b/src/EVM/SMT/Common.hs deleted file mode 100644 index 1032cf1ba..000000000 --- a/src/EVM/SMT/Common.hs +++ /dev/null @@ -1,53 +0,0 @@ -module EVM.SMT.Common where - -import Data.Text.Lazy.Builder - --- | Space-separated concatenation of two builders -sp :: Builder -> Builder -> Builder -a `sp` b = a <> " " <> b - --- | Zero constant for 256-bit bitvectors -zero :: Builder -zero = "(_ bv0 256)" - --- | One constant for 256-bit bitvectors -one :: Builder -one = "(_ bv1 256)" - --- | Guard against division by zero: if divisor is zero return zero, else use the given result. --- Produces: (ite (= divisor 0) 0 nonZeroResult) -smtZeroGuard :: Builder -> Builder -> Builder -smtZeroGuard divisor nonZeroResult = - "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" - --- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) -smtAbs :: Builder -> Builder -smtAbs x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" - --- | Encode negation: -x = (bvsub 0 x) -smtNeg :: Builder -> Builder -smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" - --- | Check if two values have the same sign (both negative or both non-negative) -smtSameSign :: Builder -> Builder -> Builder -smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" - --- | Check if value is non-negative: x >= 0 -smtIsNonNeg :: Builder -> Builder -smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" - --- | Encode SDiv result given the unsigned division of absolute values. --- SDiv semantics: result sign depends on whether operand signs match. --- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) -smtSdivResult :: Builder -> Builder -> Builder -> Builder -smtSdivResult aenc benc udivResult = - smtZeroGuard benc $ - "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" - --- | Encode SMod result given the unsigned remainder of absolute values. --- SMod semantics: result sign matches the dividend (a). --- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) -smtSmodResult :: Builder -> Builder -> Builder -> Builder -smtSmodResult aenc benc uremResult = - smtZeroGuard benc $ - "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 8cb61cbaa..319abb10d 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -18,7 +18,6 @@ import EVM.Effects import EVM.SMT import EVM.Traversals import EVM.Types -import EVM.SMT.Common -- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). From b07ee28eefc794b9379020cf90e1f2bc079e5a9c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 11 Feb 2026 17:26:06 +0100 Subject: [PATCH 027/150] Fixing --- src/EVM/SMT.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 617dab35c..c46327786 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -501,9 +501,9 @@ exprToSMTWith enc = \case cond <- op2 "=" a (Lit 0) pure $ "(ite " <> cond `sp` one `sp` zero <> ")" ITE c t f -> do - condEnc <- exprToSMT c - thenEnc <- exprToSMT t - elseEnc <- exprToSMT f + condEnc <- toSMT c + thenEnc <- toSMT t + elseEnc <- toSMT f pure $ "(ite (distinct " <> condEnc `sp` zero <> ") " <> thenEnc `sp` elseEnc <> ")" And a b -> op2 "bvand" a b Or a b -> op2 "bvor" a b From de827326e3714865b93715bdd36800e2b84f687e Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 11 Feb 2026 17:46:32 +0100 Subject: [PATCH 028/150] assertProps is now abst+axioms+refine --- src/EVM/Fetch.hs | 2 +- src/EVM/SMT.hs | 15 --------------- src/EVM/SMT/DivEncoding.hs | 33 ++++++++++++++++----------------- src/EVM/Solvers.hs | 2 +- test/test.hs | 1 + 5 files changed, 19 insertions(+), 34 deletions(-) diff --git a/src/EVM/Fetch.hs b/src/EVM/Fetch.hs index a72064044..98fd3c6a1 100644 --- a/src/EVM/Fetch.hs +++ b/src/EVM/Fetch.hs @@ -34,7 +34,7 @@ import EVM (initialContract, unknownContract) import EVM.ABI import EVM.FeeSchedule (feeSchedule) import EVM.Format (hexText) -import EVM.SMT +import EVM.SMT.DivEncoding import EVM.Solvers import EVM.Types hiding (ByteStringS) import EVM.Types (ByteStringS(..)) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index c46327786..cf7938a5a 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -11,7 +11,6 @@ module EVM.SMT getVar, formatSMT2, declareIntermediates, - assertProps, assertPropsHelperWith, decompose, exprToSMT, @@ -126,14 +125,6 @@ declareIntermediatesWith enc bufs stores = do storage <- exprToSMTWith enc expr pure [SMTCommand ("(define-fun store" <> (Data.Text.Lazy.Builder.Int.decimal n) <> " () Storage " <> storage <> ")")] --- simplify to rewrite sload/sstore combos --- notice: it is VERY important not to concretize early, because Keccak assumptions --- need unconcretized Props -assertProps :: Config -> [Prop] -> Err SMT2 -assertProps conf ps = - if not conf.simp then assertPropsHelper False ps - else assertPropsHelper True (decompose conf ps) - decompose :: Config -> [Prop] -> [Prop] decompose conf props = if conf.decomposeStorage && safeExprs && safeProps then fromMaybe props (mapM (mapPropM Expr.decomposeStorage) props) @@ -143,12 +134,6 @@ decompose conf props = if conf.decomposeStorage && safeExprs && safeProps safeExprs = all (isJust . mapPropM_ Expr.safeToDecompose) props safeProps = all Expr.safeToDecomposeProp props --- Note: we need a version that does NOT call simplify, --- because we make use of it to verify the correctness of our simplification --- passes through property-based testing. -assertPropsHelper :: Bool -> [Prop] -> Err SMT2 -assertPropsHelper simp = assertPropsHelperWith ConcreteDivision simp [] - assertPropsHelperWith :: DivEncoding -> Bool -> [SMTEntry] -> [Prop] -> Err SMT2 assertPropsHelperWith divEnc simp extraDecls psPreConc = do encs <- mapM (propToSMTWith divEnc) psElim diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 319abb10d..b7880e893 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -5,8 +5,8 @@ module EVM.SMT.DivEncoding ( divModAbstractDecls , divModBounds + , assertProps , assertPropsAbstract - , assertPropsRefined ) where import Data.Containers.ListUtils (nubOrd) @@ -19,6 +19,21 @@ import EVM.SMT import EVM.Traversals import EVM.Types +-- | Phase 1: Encode props using uninterpreted functions for div/mod +assertPropsAbstract :: Config -> [Prop] -> Err SMT2 +assertPropsAbstract conf ps = do + let mkBase simp = assertPropsHelperWith AbstractDivision simp divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) + bounds <- divModBounds ps + pure $ base <> SMT2 (SMTScript bounds) mempty mempty + +-- | Phase 2: Add ground-instance axioms for div/mod operations +assertProps :: Config -> [Prop] -> Err SMT2 +assertProps conf ps = do + abst <- assertPropsAbstract conf ps + refine <- divModGroundAxioms ps + pure $ abst <> SMT2 (SMTScript refine) mempty mempty -- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). divModAbstractDecls :: [SMTEntry] @@ -56,22 +71,6 @@ divModBounds props = do let result = "(" <> fname `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" --- | Phase 1: Encode props using uninterpreted functions for div/mod -assertPropsAbstract :: Config -> [Prop] -> Err SMT2 -assertPropsAbstract conf ps = do - let mkBase simp = assertPropsHelperWith AbstractDivision simp divModAbstractDecls - base <- if not conf.simp then mkBase False ps - else mkBase True (decompose conf ps) - bounds <- divModBounds ps - pure $ base <> SMT2 (SMTScript bounds) mempty mempty - --- | Phase 2: Add ground-instance axioms for div/mod operations -assertPropsRefined :: Config -> [Prop] -> Err SMT2 -assertPropsRefined conf ps = do - abst <- assertPropsAbstract conf ps - refine <- divModGroundAxioms ps - pure $ abst <> SMT2 (SMTScript refine) mempty mempty - data DivModOp = IsDiv | IsMod deriving (Eq, Ord) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index ce9535320..5bd7afc7d 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -146,7 +146,7 @@ checkSatWithProps sg props = do Cex _ -> do -- Phase 2: Refine with exact definitions to validate counterexample when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." - let smt2Refined = assertPropsRefined conf allProps + let smt2Refined = assertProps conf allProps if isLeft smt2Refined then pure $ Error $ getError smt2Refined else liftIO $ checkSat sg (Just props) smt2Refined diff --git a/test/test.hs b/test/test.hs index 6c7c72d2e..6e7f0e5b9 100644 --- a/test/test.hs +++ b/test/test.hs @@ -55,6 +55,7 @@ import EVM.Format (hexText) import EVM.Precompiled import EVM.RLP import EVM.SMT +import EVM.SMT.DivEncoding import EVM.Solidity import EVM.Solvers import EVM.Stepper qualified as Stepper From 3ad2715eddbe03b1bfa711cb1ae7214b7e867ad4 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 11:00:21 +0100 Subject: [PATCH 029/150] Update --- hevm.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/hevm.cabal b/hevm.cabal index b784b3bda..69ad61a5d 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -119,10 +119,9 @@ library EVM.UnitTest, EVM.Sign, EVM.Effects, + EVM.SMT.DivEncoding, other-modules: EVM.CheatsTH, - EVM.SMT.Common, - EVM.SMT.DivEncoding, EVM.SMT.Types, EVM.SMT.SMTLIB, Paths_hevm From 6816fc91a8b88726313ed87f22ee4637739330bc Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 11:29:45 +0100 Subject: [PATCH 030/150] Proper 2-phase --- src/EVM/SMT/DivEncoding.hs | 2 +- src/EVM/Solvers.hs | 69 ++++++++++++++++++++++++++------------ 2 files changed, 49 insertions(+), 22 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index b7880e893..49fe688fe 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -4,7 +4,7 @@ -} module EVM.SMT.DivEncoding ( divModAbstractDecls - , divModBounds + , divModGroundAxioms , assertProps , assertPropsAbstract ) where diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 5bd7afc7d..55df510ab 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -104,8 +104,9 @@ data MultiData = MultiData data SingleData = SingleData SMT2 - (Maybe [Prop]) - (Chan SMTResult) -- result channel + (Maybe SMTScript) -- refinement for two-phase solving, if abst-ref is used + (Maybe [Prop]) -- Props that generated the SMT2, if available. Used for caching + (Chan SMTResult) -- result channel -- returns True if a is a superset of any of the sets in bs supersetAny :: Set Prop -> [Set Prop] -> Bool @@ -138,17 +139,10 @@ checkSatWithProps sg props = do -- Two-phase solving with abstract division -- Phase 1: Use uninterpreted functions (overapproximation) let smt2Abstract = assertPropsAbstract conf allProps + let refinement = divModGroundAxioms allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract - else liftIO $ checkSat sg (Just props) smt2Abstract >>= \case - Qed -> pure Qed -- UNSAT with abstractions => truly UNSAT (sound) - e@(Error _) -> pure e - u@(Unknown _) -> pure u - Cex _ -> do - -- Phase 2: Refine with exact definitions to validate counterexample - when conf.debug $ liftIO $ putStrLn "Abstract div/mod: potential cex found, refining..." - let smt2Refined = assertProps conf allProps - if isLeft smt2Refined then pure $ Error $ getError smt2Refined - else liftIO $ checkSat sg (Just props) smt2Refined + else if isLeft refinement then pure $ Error $ getError refinement + else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (SMTScript (getNonError refinement)) -- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult @@ -158,7 +152,18 @@ checkSat (SolverGroup taskq) props smt2 = do -- prepare result channel resChan <- newChan -- send task to solver group - writeChan taskq (TaskSingle (SingleData (getNonError smt2) props resChan)) + writeChan taskq (TaskSingle (SingleData (getNonError smt2) Nothing props resChan)) + -- collect result + readChan resChan + +checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> SMTScript -> IO SMTResult +checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do + if isLeft smt2 then pure $ Error $ getError smt2 + else do + -- prepare result channel + resChan <- newChan + -- send task to solver group + writeChan taskq (TaskSingle (SingleData (getNonError smt2) (Just refinement) props resChan)) -- collect result readChan resChan @@ -196,13 +201,13 @@ withSolvers solver count timeout maxMemory cont = do Nothing -> do task <- liftIO $ readChan taskq case task of - TaskSingle (SingleData _ props r) | isJust props && supersetAny (fromList (fromJust props)) knownUnsat -> do + TaskSingle (SingleData _ _ props r) | isJust props && supersetAny (fromList (fromJust props)) knownUnsat -> do liftIO $ writeChan r Qed when conf.debug $ liftIO $ putStrLn " Qed found via cache!" orchestrate taskq cacheq sem knownUnsat fileCounter _ -> do runTask' <- case task of - TaskSingle (SingleData smt2 props r) -> toIO $ getOneSol solver timeout maxMemory smt2 props r cacheq sem fileCounter + TaskSingle (SingleData smt2 refinement props r) -> toIO $ getOneSol solver timeout maxMemory smt2 refinement props r cacheq sem fileCounter TaskMulti (MultiData smt2 multiSol r) -> toIO $ getMultiSol solver timeout maxMemory smt2 multiSol r sem fileCounter _ <- liftIO $ forkIO runTask' orchestrate taskq cacheq sem knownUnsat (fileCounter + 1) @@ -281,8 +286,8 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f ) ) -getOneSol :: (MonadIO m, ReadConfig m) => Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () -getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) props r cacheq sem fileCounter = do +getOneSol :: (MonadIO m, ReadConfig m) => Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe SMTScript -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () +getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r cacheq sem fileCounter = do conf <- readConfig liftIO $ bracket_ (waitQSem sem) @@ -308,10 +313,32 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) props r cacheq sem dumpUnsolved smt2 fileCounter conf.dumpUnsolved pure $ Unknown "Result unknown by SMT solver" "sat" -> do - mmodel <- getModel inst cexvars - case mmodel of - Just model -> pure $ Cex model - Nothing -> pure $ Unknown "Solver died while extracting model" + case refinement of + Just refScript -> do + when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." + outRef <- liftIO $ sendScript inst refScript + case outRef of + Left e -> pure $ Unknown $ "Error sending refinement: " <> T.unpack e + Right () -> do + sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" + case sat2 of + "unsat" -> do + -- UNSAT after refinement => UNSAT + when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) + pure Qed + "sat" -> do + mmodel <- getModel inst cexvars + case mmodel of + Just model -> pure $ Cex model + Nothing -> pure $ Unknown "Solver died while extracting model" + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> pure $ Unknown "Result unknown by SMT solver" + _ -> pure $ Unknown $ "Solver returned " <> T.unpack sat2 <> " after refinement" + Nothing -> do + mmodel <- getModel inst cexvars + case mmodel of + Just model -> pure $ Cex model + Nothing -> pure $ Unknown "Solver died while extracting model" _ -> let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) From 1f654ec07e4d0694790fba9b26832e4dca07628a Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 11:35:42 +0100 Subject: [PATCH 031/150] Cleanup --- src/EVM/Solvers.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 55df510ab..0af028a58 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -142,7 +142,7 @@ checkSatWithProps sg props = do let refinement = divModGroundAxioms allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement - else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (SMTScript (getNonError refinement)) + else liftIO $ checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) -- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult @@ -156,14 +156,12 @@ checkSat (SolverGroup taskq) props smt2 = do -- collect result readChan resChan -checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> SMTScript -> IO SMTResult +checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> SMT2 -> SMTScript -> IO SMTResult checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do - if isLeft smt2 then pure $ Error $ getError smt2 - else do -- prepare result channel resChan <- newChan -- send task to solver group - writeChan taskq (TaskSingle (SingleData (getNonError smt2) (Just refinement) props resChan)) + writeChan taskq (TaskSingle (SingleData smt2 (Just refinement) props resChan)) -- collect result readChan resChan From b20e92d37abb196461b4ec536eef579b3c134179 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 11:42:19 +0100 Subject: [PATCH 032/150] OK, now doing assertProps on its own as well --- src/EVM/SMT/DivEncoding.hs | 9 ++++----- src/EVM/Solvers.hs | 1 - 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 49fe688fe..75782b8c9 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -28,12 +28,11 @@ assertPropsAbstract conf ps = do bounds <- divModBounds ps pure $ base <> SMT2 (SMTScript bounds) mempty mempty --- | Phase 2: Add ground-instance axioms for div/mod operations + assertProps :: Config -> [Prop] -> Err SMT2 -assertProps conf ps = do - abst <- assertPropsAbstract conf ps - refine <- divModGroundAxioms ps - pure $ abst <> SMT2 (SMTScript refine) mempty mempty +assertProps conf ps = + if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps + else assertPropsHelperWith ConcreteDivision True [] (decompose conf ps) -- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). divModAbstractDecls :: [SMTEntry] diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 0af028a58..5ef5e4d39 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -144,7 +144,6 @@ checkSatWithProps sg props = do else if isLeft refinement then pure $ Error $ getError refinement else liftIO $ checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) --- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult checkSat (SolverGroup taskq) props smt2 = do if isLeft smt2 then pure $ Error $ getError smt2 From 51e93d186c256626759fda80232c44cc8e638025 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 11:43:10 +0100 Subject: [PATCH 033/150] Better comments --- src/EVM/Solvers.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 5ef5e4d39..3e3cc7222 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -136,8 +136,7 @@ checkSatWithProps sg props = do if isLeft smt2 then pure $ Error $ getError smt2 else liftIO $ checkSat sg (Just props) smt2 else do - -- Two-phase solving with abstract division - -- Phase 1: Use uninterpreted functions (overapproximation) + -- Two-phase solving with abstraction+refinement let smt2Abstract = assertPropsAbstract conf allProps let refinement = divModGroundAxioms allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract From e65f9844e9ddd7dcbcda4d789c58a29a5bd555f2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 12:08:05 +0100 Subject: [PATCH 034/150] No more exprToSMT --- src/EVM/SMT.hs | 44 +++++++++++++++++++++----------------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index cf7938a5a..f057ca8cf 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -13,7 +13,6 @@ module EVM.SMT declareIntermediates, assertPropsHelperWith, decompose, - exprToSMT, exprToSMTWith, encodeConcreteStore, sp, @@ -166,9 +165,9 @@ assertPropsHelperWith divEnc simp extraDecls psPreConc = do -- vars, frames, and block contexts in need of declaration allVars = fmap referencedVars toDeclarePsElim <> fmap referencedVars bufVals <> fmap referencedVars storeVals - frameCtx = fmap referencedFrameContext toDeclarePsElim <> fmap referencedFrameContext bufVals <> fmap referencedFrameContext storeVals + frameCtx = fmap (referencedFrameContext divEnc) toDeclarePsElim <> fmap (referencedFrameContext divEnc) bufVals <> fmap (referencedFrameContext divEnc) storeVals blockCtx = fmap referencedBlockContext toDeclarePsElim <> fmap referencedBlockContext bufVals <> fmap referencedBlockContext storeVals - gasOrder = enforceGasOrder psPreConc + gasOrder = enforceGasOrder divEnc psPreConc -- Buf, Storage, etc. declarations needed bufVals = Map.elems bufs @@ -227,16 +226,18 @@ referencedVars expr = nubOrd $ foldTerm go [] expr Var s -> [fromText s] _ -> [] -referencedFrameContext :: TraversableTerm a => a -> [(Builder, [Prop])] -referencedFrameContext expr = nubOrd $ foldTerm go [] expr +referencedFrameContext :: DivEncoding -> TraversableTerm a => a -> [(Builder, [Prop])] +referencedFrameContext enc expr = nubOrd $ foldTerm go [] expr where go :: Expr a -> [(Builder, [Prop])] go = \case - o@TxValue -> [(fromRight' $ exprToSMT o, [])] - o@(Balance _) -> [(fromRight' $ exprToSMT o, [PLT o (Lit $ 2 ^ (96 :: Int))])] - o@(Gas _ _) -> [(fromRight' $ exprToSMT o, [])] - o@(CodeHash (LitAddr _)) -> [(fromRight' $ exprToSMT o, [])] + o@TxValue -> [(fromRight' $ toSMT o, [])] + o@(Balance _) -> [(fromRight' $ toSMT o, [PLT o (Lit $ 2 ^ (96 :: Int))])] + o@(Gas _ _) -> [(fromRight' $ toSMT o, [])] + o@(CodeHash (LitAddr _)) -> [(fromRight' $ toSMT o, [])] _ -> [] + toSMT :: Expr x -> Err Builder + toSMT = exprToSMTWith enc referencedBlockContext :: TraversableTerm a => a -> [(Builder, [Prop])] referencedBlockContext expr = nubOrd $ foldTerm go [] expr @@ -360,14 +361,14 @@ declareConstrainAddrs names = SMT2 (SMTScript ([SMTComment "concrete and symboli -- The gas is a tuple of (prefix, index). Within each prefix, the gas is strictly decreasing as the -- index increases. This function gets a map of Prefix -> [Int], and for each prefix, -- enforces the order -enforceGasOrder :: [Prop] -> [SMTEntry] -enforceGasOrder ps = [SMTComment "gas ordering"] <> (concatMap (uncurry order) indices) +enforceGasOrder :: DivEncoding -> [Prop] -> [SMTEntry] +enforceGasOrder enc ps = [SMTComment "gas ordering"] <> (concatMap (uncurry order) indices) where order :: TS.Text -> [Int] -> [SMTEntry] order prefix n = consecutivePairs (nubInt n) >>= \(x, y)-> -- The GAS instruction itself costs gas, so it's strictly decreasing - [SMTCommand $ "(assert (bvugt " <> fromRight' (exprToSMT (Gas prefix x)) <> " " <> - fromRight' ((exprToSMT (Gas prefix y))) <> "))"] + [SMTCommand $ "(assert (bvugt " <> fromRight' (exprToSMTWith enc (Gas prefix x)) <> " " <> + fromRight' ((exprToSMTWith enc (Gas prefix y))) <> "))"] consecutivePairs :: [Int] -> [(Int, Int)] consecutivePairs [] = [] consecutivePairs l@(_:t) = zip l t @@ -418,9 +419,6 @@ wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" byteAsBV :: Word8 -> Builder byteAsBV b = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal b <> " 8)" -exprToSMT :: Expr a -> Err Builder -exprToSMT = exprToSMTWith ConcreteDivision - exprToSMTWith :: DivEncoding -> Expr a -> Err Builder exprToSMTWith enc = \case Lit w -> pure $ wordAsBV w @@ -584,7 +582,7 @@ exprToSMTWith enc = \case copySliceWith enc srcIdx dstIdx size srcSMT dstSMT -- we need to do a bit of processing here. - ConcreteStore s -> encodeConcreteStore s + ConcreteStore s -> encodeConcreteStore enc s AbstractStore a idx -> pure $ storeName a idx SStore idx val prev -> do encIdx <- toSMT idx @@ -790,13 +788,13 @@ writeBytesWith divEnc bytes buf = do where !idx' = idx + 1 -encodeConcreteStore :: Map W256 W256 -> Err Builder -encodeConcreteStore s = foldM encodeWrite ("((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000)") (Map.toList s) +encodeConcreteStore :: DivEncoding -> Map W256 W256 -> Err Builder +encodeConcreteStore enc s = foldM encodeWrite ("((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000)") (Map.toList s) where encodeWrite :: Builder -> (W256, W256) -> Err Builder encodeWrite prev (key, val) = do - encKey <- exprToSMT $ Lit key - encVal <- exprToSMT $ Lit val + encKey <- exprToSMTWith enc $ Lit key + encVal <- exprToSMTWith enc $ Lit val pure $ "(store " <> prev `sp` encKey `sp` encVal <> ")" storeName :: Expr EAddr -> Maybe W256 -> Builder @@ -971,8 +969,8 @@ getStore getVal (StorageReads innerMap) = do queryValue :: ValGetter -> Expr EWord -> MaybeIO W256 queryValue _ (Lit w) = pure w queryValue getVal w = do - -- this exprToSMT should never fail, since we have already ran the solver - let expr = toLazyText $ fromRight' $ exprToSMT w + -- this exprToSMTWith should never fail, since we have already ran the solver, in refined mode + let expr = toLazyText $ fromRight' $ exprToSMTWith ConcreteDivision w raw <- getVal expr hoistMaybe $ do valTxt <- extractValue raw From 6a55da85b0478ba4397d2224912c07f1781bd92d Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 12:15:00 +0100 Subject: [PATCH 035/150] Fixing testing --- test/test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/test.hs b/test/test.hs index 6e7f0e5b9..c14ab6c22 100644 --- a/test/test.hs +++ b/test/test.hs @@ -3975,7 +3975,7 @@ tests = testGroup "hevm" [ testCase "encodeConcreteStore-overwrite" $ assertEqual "" (pure "(store (store ((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000) (_ bv1 256) (_ bv2 256)) (_ bv3 256) (_ bv4 256))") - (EVM.SMT.encodeConcreteStore $ Map.fromList [(W256 1, W256 2), (W256 3, W256 4)]) + (EVM.SMT.encodeConcreteStore ConcreteDivision $ Map.fromList [(W256 1, W256 2), (W256 3, W256 4)]) ] , testGroup "calling-solvers" [ test "no-error-on-large-buf" $ do From c7e543fdb17d334af5b82162f7678a2b2b73eaee Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 12:38:55 +0100 Subject: [PATCH 036/150] Cleanup --- src/EVM/SMT.hs | 110 ++++++++++++++++++++++----------------------- src/EVM/Solvers.hs | 16 +++++-- 2 files changed, 66 insertions(+), 60 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index f057ca8cf..5a4a8695f 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -25,7 +25,6 @@ module EVM.SMT smtIsNonNeg, smtSdivResult, smtSmodResult, - propToSMT, propToSMTWith, parseVar, parseEAddr, @@ -441,23 +440,23 @@ exprToSMTWith enc = \case Mul a b -> op2 "bvmul" a b Exp a b -> case a of Lit 0 -> do - benc <- toSMT b + benc <- exprToSMT b pure $ "(ite (= " <> benc `sp` zero <> " ) " <> one `sp` zero <> ")" Lit 1 -> pure one Lit 2 -> do - benc <- toSMT b + benc <- exprToSMT b pure $ "(bvshl " <> one `sp` benc <> ")" _ -> case b of -- b is limited below, otherwise SMT query will be huge, and eventually Haskell stack overflows Lit b' | b' < 1000 -> expandExpWith enc a b' _ -> Left $ "Cannot encode symbolic exponent into SMT. Offending symbolic value: " <> show b Min a b -> do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b pure $ "(ite (bvule " <> aenc `sp` benc <> ") " <> aenc `sp` benc <> ")" Max a b -> do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b pure $ "(max " <> aenc `sp` benc <> ")" LT a b -> do cond <- op2 "bvult" a b @@ -484,9 +483,9 @@ exprToSMTWith enc = \case cond <- op2 "=" a (Lit 0) pure $ "(ite " <> cond `sp` one `sp` zero <> ")" ITE c t f -> do - condEnc <- toSMT c - thenEnc <- toSMT t - elseEnc <- toSMT f + condEnc <- exprToSMT c + thenEnc <- exprToSMT t + elseEnc <- exprToSMT f pure $ "(ite (distinct " <> condEnc `sp` zero <> ") " <> thenEnc `sp` elseEnc <> ")" And a b -> op2 "bvand" a b Or a b -> op2 "bvor" a b @@ -503,17 +502,17 @@ exprToSMTWith enc = \case SMod a b -> smodOp "abst_evm_smod" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do - aExp <- toSMT a - bExp <- toSMT b - cExp <- toSMT c + aExp <- exprToSMT a + bExp <- exprToSMT b + cExp <- exprToSMT c let aLift = "((_ zero_extend 256) " <> aExp <> ")" bLift = "((_ zero_extend 256) " <> bExp <> ")" cLift = "((_ zero_extend 256) " <> cExp <> ")" pure $ "(ite (= " <> cExp <> " (_ bv0 256)) (_ bv0 256) ((_ extract 255 0) (bvurem (bvmul " <> aLift `sp` bLift <> ")" <> cLift <> ")))" AddMod a b c -> do - aExp <- toSMT a - bExp <- toSMT b - cExp <- toSMT c + aExp <- exprToSMT a + bExp <- exprToSMT b + cExp <- exprToSMT c let aLift = "((_ zero_extend 1) " <> aExp <> ")" bLift = "((_ zero_extend 1) " <> bExp <> ")" cLift = "((_ zero_extend 1) " <> cExp <> ")" @@ -522,8 +521,8 @@ exprToSMTWith enc = \case cond <- op2 "=" a b pure $ "(ite " <> cond `sp` one `sp` zero <> ")" Keccak a -> do - e <- toSMT a - sz <- toSMT $ Expr.bufLength a + e <- exprToSMT a + sz <- exprToSMT $ Expr.bufLength a pure $ "(keccak " <> e <> " " <> sz <> ")" TxValue -> pure $ fromString "txvalue" @@ -531,10 +530,10 @@ exprToSMTWith enc = \case Origin -> pure "origin" BlockHash a -> do - e <- toSMT a + e <- exprToSMT a pure $ "(blockhash " <> e <> ")" CodeSize a -> do - e <- toSMT a + e <- exprToSMT a pure $ "(codesize " <> e <> ")" Coinbase -> pure "coinbase" Timestamp -> pure "timestamp" @@ -546,16 +545,16 @@ exprToSMTWith enc = \case a@(SymAddr _) -> pure $ formatEAddr a WAddr(a@(SymAddr _)) -> do - wa <- toSMT a + wa <- exprToSMT a pure $ "((_ zero_extend 96)" `sp` wa `sp` ")" LitByte b -> pure $ byteAsBV b IndexWord idx w -> case idx of Lit n -> if n >= 0 && n < 32 then do - e <- toSMT w + e <- exprToSMT w pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` e <> ")" - else toSMT (LitByte 0) + else exprToSMT (LitByte 0) _ -> op2 "indexWord" idx w ReadByte idx src -> op2 "select" src idx @@ -565,29 +564,29 @@ exprToSMTWith enc = \case ReadWord idx prev -> op2 "readWord" idx prev BufLength (AbstractBuf b) -> pure $ fromText b <> "_length" BufLength (GVar (BufVar n)) -> pure $ fromLazyText $ "buf" <> (T.pack . show $ n) <> "_length" - BufLength b -> toSMT (bufLength b) + BufLength b -> exprToSMT (bufLength b) WriteByte idx val prev -> do - encIdx <- toSMT idx - encVal <- toSMT val - encPrev <- toSMT prev + encIdx <- exprToSMT idx + encVal <- exprToSMT val + encPrev <- exprToSMT prev pure $ "(store " <> encPrev `sp` encIdx `sp` encVal <> ")" WriteWord idx val prev -> do - encIdx <- toSMT idx - encVal <- toSMT val - encPrev <- toSMT prev + encIdx <- exprToSMT idx + encVal <- exprToSMT val + encPrev <- exprToSMT prev pure $ "(writeWord " <> encIdx `sp` encVal `sp` encPrev <> ")" CopySlice srcIdx dstIdx size src dst -> do - srcSMT <- toSMT src - dstSMT <- toSMT dst + srcSMT <- exprToSMT src + dstSMT <- exprToSMT dst copySliceWith enc srcIdx dstIdx size srcSMT dstSMT -- we need to do a bit of processing here. ConcreteStore s -> encodeConcreteStore enc s AbstractStore a idx -> pure $ storeName a idx SStore idx val prev -> do - encIdx <- toSMT idx - encVal <- toSMT val - encPrev <- toSMT prev + encIdx <- exprToSMT idx + encVal <- exprToSMT val + encPrev <- exprToSMT prev pure $ "(store" `sp` encPrev `sp` encIdx `sp` encVal <> ")" SLoad idx store -> op2 "select" store idx LitAddr n -> pure $ fromLazyText $ "(_ bv" <> T.pack (show (into n :: Integer)) <> " 160)" @@ -596,21 +595,21 @@ exprToSMTWith enc = \case a -> internalError $ "TODO: implement: " <> show a where - toSMT :: Expr x -> Err Builder - toSMT = exprToSMTWith enc + exprToSMT :: Expr x -> Err Builder + exprToSMT = exprToSMTWith enc op1 :: Builder -> Expr x -> Err Builder op1 op a = do - e <- toSMT a + e <- exprToSMT a pure $ "(" <> op `sp` e <> ")" op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b pure $ "(" <> op `sp` aenc `sp` benc <> ")" op2CheckZero :: Builder -> Expr x -> Expr y -> Err Builder op2CheckZero op a b = do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" divOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder divOp concreteOp abstractOp a b = case enc of @@ -621,8 +620,8 @@ exprToSMTWith enc = \case sdivOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b ConcreteDivision -> do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b let udiv = "(bvudiv" `sp` smtAbs aenc `sp` smtAbs benc <> ")" pure $ smtSdivResult aenc benc udiv -- | Encode SMod using bvurem with abs-value decomposition @@ -631,8 +630,8 @@ exprToSMTWith enc = \case smodOp abstractOp a b = case enc of AbstractDivision -> op2 abstractOp a b ConcreteDivision -> do - aenc <- toSMT a - benc <- toSMT b + aenc <- exprToSMT a + benc <- exprToSMT b let urem = "(bvurem" `sp` smtAbs aenc `sp` smtAbs benc <> ")" pure $ smtSmodResult aenc benc urem @@ -690,9 +689,6 @@ smtSmodResult aenc benc uremResult = "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" -propToSMT :: Prop -> Err Builder -propToSMT = propToSMTWith ConcreteDivision - propToSMTWith :: DivEncoding -> Prop -> Err Builder propToSMTWith enc = \case PEq a b -> op2 "=" a b @@ -701,22 +697,24 @@ propToSMTWith enc = \case PLEq a b -> op2 "bvule" a b PGEq a b -> op2 "bvuge" a b PNeg a -> do - e <- propToSMTWith enc a + e <- propToSMT a pure $ "(not " <> e <> ")" PAnd a b -> do - aenc <- propToSMTWith enc a - benc <- propToSMTWith enc b + aenc <- propToSMT a + benc <- propToSMT b pure $ "(and " <> aenc <> " " <> benc <> ")" POr a b -> do - aenc <- propToSMTWith enc a - benc <- propToSMTWith enc b + aenc <- propToSMT a + benc <- propToSMT b pure $ "(or " <> aenc <> " " <> benc <> ")" PImpl a b -> do - aenc <- propToSMTWith enc a - benc <- propToSMTWith enc b + aenc <- propToSMT a + benc <- propToSMT b pure $ "(=> " <> aenc <> " " <> benc <> ")" PBool b -> pure $ if b then "true" else "false" where + propToSMT :: Prop -> Err Builder + propToSMT = propToSMTWith enc op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do aenc <- exprToSMTWith enc a diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 3e3cc7222..d538330d4 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -314,7 +314,9 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." outRef <- liftIO $ sendScript inst refScript case outRef of - Left e -> pure $ Unknown $ "Error sending refinement: " <> T.unpack e + Left e -> do + when conf.debug $ liftIO $ putStrLn $ " Error sending refinement: " <> T.unpack e + pure $ Unknown $ "Error sending refinement: " <> T.unpack e Right () -> do sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" case sat2 of @@ -326,7 +328,9 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r mmodel <- getModel inst cexvars case mmodel of Just model -> pure $ Cex model - Nothing -> pure $ Unknown "Solver died while extracting model" + Nothing -> do + when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + pure $ Unknown "Solver died while extracting model" "timeout" -> pure $ Unknown "Result timeout by SMT solver" "unknown" -> pure $ Unknown "Result unknown by SMT solver" _ -> pure $ Unknown $ "Solver returned " <> T.unpack sat2 <> " after refinement" @@ -334,14 +338,18 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r mmodel <- getModel inst cexvars case mmodel of Just model -> pure $ Cex model - Nothing -> pure $ Unknown "Solver died while extracting model" + Nothing -> do + when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + pure $ Unknown "Solver died while extracting model" _ -> let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) || ("not support" `T.isInfixOf` sat) in case supportIssue of True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat - False -> pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + False -> do + when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat + pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat writeChan r res ) ) From a9a86c8343e44fec68a039b99e204c5f9f5b4be5 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 12:50:10 +0100 Subject: [PATCH 037/150] Cleanup --- src/EVM/SMT.hs | 12 +++---- src/EVM/Solvers.hs | 90 ++++++++++++++++++++++------------------------ 2 files changed, 49 insertions(+), 53 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 5a4a8695f..9314bfdd4 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -230,13 +230,13 @@ referencedFrameContext enc expr = nubOrd $ foldTerm go [] expr where go :: Expr a -> [(Builder, [Prop])] go = \case - o@TxValue -> [(fromRight' $ toSMT o, [])] - o@(Balance _) -> [(fromRight' $ toSMT o, [PLT o (Lit $ 2 ^ (96 :: Int))])] - o@(Gas _ _) -> [(fromRight' $ toSMT o, [])] - o@(CodeHash (LitAddr _)) -> [(fromRight' $ toSMT o, [])] + o@TxValue -> [(fromRight' $ exprToSMT o, [])] + o@(Balance _) -> [(fromRight' $ exprToSMT o, [PLT o (Lit $ 2 ^ (96 :: Int))])] + o@(Gas _ _) -> [(fromRight' $ exprToSMT o, [])] + o@(CodeHash (LitAddr _)) -> [(fromRight' $ exprToSMT o, [])] _ -> [] - toSMT :: Expr x -> Err Builder - toSMT = exprToSMTWith enc + exprToSMT :: Expr x -> Err Builder + exprToSMT = exprToSMTWith enc referencedBlockContext :: TraversableTerm a => a -> [(Builder, [Prop])] referencedBlockContext expr = nubOrd $ foldTerm go [] expr diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index d538330d4..3729bbcbd 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -299,53 +299,49 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r Left e -> writeChan r (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) Right () -> do sat <- sendCommand inst $ SMTCommand "(check-sat)" - res <- do - case sat of - "unsat" -> do - when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) - pure Qed - "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved - pure $ Unknown "Result unknown by SMT solver" - "sat" -> do - case refinement of - Just refScript -> do - when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." - outRef <- liftIO $ sendScript inst refScript - case outRef of - Left e -> do - when conf.debug $ liftIO $ putStrLn $ " Error sending refinement: " <> T.unpack e - pure $ Unknown $ "Error sending refinement: " <> T.unpack e - Right () -> do - sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" - case sat2 of - "unsat" -> do - -- UNSAT after refinement => UNSAT - when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) - pure Qed - "sat" -> do - mmodel <- getModel inst cexvars - case mmodel of - Just model -> pure $ Cex model - Nothing -> do - when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." - pure $ Unknown "Solver died while extracting model" - "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> pure $ Unknown "Result unknown by SMT solver" - _ -> pure $ Unknown $ "Solver returned " <> T.unpack sat2 <> " after refinement" - Nothing -> do - mmodel <- getModel inst cexvars - case mmodel of - Just model -> pure $ Cex model - Nothing -> do - when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." - pure $ Unknown "Solver died while extracting model" - _ -> let supportIssue = - ("does not yet support" `T.isInfixOf` sat) - || ("unsupported" `T.isInfixOf` sat) - || ("not support" `T.isInfixOf` sat) - in case supportIssue of + res <- case sat of + "unsat" -> do + when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) + pure Qed + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> do + dumpUnsolved smt2 fileCounter conf.dumpUnsolved + pure $ Unknown "Result unknown by SMT solver" + "sat" -> case refinement of + Just refScript -> do + when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." + outRef <- liftIO $ sendScript inst refScript + case outRef of + Left e -> do + when conf.debug $ liftIO $ putStrLn $ " Error sending refinement: " <> T.unpack e + pure $ Unknown $ "Error sending refinement: " <> T.unpack e + Right () -> do + sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" + case sat2 of + "unsat" -> do + -- UNSAT after refinement => UNSAT + when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) + pure Qed + "sat" -> do + mmodel <- getModel inst cexvars + case mmodel of + Just model -> pure $ Cex model + Nothing -> do + when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + pure $ Unknown "Solver died while extracting model" + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> pure $ Unknown "Result unknown by SMT solver" + _ -> pure $ Unknown $ "Solver returned " <> T.unpack sat2 <> " after refinement" + Nothing -> getModel inst cexvars >>= \case + Just model -> pure $ Cex model + Nothing -> do + when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + pure $ Unknown "Solver died while extracting model" + _ -> let supportIssue = + ("does not yet support" `T.isInfixOf` sat) + || ("unsupported" `T.isInfixOf` sat) + || ("not support" `T.isInfixOf` sat) + in case supportIssue of True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat False -> do when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat From ae8fb7f0bfe8460d9bc4279559d5d392853e879a Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 12:57:22 +0100 Subject: [PATCH 038/150] Fixing --- src/EVM/Solvers.hs | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 3729bbcbd..0c7f932a2 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -303,10 +303,6 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r "unsat" -> do when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) pure Qed - "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved - pure $ Unknown "Result unknown by SMT solver" "sat" -> case refinement of Just refScript -> do when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." @@ -330,25 +326,31 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." pure $ Unknown "Solver died while extracting model" "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> pure $ Unknown "Result unknown by SMT solver" - _ -> pure $ Unknown $ "Solver returned " <> T.unpack sat2 <> " after refinement" + "unknown" -> do + dumpUnsolved smt2 fileCounter conf.dumpUnsolved + pure $ Unknown "Result unknown by SMT solver" + _ -> dealWithIssue conf sat2 Nothing -> getModel inst cexvars >>= \case Just model -> pure $ Cex model Nothing -> do when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." pure $ Unknown "Solver died while extracting model" - _ -> let supportIssue = - ("does not yet support" `T.isInfixOf` sat) - || ("unsupported" `T.isInfixOf` sat) - || ("not support" `T.isInfixOf` sat) - in case supportIssue of - True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat - False -> do - when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat - pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> do + dumpUnsolved smt2 fileCounter conf.dumpUnsolved + pure $ Unknown "Result unknown by SMT solver" + _ -> dealWithIssue conf sat writeChan r res ) ) + where + dealWithIssue conf sat = do + let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) || ("not support" `T.isInfixOf` sat) + case supportIssue of + True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat + False -> do + when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat + pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do From 0e6403b7155503fd050dbec6713dfe67a9fd0ca2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 13:06:30 +0100 Subject: [PATCH 039/150] Cleanup --- src/EVM/Solvers.hs | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 0c7f932a2..be0bf8b77 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -315,42 +315,38 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" case sat2 of "unsat" -> do - -- UNSAT after refinement => UNSAT when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) pure Qed - "sat" -> do - mmodel <- getModel inst cexvars - case mmodel of - Just model -> pure $ Cex model - Nothing -> do - when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." - pure $ Unknown "Solver died while extracting model" + "sat" -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved - pure $ Unknown "Result unknown by SMT solver" + "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf sat2 - Nothing -> getModel inst cexvars >>= \case - Just model -> pure $ Cex model - Nothing -> do - when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." - pure $ Unknown "Solver died while extracting model" + Nothing -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved - pure $ Unknown "Result unknown by SMT solver" + "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf sat writeChan r res ) ) where + dealWithUnknown conf = do + dumpUnsolved smt2 fileCounter conf.dumpUnsolved + when conf.debug $ liftIO $ putStrLn "Solver returned unknown result." + pure $ Unknown "Result unknown by SMT solver" + dealWithModel conf inst = getModel inst cexvars >>= \case + Just model -> pure $ Cex model + Nothing -> do + when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + pure $ Unknown "Solver died while extracting model" dealWithIssue conf sat = do - let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) || ("not support" `T.isInfixOf` sat) - case supportIssue of - True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat - False -> do - when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat - pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + let supportIssue = ("does not yet support" `T.isInfixOf` sat) + || ("unsupported" `T.isInfixOf` sat) + || ("not support" `T.isInfixOf` sat) + case supportIssue of + True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat + False -> do + when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat + pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do From 38eec420da9cc8993992014be67627dd3246d7bb Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 13:08:29 +0100 Subject: [PATCH 040/150] Less code --- src/EVM/Solvers.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index be0bf8b77..0be5d8094 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -300,9 +300,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r Right () -> do sat <- sendCommand inst $ SMTCommand "(check-sat)" res <- case sat of - "unsat" -> do - when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) - pure Qed + "unsat" -> dealWithUnsat "sat" -> case refinement of Just refScript -> do when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." @@ -314,9 +312,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r Right () -> do sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" case sat2 of - "unsat" -> do - when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) - pure Qed + "unsat" -> dealWithUnsat "sat" -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" "unknown" -> dealWithUnknown conf @@ -329,6 +325,9 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r ) ) where + dealWithUnsat = do + when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) + pure Qed dealWithUnknown conf = do dumpUnsolved smt2 fileCounter conf.dumpUnsolved when conf.debug $ liftIO $ putStrLn "Solver returned unknown result." From 8901ba66a4f0d918afee87d63941ecb5aa942a30 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 15:58:54 +0100 Subject: [PATCH 041/150] I think this is better --- src/EVM/Solvers.hs | 69 ++++++++++++++++++++++++---------------------- 1 file changed, 36 insertions(+), 33 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 0be5d8094..725daf677 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -22,7 +22,7 @@ import Prelude hiding (LT, GT) import GHC.Natural import GHC.IO.Handle (Handle, hFlush, hSetBuffering, BufferMode(..)) import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan) -import Control.Concurrent (forkIO, killThread) +import Control.Concurrent (forkIO, killThread, myThreadId) import Control.Concurrent.QSem (QSem, newQSem, waitQSem, signalQSem) import Control.Exception (bracket, bracket_, try, IOException) import Control.Concurrent.STM (writeTChan, newTChan, TChan, tryReadTChan, atomically) @@ -282,7 +282,8 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f ) ) -getOneSol :: (MonadIO m, ReadConfig m) => Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe SMTScript -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () +getOneSol :: forall m . (MonadIO m, ReadConfig m) => + Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe SMTScript -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r cacheq sem fileCounter = do conf <- readConfig liftIO $ bracket_ @@ -294,48 +295,47 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - out <- sendScript inst cmds - case out of - Left e -> writeChan r (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) - Right () -> do - sat <- sendCommand inst $ SMTCommand "(check-sat)" - res <- case sat of - "unsat" -> dealWithUnsat - "sat" -> case refinement of - Just refScript -> do - when conf.debug $ liftIO $ putStrLn " Phase 1 SAT, refining..." - outRef <- liftIO $ sendScript inst refScript - case outRef of - Left e -> do - when conf.debug $ liftIO $ putStrLn $ " Error sending refinement: " <> T.unpack e - pure $ Unknown $ "Error sending refinement: " <> T.unpack e - Right () -> do - sat2 <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" - case sat2 of - "unsat" -> dealWithUnsat - "sat" -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> dealWithUnknown conf - _ -> dealWithIssue conf sat2 - Nothing -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Result timeout by SMT solver" - "unknown" -> dealWithUnknown conf - _ -> dealWithIssue conf sat - writeChan r res + sendAndCheck inst cmds $ \res -> do + ret <- case res of + "unsat" -> dealWithUnsat + "sat" -> case refinement of + Just refScript -> do + when conf.debug $ logWithTid "Phase 1 SAT, refining..." + sendAndCheck inst refScript $ \sat2 -> do + ret2 <- case sat2 of + "unsat" -> dealWithUnsat + "sat" -> dealWithModel conf inst + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> dealWithUnknown conf + _ -> dealWithIssue conf sat2 + writeChan r ret2 + Nothing -> dealWithModel conf inst + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> dealWithUnknown conf + _ -> dealWithIssue conf res + writeChan r ret ) ) where + sendAndCheck :: SolverInstance -> SMTScript -> (Text -> IO ()) -> IO () + sendAndCheck inst dat cont = do + out <- liftIO $ sendScript inst dat + case out of + Left e -> liftIO $ writeChan r (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) + Right () -> do + res <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" + cont res dealWithUnsat = do when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) pure Qed dealWithUnknown conf = do dumpUnsolved smt2 fileCounter conf.dumpUnsolved - when conf.debug $ liftIO $ putStrLn "Solver returned unknown result." + when conf.debug $ logWithTid "Solver returned unknown result after" pure $ Unknown "Result unknown by SMT solver" dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model Nothing -> do - when conf.debug $ liftIO $ putStrLn "Solver died while extracting model." + when conf.debug $ logWithTid "Solver died while extracting model." pure $ Unknown "Solver died while extracting model" dealWithIssue conf sat = do let supportIssue = ("does not yet support" `T.isInfixOf` sat) @@ -344,8 +344,11 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r case supportIssue of True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat False -> do - when conf.debug $ liftIO $ putStrLn $ "Unexpected SMT solver response: " <> T.unpack sat + when conf.debug $ logWithTid $ "Unexpected SMT solver response: " <> T.unpack sat pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + logWithTid msg = do + tid <- liftIO myThreadId + liftIO $ putStrLn $ "[" <> show tid <> "] " <> msg dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do From 327fe2820dd0e7347bacf246af52c0fd433b669f Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 16:03:18 +0100 Subject: [PATCH 042/150] Fixing --- src/EVM/Solvers.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 725daf677..b11049e2f 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -295,33 +295,32 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - sendAndCheck inst cmds $ \res -> do - ret <- case res of + ret <- sendAndCheck inst cmds $ \res -> do + case res of "unsat" -> dealWithUnsat "sat" -> case refinement of Just refScript -> do when conf.debug $ logWithTid "Phase 1 SAT, refining..." sendAndCheck inst refScript $ \sat2 -> do - ret2 <- case sat2 of + case sat2 of "unsat" -> dealWithUnsat "sat" -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf sat2 - writeChan r ret2 Nothing -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf res - writeChan r ret + writeChan r ret ) ) where - sendAndCheck :: SolverInstance -> SMTScript -> (Text -> IO ()) -> IO () + sendAndCheck :: SolverInstance -> SMTScript -> (Text -> IO SMTResult) -> IO SMTResult sendAndCheck inst dat cont = do out <- liftIO $ sendScript inst dat case out of - Left e -> liftIO $ writeChan r (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) + Left e -> pure (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) Right () -> do res <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" cont res From 560dce39e266b4f74f272b1cb201efb3e94b0f36 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 17:05:52 +0100 Subject: [PATCH 043/150] Update --- src/EVM/Solvers.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index b11049e2f..971b7afef 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -329,7 +329,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r pure Qed dealWithUnknown conf = do dumpUnsolved smt2 fileCounter conf.dumpUnsolved - when conf.debug $ logWithTid "Solver returned unknown result after" + when conf.debug $ logWithTid "Solver returned unknown result" pure $ Unknown "Result unknown by SMT solver" dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model From 36b9b055797b12d8f524373ecd579efcb3981755 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 17:09:33 +0100 Subject: [PATCH 044/150] Cleanup --- src/EVM/Solvers.hs | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 971b7afef..92625866d 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -329,22 +329,28 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r pure Qed dealWithUnknown conf = do dumpUnsolved smt2 fileCounter conf.dumpUnsolved - when conf.debug $ logWithTid "Solver returned unknown result" - pure $ Unknown "Result unknown by SMT solver" + let txt = "SMT solver returned unknown (maybe it got killed?)" + when conf.debug $ logWithTid txt + pure $ Unknown txt dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model Nothing -> do - when conf.debug $ logWithTid "Solver died while extracting model." - pure $ Unknown "Solver died while extracting model" + let txt = "Solver died while extracting model." + when conf.debug $ logWithTid txt + pure $ Unknown txt dealWithIssue conf sat = do let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) || ("not support" `T.isInfixOf` sat) case supportIssue of - True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat + True -> do + let txt = "SMT solver reported unsupported operation: " <> T.unpack sat + when conf.debug $ logWithTid txt + pure $ Error txt False -> do - when conf.debug $ logWithTid $ "Unexpected SMT solver response: " <> T.unpack sat - pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + let txt = "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + when conf.debug $ logWithTid txt + pure $ Unknown txt logWithTid msg = do tid <- liftIO myThreadId liftIO $ putStrLn $ "[" <> show tid <> "] " <> msg From fd796b09ceb3e61c9960f488ec8d3a366ce1b476 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 17:13:43 +0100 Subject: [PATCH 045/150] Cleanup --- src/EVM/Solvers.hs | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 92625866d..261e29446 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -295,13 +295,13 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - ret <- sendAndCheck inst cmds $ \res -> do + ret <- sendAndCheck conf inst cmds $ \res -> do case res of "unsat" -> dealWithUnsat "sat" -> case refinement of Just refScript -> do when conf.debug $ logWithTid "Phase 1 SAT, refining..." - sendAndCheck inst refScript $ \sat2 -> do + sendAndCheck conf inst refScript $ \sat2 -> do case sat2 of "unsat" -> dealWithUnsat "sat" -> dealWithModel conf inst @@ -316,11 +316,10 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r ) ) where - sendAndCheck :: SolverInstance -> SMTScript -> (Text -> IO SMTResult) -> IO SMTResult - sendAndCheck inst dat cont = do + sendAndCheck conf inst dat cont = do out <- liftIO $ sendScript inst dat case out of - Left e -> pure (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) + Left e -> unknown conf $ "Issue while writing SMT to solver (maybe it got killed)?: " <> T.unpack e Right () -> do res <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" cont res @@ -329,15 +328,10 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r pure Qed dealWithUnknown conf = do dumpUnsolved smt2 fileCounter conf.dumpUnsolved - let txt = "SMT solver returned unknown (maybe it got killed?)" - when conf.debug $ logWithTid txt - pure $ Unknown txt + unknown conf "SMT solver returned unknown (maybe it got killed?)" dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model - Nothing -> do - let txt = "Solver died while extracting model." - when conf.debug $ logWithTid txt - pure $ Unknown txt + Nothing -> unknown conf "Solver died while extracting model." dealWithIssue conf sat = do let supportIssue = ("does not yet support" `T.isInfixOf` sat) || ("unsupported" `T.isInfixOf` sat) @@ -347,13 +341,13 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r let txt = "SMT solver reported unsupported operation: " <> T.unpack sat when conf.debug $ logWithTid txt pure $ Error txt - False -> do - let txt = "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat - when conf.debug $ logWithTid txt - pure $ Unknown txt + False -> unknown conf $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat logWithTid msg = do tid <- liftIO myThreadId liftIO $ putStrLn $ "[" <> show tid <> "] " <> msg + unknown conf msg = do + when conf.debug $ logWithTid msg + pure $ Unknown msg dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do From 4ef42ae21baa58e3846306d4879ab740695531b0 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Thu, 12 Feb 2026 17:57:33 +0100 Subject: [PATCH 046/150] Flush output buffer via traceM --- src/EVM/Solvers.hs | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 261e29446..c8f51698a 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -53,6 +53,7 @@ import EVM.Keccak qualified as Keccak (concreteKeccaks) import EVM.SMT import EVM.SMT.DivEncoding import EVM.Types +import Debug.Trace (traceM) -- In megabytes, i.e. 1GB @@ -270,7 +271,7 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - out <- sendScript inst cmds + out <- sendScript conf inst cmds case out of Left err -> do when conf.debug $ putStrLn $ "Issue while writing SMT to solver (maybe it got killed)?: " <> (T.unpack err) @@ -299,9 +300,9 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r case res of "unsat" -> dealWithUnsat "sat" -> case refinement of - Just refScript -> do - when conf.debug $ logWithTid "Phase 1 SAT, refining..." - sendAndCheck conf inst refScript $ \sat2 -> do + Just refine -> do + when conf.debug $ logWithTid "Phase 1 is SAT, refining..." + sendAndCheck conf inst refine $ \sat2 -> do case sat2 of "unsat" -> dealWithUnsat "sat" -> dealWithModel conf inst @@ -317,7 +318,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r ) where sendAndCheck conf inst dat cont = do - out <- liftIO $ sendScript inst dat + out <- liftIO $ sendScript conf inst dat case out of Left e -> unknown conf $ "Issue while writing SMT to solver (maybe it got killed)?: " <> T.unpack e Right () -> do @@ -344,7 +345,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r False -> unknown conf $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat logWithTid msg = do tid <- liftIO myThreadId - liftIO $ putStrLn $ "[" <> show tid <> "] " <> msg + traceM $ "[" <> show tid <> "] " <> msg unknown conf msg = do when conf.debug $ logWithTid msg pure $ Unknown msg @@ -537,8 +538,8 @@ stopSolver :: SolverInstance -> IO () stopSolver (SolverInstance _ stdin stdout process) = cleanupProcess (Just stdin, Just stdout, Nothing, process) -- | Sends a list of commands to the solver. Returns the first error, if there was one. -sendScript :: SolverInstance -> SMTScript -> IO (Either Text ()) -sendScript solver (SMTScript entries) = do +sendScript :: Config -> SolverInstance -> SMTScript -> IO (Either Text ()) +sendScript conf solver (SMTScript entries) = do go entries where go [] = pure $ Right () @@ -547,7 +548,9 @@ sendScript solver (SMTScript entries) = do out <- sendCommand solver c case out of "success" -> go cs - e -> pure $ Left $ "Solver returned an error:\n" <> e <> "\nwhile sending the following command: " <> toLazyText command + e -> do + when conf.debug $ putStrLn $ "Error while writing SMT to solver: " <> T.unpack e <> " -- Command was: " <> T.unpack (toLazyText command) + pure $ Left $ "Solver returned an error:\n" <> e <> "\nwhile sending the following command: " <> toLazyText command -- | Returns Nothing if the solver died or returned an error checkCommand :: SolverInstance -> SMTEntry -> IO (Maybe ()) From d6ed757d3c81bc899dd276a4d8c796764fe15b39 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 11:48:35 +0100 Subject: [PATCH 047/150] Making more progress --- src/EVM/SMT.hs | 8 +- src/EVM/SMT/DivEncoding.hs | 168 ++++++++++++++++++++++++++++++++++--- src/EVM/Solvers.hs | 17 +++- 3 files changed, 178 insertions(+), 15 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 9314bfdd4..209a5fa33 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -496,10 +496,10 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> divOp "bvudiv" "abst_evm_div" a b - SDiv a b -> sdivOp "abst_evm_sdiv" a b - Mod a b -> divOp "bvurem" "abst_evm_mod" a b - SMod a b -> smodOp "abst_evm_smod" a b + Div a b -> divOp "bvudiv" "abst_evm_bvudiv" a b + SDiv a b -> sdivOp "abst_evm_bvsdiv" a b + Mod a b -> divOp "bvurem" "abst_evm_bvurem" a b + SMod a b -> smodOp "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do aExp <- exprToSMT a diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 75782b8c9..7b37572bc 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -7,10 +7,12 @@ module EVM.SMT.DivEncoding , divModGroundAxioms , assertProps , assertPropsAbstract + , assertPropsShiftBounds ) where +import Data.Bits ((.&.), countTrailingZeros) import Data.Containers.ListUtils (nubOrd) -import Data.List (groupBy, sortBy) +import Data.List (groupBy, sortBy, nubBy) import Data.Ord (comparing) import Data.Text.Lazy.Builder @@ -38,10 +40,10 @@ assertProps conf ps = divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun abst_evm_div ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_sdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_mod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_smod ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] exprToSMTAbs :: Expr a -> Err Builder @@ -59,8 +61,8 @@ divModBounds props = do where collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] collectBounds = \case - Div a b -> [("abst_evm_div", a, b)] - Mod a b -> [("abst_evm_mod", a, b)] + Div a b -> [("abst_evm_bvudiv", a, b)] + Mod a b -> [("abst_evm_bvurem", a, b)] _ -> [] mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry @@ -110,7 +112,7 @@ absKey (kind, a, b) -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: -- - declare-const for abs_a, abs_b, and the bvudiv/bvurem result --- - axioms expressing each evm_bvXdiv call in terms of the shared result +-- - axioms expressing each abst_evm_bvXdiv call in terms of the shared result divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do let allDivs = nubOrd $ concatMap (foldProp collect []) props @@ -169,7 +171,7 @@ divModGroundAxioms props = do mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b - let fname = if kind == UDiv then "abst_evm_div" else "abst_evm_mod" + let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" @@ -179,7 +181,7 @@ divModGroundAxioms props = do mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTAbs a benc <- exprToSMTAbs b - let fname = if kind == USDiv then "abst_evm_sdiv" else "abst_evm_smod" + let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" concrete = if kind == USDiv then smtSdivResult aenc benc coreName @@ -208,3 +210,149 @@ mkCongruenceLinks indexedGroups = in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" <> "(=" `sp` coreI `sp` coreJ <> ")))" ] + + +-- | Encode props with shift-based quotient bounds instead of bvudiv. +-- When the dividend of a signed division has the form SHL(k, x), we know that +-- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): +-- if |y| >= 2^k then q <= bvlshr(|a|, k) +-- if |y| < 2^k then q >= bvlshr(|a|, k) +-- This avoids bvudiv entirely, which bitwuzla struggles with at 256 bits. +assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 +assertPropsShiftBounds conf ps = do + let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) + bounds <- divModBounds ps + axioms <- divModShiftBoundAxioms ps + pure $ base + <> SMT2 (SMTScript bounds) mempty mempty + <> SMT2 (SMTScript axioms) mempty mempty + +isMod :: DivOpKind -> Bool +isMod UMod = True +isMod USMod = True +isMod _ = False + +-- | Generate shift-based bound axioms (no bvudiv/bvurem). +-- For each group of signed div/mod ops, if the dividend has a SHL(k, _) structure, +-- generates bounds using bvlshr instead of bvudiv. +divModShiftBoundAxioms :: [Prop] -> Err [SMTEntry] +divModShiftBoundAxioms props = do + let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props + if null allDivs then pure [] + else do + let groups = groupBy (\a b -> absKey a == absKey b) + $ sortBy (comparing absKey) allDivs + indexedGroups = zip [0..] groups + entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups + let links = mkCongruenceLinks indexedGroups + pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links + where + collectDivOps :: forall a . Expr a -> [DivOp] + collectDivOps = \case + Div a b -> [(UDiv, a, b)] + SDiv a b -> [(USDiv, a, b)] + Mod a b -> [(UMod, a, b)] + SMod a b -> [(USMod, a, b)] + _ -> [] + + eqDivOp :: DivOp -> DivOp -> Bool + eqDivOp (k1, a1, b1) (k2, a2, b2) = + k1 == k2 && a1 == a2 && b1 == b2 + + -- | Extract shift amount from a dividend expression. + -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), + -- or if it is a literal that is an exact power of 2 (Lit 2^k). + extractShift :: Expr EWord -> Maybe Int + extractShift (SHL (Lit k) _) = Just (fromIntegral k) + extractShift (Sub (Lit 0) x) = extractShift x + extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (countTrailingZeros n) + extractShift _ = Nothing + + mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] + mkGroupShiftAxioms _ [] = pure [] + mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do + let isDiv' = not (isMod firstKind) + prefix = if isDiv' then "udiv" else "urem" + coreName = fromString $ prefix <> "_" <> show groupIdx + + if not (isSigned firstKind) then do + -- Unsigned: fall back to full bvudiv axiom (these are usually fast) + mapM (mkUnsignedAxiom coreName) ops + else do + let absAName = fromString $ "abs_a_" <> show groupIdx + absBName = fromString $ "abs_b_" <> show groupIdx + canonA = stripNeg firstA + canonB = stripNeg firstB + canonAenc <- exprToSMTWith AbstractDivision canonA + canonBenc <- exprToSMTWith AbstractDivision canonB + let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" + `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" + absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" + `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" + let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" + , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" + ] + -- Generate shift bounds or fall back to bvudiv + let shiftBounds = case (isDiv', extractShift canonA) of + (True, Just k) -> + let kLit = fromString $ show k + threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" + shifted = "(bvlshr" `sp` absAName `sp` "(_ bv" <> kLit <> " 256))" + in [ -- q = 0 when b = 0 + SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" + , -- q <= abs_a (always true) + SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + , -- if |b| >= 2^k then q <= |a| >> k + SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" + , -- if |b| < 2^k then q >= |a| >> k + SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" + ] + _ -> + -- No shift structure or it's a modulo op: use abstract bounds only. + -- This avoids bvudiv entirely, making the encoding an overapproximation. + -- Only UNSAT results are sound (checked by caller). + [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" + , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + ] + axioms <- mapM (mkSignedAxiom coreName) ops + pure $ decls <> shiftBounds <> axioms + + stripNeg :: Expr EWord -> Expr EWord + stripNeg (Sub (Lit 0) x) = x + stripNeg x = x + + mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkUnsignedAxiom _coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + op = if kind == UDiv then "bvudiv" else "bvurem" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(" <> op `sp` aenc `sp` benc <> "))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + + mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry + mkSignedAxiom coreName (kind, a, b) = do + aenc <- exprToSMTWith AbstractDivision a + benc <- exprToSMTWith AbstractDivision b + let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + if kind == USDiv then do + let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" + `sp` "(bvslt" `sp` benc `sp` zero <> "))" + concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite" `sp` sameSign `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + else do + let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero + `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" + `sp` coreName + `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index c8f51698a..b82a07b07 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -142,7 +142,22 @@ checkSatWithProps sg props = do let refinement = divModGroundAxioms allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement - else liftIO $ checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) + else liftIO $ do + ret <- checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) + case ret of + Cex cex -> do + when conf.debug $ traceM "Model from abstract query is not spurious, returning cex." + pure $ Cex cex + Qed -> do + when conf.debug $ traceM "Refinement successful, query is Qed." + pure Qed + Unknown msg -> do + when conf.debug $ traceM $ "Solver returned unknown during refinement phase: " <> msg + let withShiftBounds = assertPropsShiftBounds conf allProps + checkSat sg (Just props) withShiftBounds + Error msg -> do + when conf.debug $ traceM $ "Solver returned error during refinement phase: " <> msg + pure $ Error msg checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult checkSat (SolverGroup taskq) props smt2 = do From ce1bd7a612ebf18346a8bdea52ea849a96227b5c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:29:53 +0100 Subject: [PATCH 048/150] Rename --- src/EVM/SMT/DivEncoding.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 7b37572bc..33d5e73be 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -115,17 +115,17 @@ absKey (kind, a, b) -- - axioms expressing each abst_evm_bvXdiv call in terms of the shared result divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do - let allDivs = nubOrd $ concatMap (foldProp collect []) props - if null allDivs then pure [] + let allDivMods = nubOrd $ concatMap (foldProp collectDivMod []) props + if null allDivMods then pure [] else do - let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivs + let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivMods indexedGroups = zip [0..] groups entries <- concat <$> mapM (uncurry mkGroupAxioms) indexedGroups let links = mkCongruenceLinks indexedGroups pure $ (SMTComment "division/modulo ground-instance axioms") : entries <> links where - collect :: forall a . Expr a -> [DivOp] - collect = \case + collectDivMod :: forall a . Expr a -> [DivOp] + collectDivMod = \case Div a b -> [(UDiv, a, b)] SDiv a b -> [(USDiv, a, b)] Mod a b -> [(UMod, a, b)] From 2d72720d8c9f559fdd63e335408604e803dcf5f8 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:41:10 +0100 Subject: [PATCH 049/150] Cleaner code --- src/EVM/SMT/DivEncoding.hs | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 33d5e73be..162e9d719 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -145,8 +145,8 @@ divModGroundAxioms props = do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx -- Use the canonical (non-negated) form for abs value encoding - let canonA = stripNeg firstA - canonB = stripNeg firstB + let canonA = canonicalAbs firstA + canonB = canonicalAbs firstB canonAenc <- exprToSMTAbs canonA canonBenc <- exprToSMTAbs canonB let absAEnc = smtAbs canonAenc @@ -163,10 +163,6 @@ divModGroundAxioms props = do axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> axioms - stripNeg :: Expr EWord -> Expr EWord - stripNeg (Sub (Lit 0) x) = x - stripNeg x = x - mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbs a @@ -283,8 +279,8 @@ divModShiftBoundAxioms props = do else do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx - canonA = stripNeg firstA - canonB = stripNeg firstB + canonA = canonicalAbs firstA + canonB = canonicalAbs firstB canonAenc <- exprToSMTWith AbstractDivision canonA canonBenc <- exprToSMTWith AbstractDivision canonB let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" @@ -322,10 +318,6 @@ divModShiftBoundAxioms props = do axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> shiftBounds <> axioms - stripNeg :: Expr EWord -> Expr EWord - stripNeg (Sub (Lit 0) x) = x - stripNeg x = x - mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTWith AbstractDivision a From 0e25ff9e850e58dba3dabb66dba3ba444b59f4de Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:44:08 +0100 Subject: [PATCH 050/150] OK, let's try this? --- src/EVM/SMT/DivEncoding.hs | 73 ++++++++++++-------------------------- 1 file changed, 22 insertions(+), 51 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 162e9d719..5d1cfa68c 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -163,26 +163,28 @@ divModGroundAxioms props = do axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> axioms - mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkUnsignedAxiom _coreName (kind, a, b) = do - aenc <- exprToSMTAbs a - benc <- exprToSMTAbs b - let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == UDiv then "bvudiv" else "bvurem" - concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - - mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkSignedAxiom coreName (kind, a, b) = do - aenc <- exprToSMTAbs a - benc <- exprToSMTAbs b - let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - concrete = if kind == USDiv - then smtSdivResult aenc benc coreName - else smtSmodResult aenc benc coreName - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" +-- | Encode unsigned division/remainder axiom: abstract(a,b) = concrete(a,b) +mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry +mkUnsignedAxiom _coreName (kind, a, b) = do + aenc <- exprToSMTAbs a + benc <- exprToSMTAbs b + let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + op = if kind == UDiv then "bvudiv" else "bvurem" + concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" + +-- | Encode signed division/remainder axiom using absolute value core result +mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry +mkSignedAxiom coreName (kind, a, b) = do + aenc <- exprToSMTAbs a + benc <- exprToSMTAbs b + let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" + abstract = "(" <> fname `sp` aenc `sp` benc <> ")" + concrete = if kind == USDiv + then smtSdivResult aenc benc coreName + else smtSmodResult aenc benc coreName + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | For each pair of signed groups with the same operation type (udiv/urem), -- emit a congruence lemma: if abs inputs are equal, results are equal. @@ -317,34 +319,3 @@ divModShiftBoundAxioms props = do ] axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> shiftBounds <> axioms - - mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkUnsignedAxiom _coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b - let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == UDiv then "bvudiv" else "bvurem" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(" <> op `sp` aenc `sp` benc <> "))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - - mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry - mkSignedAxiom coreName (kind, a, b) = do - aenc <- exprToSMTWith AbstractDivision a - benc <- exprToSMTWith AbstractDivision b - let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - if kind == USDiv then do - let sameSign = "(=" `sp` "(bvslt" `sp` aenc `sp` zero <> ")" - `sp` "(bvslt" `sp` benc `sp` zero <> "))" - concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite" `sp` sameSign `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - else do - let concrete = "(ite (=" `sp` benc `sp` zero <> ")" `sp` zero - `sp` "(ite (bvsge" `sp` aenc `sp` zero <> ")" - `sp` coreName - `sp` "(bvsub" `sp` zero `sp` coreName <> ")))" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" From de03abf7d3e631d03597c0215f1f1ba01bc8a7e0 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:50:45 +0100 Subject: [PATCH 051/150] Remove nonsense comment --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 5d1cfa68c..3a17daa7d 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -215,7 +215,7 @@ mkCongruenceLinks indexedGroups = -- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): -- if |y| >= 2^k then q <= bvlshr(|a|, k) -- if |y| < 2^k then q >= bvlshr(|a|, k) --- This avoids bvudiv entirely, which bitwuzla struggles with at 256 bits. +-- This avoids bvudiv entirely assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 assertPropsShiftBounds conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls From 7a42090758b91fa09f8b34bfccf79163895b5bfc Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:53:58 +0100 Subject: [PATCH 052/150] Moving code lower --- src/EVM/SMT/DivEncoding.hs | 49 +++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 3a17daa7d..559e4cd60 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -186,30 +186,6 @@ mkSignedAxiom coreName (kind, a, b) = do else smtSmodResult aenc benc coreName pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | For each pair of signed groups with the same operation type (udiv/urem), --- emit a congruence lemma: if abs inputs are equal, results are equal. --- This is a sound tautology (function congruence for bvudiv/bvurem) that --- helps solvers avoid independent reasoning about multiple bvudiv terms. -mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] -mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USDiv] -- SDiv groups - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USMod] -- SMod groups - in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) - <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) - where - allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] - mkPairLinks prefix' ((i, _), (j, _)) = - let absAi = fromString $ "abs_a_" <> show i - absBi = fromString $ "abs_b_" <> show i - absAj = fromString $ "abs_a_" <> show j - absBj = fromString $ "abs_b_" <> show j - coreI = fromString $ prefix' <> "_" <> show i - coreJ = fromString $ prefix' <> "_" <> show j - in [ SMTCommand $ "(assert (=> " - <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" - <> "(=" `sp` coreI `sp` coreJ <> ")))" ] - - -- | Encode props with shift-based quotient bounds instead of bvudiv. -- When the dividend of a signed division has the form SHL(k, x), we know that -- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): @@ -319,3 +295,28 @@ divModShiftBoundAxioms props = do ] axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> shiftBounds <> axioms + +-- | For each pair of signed groups with the same operation type (udiv/urem), +-- emit a congruence lemma: if abs inputs are equal, results are equal. +-- This is a sound tautology (function congruence for bvudiv/bvurem) that +-- helps solvers avoid independent reasoning about multiple bvudiv terms. +mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] +mkCongruenceLinks indexedGroups = + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USDiv] -- SDiv groups + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USMod] -- SMod groups + in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) + <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) + where + allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] + mkPairLinks prefix' ((i, _), (j, _)) = + let absAi = fromString $ "abs_a_" <> show i + absBi = fromString $ "abs_b_" <> show i + absAj = fromString $ "abs_a_" <> show j + absBj = fromString $ "abs_b_" <> show j + coreI = fromString $ prefix' <> "_" <> show i + coreJ = fromString $ prefix' <> "_" <> show j + in [ SMTCommand $ "(assert (=> " + <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" + <> "(=" `sp` coreI `sp` coreJ <> ")))" ] + + From 96e098030aba850fe71ab0ba5b8ec264c332fc75 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 12:54:08 +0100 Subject: [PATCH 053/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 559e4cd60..669ed8f8c 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -318,5 +318,3 @@ mkCongruenceLinks indexedGroups = in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" <> "(=" `sp` coreI `sp` coreJ <> ")))" ] - - From cb15623f73cb2df91826a950ab45155b41a6838c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 16:41:08 +0100 Subject: [PATCH 054/150] None of this 1-K stuff, also correct Cex handing on 3rd phase --- src/EVM/SMT/DivEncoding.hs | 46 ++++++++++++++------------------------ src/EVM/Solvers.hs | 9 +++++++- 2 files changed, 25 insertions(+), 30 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 669ed8f8c..ca1db11ad 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -85,12 +85,6 @@ data AbsKey | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - canonicalAbs normalized deriving (Eq, Ord) --- | Normalize an expression for absolute value canonicalization. --- |Sub(Lit 0, x)| = |x|, so we strip the negation wrapper. -canonicalAbs :: Expr EWord -> Expr EWord -canonicalAbs (Sub (Lit 0) x) = x -canonicalAbs x = x - isSigned :: DivOpKind -> Bool isSigned USDiv = True isSigned USMod = True @@ -107,7 +101,7 @@ divModOp k = if isDiv k then IsDiv else IsMod absKey :: DivOp -> AbsKey absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) - | otherwise = SignedAbsKey (canonicalAbs a) (canonicalAbs b) (divModOp kind) + | otherwise = SignedAbsKey a b (divModOp kind) -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: @@ -144,13 +138,10 @@ divModGroundAxioms props = do else do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx - -- Use the canonical (non-negated) form for abs value encoding - let canonA = canonicalAbs firstA - canonB = canonicalAbs firstB - canonAenc <- exprToSMTAbs canonA - canonBenc <- exprToSMTAbs canonB - let absAEnc = smtAbs canonAenc - absBEnc = smtAbs canonBenc + aEnc <- exprToSMTAbs firstA + bEnc <- exprToSMTAbs firstB + let absAEnc = smtAbs aEnc + absBEnc = smtAbs bEnc op = if isDiv' then "bvudiv" else "bvurem" coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" @@ -198,10 +189,10 @@ assertPropsShiftBounds conf ps = do base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) bounds <- divModBounds ps - axioms <- divModShiftBoundAxioms ps + shiftBounds <- divModShiftBounds ps pure $ base <> SMT2 (SMTScript bounds) mempty mempty - <> SMT2 (SMTScript axioms) mempty mempty + <> SMT2 (SMTScript shiftBounds) mempty mempty isMod :: DivOpKind -> Bool isMod UMod = True @@ -211,8 +202,8 @@ isMod _ = False -- | Generate shift-based bound axioms (no bvudiv/bvurem). -- For each group of signed div/mod ops, if the dividend has a SHL(k, _) structure, -- generates bounds using bvlshr instead of bvudiv. -divModShiftBoundAxioms :: [Prop] -> Err [SMTEntry] -divModShiftBoundAxioms props = do +divModShiftBounds :: [Prop] -> Err [SMTEntry] +divModShiftBounds props = do let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props if null allDivs then pure [] else do @@ -238,10 +229,9 @@ divModShiftBoundAxioms props = do -- | Extract shift amount from a dividend expression. -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), -- or if it is a literal that is an exact power of 2 (Lit 2^k). - extractShift :: Expr EWord -> Maybe Int - extractShift (SHL (Lit k) _) = Just (fromIntegral k) - extractShift (Sub (Lit 0) x) = extractShift x - extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (countTrailingZeros n) + extractShift :: Expr EWord -> Maybe W256 + extractShift (SHL (Lit k) _) = Just k + extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (fromIntegral $ countTrailingZeros n) extractShift _ = Nothing mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] @@ -257,10 +247,8 @@ divModShiftBoundAxioms props = do else do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx - canonA = canonicalAbs firstA - canonB = canonicalAbs firstB - canonAenc <- exprToSMTWith AbstractDivision canonA - canonBenc <- exprToSMTWith AbstractDivision canonB + canonAenc <- exprToSMTWith AbstractDivision firstA + canonBenc <- exprToSMTWith AbstractDivision firstB let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" @@ -272,7 +260,7 @@ divModShiftBoundAxioms props = do , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" ] -- Generate shift bounds or fall back to bvudiv - let shiftBounds = case (isDiv', extractShift canonA) of + let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> let kLit = fromString $ show k threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" @@ -283,8 +271,8 @@ divModShiftBoundAxioms props = do SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" , -- if |b| >= 2^k then q <= |a| >> k SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" - , -- if |b| < 2^k then q >= |a| >> k - SMTCommand $ "(assert (=> (bvult" `sp` absBName `sp` threshold <> ") (bvuge" `sp` coreName `sp` shifted <> ")))" + , -- if 0 < |b| < 2^k then q >= |a| >> k + SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` coreName `sp` shifted <> ")))" ] _ -> -- No shift structure or it's a modulo op: use abstract bounds only. diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index b82a07b07..3d982701c 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -154,7 +154,14 @@ checkSatWithProps sg props = do Unknown msg -> do when conf.debug $ traceM $ "Solver returned unknown during refinement phase: " <> msg let withShiftBounds = assertPropsShiftBounds conf allProps - checkSat sg (Just props) withShiftBounds + checkSat sg (Just props) withShiftBounds >>= \case + Qed -> do + when conf.debug $ traceM "Refinement with shift bounds successful, query is Qed." + pure Qed + Error msg2 -> do + when conf.debug $ traceM $ "Solver returned error during refinement with shift bounds: " <> msg2 + pure $ Error msg2 + _ -> pure ret -- can't trust Cex here, return old value Error msg -> do when conf.debug $ traceM $ "Solver returned error during refinement phase: " <> msg pure $ Error msg From 3cb47e0bde04d74570427f40d4058f22b37fa1c5 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 16:53:46 +0100 Subject: [PATCH 055/150] Maybe cleaner --- src/EVM/SMT.hs | 3 ++- src/EVM/SMT/DivEncoding.hs | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 209a5fa33..06195c204 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -34,7 +34,8 @@ module EVM.SMT getVars, queryMaxReads, getBufs, - getStore + getStore, + wordAsBV ) where import Prelude hiding (LT, GT, Foldable(..)) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index ca1db11ad..fdeb80b28 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -262,9 +262,9 @@ divModShiftBounds props = do -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> - let kLit = fromString $ show k - threshold = "(bvshl (_ bv1 256) (_ bv" <> kLit <> " 256))" - shifted = "(bvlshr" `sp` absAName `sp` "(_ bv" <> kLit <> " 256))" + let kLit = wordAsBV k + threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" + shifted = "(bvlshr" `sp` absAName <> " " <> kLit <> ")" in [ -- q = 0 when b = 0 SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" , -- q <= abs_a (always true) From a2bf7f1df024fb103bfdf71117bf4b605da7dee2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 16:59:24 +0100 Subject: [PATCH 056/150] Rename --- src/EVM/SMT/DivEncoding.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index fdeb80b28..cb144244b 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -46,8 +46,8 @@ divModAbstractDecls = , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] -exprToSMTAbs :: Expr a -> Err Builder -exprToSMTAbs = exprToSMTWith AbstractDivision +exprToSMTAbst :: Expr a -> Err Builder +exprToSMTAbst = exprToSMTWith AbstractDivision -- | Generate bounds constraints for abstract div/mod operations. -- These help the solver prune impossible models without full bitvector division reasoning. @@ -67,8 +67,8 @@ divModBounds props = do mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry mkAssertion (fname, a, b) = do - aenc <- exprToSMTAbs a - benc <- exprToSMTAbs b + aenc <- exprToSMTAbst a + benc <- exprToSMTAbst b let result = "(" <> fname `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" @@ -138,10 +138,10 @@ divModGroundAxioms props = do else do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx - aEnc <- exprToSMTAbs firstA - bEnc <- exprToSMTAbs firstB - let absAEnc = smtAbs aEnc - absBEnc = smtAbs bEnc + aEnc <- exprToSMTAbst firstA + bEnc <- exprToSMTAbst firstB + let absAEnc = smtAbsolute aEnc + absBEnc = smtAbsolute bEnc op = if isDiv' then "bvudiv" else "bvurem" coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" @@ -157,8 +157,8 @@ divModGroundAxioms props = do -- | Encode unsigned division/remainder axiom: abstract(a,b) = concrete(a,b) mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do - aenc <- exprToSMTAbs a - benc <- exprToSMTAbs b + aenc <- exprToSMTAbst a + benc <- exprToSMTAbst b let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" op = if kind == UDiv then "bvudiv" else "bvurem" @@ -168,8 +168,8 @@ mkUnsignedAxiom _coreName (kind, a, b) = do -- | Encode signed division/remainder axiom using absolute value core result mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom coreName (kind, a, b) = do - aenc <- exprToSMTAbs a - benc <- exprToSMTAbs b + aenc <- exprToSMTAbst a + benc <- exprToSMTAbst b let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" concrete = if kind == USDiv From 52edee676faaeb5fa7daa96445f978f99f13a12c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:02:30 +0100 Subject: [PATCH 057/150] Better naming --- src/EVM/SMT.hs | 10 +++++----- src/EVM/SMT/DivEncoding.hs | 3 ++- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 06195c204..88f5a0037 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -19,7 +19,7 @@ module EVM.SMT zero, one, smtZeroGuard, - smtAbs, + smtAbsolute, smtNeg, smtSameSign, smtIsNonNeg, @@ -623,7 +623,7 @@ exprToSMTWith enc = \case ConcreteDivision -> do aenc <- exprToSMT a benc <- exprToSMT b - let udiv = "(bvudiv" `sp` smtAbs aenc `sp` smtAbs benc <> ")" + let udiv = "(bvudiv" `sp` smtAbsolute aenc `sp` smtAbsolute benc <> ")" pure $ smtSdivResult aenc benc udiv -- | Encode SMod using bvurem with abs-value decomposition -- EVM SMOD: result has the sign of the dividend (a) @@ -633,7 +633,7 @@ exprToSMTWith enc = \case ConcreteDivision -> do aenc <- exprToSMT a benc <- exprToSMT b - let urem = "(bvurem" `sp` smtAbs aenc `sp` smtAbs benc <> ")" + let urem = "(bvurem" `sp` smtAbsolute aenc `sp` smtAbsolute benc <> ")" pure $ smtSmodResult aenc benc urem @@ -658,8 +658,8 @@ smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" -- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) -smtAbs :: Builder -> Builder -smtAbs x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" +smtAbsolute :: Builder -> Builder +smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" -- | Encode negation: -x = (bvsub 0 x) smtNeg :: Builder -> Builder diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index cb144244b..54960ff77 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -134,7 +134,8 @@ divModGroundAxioms props = do prefix = if isDiv' then "udiv" else "urem" coreName = fromString $ prefix <> "_" <> show groupIdx - if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops + if not (isSigned firstKind) + then mapM (mkUnsignedAxiom coreName) ops else do let absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx From cd5333f275ecb48940ef72a4fa41cc538539f93c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:18:02 +0100 Subject: [PATCH 058/150] More cleanup --- src/EVM/SMT/DivEncoding.hs | 63 ++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 29 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 54960ff77..91a2e9583 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -82,7 +82,7 @@ type DivOp = (DivOpKind, Expr EWord, Expr EWord) data AbsKey = UnsignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - raw operands - | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - canonicalAbs normalized + | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - absolute values deriving (Eq, Ord) isSigned :: DivOpKind -> Bool @@ -103,6 +103,19 @@ absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) | otherwise = SignedAbsKey a b (divModOp kind) +-- | Helper to generate common declarations for abs_a, abs_b, and core result. +mkDivModDecls :: Int -> Builder -> Builder -> Builder -> Err ([SMTEntry], (Builder, Builder)) +mkDivModDecls groupIdx absAEnc absBEnc coreName = do + let absAName = fromString $ "abs_a_" <> show groupIdx + absBName = fromString $ "abs_b_" <> show groupIdx + let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" + , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" + ] + pure (decls, (absAName, absBName)) + -- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: -- - declare-const for abs_a, abs_b, and the bvudiv/bvurem result @@ -137,23 +150,20 @@ divModGroundAxioms props = do if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do - let absAName = fromString $ "abs_a_" <> show groupIdx - absBName = fromString $ "abs_b_" <> show groupIdx - aEnc <- exprToSMTAbst firstA - bEnc <- exprToSMTAbst firstB - let absAEnc = smtAbsolute aEnc - absBEnc = smtAbsolute bEnc + aenc <- exprToSMTAbst firstA + benc <- exprToSMTAbst firstB + let absAEnc = smtAbsolute aenc + absBEnc = smtAbsolute benc op = if isDiv' then "bvudiv" else "bvurem" + absAName = fromString $ "abs_a_" <> show groupIdx + absBName = fromString $ "abs_b_" <> show groupIdx coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" - let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" - , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" - , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" - , SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" - ] + + (decls, _) <- mkDivModDecls groupIdx absAEnc absBEnc coreName + + let coreAssert = SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" axioms <- mapM (mkSignedAxiom coreName) ops - pure $ decls <> axioms + pure $ decls <> [coreAssert] <> axioms -- | Encode unsigned division/remainder axiom: abstract(a,b) = concrete(a,b) mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry @@ -246,20 +256,15 @@ divModShiftBounds props = do -- Unsigned: fall back to full bvudiv axiom (these are usually fast) mapM (mkUnsignedAxiom coreName) ops else do - let absAName = fromString $ "abs_a_" <> show groupIdx - absBName = fromString $ "abs_b_" <> show groupIdx - canonAenc <- exprToSMTWith AbstractDivision firstA - canonBenc <- exprToSMTWith AbstractDivision firstB - let absAEnc = "(ite (bvsge" `sp` canonAenc `sp` zero <> ")" - `sp` canonAenc `sp` "(bvsub" `sp` zero `sp` canonAenc <> "))" - absBEnc = "(ite (bvsge" `sp` canonBenc `sp` zero <> ")" - `sp` canonBenc `sp` "(bvsub" `sp` zero `sp` canonBenc <> "))" - let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" - , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" - , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" - ] + aenc <- exprToSMTWith AbstractDivision firstA + benc <- exprToSMTWith AbstractDivision firstB + let absoluteAEnc = "(ite (bvsge" `sp` aenc `sp` zero <> ")" + `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" + absoluteBEnc = "(ite (bvsge" `sp` benc `sp` zero <> ")" + `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" + + (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absoluteAEnc absoluteBEnc coreName + -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> From d9ac366598f0111ae437f7b348394b08c1721317 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:18:49 +0100 Subject: [PATCH 059/150] More cleanup --- src/EVM/SMT/DivEncoding.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 91a2e9583..5d14128cd 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -256,8 +256,8 @@ divModShiftBounds props = do -- Unsigned: fall back to full bvudiv axiom (these are usually fast) mapM (mkUnsignedAxiom coreName) ops else do - aenc <- exprToSMTWith AbstractDivision firstA - benc <- exprToSMTWith AbstractDivision firstB + aenc <- exprToSMTAbst firstA + benc <- exprToSMTAbst firstB let absoluteAEnc = "(ite (bvsge" `sp` aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" absoluteBEnc = "(ite (bvsge" `sp` benc `sp` zero <> ")" From 0b0d161149170eb2a02171472bfe24caafc00bd0 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:20:29 +0100 Subject: [PATCH 060/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 5d14128cd..44262f231 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -258,12 +258,11 @@ divModShiftBounds props = do else do aenc <- exprToSMTAbst firstA benc <- exprToSMTAbst firstB - let absoluteAEnc = "(ite (bvsge" `sp` aenc `sp` zero <> ")" + let absAEnc = "(ite (bvsge" `sp` aenc `sp` zero <> ")" `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" - absoluteBEnc = "(ite (bvsge" `sp` benc `sp` zero <> ")" + absBEnc = "(ite (bvsge" `sp` benc `sp` zero <> ")" `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" - - (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absoluteAEnc absoluteBEnc coreName + (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absAEnc absBEnc coreName -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of From e0abb57a473dfb24f3a5cc6e1853d242783e14ce Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:32:51 +0100 Subject: [PATCH 061/150] Better printing Better comments --- src/EVM/SMT/DivEncoding.hs | 1 - src/EVM/Solvers.hs | 20 +++++++++++--------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 44262f231..b4514ecbe 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -21,7 +21,6 @@ import EVM.SMT import EVM.Traversals import EVM.Types --- | Phase 1: Encode props using uninterpreted functions for div/mod assertPropsAbstract :: Config -> [Prop] -> Err SMT2 assertPropsAbstract conf ps = do let mkBase simp = assertPropsHelperWith AbstractDivision simp divModAbstractDecls diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 3d982701c..39ebe5a49 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -146,24 +146,25 @@ checkSatWithProps sg props = do ret <- checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) case ret of Cex cex -> do - when conf.debug $ traceM "Model from abstract query is not spurious, returning cex." + when conf.debug $ logWithTid "Model from abstract query is not spurious, returning cex." pure $ Cex cex Qed -> do - when conf.debug $ traceM "Refinement successful, query is Qed." + when conf.debug $ logWithTid "Refinement successful, query is Qed." pure Qed Unknown msg -> do - when conf.debug $ traceM $ "Solver returned unknown during refinement phase: " <> msg + -- 3rd phase: shift bounds + when conf.debug $ logWithTid $ "Solver returned unknown during refinement phase: " <> msg let withShiftBounds = assertPropsShiftBounds conf allProps checkSat sg (Just props) withShiftBounds >>= \case Qed -> do - when conf.debug $ traceM "Refinement with shift bounds successful, query is Qed." + when conf.debug $ logWithTid "Refinement with shift bounds successful, query is Qed." pure Qed Error msg2 -> do - when conf.debug $ traceM $ "Solver returned error during refinement with shift bounds: " <> msg2 + when conf.debug $ logWithTid $ "Solver returned error during refinement with shift bounds: " <> msg2 pure $ Error msg2 _ -> pure ret -- can't trust Cex here, return old value Error msg -> do - when conf.debug $ traceM $ "Solver returned error during refinement phase: " <> msg + when conf.debug $ logWithTid $ "Solver returned error during refinement phase: " <> msg pure $ Error msg checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult @@ -365,13 +366,14 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when conf.debug $ logWithTid txt pure $ Error txt False -> unknown conf $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat - logWithTid msg = do - tid <- liftIO myThreadId - traceM $ "[" <> show tid <> "] " <> msg unknown conf msg = do when conf.debug $ logWithTid msg pure $ Unknown msg +logWithTid msg = do + tid <- liftIO myThreadId + traceM $ "[" <> show tid <> "] " <> msg + dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do case dump of From bf5e111501998d1f7674ec3fe04673600a2a31db Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 17:41:58 +0100 Subject: [PATCH 062/150] Cleaner --- src/EVM/Solvers.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 39ebe5a49..6370b7fd2 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -143,7 +143,7 @@ checkSatWithProps sg props = do if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement else liftIO $ do - ret <- checkSatTwoPhase sg (Just props) (getNonError smt2Abstract) (SMTScript (getNonError refinement)) + ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) case ret of Cex cex -> do when conf.debug $ logWithTid "Model from abstract query is not spurious, returning cex." @@ -167,25 +167,19 @@ checkSatWithProps sg props = do when conf.debug $ logWithTid $ "Solver returned error during refinement phase: " <> msg pure $ Error msg -checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult -checkSat (SolverGroup taskq) props smt2 = do +checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> Maybe SMTScript -> IO SMTResult +checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do if isLeft smt2 then pure $ Error $ getError smt2 else do -- prepare result channel resChan <- newChan -- send task to solver group - writeChan taskq (TaskSingle (SingleData (getNonError smt2) Nothing props resChan)) + writeChan taskq (TaskSingle (SingleData (getNonError smt2) refinement props resChan)) -- collect result readChan resChan -checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> SMT2 -> SMTScript -> IO SMTResult -checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do - -- prepare result channel - resChan <- newChan - -- send task to solver group - writeChan taskq (TaskSingle (SingleData smt2 (Just refinement) props resChan)) - -- collect result - readChan resChan +checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult +checkSat sg props smt2 = checkSatTwoPhase sg props smt2 Nothing writeSMT2File :: SMT2 -> FilePath -> String -> IO () writeSMT2File smt2 path postfix = do From c38dcbfbeee14e7243321ef5069d3797f8be50f4 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:03:03 +0100 Subject: [PATCH 063/150] Cleanup --- src/EVM/SMT.hs | 32 ++++++-------------------------- src/EVM/Solvers.hs | 1 + 2 files changed, 7 insertions(+), 26 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 88f5a0037..f4cdd24ab 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -497,10 +497,10 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> divOp "bvudiv" "abst_evm_bvudiv" a b - SDiv a b -> sdivOp "abst_evm_bvsdiv" a b - Mod a b -> divOp "bvurem" "abst_evm_bvurem" a b - SMod a b -> smodOp "abst_evm_bvsrem" a b + Div a b -> divModOp "bvudiv" "abst_evm_bvudiv" a b + SDiv a b -> divModOp "bvsdiv" "abst_evm_bvsdiv" a b + Mod a b -> divModOp "bvurem" "abst_evm_bvurem" a b + SMod a b -> divModOp "bvsrem" "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do aExp <- exprToSMT a @@ -612,30 +612,10 @@ exprToSMTWith enc = \case aenc <- exprToSMT a benc <- exprToSMT b pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" - divOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder - divOp concreteOp abstractOp a b = case enc of + divModOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder + divModOp concreteOp abstractOp a b = case enc of ConcreteDivision -> op2CheckZero concreteOp a b AbstractDivision -> op2 abstractOp a b - -- | Encode SDiv using bvudiv with abs-value decomposition - sdivOp :: Builder -> Expr x -> Expr y -> Err Builder - sdivOp abstractOp a b = case enc of - AbstractDivision -> op2 abstractOp a b - ConcreteDivision -> do - aenc <- exprToSMT a - benc <- exprToSMT b - let udiv = "(bvudiv" `sp` smtAbsolute aenc `sp` smtAbsolute benc <> ")" - pure $ smtSdivResult aenc benc udiv - -- | Encode SMod using bvurem with abs-value decomposition - -- EVM SMOD: result has the sign of the dividend (a) - smodOp :: Builder -> Expr x -> Expr y -> Err Builder - smodOp abstractOp a b = case enc of - AbstractDivision -> op2 abstractOp a b - ConcreteDivision -> do - aenc <- exprToSMT a - benc <- exprToSMT b - let urem = "(bvurem" `sp` smtAbsolute aenc `sp` smtAbsolute benc <> ")" - pure $ smtSmodResult aenc benc urem - -- ** SMT builder helpers ** ----------------------------------------------------------------------- diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 6370b7fd2..ce32a7df2 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -364,6 +364,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when conf.debug $ logWithTid msg pure $ Unknown msg +logWithTid :: MonadIO m => String -> m () logWithTid msg = do tid <- liftIO myThreadId traceM $ "[" <> show tid <> "] " <> msg From ca534eb2043ad43f4bda3a40bf9384a7d0fbc69c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:18:15 +0100 Subject: [PATCH 064/150] Cleaning up comments --- src/EVM/SMT/DivEncoding.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index b4514ecbe..de144891c 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -237,7 +237,7 @@ divModShiftBounds props = do k1 == k2 && a1 == a2 && b1 == b2 -- | Extract shift amount from a dividend expression. - -- Returns Just k if the canonical (abs-stripped) dividend is SHL(Lit k, _), + -- Returns Just k if the dividend is SHL(Lit k, _), -- or if it is a literal that is an exact power of 2 (Lit 2^k). extractShift :: Expr EWord -> Maybe W256 extractShift (SHL (Lit k) _) = Just k @@ -281,7 +281,7 @@ divModShiftBounds props = do _ -> -- No shift structure or it's a modulo op: use abstract bounds only. -- This avoids bvudiv entirely, making the encoding an overapproximation. - -- Only UNSAT results are sound (checked by caller). + -- Only UNSAT results are sound [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" ] From ec81d151cc03f3c73f6eabf1475849d4e0983a94 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:26:42 +0100 Subject: [PATCH 065/150] Cleaner --- src/EVM/SMT/DivEncoding.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index de144891c..cebc46c42 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -257,10 +257,8 @@ divModShiftBounds props = do else do aenc <- exprToSMTAbst firstA benc <- exprToSMTAbst firstB - let absAEnc = "(ite (bvsge" `sp` aenc `sp` zero <> ")" - `sp` aenc `sp` "(bvsub" `sp` zero `sp` aenc <> "))" - absBEnc = "(ite (bvsge" `sp` benc `sp` zero <> ")" - `sp` benc `sp` "(bvsub" `sp` zero `sp` benc <> "))" + let absAEnc = smtAbsolute aenc + absBEnc = smtAbsolute benc (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absAEnc absBEnc coreName -- Generate shift bounds or fall back to bvudiv From bb54f863455dc0bd55509e99379e3f451b1824d0 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:27:10 +0100 Subject: [PATCH 066/150] Fix spacing --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index cebc46c42..d6465f46f 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -266,7 +266,7 @@ divModShiftBounds props = do (True, Just k) -> let kLit = wordAsBV k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" - shifted = "(bvlshr" `sp` absAName <> " " <> kLit <> ")" + shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" in [ -- q = 0 when b = 0 SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" , -- q <= abs_a (always true) From 4c820082fd9c8f94ce868735b40d00d79f84f858 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:28:46 +0100 Subject: [PATCH 067/150] Even cleaner --- src/EVM/SMT/DivEncoding.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index d6465f46f..6521317c3 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -3,8 +3,7 @@ Description: Abstract division/modulo encoding for two-phase SMT solving (Halmos-style) -} module EVM.SMT.DivEncoding - ( divModAbstractDecls - , divModGroundAxioms + ( divModGroundAxioms , assertProps , assertPropsAbstract , assertPropsShiftBounds From 15038e8c5644eb6f79105ac6457b5e2e348fb031 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:54:11 +0100 Subject: [PATCH 068/150] Update --- src/EVM/SMT/DivEncoding.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 6521317c3..2501aa743 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -114,7 +114,7 @@ mkDivModDecls groupIdx absAEnc absBEnc coreName = do ] pure (decls, (absAName, absBName)) --- | Generate ground-instance axioms with CSE'd bvudiv/bvurem intermediates. +-- | Generate ground-instance axioms with bvudiv/bvurem intermediates. -- For each group of div/mod ops sharing the same (|a|, |b|), generates: -- - declare-const for abs_a, abs_b, and the bvudiv/bvurem result -- - axioms expressing each abst_evm_bvXdiv call in terms of the shared result @@ -153,11 +153,9 @@ divModGroundAxioms props = do let absAEnc = smtAbsolute aenc absBEnc = smtAbsolute benc op = if isDiv' then "bvudiv" else "bvurem" - absAName = fromString $ "abs_a_" <> show groupIdx - absBName = fromString $ "abs_b_" <> show groupIdx - coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" - (decls, _) <- mkDivModDecls groupIdx absAEnc absBEnc coreName + (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absAEnc absBEnc coreName + let coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let coreAssert = SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" axioms <- mapM (mkSignedAxiom coreName) ops From 29acc17c507bce8d80e8d0ee1ed595393553ce15 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Mon, 16 Feb 2026 18:57:01 +0100 Subject: [PATCH 069/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 2501aa743..38ff88ec9 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -101,10 +101,14 @@ absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) | otherwise = SignedAbsKey a b (divModOp kind) --- | Helper to generate common declarations for abs_a, abs_b, and core result. -mkDivModDecls :: Int -> Builder -> Builder -> Builder -> Err ([SMTEntry], (Builder, Builder)) -mkDivModDecls groupIdx absAEnc absBEnc coreName = do - let absAName = fromString $ "abs_a_" <> show groupIdx +-- | Encode operands as absolute values and generate declarations for abs_a, abs_b, and core result. +mkSignedDecls :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +mkSignedDecls groupIdx firstA firstB coreName = do + aenc <- exprToSMTAbst firstA + benc <- exprToSMTAbst firstB + let absAEnc = smtAbsolute aenc + absBEnc = smtAbsolute benc + absAName = fromString $ "abs_a_" <> show groupIdx absBName = fromString $ "abs_b_" <> show groupIdx let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" @@ -148,14 +152,9 @@ divModGroundAxioms props = do if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do - aenc <- exprToSMTAbst firstA - benc <- exprToSMTAbst firstB - let absAEnc = smtAbsolute aenc - absBEnc = smtAbsolute benc - op = if isDiv' then "bvudiv" else "bvurem" - - (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absAEnc absBEnc coreName - let coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" + (decls, (absAName, absBName)) <- mkSignedDecls groupIdx firstA firstB coreName + let op = if isDiv' then "bvudiv" else "bvurem" + coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let coreAssert = SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" axioms <- mapM (mkSignedAxiom coreName) ops @@ -252,11 +251,7 @@ divModShiftBounds props = do -- Unsigned: fall back to full bvudiv axiom (these are usually fast) mapM (mkUnsignedAxiom coreName) ops else do - aenc <- exprToSMTAbst firstA - benc <- exprToSMTAbst firstB - let absAEnc = smtAbsolute aenc - absBEnc = smtAbsolute benc - (decls, (absAName, absBName)) <- mkDivModDecls groupIdx absAEnc absBEnc coreName + (decls, (absAName, absBName)) <- mkSignedDecls groupIdx firstA firstB coreName -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of From c68cd6ee06a00e24cbb25e4b376f81960c70d80a Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 10:50:40 +0100 Subject: [PATCH 070/150] Moving functions, sorry! --- src/EVM/SMT.hs | 44 -------------------------------------- src/EVM/SMT/DivEncoding.hs | 38 ++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 44 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index f4cdd24ab..0a20dd460 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -18,13 +18,6 @@ module EVM.SMT sp, zero, one, - smtZeroGuard, - smtAbsolute, - smtNeg, - smtSameSign, - smtIsNonNeg, - smtSdivResult, - smtSmodResult, propToSMTWith, parseVar, parseEAddr, @@ -631,43 +624,6 @@ zero = "(_ bv0 256)" one :: Builder one = "(_ bv1 256)" --- | Guard against division by zero: if divisor is zero return zero, else use the given result. --- Produces: (ite (= divisor 0) 0 nonZeroResult) -smtZeroGuard :: Builder -> Builder -> Builder -smtZeroGuard divisor nonZeroResult = - "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" - --- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) -smtAbsolute :: Builder -> Builder -smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" - --- | Encode negation: -x = (bvsub 0 x) -smtNeg :: Builder -> Builder -smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" - --- | Check if two values have the same sign (both negative or both non-negative) -smtSameSign :: Builder -> Builder -> Builder -smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" - --- | Check if value is non-negative: x >= 0 -smtIsNonNeg :: Builder -> Builder -smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" - --- | Encode SDiv result given the unsigned division of absolute values. --- SDiv semantics: result sign depends on whether operand signs match. --- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) -smtSdivResult :: Builder -> Builder -> Builder -> Builder -smtSdivResult aenc benc udivResult = - smtZeroGuard benc $ - "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" - --- | Encode SMod result given the unsigned remainder of absolute values. --- SMod semantics: result sign matches the dividend (a). --- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) -smtSmodResult :: Builder -> Builder -> Builder -> Builder -smtSmodResult aenc benc uremResult = - smtZeroGuard benc $ - "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" propToSMTWith :: DivEncoding -> Prop -> Err Builder diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 38ff88ec9..b8aa744c0 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -300,3 +300,41 @@ mkCongruenceLinks indexedGroups = in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" <> "(=" `sp` coreI `sp` coreJ <> ")))" ] + +-- | Guard against division by zero: if divisor is zero return zero, else use the given result. +-- Produces: (ite (= divisor 0) 0 nonZeroResult) +smtZeroGuard :: Builder -> Builder -> Builder +smtZeroGuard divisor nonZeroResult = + "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" + +-- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) +smtAbsolute :: Builder -> Builder +smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" + +-- | Encode negation: -x = (bvsub 0 x) +smtNeg :: Builder -> Builder +smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" + +-- | Check if two values have the same sign (both negative or both non-negative) +smtSameSign :: Builder -> Builder -> Builder +smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" + +-- | Check if value is non-negative: x >= 0 +smtIsNonNeg :: Builder -> Builder +smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" + +-- | Encode SDiv result given the unsigned division of absolute values. +-- SDiv semantics: result sign depends on whether operand signs match. +-- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) +smtSdivResult :: Builder -> Builder -> Builder -> Builder +smtSdivResult aenc benc udivResult = + smtZeroGuard benc $ + "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" + +-- | Encode SMod result given the unsigned remainder of absolute values. +-- SMod semantics: result sign matches the dividend (a). +-- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) +smtSmodResult :: Builder -> Builder -> Builder -> Builder +smtSmodResult aenc benc uremResult = + smtZeroGuard benc $ + "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" From 5fbf561a38006903959c9eaed0fc135e2aac234b Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 11:07:20 +0100 Subject: [PATCH 071/150] Cleanupo --- src/EVM/SMT/DivEncoding.hs | 49 +++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index b8aa744c0..08b01a2fc 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -18,7 +18,8 @@ import Data.Text.Lazy.Builder import EVM.Effects import EVM.SMT import EVM.Traversals -import EVM.Types +import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) +import EVM.Types qualified as T assertPropsAbstract :: Config -> [Prop] -> Err SMT2 assertPropsAbstract conf ps = do @@ -59,8 +60,8 @@ divModBounds props = do where collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] collectBounds = \case - Div a b -> [("abst_evm_bvudiv", a, b)] - Mod a b -> [("abst_evm_bvurem", a, b)] + T.Div a b -> [("abst_evm_bvudiv", a, b)] + T.Mod a b -> [("abst_evm_bvurem", a, b)] _ -> [] mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry @@ -73,7 +74,7 @@ divModBounds props = do data DivModOp = IsDiv | IsMod deriving (Eq, Ord) -data DivOpKind = UDiv | USDiv | UMod | USMod +data DivOpKind = Div | SDiv | Mod | SMod deriving (Eq, Ord) type DivOp = (DivOpKind, Expr EWord, Expr EWord) @@ -84,13 +85,13 @@ data AbsKey deriving (Eq, Ord) isSigned :: DivOpKind -> Bool -isSigned USDiv = True -isSigned USMod = True +isSigned SDiv = True +isSigned SMod = True isSigned _ = False isDiv :: DivOpKind -> Bool -isDiv UDiv = True -isDiv USDiv = True +isDiv Div = True +isDiv SDiv = True isDiv _ = False divModOp :: DivOpKind -> DivModOp @@ -135,10 +136,10 @@ divModGroundAxioms props = do where collectDivMod :: forall a . Expr a -> [DivOp] collectDivMod = \case - Div a b -> [(UDiv, a, b)] - SDiv a b -> [(USDiv, a, b)] - Mod a b -> [(UMod, a, b)] - SMod a b -> [(USMod, a, b)] + T.Div a b -> [(Div, a, b)] + T.SDiv a b -> [(SDiv, a, b)] + T.Mod a b -> [(Mod, a, b)] + T.SMod a b -> [(SMod, a, b)] _ -> [] -- | Generate axioms for a group of ops sharing the same bvudiv/bvurem core. @@ -165,9 +166,9 @@ mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b - let fname = if kind == UDiv then "abst_evm_bvudiv" else "abst_evm_bvurem" + let fname = if kind == Div then "abst_evm_bvudiv" else "abst_evm_bvurem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == UDiv then "bvudiv" else "bvurem" + op = if kind == Div then "bvudiv" else "bvurem" concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" @@ -176,9 +177,9 @@ mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b - let fname = if kind == USDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" + let fname = if kind == SDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - concrete = if kind == USDiv + concrete = if kind == SDiv then smtSdivResult aenc benc coreName else smtSmodResult aenc benc coreName pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" @@ -201,8 +202,8 @@ assertPropsShiftBounds conf ps = do <> SMT2 (SMTScript shiftBounds) mempty mempty isMod :: DivOpKind -> Bool -isMod UMod = True -isMod USMod = True +isMod Mod = True +isMod SMod = True isMod _ = False -- | Generate shift-based bound axioms (no bvudiv/bvurem). @@ -222,10 +223,10 @@ divModShiftBounds props = do where collectDivOps :: forall a . Expr a -> [DivOp] collectDivOps = \case - Div a b -> [(UDiv, a, b)] - SDiv a b -> [(USDiv, a, b)] - Mod a b -> [(UMod, a, b)] - SMod a b -> [(USMod, a, b)] + T.Div a b -> [(Div, a, b)] + T.SDiv a b -> [(SDiv, a, b)] + T.Mod a b -> [(Mod, a, b)] + T.SMod a b -> [(SMod, a, b)] _ -> [] eqDivOp :: DivOp -> DivOp -> Bool @@ -284,8 +285,8 @@ divModShiftBounds props = do -- helps solvers avoid independent reasoning about multiple bvudiv terms. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USDiv] -- SDiv groups - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == USMod] -- SMod groups + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SDiv] -- SDiv groups + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SMod] -- SMod groups in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where From 114b4ceaf19b914b658ac01b299366e60510d711 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 11:13:04 +0100 Subject: [PATCH 072/150] Better naming --- src/EVM/SMT/DivEncoding.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 08b01a2fc..3e87d167e 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -103,8 +103,8 @@ absKey (kind, a, b) | otherwise = SignedAbsKey a b (divModOp kind) -- | Encode operands as absolute values and generate declarations for abs_a, abs_b, and core result. -mkSignedDecls :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) -mkSignedDecls groupIdx firstA firstB coreName = do +declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +declareAbs groupIdx firstA firstB coreName = do aenc <- exprToSMTAbst firstA benc <- exprToSMTAbst firstB let absAEnc = smtAbsolute aenc @@ -153,7 +153,7 @@ divModGroundAxioms props = do if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do - (decls, (absAName, absBName)) <- mkSignedDecls groupIdx firstA firstB coreName + (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName let op = if isDiv' then "bvudiv" else "bvurem" coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" @@ -252,7 +252,7 @@ divModShiftBounds props = do -- Unsigned: fall back to full bvudiv axiom (these are usually fast) mapM (mkUnsignedAxiom coreName) ops else do - (decls, (absAName, absBName)) <- mkSignedDecls groupIdx firstA firstB coreName + (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of From 1f350e5d21a4b1cf6e04fb4a3da23f45f1d44c13 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 11:13:41 +0100 Subject: [PATCH 073/150] Better naming --- src/EVM/SMT/DivEncoding.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 3e87d167e..3f9c9e5c2 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -39,9 +39,9 @@ assertProps conf ps = divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] From e73cfc69cb470c9d662ed1dc1579f5777b187c47 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 11:24:24 +0100 Subject: [PATCH 074/150] Adding div/mod bounds --- src/EVM/SMT/DivEncoding.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 3f9c9e5c2..384b9ec48 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -49,17 +49,17 @@ exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision -- | Generate bounds constraints for abstract div/mod operations. --- These help the solver prune impossible models without full bitvector division reasoning. +-- result of div(a,b) is always <= a, and result of mod(a,b) is always <= b divModBounds :: [Prop] -> Err [SMTEntry] divModBounds props = do - let allBounds = concatMap (foldProp collectBounds []) props + let allBounds = concatMap (foldProp collectDivMod []) props if null allBounds then pure [] else do assertions <- mapM mkAssertion allBounds pure $ (SMTComment "division/modulo bounds") : assertions where - collectBounds :: Expr a -> [(Builder, Expr EWord, Expr EWord)] - collectBounds = \case + collectDivMod :: Expr a -> [(Builder, Expr EWord, Expr EWord)] + collectDivMod = \case T.Div a b -> [("abst_evm_bvudiv", a, b)] T.Mod a b -> [("abst_evm_bvurem", a, b)] _ -> [] From 7b54eb4cc8a9fcc5617570c78a74729c86513490 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 12:08:47 +0100 Subject: [PATCH 075/150] More --- src/EVM/SMT/DivEncoding.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 384b9ec48..37f7531d8 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -147,15 +147,14 @@ divModGroundAxioms props = do mkGroupAxioms _ [] = pure [] mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do let isDiv' = isDiv firstKind - prefix = if isDiv' then "udiv" else "urem" - coreName = fromString $ prefix <> "_" <> show groupIdx + op = if isDiv' then "bvudiv" else "bvurem" + coreName = op <> (fromString $ "_" <> show groupIdx) if not (isSigned firstKind) then mapM (mkUnsignedAxiom coreName) ops else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName - let op = if isDiv' then "bvudiv" else "bvurem" - coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" + let coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let coreAssert = SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" axioms <- mapM (mkSignedAxiom coreName) ops @@ -206,9 +205,7 @@ isMod Mod = True isMod SMod = True isMod _ = False --- | Generate shift-based bound axioms (no bvudiv/bvurem). --- For each group of signed div/mod ops, if the dividend has a SHL(k, _) structure, --- generates bounds using bvlshr instead of bvudiv. +-- | Generate shift-based bound axioms divModShiftBounds :: [Prop] -> Err [SMTEntry] divModShiftBounds props = do let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props From 3b180b99226e0e2480918b741bf6aaad9f2089ad Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 14:49:33 +0100 Subject: [PATCH 076/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 37f7531d8..9a1f96295 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -171,14 +171,14 @@ mkUnsignedAxiom _coreName (kind, a, b) = do concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Encode signed division/remainder axiom using absolute value core result +-- | Encode signed division/remainder axiom using absolute value mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b - let fname = if kind == SDiv then "abst_evm_bvsdiv" else "abst_evm_bvsrem" + let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - concrete = if kind == SDiv + concrete = if isDiv kind then smtSdivResult aenc benc coreName else smtSmodResult aenc benc coreName pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" From 73c1d9a62bfaca370db1730bb53be4fa1f99d232 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 14:54:56 +0100 Subject: [PATCH 077/150] Better comments --- src/EVM/SMT/DivEncoding.hs | 87 +++++++++++++------------------------- 1 file changed, 29 insertions(+), 58 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 9a1f96295..82a9878b8 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,7 +1,4 @@ -{- | - Module: EVM.SMT.DivEncoding - Description: Abstract division/modulo encoding for two-phase SMT solving (Halmos-style) --} +{- | Abstract div/mod encoding for two-phase SMT solving. -} module EVM.SMT.DivEncoding ( divModGroundAxioms , assertProps @@ -35,7 +32,7 @@ assertProps conf ps = if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps else assertPropsHelperWith ConcreteDivision True [] (decompose conf ps) --- | Uninterpreted function declarations for abstract div/mod encoding (Phase 1). +-- | Uninterpreted function declarations for abstract div/mod. divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" @@ -48,8 +45,8 @@ divModAbstractDecls = exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision --- | Generate bounds constraints for abstract div/mod operations. --- result of div(a,b) is always <= a, and result of mod(a,b) is always <= b +-- | Result of div(a,b) is always <= a, and result of mod(a,b) is always <= b +-- Unsigned ONLY divModBounds :: [Prop] -> Err [SMTEntry] divModBounds props = do let allBounds = concatMap (foldProp collectDivMod []) props @@ -80,8 +77,8 @@ data DivOpKind = Div | SDiv | Mod | SMod type DivOp = (DivOpKind, Expr EWord, Expr EWord) data AbsKey - = UnsignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - raw operands - | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp -- ^ (dividend, divisor, op) - absolute values + = UnsignedAbsKey (Expr EWord) (Expr EWord) DivModOp + | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp deriving (Eq, Ord) isSigned :: DivOpKind -> Bool @@ -102,7 +99,7 @@ absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) | otherwise = SignedAbsKey a b (divModOp kind) --- | Encode operands as absolute values and generate declarations for abs_a, abs_b, and core result. +-- | Declare abs_a, abs_b, and core result variables for a signed group. declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) declareAbs groupIdx firstA firstB coreName = do aenc <- exprToSMTAbst firstA @@ -119,10 +116,7 @@ declareAbs groupIdx firstA firstB coreName = do ] pure (decls, (absAName, absBName)) --- | Generate ground-instance axioms with bvudiv/bvurem intermediates. --- For each group of div/mod ops sharing the same (|a|, |b|), generates: --- - declare-const for abs_a, abs_b, and the bvudiv/bvurem result --- - axioms expressing each abst_evm_bvXdiv call in terms of the shared result +-- | Ground axioms: abstract div/mod = concrete bvudiv/bvurem, grouped by operands. divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do let allDivMods = nubOrd $ concatMap (foldProp collectDivMod []) props @@ -142,7 +136,6 @@ divModGroundAxioms props = do T.SMod a b -> [(SMod, a, b)] _ -> [] - -- | Generate axioms for a group of ops sharing the same bvudiv/bvurem core. mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] mkGroupAxioms _ [] = pure [] mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do @@ -160,7 +153,7 @@ divModGroundAxioms props = do axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> [coreAssert] <> axioms --- | Encode unsigned division/remainder axiom: abstract(a,b) = concrete(a,b) +-- | Assert abstract(a,b) = concrete bvudiv/bvurem(a,b). mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry mkUnsignedAxiom _coreName (kind, a, b) = do aenc <- exprToSMTAbst a @@ -171,7 +164,7 @@ mkUnsignedAxiom _coreName (kind, a, b) = do concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Encode signed division/remainder axiom using absolute value +-- | Assert abstract(a,b) = signed result derived from unsigned core. mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom coreName (kind, a, b) = do aenc <- exprToSMTAbst a @@ -183,12 +176,7 @@ mkSignedAxiom coreName (kind, a, b) = do else smtSmodResult aenc benc coreName pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Encode props with shift-based quotient bounds instead of bvudiv. --- When the dividend of a signed division has the form SHL(k, x), we know that --- bvudiv(|SHL(k,x)|, |y|) has a tight relationship with bvlshr(|SHL(k,x)|, k): --- if |y| >= 2^k then q <= bvlshr(|a|, k) --- if |y| < 2^k then q >= bvlshr(|a|, k) --- This avoids bvudiv entirely +-- | Assert props using shift-based bounds to avoid bvudiv when possible. assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 assertPropsShiftBounds conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls @@ -205,7 +193,7 @@ isMod Mod = True isMod SMod = True isMod _ = False --- | Generate shift-based bound axioms +-- | Shift-based bound axioms for div/mod with SHL dividends. divModShiftBounds :: [Prop] -> Err [SMTEntry] divModShiftBounds props = do let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props @@ -230,9 +218,7 @@ divModShiftBounds props = do eqDivOp (k1, a1, b1) (k2, a2, b2) = k1 == k2 && a1 == a2 && b1 == b2 - -- | Extract shift amount from a dividend expression. - -- Returns Just k if the dividend is SHL(Lit k, _), - -- or if it is a literal that is an exact power of 2 (Lit 2^k). + -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. extractShift :: Expr EWord -> Maybe W256 extractShift (SHL (Lit k) _) = Just k extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (fromIntegral $ countTrailingZeros n) @@ -246,44 +232,34 @@ divModShiftBounds props = do coreName = fromString $ prefix <> "_" <> show groupIdx if not (isSigned firstKind) then do - -- Unsigned: fall back to full bvudiv axiom (these are usually fast) + -- Unsigned: use concrete bvudiv/bvurem directly mapM (mkUnsignedAxiom coreName) ops else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName - -- Generate shift bounds or fall back to bvudiv let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> let kLit = wordAsBV k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" - in [ -- q = 0 when b = 0 - SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" - , -- q <= abs_a (always true) - SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" - , -- if |b| >= 2^k then q <= |a| >> k - SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" - , -- if 0 < |b| < 2^k then q >= |a| >> k - SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` coreName `sp` shifted <> ")))" + in [ SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" + , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + , SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" + , SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` coreName `sp` shifted <> ")))" ] _ -> - -- No shift structure or it's a modulo op: use abstract bounds only. - -- This avoids bvudiv entirely, making the encoding an overapproximation. - -- Only UNSAT results are sound + -- No shift info: overapproximate (only UNSAT is sound) [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" ] axioms <- mapM (mkSignedAxiom coreName) ops pure $ decls <> shiftBounds <> axioms --- | For each pair of signed groups with the same operation type (udiv/urem), --- emit a congruence lemma: if abs inputs are equal, results are equal. --- This is a sound tautology (function congruence for bvudiv/bvurem) that --- helps solvers avoid independent reasoning about multiple bvudiv terms. +-- | Congruence: if two signed groups have equal abs inputs, their results are equal. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SDiv] -- SDiv groups - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SMod] -- SMod groups + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SDiv] + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SMod] in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where @@ -299,39 +275,34 @@ mkCongruenceLinks indexedGroups = <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" <> "(=" `sp` coreI `sp` coreJ <> ")))" ] --- | Guard against division by zero: if divisor is zero return zero, else use the given result. --- Produces: (ite (= divisor 0) 0 nonZeroResult) +-- | (ite (= divisor 0) 0 result) smtZeroGuard :: Builder -> Builder -> Builder smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" --- | Encode absolute value: |x| = (ite (bvsge x 0) x (- x)) +-- | |x| as SMT. smtAbsolute :: Builder -> Builder smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" --- | Encode negation: -x = (bvsub 0 x) +-- | -x as SMT. smtNeg :: Builder -> Builder smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" --- | Check if two values have the same sign (both negative or both non-negative) +-- | True if a and b have the same sign. smtSameSign :: Builder -> Builder -> Builder smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" --- | Check if value is non-negative: x >= 0 +-- | x >= 0. smtIsNonNeg :: Builder -> Builder smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" --- | Encode SDiv result given the unsigned division of absolute values. --- SDiv semantics: result sign depends on whether operand signs match. --- sdiv(a, b) = if b == 0 then 0 else (if sameSign(a,b) then udiv(|a|,|b|) else -udiv(|a|,|b|)) +-- | sdiv(a,b) from udiv(|a|,|b|): negate result if signs differ. smtSdivResult :: Builder -> Builder -> Builder -> Builder smtSdivResult aenc benc udivResult = smtZeroGuard benc $ "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" --- | Encode SMod result given the unsigned remainder of absolute values. --- SMod semantics: result sign matches the dividend (a). --- smod(a, b) = if b == 0 then 0 else (if a >= 0 then urem(|a|,|b|) else -urem(|a|,|b|)) +-- | smod(a,b) from urem(|a|,|b|): result sign matches dividend. smtSmodResult :: Builder -> Builder -> Builder -> Builder smtSmodResult aenc benc uremResult = smtZeroGuard benc $ From 7c093e4cf818a7b5b126785ac5c5abeecb9e1df7 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:00:20 +0100 Subject: [PATCH 078/150] Update --- src/EVM/SMT/DivEncoding.hs | 56 +++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 82a9878b8..cf3e55f94 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -99,9 +99,9 @@ absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) | otherwise = SignedAbsKey a b (divModOp kind) --- | Declare abs_a, abs_b, and core result variables for a signed group. +-- | Declare abs_a, abs_b, and unsigned result variables for a signed group. declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) -declareAbs groupIdx firstA firstB coreName = do +declareAbs groupIdx firstA firstB unsignedResult = do aenc <- exprToSMTAbst firstA benc <- exprToSMTAbst firstB let absAEnc = smtAbsolute aenc @@ -110,7 +110,7 @@ declareAbs groupIdx firstA firstB coreName = do absBName = fromString $ "abs_b_" <> show groupIdx let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` coreName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` unsignedResult `sp` "(_ BitVec 256))" , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" ] @@ -141,21 +141,21 @@ divModGroundAxioms props = do mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do let isDiv' = isDiv firstKind op = if isDiv' then "bvudiv" else "bvurem" - coreName = op <> (fromString $ "_" <> show groupIdx) + unsignedResult = op <> (fromString $ "_" <> show groupIdx) if not (isSigned firstKind) - then mapM (mkUnsignedAxiom coreName) ops + then mapM (mkUnsignedAxiom unsignedResult) ops else do - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName - let coreEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" + (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult + let unsignedEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" - let coreAssert = SMTCommand $ "(assert (=" `sp` coreName `sp` coreEnc <> "))" - axioms <- mapM (mkSignedAxiom coreName) ops - pure $ decls <> [coreAssert] <> axioms + let unsignedAssert = SMTCommand $ "(assert (=" `sp` unsignedResult `sp` unsignedEnc <> "))" + axioms <- mapM (mkSignedAxiom unsignedResult) ops + pure $ decls <> [unsignedAssert] <> axioms -- | Assert abstract(a,b) = concrete bvudiv/bvurem(a,b). mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry -mkUnsignedAxiom _coreName (kind, a, b) = do +mkUnsignedAxiom _unsignedResult (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b let fname = if kind == Div then "abst_evm_bvudiv" else "abst_evm_bvurem" @@ -164,16 +164,16 @@ mkUnsignedAxiom _coreName (kind, a, b) = do concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Assert abstract(a,b) = signed result derived from unsigned core. +-- | Assert abstract(a,b) = signed result derived from unsigned result. mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry -mkSignedAxiom coreName (kind, a, b) = do +mkSignedAxiom unsignedResult (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" concrete = if isDiv kind - then smtSdivResult aenc benc coreName - else smtSmodResult aenc benc coreName + then smtSdivResult aenc benc unsignedResult + else smtSmodResult aenc benc unsignedResult pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | Assert props using shift-based bounds to avoid bvudiv when possible. @@ -229,30 +229,30 @@ divModShiftBounds props = do mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do let isDiv' = not (isMod firstKind) prefix = if isDiv' then "udiv" else "urem" - coreName = fromString $ prefix <> "_" <> show groupIdx + unsignedResult = fromString $ prefix <> "_" <> show groupIdx if not (isSigned firstKind) then do -- Unsigned: use concrete bvudiv/bvurem directly - mapM (mkUnsignedAxiom coreName) ops + mapM (mkUnsignedAxiom unsignedResult) ops else do - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB coreName + (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> let kLit = wordAsBV k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" - in [ SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" - , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" - , SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` coreName `sp` shifted <> ")))" - , SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` coreName `sp` shifted <> ")))" + in [ SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` unsignedResult `sp` zero <> ")))" + , SMTCommand $ "(assert (bvule" `sp` unsignedResult `sp` absAName <> "))" + , SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + , SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> -- No shift info: overapproximate (only UNSAT is sound) - [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` coreName `sp` zero <> ")))" - , SMTCommand $ "(assert (bvule" `sp` coreName `sp` absAName <> "))" + [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` unsignedResult `sp` zero <> ")))" + , SMTCommand $ "(assert (bvule" `sp` unsignedResult `sp` absAName <> "))" ] - axioms <- mapM (mkSignedAxiom coreName) ops + axioms <- mapM (mkSignedAxiom unsignedResult) ops pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal abs inputs, their results are equal. @@ -269,11 +269,11 @@ mkCongruenceLinks indexedGroups = absBi = fromString $ "abs_b_" <> show i absAj = fromString $ "abs_a_" <> show j absBj = fromString $ "abs_b_" <> show j - coreI = fromString $ prefix' <> "_" <> show i - coreJ = fromString $ prefix' <> "_" <> show j + unsignedResultI = fromString $ prefix' <> "_" <> show i + unsignedResultJ = fromString $ prefix' <> "_" <> show j in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" - <> "(=" `sp` coreI `sp` coreJ <> ")))" ] + <> "(=" `sp` unsignedResultI `sp` unsignedResultJ <> ")))" ] -- | (ite (= divisor 0) 0 result) smtZeroGuard :: Builder -> Builder -> Builder From 7c88e6265fab8592e7ffbd9edf6651a78c44a179 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:01:34 +0100 Subject: [PATCH 079/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index cf3e55f94..6716f15cf 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -144,7 +144,7 @@ divModGroundAxioms props = do unsignedResult = op <> (fromString $ "_" <> show groupIdx) if not (isSigned firstKind) - then mapM (mkUnsignedAxiom unsignedResult) ops + then mapM mkUnsignedAxiom ops else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult let unsignedEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" @@ -154,8 +154,8 @@ divModGroundAxioms props = do pure $ decls <> [unsignedAssert] <> axioms -- | Assert abstract(a,b) = concrete bvudiv/bvurem(a,b). -mkUnsignedAxiom :: Builder -> DivOp -> Err SMTEntry -mkUnsignedAxiom _unsignedResult (kind, a, b) = do +mkUnsignedAxiom :: DivOp -> Err SMTEntry +mkUnsignedAxiom (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b let fname = if kind == Div then "abst_evm_bvudiv" else "abst_evm_bvurem" @@ -233,7 +233,7 @@ divModShiftBounds props = do if not (isSigned firstKind) then do -- Unsigned: use concrete bvudiv/bvurem directly - mapM (mkUnsignedAxiom unsignedResult) ops + mapM mkUnsignedAxiom ops else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult From d057c918a3c2c543a5caa3614cbffa048b345336 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:06:23 +0100 Subject: [PATCH 080/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 43 ++++++++++++++------------------------ 1 file changed, 16 insertions(+), 27 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 6716f15cf..de6a6cffd 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -8,7 +8,7 @@ module EVM.SMT.DivEncoding import Data.Bits ((.&.), countTrailingZeros) import Data.Containers.ListUtils (nubOrd) -import Data.List (groupBy, sortBy, nubBy) +import Data.List (groupBy, sortBy) import Data.Ord (comparing) import Data.Text.Lazy.Builder @@ -49,17 +49,17 @@ exprToSMTAbst = exprToSMTWith AbstractDivision -- Unsigned ONLY divModBounds :: [Prop] -> Err [SMTEntry] divModBounds props = do - let allBounds = concatMap (foldProp collectDivMod []) props + let allBounds = concatMap (foldProp collectUnsigned []) props if null allBounds then pure [] else do assertions <- mapM mkAssertion allBounds pure $ (SMTComment "division/modulo bounds") : assertions where - collectDivMod :: Expr a -> [(Builder, Expr EWord, Expr EWord)] - collectDivMod = \case + collectUnsigned :: Expr a -> [(Builder, Expr EWord, Expr EWord)] + collectUnsigned = \case T.Div a b -> [("abst_evm_bvudiv", a, b)] T.Mod a b -> [("abst_evm_bvurem", a, b)] - _ -> [] + _ -> [] mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry mkAssertion (fname, a, b) = do @@ -94,6 +94,15 @@ isDiv _ = False divModOp :: DivOpKind -> DivModOp divModOp k = if isDiv k then IsDiv else IsMod +-- | Collect all div/mod operations from an expression. +collectDivMods :: Expr a -> [DivOp] +collectDivMods = \case + T.Div a b -> [(Div, a, b)] + T.SDiv a b -> [(SDiv, a, b)] + T.Mod a b -> [(Mod, a, b)] + T.SMod a b -> [(SMod, a, b)] + _ -> [] + absKey :: DivOp -> AbsKey absKey (kind, a, b) | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) @@ -119,7 +128,7 @@ declareAbs groupIdx firstA firstB unsignedResult = do -- | Ground axioms: abstract div/mod = concrete bvudiv/bvurem, grouped by operands. divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do - let allDivMods = nubOrd $ concatMap (foldProp collectDivMod []) props + let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivMods then pure [] else do let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivMods @@ -128,14 +137,6 @@ divModGroundAxioms props = do let links = mkCongruenceLinks indexedGroups pure $ (SMTComment "division/modulo ground-instance axioms") : entries <> links where - collectDivMod :: forall a . Expr a -> [DivOp] - collectDivMod = \case - T.Div a b -> [(Div, a, b)] - T.SDiv a b -> [(SDiv, a, b)] - T.Mod a b -> [(Mod, a, b)] - T.SMod a b -> [(SMod, a, b)] - _ -> [] - mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] mkGroupAxioms _ [] = pure [] mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do @@ -196,7 +197,7 @@ isMod _ = False -- | Shift-based bound axioms for div/mod with SHL dividends. divModShiftBounds :: [Prop] -> Err [SMTEntry] divModShiftBounds props = do - let allDivs = nubBy eqDivOp $ concatMap (foldProp collectDivOps []) props + let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivs then pure [] else do let groups = groupBy (\a b -> absKey a == absKey b) @@ -206,18 +207,6 @@ divModShiftBounds props = do let links = mkCongruenceLinks indexedGroups pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links where - collectDivOps :: forall a . Expr a -> [DivOp] - collectDivOps = \case - T.Div a b -> [(Div, a, b)] - T.SDiv a b -> [(SDiv, a, b)] - T.Mod a b -> [(Mod, a, b)] - T.SMod a b -> [(SMod, a, b)] - _ -> [] - - eqDivOp :: DivOp -> DivOp -> Bool - eqDivOp (k1, a1, b1) (k2, a2, b2) = - k1 == k2 && a1 == a2 && b1 == b2 - -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. extractShift :: Expr EWord -> Maybe W256 extractShift (SHL (Lit k) _) = Just k From 6072b47f50535cc951fb42e6f687a11b0e149224 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:15:03 +0100 Subject: [PATCH 081/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index de6a6cffd..b72ba0395 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -125,7 +125,11 @@ declareAbs groupIdx firstA firstB unsignedResult = do ] pure (decls, (absAName, absBName)) --- | Ground axioms: abstract div/mod = concrete bvudiv/bvurem, grouped by operands. +-- | Ground axioms that tie abstract (uninterpreted) div/mod to concrete semantics. +-- Operations sharing the same operands and signedness are grouped so they can +-- share a single unsigned result variable. Signed ops are decomposed into +-- unsigned ops on absolute values, with sign fixup applied per-axiom. +-- Congruence links assert that groups with equal absolute inputs produce equal results. divModGroundAxioms :: [Prop] -> Err [SMTEntry] divModGroundAxioms props = do let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props @@ -145,11 +149,12 @@ divModGroundAxioms props = do unsignedResult = op <> (fromString $ "_" <> show groupIdx) if not (isSigned firstKind) + -- Unsigned: directly equate abstract(a,b) = bvudiv/bvurem(a,b) then mapM mkUnsignedAxiom ops + -- Signed: compute unsigned result on |a|,|b|, then derive each signed op from it else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult let unsignedEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" - let unsignedAssert = SMTCommand $ "(assert (=" `sp` unsignedResult `sp` unsignedEnc <> "))" axioms <- mapM (mkSignedAxiom unsignedResult) ops pure $ decls <> [unsignedAssert] <> axioms @@ -220,12 +225,10 @@ divModShiftBounds props = do prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - if not (isSigned firstKind) then do - -- Unsigned: use concrete bvudiv/bvurem directly - mapM mkUnsignedAxiom ops + -- Unsigned: use concrete bvudiv/bvurem directly + if not (isSigned firstKind) then mapM mkUnsignedAxiom ops else do (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult - let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> let kLit = wordAsBV k @@ -234,7 +237,9 @@ divModShiftBounds props = do in [ SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` unsignedResult `sp` zero <> ")))" , SMTCommand $ "(assert (bvule" `sp` unsignedResult `sp` absAName <> "))" , SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" - , SMTCommand $ "(assert (=> (and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> ")) (bvuge" `sp` unsignedResult `sp` shifted <> ")))" + , SMTCommand $ "(assert (=> " + <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" + <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> -- No shift info: overapproximate (only UNSAT is sound) From 85dc0b43dfbfa99cc0372bd925dafd0369152a73 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:24:46 +0100 Subject: [PATCH 082/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index b72ba0395..a069ea037 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -45,7 +45,7 @@ divModAbstractDecls = exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision --- | Result of div(a,b) is always <= a, and result of mod(a,b) is always <= b +-- | Result of div(a,b) is always <= b, and result of mod(a,b) is always <= b -- Unsigned ONLY divModBounds :: [Prop] -> Err [SMTEntry] divModBounds props = do @@ -66,7 +66,7 @@ divModBounds props = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b let result = "(" <> fname `sp` aenc `sp` benc <> ")" - pure $ SMTCommand $ "(assert (bvule " <> result `sp` aenc <> "))" + pure $ SMTCommand $ "(assert (bvule " <> result `sp` benc <> "))" data DivModOp = IsDiv | IsMod deriving (Eq, Ord) @@ -145,14 +145,15 @@ divModGroundAxioms props = do mkGroupAxioms _ [] = pure [] mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do let isDiv' = isDiv firstKind - op = if isDiv' then "bvudiv" else "bvurem" - unsignedResult = op <> (fromString $ "_" <> show groupIdx) + prefix = if isDiv' then "udiv" else "urem" + unsignedResult = fromString $ prefix <> "_" <> show groupIdx if not (isSigned firstKind) -- Unsigned: directly equate abstract(a,b) = bvudiv/bvurem(a,b) then mapM mkUnsignedAxiom ops -- Signed: compute unsigned result on |a|,|b|, then derive each signed op from it else do + let op = if isDiv' then "bvudiv" else "bvurem" (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult let unsignedEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" let unsignedAssert = SMTCommand $ "(assert (=" `sp` unsignedResult `sp` unsignedEnc <> "))" From c1ac1ce605a72452a0cb1732a85897d90a4b6c28 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:25:10 +0100 Subject: [PATCH 083/150] Fixing --- src/EVM/SMT/DivEncoding.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index a069ea037..02d2561e0 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -45,8 +45,7 @@ divModAbstractDecls = exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision --- | Result of div(a,b) is always <= b, and result of mod(a,b) is always <= b --- Unsigned ONLY +-- | For unsigned, result of div(a,b) is always <= b, and result of mod(a,b) is always <= b divModBounds :: [Prop] -> Err [SMTEntry] divModBounds props = do let allBounds = concatMap (foldProp collectUnsigned []) props From 7447f0db744bf3b3af437da7ef6c63d0f81b8d03 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:29:24 +0100 Subject: [PATCH 084/150] Update --- src/EVM/SMT/DivEncoding.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 02d2561e0..9ae72c4cc 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -275,6 +275,10 @@ smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" -- | |x| as SMT. +-- Bug 3 (Minor): smtAbsolute doesn't handle MIN_INT (line 278-279) +-- smtAbsolute computes ite(x >= 0, x, 0 - x). +-- For the minimum signed 256-bit value (-2^255), 0 - (-2^255) overflows back to -2^255 in two's complement. So |MIN_INT| = MIN_INT (negative), +-- which could produce incorrect signed div/mod results for edge cases like sdiv(-2^255, -1) (which EVM defines as -2^255). smtAbsolute :: Builder -> Builder smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" From 66f14aa363a5625011e25dfb65f6e41e2b3bde1f Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:36:29 +0100 Subject: [PATCH 085/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 9ae72c4cc..bf60f10c5 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -147,9 +147,8 @@ divModGroundAxioms props = do prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - if not (isSigned firstKind) -- Unsigned: directly equate abstract(a,b) = bvudiv/bvurem(a,b) - then mapM mkUnsignedAxiom ops + if not (isSigned firstKind) then mapM mkUnsignedAxiom ops -- Signed: compute unsigned result on |a|,|b|, then derive each signed op from it else do let op = if isDiv' then "bvudiv" else "bvurem" From 4d775f3146431970669ebdaa895c20dbb11cca35 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 15:46:06 +0100 Subject: [PATCH 086/150] Now without divmod --- src/EVM/SMT/DivEncoding.hs | 41 +++----------------------------------- src/EVM/Solvers.hs | 23 +++++++++++---------- 2 files changed, 15 insertions(+), 49 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index bf60f10c5..173508e74 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,7 +1,6 @@ {- | Abstract div/mod encoding for two-phase SMT solving. -} module EVM.SMT.DivEncoding - ( divModGroundAxioms - , assertProps + ( assertProps , assertPropsAbstract , assertPropsShiftBounds ) where @@ -124,40 +123,6 @@ declareAbs groupIdx firstA firstB unsignedResult = do ] pure (decls, (absAName, absBName)) --- | Ground axioms that tie abstract (uninterpreted) div/mod to concrete semantics. --- Operations sharing the same operands and signedness are grouped so they can --- share a single unsigned result variable. Signed ops are decomposed into --- unsigned ops on absolute values, with sign fixup applied per-axiom. --- Congruence links assert that groups with equal absolute inputs produce equal results. -divModGroundAxioms :: [Prop] -> Err [SMTEntry] -divModGroundAxioms props = do - let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props - if null allDivMods then pure [] - else do - let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivMods - indexedGroups = zip [0..] groups - entries <- concat <$> mapM (uncurry mkGroupAxioms) indexedGroups - let links = mkCongruenceLinks indexedGroups - pure $ (SMTComment "division/modulo ground-instance axioms") : entries <> links - where - mkGroupAxioms :: Int -> [DivOp] -> Err [SMTEntry] - mkGroupAxioms _ [] = pure [] - mkGroupAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do - let isDiv' = isDiv firstKind - prefix = if isDiv' then "udiv" else "urem" - unsignedResult = fromString $ prefix <> "_" <> show groupIdx - - -- Unsigned: directly equate abstract(a,b) = bvudiv/bvurem(a,b) - if not (isSigned firstKind) then mapM mkUnsignedAxiom ops - -- Signed: compute unsigned result on |a|,|b|, then derive each signed op from it - else do - let op = if isDiv' then "bvudiv" else "bvurem" - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult - let unsignedEnc = smtZeroGuard absBName $ "(" <> op `sp` absAName `sp` absBName <> ")" - let unsignedAssert = SMTCommand $ "(assert (=" `sp` unsignedResult `sp` unsignedEnc <> "))" - axioms <- mapM (mkSignedAxiom unsignedResult) ops - pure $ decls <> [unsignedAssert] <> axioms - -- | Assert abstract(a,b) = concrete bvudiv/bvurem(a,b). mkUnsignedAxiom :: DivOp -> Err SMTEntry mkUnsignedAxiom (kind, a, b) = do @@ -187,10 +152,10 @@ assertPropsShiftBounds conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) - bounds <- divModBounds ps + -- bounds <- divModBounds ps shiftBounds <- divModShiftBounds ps pure $ base - <> SMT2 (SMTScript bounds) mempty mempty + -- <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript shiftBounds) mempty mempty isMod :: DivOpKind -> Bool diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index ce32a7df2..331c8c41d 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -132,18 +132,19 @@ checkSatWithProps sg props = do else do let concreteKeccaks = fmap (\(buf,val) -> PEq (Lit val) (Keccak buf)) (toList $ Keccak.concreteKeccaks props) let allProps = if conf.simp then psSimp <> concreteKeccaks else psSimp - if not conf.abstractArith then do - let smt2 = assertProps conf allProps - if isLeft smt2 then pure $ Error $ getError smt2 - else liftIO $ checkSat sg (Just props) smt2 - else do + -- if not conf.abstractArith then do + let smt2 = assertProps conf allProps + if isLeft smt2 then pure $ Error $ getError smt2 + else liftIO $ do + ret <- checkSat sg (Just props) smt2 + -- else do -- Two-phase solving with abstraction+refinement - let smt2Abstract = assertPropsAbstract conf allProps - let refinement = divModGroundAxioms allProps - if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract - else if isLeft refinement then pure $ Error $ getError refinement - else liftIO $ do - ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) + -- let smt2Abstract = assertPropsAbstract conf allProps + -- let refinement = divModGroundAxioms allProps + -- if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract + -- else if isLeft refinement then pure $ Error $ getError refinement + -- else liftIO $ do + -- ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) case ret of Cex cex -> do when conf.debug $ logWithTid "Model from abstract query is not spurious, returning cex." From b40f87579d7658fcf3a48e032e3cd71238dade13 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:04:09 +0100 Subject: [PATCH 087/150] Even less --- src/EVM/SMT/DivEncoding.hs | 43 ++------------------------------------ 1 file changed, 2 insertions(+), 41 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 173508e74..0522f1aed 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,7 +1,6 @@ {- | Abstract div/mod encoding for two-phase SMT solving. -} module EVM.SMT.DivEncoding ( assertProps - , assertPropsAbstract , assertPropsShiftBounds ) where @@ -17,15 +16,6 @@ import EVM.Traversals import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) import EVM.Types qualified as T -assertPropsAbstract :: Config -> [Prop] -> Err SMT2 -assertPropsAbstract conf ps = do - let mkBase simp = assertPropsHelperWith AbstractDivision simp divModAbstractDecls - base <- if not conf.simp then mkBase False ps - else mkBase True (decompose conf ps) - bounds <- divModBounds ps - pure $ base <> SMT2 (SMTScript bounds) mempty mempty - - assertProps :: Config -> [Prop] -> Err SMT2 assertProps conf ps = if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps @@ -44,28 +34,6 @@ divModAbstractDecls = exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision --- | For unsigned, result of div(a,b) is always <= b, and result of mod(a,b) is always <= b -divModBounds :: [Prop] -> Err [SMTEntry] -divModBounds props = do - let allBounds = concatMap (foldProp collectUnsigned []) props - if null allBounds then pure [] - else do - assertions <- mapM mkAssertion allBounds - pure $ (SMTComment "division/modulo bounds") : assertions - where - collectUnsigned :: Expr a -> [(Builder, Expr EWord, Expr EWord)] - collectUnsigned = \case - T.Div a b -> [("abst_evm_bvudiv", a, b)] - T.Mod a b -> [("abst_evm_bvurem", a, b)] - _ -> [] - - mkAssertion :: (Builder, Expr EWord, Expr EWord) -> Err SMTEntry - mkAssertion (fname, a, b) = do - aenc <- exprToSMTAbst a - benc <- exprToSMTAbst b - let result = "(" <> fname `sp` aenc `sp` benc <> ")" - pure $ SMTCommand $ "(assert (bvule " <> result `sp` benc <> "))" - data DivModOp = IsDiv | IsMod deriving (Eq, Ord) @@ -152,7 +120,6 @@ assertPropsShiftBounds conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) - -- bounds <- divModBounds ps shiftBounds <- divModShiftBounds ps pure $ base -- <> SMT2 (SMTScript bounds) mempty mempty @@ -198,18 +165,12 @@ divModShiftBounds props = do let kLit = wordAsBV k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" - in [ SMTCommand $ "(assert (=> (=" `sp` absBName `sp` zero <> ") (=" `sp` unsignedResult `sp` zero <> ")))" - , SMTCommand $ "(assert (bvule" `sp` unsignedResult `sp` absAName <> "))" - , SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + in [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" , SMTCommand $ "(assert (=> " <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] - _ -> - -- No shift info: overapproximate (only UNSAT is sound) - [ SMTCommand $ "(assert (=> (=" `sp` absAName `sp` zero <> ") (=" `sp` unsignedResult `sp` zero <> ")))" - , SMTCommand $ "(assert (bvule" `sp` unsignedResult `sp` absAName <> "))" - ] + _ -> [] axioms <- mapM (mkSignedAxiom unsignedResult) ops pure $ decls <> shiftBounds <> axioms From 94d98a8a238c9ec9cabae17059f0049039d566ed Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:17:40 +0100 Subject: [PATCH 088/150] Cleanup --- src/EVM/SMT.hs | 4 +-- src/EVM/SMT/DivEncoding.hs | 70 +++++++++++--------------------------- 2 files changed, 22 insertions(+), 52 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 0a20dd460..f38fd5be6 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -490,9 +490,9 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> divModOp "bvudiv" "abst_evm_bvudiv" a b + Div a b -> op2 "bvudiv" a b SDiv a b -> divModOp "bvsdiv" "abst_evm_bvsdiv" a b - Mod a b -> divModOp "bvurem" "abst_evm_bvurem" a b + Mod a b -> op2 "bvurem" a b SMod a b -> divModOp "bvsrem" "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 0522f1aed..01dd95392 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -25,9 +25,7 @@ assertProps conf ps = divModAbstractDecls :: [SMTEntry] divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] @@ -37,42 +35,33 @@ exprToSMTAbst = exprToSMTWith AbstractDivision data DivModOp = IsDiv | IsMod deriving (Eq, Ord) -data DivOpKind = Div | SDiv | Mod | SMod +data DivOpKind = SDiv | SMod deriving (Eq, Ord) type DivOp = (DivOpKind, Expr EWord, Expr EWord) -data AbsKey - = UnsignedAbsKey (Expr EWord) (Expr EWord) DivModOp - | SignedAbsKey (Expr EWord) (Expr EWord) DivModOp +data AbsKey = SignedAbsKey (Expr EWord) (Expr EWord) DivModOp deriving (Eq, Ord) -isSigned :: DivOpKind -> Bool -isSigned SDiv = True -isSigned SMod = True -isSigned _ = False - isDiv :: DivOpKind -> Bool -isDiv Div = True isDiv SDiv = True isDiv _ = False +isMod :: DivOpKind -> Bool +isMod = not . isDiv + divModOp :: DivOpKind -> DivModOp divModOp k = if isDiv k then IsDiv else IsMod -- | Collect all div/mod operations from an expression. collectDivMods :: Expr a -> [DivOp] collectDivMods = \case - T.Div a b -> [(Div, a, b)] T.SDiv a b -> [(SDiv, a, b)] - T.Mod a b -> [(Mod, a, b)] T.SMod a b -> [(SMod, a, b)] _ -> [] absKey :: DivOp -> AbsKey -absKey (kind, a, b) - | not (isSigned kind) = UnsignedAbsKey a b (divModOp kind) - | otherwise = SignedAbsKey a b (divModOp kind) +absKey (kind, a, b) = SignedAbsKey a b (divModOp kind) -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) @@ -91,17 +80,6 @@ declareAbs groupIdx firstA firstB unsignedResult = do ] pure (decls, (absAName, absBName)) --- | Assert abstract(a,b) = concrete bvudiv/bvurem(a,b). -mkUnsignedAxiom :: DivOp -> Err SMTEntry -mkUnsignedAxiom (kind, a, b) = do - aenc <- exprToSMTAbst a - benc <- exprToSMTAbst b - let fname = if kind == Div then "abst_evm_bvudiv" else "abst_evm_bvurem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - op = if kind == Div then "bvudiv" else "bvurem" - concrete = smtZeroGuard benc $ "(" <> op `sp` aenc `sp` benc <> ")" - pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" - -- | Assert abstract(a,b) = signed result derived from unsigned result. mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry mkSignedAxiom unsignedResult (kind, a, b) = do @@ -125,11 +103,6 @@ assertPropsShiftBounds conf ps = do -- <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript shiftBounds) mempty mempty -isMod :: DivOpKind -> Bool -isMod Mod = True -isMod SMod = True -isMod _ = False - -- | Shift-based bound axioms for div/mod with SHL dividends. divModShiftBounds :: [Prop] -> Err [SMTEntry] divModShiftBounds props = do @@ -156,23 +129,20 @@ divModShiftBounds props = do prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - -- Unsigned: use concrete bvudiv/bvurem directly - if not (isSigned firstKind) then mapM mkUnsignedAxiom ops - else do - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult - let shiftBounds = case (isDiv', extractShift firstA) of - (True, Just k) -> - let kLit = wordAsBV k - threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" - shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" - in [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" - , SMTCommand $ "(assert (=> " - <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" - <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" - ] - _ -> [] - axioms <- mapM (mkSignedAxiom unsignedResult) ops - pure $ decls <> shiftBounds <> axioms + (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult + let shiftBounds = case (isDiv', extractShift firstA) of + (True, Just k) -> + let kLit = wordAsBV k + threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" + shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" + in [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + , SMTCommand $ "(assert (=> " + <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" + <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" + ] + _ -> [] + axioms <- mapM (mkSignedAxiom unsignedResult) ops + pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal abs inputs, their results are equal. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] From 2d4d3446dfefb4cd8faccf9da5fa294d12c6de8e Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:18:26 +0100 Subject: [PATCH 089/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 01dd95392..68b2922ce 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -40,7 +40,7 @@ data DivOpKind = SDiv | SMod type DivOp = (DivOpKind, Expr EWord, Expr EWord) -data AbsKey = SignedAbsKey (Expr EWord) (Expr EWord) DivModOp +data AbsKey = AbsKey (Expr EWord) (Expr EWord) DivModOp deriving (Eq, Ord) isDiv :: DivOpKind -> Bool @@ -61,7 +61,7 @@ collectDivMods = \case _ -> [] absKey :: DivOp -> AbsKey -absKey (kind, a, b) = SignedAbsKey a b (divModOp kind) +absKey (kind, a, b) = AbsKey a b (divModOp kind) -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) From 9476412d70baa2bc1c0f59d1488f8aeee528ba7b Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:19:21 +0100 Subject: [PATCH 090/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 68b2922ce..6a1118a7c 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -112,8 +112,8 @@ divModShiftBounds props = do let groups = groupBy (\a b -> absKey a == absKey b) $ sortBy (comparing absKey) allDivs indexedGroups = zip [0..] groups - entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups let links = mkCongruenceLinks indexedGroups + entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links where -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. From d0ef06b10078a79ae19cf7b720d9adc3df542588 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:47:05 +0100 Subject: [PATCH 091/150] Update --- src/EVM/SMT.hs | 4 +-- src/EVM/SMT/DivEncoding.hs | 23 ++++++++++++++++++ src/EVM/Solvers.hs | 50 +++++++++++++++++--------------------- test/test.hs | 12 +++++++++ 4 files changed, 59 insertions(+), 30 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index f38fd5be6..858a42ef6 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -490,9 +490,9 @@ exprToSMTWith enc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> op2 "bvudiv" a b + Div a b -> op2CheckZero "bvudiv" a b SDiv a b -> divModOp "bvsdiv" "abst_evm_bvsdiv" a b - Mod a b -> op2 "bvurem" a b + Mod a b -> op2CheckZero "bvurem" a b SMod a b -> divModOp "bvsrem" "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 6a1118a7c..9455bc7b5 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -2,6 +2,7 @@ module EVM.SMT.DivEncoding ( assertProps , assertPropsShiftBounds + , divModGroundTruth ) where import Data.Bits ((.&.), countTrailingZeros) @@ -103,6 +104,28 @@ assertPropsShiftBounds conf ps = do -- <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript shiftBounds) mempty mempty +-- | Ground-truth axioms: for each sdiv/smod op, assert that the abstract +-- uninterpreted function equals the real bvsdiv/bvsrem. +-- e.g. (assert (= (abst_evm_bvsdiv a b) (bvsdiv a b))) +divModGroundTruth :: [Prop] -> Err [SMTEntry] +divModGroundTruth props = do + let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props + if null allDivs then pure [] + else do + axioms <- mapM mkGroundTruthAxiom allDivs + pure $ (SMTComment "division/modulo ground-truth refinement") : axioms + where + mkGroundTruthAxiom :: DivOp -> Err SMTEntry + mkGroundTruthAxiom (kind, a, b) = do + aenc <- exprToSMTAbst a + benc <- exprToSMTAbst b + let (abstFn, concFn) = if isDiv kind + then ("abst_evm_bvsdiv", "bvsdiv") + else ("abst_evm_bvsrem", "bvsrem") + pure $ SMTCommand $ "(assert (=" `sp` + "(" <> abstFn `sp` aenc `sp` benc <> ")" `sp` + "(" <> concFn `sp` aenc `sp` benc <> ")))" + -- | Shift-based bound axioms for div/mod with SHL dividends. divModShiftBounds :: [Prop] -> Err [SMTEntry] divModShiftBounds props = do diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 331c8c41d..a1b62703d 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -132,38 +132,28 @@ checkSatWithProps sg props = do else do let concreteKeccaks = fmap (\(buf,val) -> PEq (Lit val) (Keccak buf)) (toList $ Keccak.concreteKeccaks props) let allProps = if conf.simp then psSimp <> concreteKeccaks else psSimp - -- if not conf.abstractArith then do - let smt2 = assertProps conf allProps - if isLeft smt2 then pure $ Error $ getError smt2 - else liftIO $ do - ret <- checkSat sg (Just props) smt2 - -- else do + if not conf.abstractArith then do + let smt2 = assertProps conf allProps + if isLeft smt2 then pure $ Error $ getError smt2 + else liftIO $ checkSat sg (Just props) smt2 + else liftIO $ do -- Two-phase solving with abstraction+refinement - -- let smt2Abstract = assertPropsAbstract conf allProps - -- let refinement = divModGroundAxioms allProps - -- if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract - -- else if isLeft refinement then pure $ Error $ getError refinement - -- else liftIO $ do - -- ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) + let smt2Abstract = assertPropsShiftBounds conf allProps + let refinement = divModGroundTruth allProps + if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract + else if isLeft refinement then pure $ Error $ getError refinement + else liftIO $ do + ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) case ret of - Cex cex -> do - when conf.debug $ logWithTid "Model from abstract query is not spurious, returning cex." - pure $ Cex cex + Cex model -> do + when conf.debug $ logWithTid "Refinement successful, query is SAT." + pure $ Cex model Qed -> do - when conf.debug $ logWithTid "Refinement successful, query is Qed." + when conf.debug $ logWithTid "Query successful, query is Qed." pure Qed Unknown msg -> do - -- 3rd phase: shift bounds when conf.debug $ logWithTid $ "Solver returned unknown during refinement phase: " <> msg - let withShiftBounds = assertPropsShiftBounds conf allProps - checkSat sg (Just props) withShiftBounds >>= \case - Qed -> do - when conf.debug $ logWithTid "Refinement with shift bounds successful, query is Qed." - pure Qed - Error msg2 -> do - when conf.debug $ logWithTid $ "Solver returned error during refinement with shift bounds: " <> msg2 - pure $ Error msg2 - _ -> pure ret -- can't trust Cex here, return old value + pure $ Unknown msg Error msg -> do when conf.debug $ logWithTid $ "Solver returned error during refinement phase: " <> msg pure $ Error msg @@ -316,13 +306,17 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r (\inst -> do ret <- sendAndCheck conf inst cmds $ \res -> do case res of - "unsat" -> dealWithUnsat + "unsat" -> do + when conf.debug $ logWithTid "Orig Query is UNSAT." + dealWithUnsat "sat" -> case refinement of Just refine -> do when conf.debug $ logWithTid "Phase 1 is SAT, refining..." sendAndCheck conf inst refine $ \sat2 -> do case sat2 of - "unsat" -> dealWithUnsat + "unsat" -> do + when conf.debug $ logWithTid "Refined Query is UNSAT." + dealWithUnsat "sat" -> dealWithModel conf inst "timeout" -> pure $ Unknown "Result timeout by SMT solver" "unknown" -> dealWithUnknown conf diff --git a/test/test.hs b/test/test.hs index c14ab6c22..5f545fa1e 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1343,6 +1343,18 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Expected counterexample" (any isCex res) + , testAbstractArith "arith-mod-fail" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_fail(uint x, uint y) external pure { + require(x > y); + uint q; + assembly { q := mod(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) , testAbstractArith "math-avg" $ do Just c <- solcRuntime "C" [i| contract C { From b2b8b4f692552e153f964a64ff185871df0a288d Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 16:55:22 +0100 Subject: [PATCH 092/150] Better --- src/EVM/SMT/DivEncoding.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 9455bc7b5..fd9dd97b0 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -151,14 +151,24 @@ divModShiftBounds props = do let isDiv' = not (isMod firstKind) prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult + + -- When the dividend is a left-shift (a = x << k, i.e. a = x * 2^k), + -- we can bound the unsigned division result using cheap bitshift + -- operations instead of the expensive bvudiv SMT theory. + -- The pivot point is |a| >> k (= |a| / 2^k): + -- - If |b| >= 2^k: result <= |a| >> k (upper bound) + -- - If |b| < 2^k and b != 0: result >= |a| >> k (lower bound) let shiftBounds = case (isDiv', extractShift firstA) of (True, Just k) -> let kLit = wordAsBV k + -- threshold = 2^k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" + -- shifted = |a| >> k = |a| / 2^k shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" - in [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + in -- |b| >= 2^k => |a|/|b| <= |a|/2^k + [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + -- |b| < 2^k and b != 0 => |a|/|b| >= |a|/2^k , SMTCommand $ "(assert (=> " <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" From 359f5dcab7de85ce563ae917c431628f53d8a22b Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:04:07 +0100 Subject: [PATCH 093/150] Better printing --- src/EVM/Solvers.hs | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index a1b62703d..6b56808e4 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -142,21 +142,7 @@ checkSatWithProps sg props = do let refinement = divModGroundTruth allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement - else liftIO $ do - ret <- checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) - case ret of - Cex model -> do - when conf.debug $ logWithTid "Refinement successful, query is SAT." - pure $ Cex model - Qed -> do - when conf.debug $ logWithTid "Query successful, query is Qed." - pure Qed - Unknown msg -> do - when conf.debug $ logWithTid $ "Solver returned unknown during refinement phase: " <> msg - pure $ Unknown msg - Error msg -> do - when conf.debug $ logWithTid $ "Solver returned error during refinement phase: " <> msg - pure $ Error msg + else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> Maybe SMTScript -> IO SMTResult checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do @@ -307,22 +293,22 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r ret <- sendAndCheck conf inst cmds $ \res -> do case res of "unsat" -> do - when conf.debug $ logWithTid "Orig Query is UNSAT." + when conf.debug $ logWithTid "Abstract query is UNSAT." dealWithUnsat "sat" -> case refinement of Just refine -> do - when conf.debug $ logWithTid "Phase 1 is SAT, refining..." + when conf.debug $ logWithTid "Abstract query is SAT, refining..." sendAndCheck conf inst refine $ \sat2 -> do case sat2 of "unsat" -> do - when conf.debug $ logWithTid "Refined Query is UNSAT." + when conf.debug $ logWithTid "Refined query is UNSAT." dealWithUnsat "sat" -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "timeout" -> pure $ Unknown "Refined query timeout" "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf sat2 Nothing -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "timeout" -> pure $ Unknown "Abstract query timeout" "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf res writeChan r ret From 4de3a172dacdfa997a24fdb671076062ce463646 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:08:21 +0100 Subject: [PATCH 094/150] Move --- test/test.hs | 49 ++++++++++++++++++------------------------------- 1 file changed, 18 insertions(+), 31 deletions(-) diff --git a/test/test.hs b/test/test.hs index 5f545fa1e..387fb351a 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1280,10 +1280,26 @@ tests = testGroup "hevm" let testFile = "test/contracts/pass/keccak.sol" runForgeTest testFile "prove_access" >>= assertEqualM "test result" (True, True) ] - , testGroup "Abstract-Arith" + , testGroup "Arith" -- Tests adapted from halmos (tests/regression/test/Arith.t.sol, tests/solver/test/SignedDiv.t.sol, tests/solver/test/Math.t.sol) -- Run with abstractArith = True to exercise two-phase solving - [ testAbstractArith "arith-mod" $ do + [ test "math-avg" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Avg(uint a, uint b) external pure { + require(a + b >= a); + unchecked { + uint r1 = (a & b) + (a ^ b) / 2; + uint r2 = (a + b) / 2; + assert(r1 == r2); + } + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + ] + , testGroup "Abstract-Arith" + , testAbstractArith "arith-mod" $ do Just c <- solcRuntime "C" [i| contract C { function unchecked_mod(uint x, uint y) internal pure returns (uint ret) { @@ -1303,21 +1319,6 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res - , testAbstractArith "arith-exp" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_Exp(uint x) external pure { - unchecked { - assert(x ** 0 == 1); - assert(x ** 1 == x); - assert(x ** 2 == x * x); - assert((x ** 2) ** 2 == x * x * x * x); - assert(((x ** 2) ** 2) ** 2 == (x**2) * (x**2) * (x**2) * (x**2)); - } - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res , testAbstractArith "arith-div-pass" $ do Just c <- solcRuntime "C" [i| contract C { @@ -1355,20 +1356,6 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Expected counterexample" (any isCex res) - , testAbstractArith "math-avg" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_Avg(uint a, uint b) external pure { - require(a + b >= a); - unchecked { - uint r1 = (a & b) + (a ^ b) / 2; - uint r2 = (a + b) / 2; - assert(r1 == r2); - } - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res , testAbstractArith "math-mint-fail" $ do Just c <- solcRuntime "C" [i| contract C { From d5d2659756809dd725425228ad8d054b4a0f646b Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:10:42 +0100 Subject: [PATCH 095/150] Update --- test/test.hs | 509 +++++++++++++++++++++++++-------------------------- 1 file changed, 253 insertions(+), 256 deletions(-) diff --git a/test/test.hs b/test/test.hs index 387fb351a..1845de0ed 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1299,6 +1299,259 @@ tests = testGroup "hevm" assertEqualM "Must be QED" [] res ] , testGroup "Abstract-Arith" + [ testAbstractArith "sdiv-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_one(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, 1) } + assert(result == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "sdiv-by-neg-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_neg_one(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, sub(0, 1)) } + if (a == -170141183460469231731687303715884105728 * 2**128) { // type(int256).min + assert(result == a); + } else { + assert(result == -a); + } + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "sdiv-intmin-by-two" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_intmin_by_two() external pure { + int256 result; + assembly { + let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 + result := sdiv(intmin, 2) + } + // -2**254 is 0xc000...0000 + assert(result == -0x4000000000000000000000000000000000000000000000000000000000000000); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_by_zero(int256 a) external pure { + int256 result; + assembly { result := smod(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , testAbstractArith "smod-intmin-by-three" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_intmin_by_three() external pure { + int256 result; + assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 3) } + assert(result == -2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" res [] + , expectFail $ testAbstractArith "div-mod-identity" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_div_mod_identity(int256 a, int256 b) external pure { + if (b == 0) return; + int256 q; + int256 r; + assembly { + q := sdiv(a, b) + r := smod(a, b) + } + int256 reconstructed; + // using unchecked because SDiv(min, -1) * -1 + 0 = min in EVM (wraps) + unchecked { + reconstructed = q * b + r; + } + assert(reconstructed == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_by_one(uint256 a) external pure { + uint256 result; + assembly { result := div(a, 1) } + assert(result == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "umod-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_umod_by_zero(uint256 a) external pure { + uint256 result; + assembly { result := mod(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_by_zero(int256 a) external pure { + int256 result; + assembly { result := sdiv(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-zero-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_zero_dividend(int256 b) external pure { + int256 result; + assembly { result := sdiv(0, b) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-truncation" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_truncation() external pure { + int256 result; + assembly { result := sdiv(sub(0, 7), 2) } + assert(result == -3); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-sign-symmetry" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_sign_symmetry(int256 a, int256 b) external pure { + if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == 0) return; + int256 r1; + int256 r2; + assembly { + r1 := sdiv(a, b) + r2 := sdiv(sub(0, a), sub(0, b)) + } + assert(r1 == r2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-sign-antisymmetry" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_sign_antisymmetry(int256 a, int256 b) external pure { + if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; + if (b == 0) return; + int256 r1; + int256 r2; + assembly { + r1 := sdiv(a, b) + r2 := sdiv(sub(0, a), b) + } + assert(r1 == -r2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_by_one(int256 a) external pure { + int256 r1; + int256 r2; + assembly { + r1 := smod(a, 1) + r2 := smod(a, sub(0, 1)) + } + assert(r1 == 0); + assert(r2 == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-zero-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_zero_dividend(int256 b) external pure { + int256 result; + assembly { result := smod(0, b) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-sign-matches-dividend" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_sign_matches_dividend(int256 a, int256 b) external pure { + if (b == 0 || a == 0) return; + int256 result; + assembly { result := smod(a, b) } + if (result != 0) { + assert((a > 0 && result > 0) || (a < 0 && result < 0)); + } + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-intmin" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_intmin() external pure { + int256 result; + assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 2) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "unsigned-div-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_unsigned_div_by_zero(uint256 a) external pure { + uint256 result; + assembly { result := div(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , expectFail $ testAbstractArith "unsigned-div-mod-identity" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_unsigned_div_mod_identity(uint256 a, uint256 b) external pure { + if (b == 0) return; + uint256 q; + uint256 r; + assembly { + q := div(a, b) + r := mod(a, b) + } + assert(q * b + r == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res , testAbstractArith "arith-mod" $ do Just c <- solcRuntime "C" [i| contract C { @@ -4073,262 +4326,6 @@ tests = testGroup "hevm" Nothing -> assertBoolM "Address missing from storage reads" False Just storeReads -> assertBoolM "Did not collect all abstract reads!" $ (Set.size storeReads) == 2 ] - , testGroup "Arithmetic Soundness" - [ testAbstractArith "sdiv-by-one" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_by_one(int256 a) external pure { - int256 result; - assembly { result := sdiv(a, 1) } - assert(result == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" res [] - , testAbstractArith "sdiv-by-neg-one" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_by_neg_one(int256 a) external pure { - int256 result; - assembly { result := sdiv(a, sub(0, 1)) } - if (a == -170141183460469231731687303715884105728 * 2**128) { // type(int256).min - assert(result == a); - } else { - assert(result == -a); - } - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" res [] - , testAbstractArith "sdiv-intmin-by-two" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_intmin_by_two() external pure { - int256 result; - assembly { - let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 - result := sdiv(intmin, 2) - } - // -2**254 is 0xc000...0000 - assert(result == -0x4000000000000000000000000000000000000000000000000000000000000000); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "smod-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_by_zero(int256 a) external pure { - int256 result; - assembly { result := smod(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" res [] - , testAbstractArith "smod-intmin-by-three" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_intmin_by_three() external pure { - int256 result; - assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 3) } - assert(result == -2); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" res [] - , expectFail $ testAbstractArith "div-mod-identity" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_div_mod_identity(int256 a, int256 b) external pure { - if (b == 0) return; - int256 q; - int256 r; - assembly { - q := sdiv(a, b) - r := smod(a, b) - } - int256 reconstructed; - // using unchecked because SDiv(min, -1) * -1 + 0 = min in EVM (wraps) - unchecked { - reconstructed = q * b + r; - } - assert(reconstructed == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "udiv-by-one" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_udiv_by_one(uint256 a) external pure { - uint256 result; - assembly { result := div(a, 1) } - assert(result == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "umod-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_umod_by_zero(uint256 a) external pure { - uint256 result; - assembly { result := mod(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "sdiv-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_by_zero(int256 a) external pure { - int256 result; - assembly { result := sdiv(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "sdiv-zero-dividend" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_zero_dividend(int256 b) external pure { - int256 result; - assembly { result := sdiv(0, b) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "sdiv-truncation" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_truncation() external pure { - int256 result; - assembly { result := sdiv(sub(0, 7), 2) } - assert(result == -3); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "sdiv-sign-symmetry" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_sign_symmetry(int256 a, int256 b) external pure { - if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; - if (b == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; - if (b == 0) return; - int256 r1; - int256 r2; - assembly { - r1 := sdiv(a, b) - r2 := sdiv(sub(0, a), sub(0, b)) - } - assert(r1 == r2); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "sdiv-sign-antisymmetry" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_sdiv_sign_antisymmetry(int256 a, int256 b) external pure { - if (a == -57896044618658097711785492504343953926634992332820282019728792003956564819968) return; - if (b == 0) return; - int256 r1; - int256 r2; - assembly { - r1 := sdiv(a, b) - r2 := sdiv(sub(0, a), b) - } - assert(r1 == -r2); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "smod-by-one" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_by_one(int256 a) external pure { - int256 r1; - int256 r2; - assembly { - r1 := smod(a, 1) - r2 := smod(a, sub(0, 1)) - } - assert(r1 == 0); - assert(r2 == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "smod-zero-dividend" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_zero_dividend(int256 b) external pure { - int256 result; - assembly { result := smod(0, b) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "smod-sign-matches-dividend" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_sign_matches_dividend(int256 a, int256 b) external pure { - if (b == 0 || a == 0) return; - int256 result; - assembly { result := smod(a, b) } - if (result != 0) { - assert((a > 0 && result > 0) || (a < 0 && result < 0)); - } - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "smod-intmin" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_smod_intmin() external pure { - int256 result; - assembly { result := smod(0x8000000000000000000000000000000000000000000000000000000000000000, 2) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "unsigned-div-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_unsigned_div_by_zero(uint256 a) external pure { - uint256 result; - assembly { result := div(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , expectFail $ testAbstractArith "unsigned-div-mod-identity" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_unsigned_div_mod_identity(uint256 a, uint256 b) external pure { - if (b == 0) return; - uint256 q; - uint256 r; - assembly { - q := div(a, b) - r := mod(a, b) - } - assert(q * b + r == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - ] - ] where (===>) = assertSolidityComputation From 05198eb6b8f64aa03592e7561c010d826e1b0563 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:19:17 +0100 Subject: [PATCH 096/150] Update tests --- test/test.hs | 174 +++++++++++++++++---------------------------------- 1 file changed, 57 insertions(+), 117 deletions(-) diff --git a/test/test.hs b/test/test.hs index 1845de0ed..c79a5cf64 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1297,6 +1297,54 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + , test "unsigned-div-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_unsigned_div_by_zero(uint256 a) external pure { + uint256 result; + assembly { result := div(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , test "arith-div-pass" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_pass(uint x, uint y) external pure { + require(x > y); + require(y > 0); + uint q; + assembly { q := div(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , test "arith-div-fail" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_fail(uint x, uint y) external pure { + require(x > y); + uint q; + assembly { q := div(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) + , test "arith-mod-fail" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_Div_fail(uint x, uint y) external pure { + require(x > y); + uint q; + assembly { q := mod(x, y) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) ] , testGroup "Abstract-Arith" [ testAbstractArith "sdiv-by-one" $ do @@ -1362,49 +1410,6 @@ tests = testGroup "hevm" } |] (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" res [] - , expectFail $ testAbstractArith "div-mod-identity" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_div_mod_identity(int256 a, int256 b) external pure { - if (b == 0) return; - int256 q; - int256 r; - assembly { - q := sdiv(a, b) - r := smod(a, b) - } - int256 reconstructed; - // using unchecked because SDiv(min, -1) * -1 + 0 = min in EVM (wraps) - unchecked { - reconstructed = q * b + r; - } - assert(reconstructed == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "udiv-by-one" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_udiv_by_one(uint256 a) external pure { - uint256 result; - assembly { result := div(a, 1) } - assert(result == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "umod-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_umod_by_zero(uint256 a) external pure { - uint256 result; - assembly { result := mod(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res , testAbstractArith "sdiv-by-zero" $ do Just c <- solcRuntime "C" [i| contract C { @@ -1525,90 +1530,24 @@ tests = testGroup "hevm" } |] (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res - , testAbstractArith "unsigned-div-by-zero" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_unsigned_div_by_zero(uint256 a) external pure { - uint256 result; - assembly { result := div(a, 0) } - assert(result == 0); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , expectFail $ testAbstractArith "unsigned-div-mod-identity" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_unsigned_div_mod_identity(uint256 a, uint256 b) external pure { - if (b == 0) return; - uint256 q; - uint256 r; - assembly { - q := div(a, b) - r := mod(a, b) - } - assert(q * b + r == a); - } - } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res , testAbstractArith "arith-mod" $ do Just c <- solcRuntime "C" [i| contract C { - function unchecked_mod(uint x, uint y) internal pure returns (uint ret) { - assembly { ret := mod(x, y) } + function unchecked_smod(int x, int y) internal pure returns (int ret) { + assembly { ret := smod(x, y) } } - function prove_Mod(uint x, uint y, address addr) external pure { + function prove_Mod(int x, int y) external pure { unchecked { - assert(unchecked_mod(x, 0) == 0); + assert(unchecked_smod(x, 0) == 0); assert(x % 1 == 0); - assert(x % 2 < 2); - assert(x % 4 < 4); - uint x_mod_y = unchecked_mod(x, y); - assert(x_mod_y <= y); - assert(uint256(uint160(addr)) % (2**160) == uint256(uint160(addr))); - } + assert(x % 2 < 2 && x % 2 > -2); + assert(x % 4 < 4 && x % 4 > -4); + int x_smod_y = unchecked_smod(x, y); + assert(x_smod_y <= y || y < 0);} } } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res - , testAbstractArith "arith-div-pass" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_Div_pass(uint x, uint y) external pure { - require(x > y); - require(y > 0); - uint q; - assembly { q := div(x, y) } - assert(q != 0); - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res - , testAbstractArith "arith-div-fail" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_Div_fail(uint x, uint y) external pure { - require(x > y); - uint q; - assembly { q := div(x, y) } - assert(q != 0); - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertBoolM "Expected counterexample" (any isCex res) - , testAbstractArith "arith-mod-fail" $ do - Just c <- solcRuntime "C" [i| - contract C { - function prove_Div_fail(uint x, uint y) external pure { - require(x > y); - uint q; - assembly { q := mod(x, y) } - assert(q != 0); - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertBoolM "Expected counterexample" (any isCex res) , testAbstractArith "math-mint-fail" $ do Just c <- solcRuntime "C" [i| contract C { @@ -4326,6 +4265,7 @@ tests = testGroup "hevm" Nothing -> assertBoolM "Address missing from storage reads" False Just storeReads -> assertBoolM "Did not collect all abstract reads!" $ (Set.size storeReads) == 2 ] + ] where (===>) = assertSolidityComputation From 0002c69b6070e29f0b733a5f9e745f0995ad434f Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:25:18 +0100 Subject: [PATCH 097/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index fd9dd97b0..1fda935fc 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -36,33 +36,27 @@ exprToSMTAbst = exprToSMTWith AbstractDivision data DivModOp = IsDiv | IsMod deriving (Eq, Ord) -data DivOpKind = SDiv | SMod - deriving (Eq, Ord) - -type DivOp = (DivOpKind, Expr EWord, Expr EWord) +type DivOp = (DivModOp, Expr EWord, Expr EWord) data AbsKey = AbsKey (Expr EWord) (Expr EWord) DivModOp deriving (Eq, Ord) -isDiv :: DivOpKind -> Bool -isDiv SDiv = True +isDiv :: DivModOp -> Bool +isDiv IsDiv = True isDiv _ = False -isMod :: DivOpKind -> Bool +isMod :: DivModOp -> Bool isMod = not . isDiv -divModOp :: DivOpKind -> DivModOp -divModOp k = if isDiv k then IsDiv else IsMod - -- | Collect all div/mod operations from an expression. collectDivMods :: Expr a -> [DivOp] collectDivMods = \case - T.SDiv a b -> [(SDiv, a, b)] - T.SMod a b -> [(SMod, a, b)] + T.SDiv a b -> [(IsDiv, a, b)] + T.SMod a b -> [(IsMod, a, b)] _ -> [] absKey :: DivOp -> AbsKey -absKey (kind, a, b) = AbsKey a b (divModOp kind) +absKey (kind, a, b) = AbsKey a b kind -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) @@ -148,7 +142,7 @@ divModShiftBounds props = do mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] mkGroupShiftAxioms _ [] = pure [] mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do - let isDiv' = not (isMod firstKind) + let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult @@ -180,8 +174,8 @@ divModShiftBounds props = do -- | Congruence: if two signed groups have equal abs inputs, their results are equal. mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SDiv] - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == SMod] + let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsDiv] + signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsMod] in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) where @@ -226,10 +220,12 @@ smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" smtSdivResult :: Builder -> Builder -> Builder -> Builder smtSdivResult aenc benc udivResult = smtZeroGuard benc $ - "(ite" `sp` smtSameSign aenc benc `sp` udivResult `sp` smtNeg udivResult <> ")" + "(ite" `sp` (smtSameSign aenc benc) `sp` + udivResult `sp` (smtNeg udivResult) <> ")" -- | smod(a,b) from urem(|a|,|b|): result sign matches dividend. smtSmodResult :: Builder -> Builder -> Builder -> Builder smtSmodResult aenc benc uremResult = smtZeroGuard benc $ - "(ite" `sp` smtIsNonNeg aenc `sp` uremResult `sp` smtNeg uremResult <> ")" + "(ite" `sp` (smtIsNonNeg aenc) `sp` + uremResult `sp` (smtNeg uremResult) <> ")" From d7bdb5542a88718f82051cae06138435daacaf86 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:43:46 +0100 Subject: [PATCH 098/150] Adding tests --- src/EVM/SMT/DivEncoding.hs | 12 ++++++----- test/test.hs | 44 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 5 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 1fda935fc..c18ee6271 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -196,11 +196,13 @@ smtZeroGuard :: Builder -> Builder -> Builder smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" --- | |x| as SMT. --- Bug 3 (Minor): smtAbsolute doesn't handle MIN_INT (line 278-279) --- smtAbsolute computes ite(x >= 0, x, 0 - x). --- For the minimum signed 256-bit value (-2^255), 0 - (-2^255) overflows back to -2^255 in two's complement. So |MIN_INT| = MIN_INT (negative), --- which could produce incorrect signed div/mod results for edge cases like sdiv(-2^255, -1) (which EVM defines as -2^255). +-- | |x| as SMT: ite(x >= 0, x, 0 - x). +-- Note: for MIN_INT (-2^255), 0 - (-2^255) overflows back to -2^255 in two's +-- complement. However, this is harmless because the bit pattern 0x8000...0 is +-- 2^255 when interpreted unsigned, which is the correct absolute value. +-- All downstream operations (udiv/urem, shift bounds) use unsigned bitvector +-- ops, so they see the correct value. Sign correction is handled separately +-- in smtSdivResult/smtSmodResult using the original signed operands. smtAbsolute :: Builder -> Builder smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" diff --git a/test/test.hs b/test/test.hs index c79a5cf64..2c2bf6f5d 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1530,6 +1530,50 @@ tests = testGroup "hevm" } |] (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-intmin-by-neg-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_intmin_by_neg_one() external pure { + int256 result; + assembly { + let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 + result := sdiv(intmin, sub(0, 1)) + } + // EVM defines sdiv(MIN_INT, -1) = MIN_INT (overflow) + assert(result == -57896044618658097711785492504343953926634992332820282019728792003956564819968); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "smod-intmin-by-neg-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_smod_intmin_by_neg_one() external pure { + int256 result; + assembly { + let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 + result := smod(intmin, sub(0, 1)) + } + // smod(MIN_INT, -1) = 0 since MIN_INT is divisible by -1 + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "sdiv-intmin-by-intmin" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_sdiv_intmin_by_intmin() external pure { + int256 result; + assembly { + let intmin := 0x8000000000000000000000000000000000000000000000000000000000000000 + result := sdiv(intmin, intmin) + } + assert(result == 1); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res , testAbstractArith "arith-mod" $ do Just c <- solcRuntime "C" [i| contract C { From 36221ec6f1de22614d206903af9b2f3f5d5b86a4 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 17:56:49 +0100 Subject: [PATCH 099/150] Cleanup --- src/EVM/SMT/DivEncoding.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index c18ee6271..46f372483 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -45,9 +45,6 @@ isDiv :: DivModOp -> Bool isDiv IsDiv = True isDiv _ = False -isMod :: DivModOp -> Bool -isMod = not . isDiv - -- | Collect all div/mod operations from an expression. collectDivMods :: Expr a -> [DivOp] collectDivMods = \case From 0aebdfb6730bd27cec3437822c38412a2852f6f0 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 18:21:09 +0100 Subject: [PATCH 100/150] Fix dumping --- src/EVM/Solvers.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 6b56808e4..7850ba59e 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -285,11 +285,11 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r (waitQSem sem) (signalQSem sem) (do - when (conf.dumpQueries) $ writeSMT2File smt2 "." (show fileCounter) bracket (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do + when (conf.dumpQueries) $ writeSMT2File smt2 "-abst." (show fileCounter) ret <- sendAndCheck conf inst cmds $ \res -> do case res of "unsat" -> do @@ -298,6 +298,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r "sat" -> case refinement of Just refine -> do when conf.debug $ logWithTid "Abstract query is SAT, refining..." + when (conf.dumpQueries) $ writeSMT2File (smt2 <> (SMT2 refine mempty mempty)) "-ref." (show fileCounter) sendAndCheck conf inst refine $ \sat2 -> do case sat2 of "unsat" -> do From 936280b873d6cdbae6142dfec5ebd5bbe4e5812c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Tue, 17 Feb 2026 18:27:02 +0100 Subject: [PATCH 101/150] Fix dumping --- src/EVM/Solvers.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 7850ba59e..76aa4d170 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -327,7 +327,8 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) pure Qed dealWithUnknown conf = do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved + let fullSMT2 = smt2 <> SMT2 (fromMaybe mempty refinement) mempty mempty + dumpUnsolved fullSMT2 fileCounter conf.dumpUnsolved unknown conf "SMT solver returned unknown (maybe it got killed?)" dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model From 8bef5996a4a92af5a13c5fa34a3d292efa21a2c2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 10:46:44 +0100 Subject: [PATCH 102/150] Better --- src/EVM/SMT/DivEncoding.hs | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 46f372483..3c62523f8 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -73,15 +73,15 @@ declareAbs groupIdx firstA firstB unsignedResult = do pure (decls, (absAName, absBName)) -- | Assert abstract(a,b) = signed result derived from unsigned result. -mkSignedAxiom :: Builder -> DivOp -> Err SMTEntry -mkSignedAxiom unsignedResult (kind, a, b) = do +assertSignedEqualsUnsignedDerived :: Builder -> DivOp -> Err SMTEntry +assertSignedEqualsUnsignedDerived unsignedResult (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" concrete = if isDiv kind - then smtSdivResult aenc benc unsignedResult - else smtSmodResult aenc benc unsignedResult + then signedFromUnsignedDiv aenc benc unsignedResult + else signedFromUnsignedMod aenc benc unsignedResult pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | Assert props using shift-based bounds to avoid bvudiv when possible. @@ -165,7 +165,7 @@ divModShiftBounds props = do <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] - axioms <- mapM (mkSignedAxiom unsignedResult) ops + axioms <- mapM (assertSignedEqualsUnsignedDerived unsignedResult) ops pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal abs inputs, their results are equal. @@ -194,12 +194,6 @@ smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" -- | |x| as SMT: ite(x >= 0, x, 0 - x). --- Note: for MIN_INT (-2^255), 0 - (-2^255) overflows back to -2^255 in two's --- complement. However, this is harmless because the bit pattern 0x8000...0 is --- 2^255 when interpreted unsigned, which is the correct absolute value. --- All downstream operations (udiv/urem, shift bounds) use unsigned bitvector --- ops, so they see the correct value. Sign correction is handled separately --- in smtSdivResult/smtSmodResult using the original signed operands. smtAbsolute :: Builder -> Builder smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" @@ -207,7 +201,7 @@ smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` smtNeg :: Builder -> Builder smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" --- | True if a and b have the same sign. +-- | True if a and b have the same sign smtSameSign :: Builder -> Builder -> Builder smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" @@ -215,16 +209,16 @@ smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` smtIsNonNeg :: Builder -> Builder smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" --- | sdiv(a,b) from udiv(|a|,|b|): negate result if signs differ. -smtSdivResult :: Builder -> Builder -> Builder -> Builder -smtSdivResult aenc benc udivResult = +-- | sdiv(a,b) from udiv(|a|,|b|): negate result if signs differ +signedFromUnsignedDiv :: Builder -> Builder -> Builder -> Builder +signedFromUnsignedDiv aenc benc udivResult = smtZeroGuard benc $ "(ite" `sp` (smtSameSign aenc benc) `sp` udivResult `sp` (smtNeg udivResult) <> ")" -- | smod(a,b) from urem(|a|,|b|): result sign matches dividend. -smtSmodResult :: Builder -> Builder -> Builder -> Builder -smtSmodResult aenc benc uremResult = +signedFromUnsignedMod :: Builder -> Builder -> Builder -> Builder +signedFromUnsignedMod aenc benc uremResult = smtZeroGuard benc $ "(ite" `sp` (smtIsNonNeg aenc) `sp` uremResult `sp` (smtNeg uremResult) <> ")" From 706952ed769683c307fe499f044a68475e256b83 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 10:49:33 +0100 Subject: [PATCH 103/150] Update --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 3c62523f8..ff377c970 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -128,7 +128,7 @@ divModShiftBounds props = do indexedGroups = zip [0..] groups let links = mkCongruenceLinks indexedGroups entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups - pure $ (SMTComment "division/modulo shift-bound axioms (no bvudiv)") : entries <> links + pure $ (SMTComment "division/modulo encoding (abs + shift-bounds + congruence, no bvudiv)") : entries <> links where -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. extractShift :: Expr EWord -> Maybe W256 From a0baa04070548229299e3a8506760ce3fbfed9d2 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 10:50:06 +0100 Subject: [PATCH 104/150] Better --- src/EVM/SMT/DivEncoding.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index ff377c970..867ef36f3 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -90,7 +90,7 @@ assertPropsShiftBounds conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) - shiftBounds <- divModShiftBounds ps + shiftBounds <- divModEncoding ps pure $ base -- <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript shiftBounds) mempty mempty @@ -118,8 +118,8 @@ divModGroundTruth props = do "(" <> concFn `sp` aenc `sp` benc <> ")))" -- | Shift-based bound axioms for div/mod with SHL dividends. -divModShiftBounds :: [Prop] -> Err [SMTEntry] -divModShiftBounds props = do +divModEncoding :: [Prop] -> Err [SMTEntry] +divModEncoding props = do let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivs then pure [] else do From ba22aac93594fdf27facd360a6cdcfec124eee22 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 10:50:25 +0100 Subject: [PATCH 105/150] Update --- src/EVM/SMT/DivEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 867ef36f3..aa42a1e00 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -117,7 +117,7 @@ divModGroundTruth props = do "(" <> abstFn `sp` aenc `sp` benc <> ")" `sp` "(" <> concFn `sp` aenc `sp` benc <> ")))" --- | Shift-based bound axioms for div/mod with SHL dividends. +-- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). divModEncoding :: [Prop] -> Err [SMTEntry] divModEncoding props = do let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props From 81c766a40d3ce91bc34b1924a003e5d34d1c2001 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 11:04:20 +0100 Subject: [PATCH 106/150] Update naming --- src/EVM/SMT/DivEncoding.hs | 35 +++++++++++++++++------------------ src/EVM/Solvers.hs | 2 +- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index aa42a1e00..31cf6f28a 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,7 +1,7 @@ {- | Abstract div/mod encoding for two-phase SMT solving. -} module EVM.SMT.DivEncoding ( assertProps - , assertPropsShiftBounds + , assertPropsAbstract , divModGroundTruth ) where @@ -33,26 +33,26 @@ divModAbstractDecls = exprToSMTAbst :: Expr a -> Err Builder exprToSMTAbst = exprToSMTWith AbstractDivision -data DivModOp = IsDiv | IsMod +data DivModKind = IsDiv | IsMod deriving (Eq, Ord) -type DivOp = (DivModOp, Expr EWord, Expr EWord) +type DivModOp = (DivModKind, Expr EWord, Expr EWord) -data AbsKey = AbsKey (Expr EWord) (Expr EWord) DivModOp +data AbsKey = AbsKey (Expr EWord) (Expr EWord) DivModKind deriving (Eq, Ord) -isDiv :: DivModOp -> Bool +isDiv :: DivModKind -> Bool isDiv IsDiv = True isDiv _ = False -- | Collect all div/mod operations from an expression. -collectDivMods :: Expr a -> [DivOp] +collectDivMods :: Expr a -> [DivModOp] collectDivMods = \case T.SDiv a b -> [(IsDiv, a, b)] T.SMod a b -> [(IsMod, a, b)] _ -> [] -absKey :: DivOp -> AbsKey +absKey :: DivModOp -> AbsKey absKey (kind, a, b) = AbsKey a b kind -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. @@ -73,7 +73,7 @@ declareAbs groupIdx firstA firstB unsignedResult = do pure (decls, (absAName, absBName)) -- | Assert abstract(a,b) = signed result derived from unsigned result. -assertSignedEqualsUnsignedDerived :: Builder -> DivOp -> Err SMTEntry +assertSignedEqualsUnsignedDerived :: Builder -> DivModOp -> Err SMTEntry assertSignedEqualsUnsignedDerived unsignedResult (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b @@ -84,15 +84,14 @@ assertSignedEqualsUnsignedDerived unsignedResult (kind, a, b) = do else signedFromUnsignedMod aenc benc unsignedResult pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Assert props using shift-based bounds to avoid bvudiv when possible. -assertPropsShiftBounds :: Config -> [Prop] -> Err SMT2 -assertPropsShiftBounds conf ps = do +-- | Assert props with abstract div/mod (uninterpreted functions + encoding constraints). +assertPropsAbstract :: Config -> [Prop] -> Err SMT2 +assertPropsAbstract conf ps = do let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) shiftBounds <- divModEncoding ps pure $ base - -- <> SMT2 (SMTScript bounds) mempty mempty <> SMT2 (SMTScript shiftBounds) mempty mempty -- | Ground-truth axioms: for each sdiv/smod op, assert that the abstract @@ -106,7 +105,7 @@ divModGroundTruth props = do axioms <- mapM mkGroundTruthAxiom allDivs pure $ (SMTComment "division/modulo ground-truth refinement") : axioms where - mkGroundTruthAxiom :: DivOp -> Err SMTEntry + mkGroundTruthAxiom :: DivModOp -> Err SMTEntry mkGroundTruthAxiom (kind, a, b) = do aenc <- exprToSMTAbst a benc <- exprToSMTAbst b @@ -127,7 +126,7 @@ divModEncoding props = do $ sortBy (comparing absKey) allDivs indexedGroups = zip [0..] groups let links = mkCongruenceLinks indexedGroups - entries <- concat <$> mapM (uncurry mkGroupShiftAxioms) indexedGroups + entries <- concat <$> mapM (uncurry mkGroupEncoding) indexedGroups pure $ (SMTComment "division/modulo encoding (abs + shift-bounds + congruence, no bvudiv)") : entries <> links where -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. @@ -136,9 +135,9 @@ divModEncoding props = do extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (fromIntegral $ countTrailingZeros n) extractShift _ = Nothing - mkGroupShiftAxioms :: Int -> [DivOp] -> Err [SMTEntry] - mkGroupShiftAxioms _ [] = pure [] - mkGroupShiftAxioms groupIdx ops@((firstKind, firstA, firstB) : _) = do + mkGroupEncoding :: Int -> [DivModOp] -> Err [SMTEntry] + mkGroupEncoding _ [] = pure [] + mkGroupEncoding groupIdx ops@((firstKind, firstA, firstB) : _) = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx @@ -169,7 +168,7 @@ divModEncoding props = do pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal abs inputs, their results are equal. -mkCongruenceLinks :: [(Int, [DivOp])] -> [SMTEntry] +mkCongruenceLinks :: [(Int, [DivModOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsDiv] signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsMod] diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 76aa4d170..fd0e1c475 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -138,7 +138,7 @@ checkSatWithProps sg props = do else liftIO $ checkSat sg (Just props) smt2 else liftIO $ do -- Two-phase solving with abstraction+refinement - let smt2Abstract = assertPropsShiftBounds conf allProps + let smt2Abstract = assertPropsAbstract conf allProps let refinement = divModGroundTruth allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement From 48bc777e6a03183cc1ffebf068b16b5199883f4d Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 11:12:36 +0100 Subject: [PATCH 107/150] Cleanup --- src/EVM/SMT.hs | 64 ++++++++++++++++++---------------------------- src/EVM/Solvers.hs | 2 +- 2 files changed, 26 insertions(+), 40 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 858a42ef6..4ab3d6774 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -413,7 +413,7 @@ byteAsBV :: Word8 -> Builder byteAsBV b = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal b <> " 8)" exprToSMTWith :: DivEncoding -> Expr a -> Err Builder -exprToSMTWith enc = \case +exprToSMTWith divEnc = \case Lit w -> pure $ wordAsBV w Var s -> pure $ fromText s GVar (BufVar n) -> pure $ fromString $ "buf" <> (show n) @@ -423,7 +423,7 @@ exprToSMTWith enc = \case eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty twentyone twentytwo twentythree twentyfour twentyfive twentysix twentyseven twentyeight twentynine thirty thirtyone - -> concatBytesWith enc [ + -> concatBytesWith divEnc [ z, o, two, three, four, five, six, seven , eight, nine, ten, eleven, twelve, thirteen, fourteen, fifteen , sixteen, seventeen, eighteen, nineteen, twenty, twentyone, twentytwo, twentythree @@ -442,7 +442,7 @@ exprToSMTWith enc = \case pure $ "(bvshl " <> one `sp` benc <> ")" _ -> case b of -- b is limited below, otherwise SMT query will be huge, and eventually Haskell stack overflows - Lit b' | b' < 1000 -> expandExpWith enc a b' + Lit b' | b' < 1000 -> expandExpWith divEnc a b' _ -> Left $ "Cannot encode symbolic exponent into SMT. Offending symbolic value: " <> show b Min a b -> do aenc <- exprToSMT a @@ -492,7 +492,7 @@ exprToSMTWith enc = \case SEx a b -> op2 "signext" a b Div a b -> op2CheckZero "bvudiv" a b SDiv a b -> divModOp "bvsdiv" "abst_evm_bvsdiv" a b - Mod a b -> op2CheckZero "bvurem" a b + Mod a b -> op2CheckZero "bvurem" a b SMod a b -> divModOp "bvsrem" "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do @@ -515,20 +515,20 @@ exprToSMTWith enc = \case cond <- op2 "=" a b pure $ "(ite " <> cond `sp` one `sp` zero <> ")" Keccak a -> do - e <- exprToSMT a + enc <- exprToSMT a sz <- exprToSMT $ Expr.bufLength a - pure $ "(keccak " <> e <> " " <> sz <> ")" + pure $ "(keccak " <> enc <> " " <> sz <> ")" TxValue -> pure $ fromString "txvalue" Balance a -> pure $ fromString "balance_" <> formatEAddr a Origin -> pure "origin" BlockHash a -> do - e <- exprToSMT a - pure $ "(blockhash " <> e <> ")" + enc <- exprToSMT a + pure $ "(blockhash " <> enc <> ")" CodeSize a -> do - e <- exprToSMT a - pure $ "(codesize " <> e <> ")" + enc <- exprToSMT a + pure $ "(codesize " <> enc <> ")" Coinbase -> pure "coinbase" Timestamp -> pure "timestamp" BlockNumber -> pure "blocknumber" @@ -546,14 +546,14 @@ exprToSMTWith enc = \case IndexWord idx w -> case idx of Lit n -> if n >= 0 && n < 32 then do - e <- exprToSMT w - pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` e <> ")" + enc <- exprToSMT w + pure $ fromLazyText ("(indexWord" <> T.pack (show (into n :: Integer))) `sp` enc <> ")" else exprToSMT (LitByte 0) _ -> op2 "indexWord" idx w ReadByte idx src -> op2 "select" src idx ConcreteBuf "" -> pure "((as const Buf) #b00000000)" - ConcreteBuf bs -> writeBytesWith enc bs mempty + ConcreteBuf bs -> writeBytesWith divEnc bs mempty AbstractBuf s -> pure $ fromText s ReadWord idx prev -> op2 "readWord" idx prev BufLength (AbstractBuf b) -> pure $ fromText b <> "_length" @@ -572,10 +572,10 @@ exprToSMTWith enc = \case CopySlice srcIdx dstIdx size src dst -> do srcSMT <- exprToSMT src dstSMT <- exprToSMT dst - copySliceWith enc srcIdx dstIdx size srcSMT dstSMT + copySliceWith divEnc srcIdx dstIdx size srcSMT dstSMT -- we need to do a bit of processing here. - ConcreteStore s -> encodeConcreteStore enc s + ConcreteStore s -> encodeConcreteStore divEnc s AbstractStore a idx -> pure $ storeName a idx SStore idx val prev -> do encIdx <- exprToSMT idx @@ -590,11 +590,11 @@ exprToSMTWith enc = \case a -> internalError $ "TODO: implement: " <> show a where exprToSMT :: Expr x -> Err Builder - exprToSMT = exprToSMTWith enc + exprToSMT = exprToSMTWith divEnc op1 :: Builder -> Expr x -> Err Builder op1 op a = do - e <- exprToSMT a - pure $ "(" <> op `sp` e <> ")" + enc <- exprToSMT a + pure $ "(" <> op `sp` enc <> ")" op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do aenc <- exprToSMT a @@ -606,36 +606,29 @@ exprToSMTWith enc = \case benc <- exprToSMT b pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" divModOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder - divModOp concreteOp abstractOp a b = case enc of + divModOp concreteOp abstractOp a b = case divEnc of ConcreteDivision -> op2CheckZero concreteOp a b AbstractDivision -> op2 abstractOp a b --- ** SMT builder helpers ** ----------------------------------------------------------------------- - --- | Space-separated concatenation of two builders sp :: Builder -> Builder -> Builder a `sp` b = a <> " " <> b --- | Zero constant for 256-bit bitvectors zero :: Builder zero = "(_ bv0 256)" --- | One constant for 256-bit bitvectors one :: Builder one = "(_ bv1 256)" - - propToSMTWith :: DivEncoding -> Prop -> Err Builder -propToSMTWith enc = \case +propToSMTWith divEnc = \case PEq a b -> op2 "=" a b PLT a b -> op2 "bvult" a b PGT a b -> op2 "bvugt" a b PLEq a b -> op2 "bvule" a b PGEq a b -> op2 "bvuge" a b PNeg a -> do - e <- propToSMT a - pure $ "(not " <> e <> ")" + enc <- propToSMT a + pure $ "(not " <> enc <> ")" PAnd a b -> do aenc <- propToSMT a benc <- propToSMT b @@ -651,19 +644,15 @@ propToSMTWith enc = \case PBool b -> pure $ if b then "true" else "false" where propToSMT :: Prop -> Err Builder - propToSMT = propToSMTWith enc + propToSMT = propToSMTWith divEnc op2 :: Builder -> Expr x -> Expr y -> Err Builder op2 op a b = do - aenc <- exprToSMTWith enc a - benc <- exprToSMTWith enc b + aenc <- exprToSMTWith divEnc a + benc <- exprToSMTWith divEnc b pure $ "(" <> op <> " " <> aenc <> " " <> benc <> ")" - - -- ** Helpers ** --------------------------------------------------------------------------------- - - copySliceWith :: DivEncoding -> Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do sz <- internal size @@ -681,7 +670,6 @@ copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do offset o e = exprToSMTWith divEnc $ Expr.add (Lit o) e copySliceWith _ _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query" - expandExpWith :: DivEncoding -> Expr EWord -> W256 -> Err Builder expandExpWith divEnc base expnt -- in EVM, anything (including 0) to the power of 0 is 1 @@ -692,7 +680,6 @@ expandExpWith divEnc base expnt n <- expandExpWith divEnc base (expnt - 1) pure $ "(bvmul " <> b `sp` n <> ")" - concatBytesWith :: DivEncoding -> [Expr Byte] -> Err Builder concatBytesWith divEnc bytes = do case List.uncons $ reverse bytes of @@ -706,7 +693,6 @@ concatBytesWith divEnc bytes = do byteSMT <- exprToSMTWith divEnc byte pure $ "(concat " <> byteSMT `sp` inner <> ")" - writeBytesWith :: DivEncoding -> ByteString -> Expr Buf -> Err Builder writeBytesWith divEnc bytes buf = do smtText <- exprToSMTWith divEnc buf diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index fd0e1c475..9b6ff7d0a 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -138,7 +138,7 @@ checkSatWithProps sg props = do else liftIO $ checkSat sg (Just props) smt2 else liftIO $ do -- Two-phase solving with abstraction+refinement - let smt2Abstract = assertPropsAbstract conf allProps + let smt2Abstract = assertPropsAbstract conf allProps let refinement = divModGroundTruth allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement From 2426e8877bea2ddf8d44c237858b4b1a9c921a65 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 11:43:28 +0100 Subject: [PATCH 108/150] Cleanup --- hevm.cabal | 2 +- src/EVM/Fetch.hs | 2 +- src/EVM/SMT.hs | 24 +++++++++++++ src/EVM/SMT/DivEncoding.hs | 69 +++++++++++++++++--------------------- src/EVM/Solvers.hs | 3 +- 5 files changed, 57 insertions(+), 43 deletions(-) diff --git a/hevm.cabal b/hevm.cabal index 69ad61a5d..90e60c99e 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -98,6 +98,7 @@ library EVM.Dapp, EVM.Expr, EVM.SMT, + EVM.SMT.DivEncoding, EVM.Solvers, EVM.Exec, EVM.Format, @@ -119,7 +120,6 @@ library EVM.UnitTest, EVM.Sign, EVM.Effects, - EVM.SMT.DivEncoding, other-modules: EVM.CheatsTH, EVM.SMT.Types, diff --git a/src/EVM/Fetch.hs b/src/EVM/Fetch.hs index 98fd3c6a1..a72064044 100644 --- a/src/EVM/Fetch.hs +++ b/src/EVM/Fetch.hs @@ -34,7 +34,7 @@ import EVM (initialContract, unknownContract) import EVM.ABI import EVM.FeeSchedule (feeSchedule) import EVM.Format (hexText) -import EVM.SMT.DivEncoding +import EVM.SMT import EVM.Solvers import EVM.Types hiding (ByteStringS) import EVM.Types (ByteStringS(..)) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 4ab3d6774..5fde484a3 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -6,11 +6,14 @@ module EVM.SMT ( module EVM.SMT.Types, module EVM.SMT.SMTLIB, + module EVM.SMT.DivEncoding, collapse, getVar, formatSMT2, declareIntermediates, + assertProps, + assertPropsAbstract, assertPropsHelperWith, decompose, exprToSMTWith, @@ -69,6 +72,7 @@ import EVM.Types import EVM.Effects import EVM.SMT.Types import EVM.SMT.SMTLIB +import EVM.SMT.DivEncoding -- ** Encoding ** ---------------------------------------------------------------------------------- @@ -126,6 +130,26 @@ decompose conf props = if conf.decomposeStorage && safeExprs && safeProps safeExprs = all (isJust . mapPropM_ Expr.safeToDecompose) props safeProps = all Expr.safeToDecomposeProp props +-- simplify to rewrite sload/sstore combos +-- notice: it is VERY important not to concretize early, because Keccak assumptions +-- need unconcretized Props +assertProps :: Config -> [Prop] -> Err SMT2 +assertProps conf ps = + if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps + else assertPropsHelperWith ConcreteDivision True [] (decompose conf ps) + +-- | Assert props with abstract div/mod (uninterpreted functions + encoding constraints). +assertPropsAbstract :: Config -> [Prop] -> Err SMT2 +assertPropsAbstract conf ps = do + let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + base <- if not conf.simp then mkBase False ps + else mkBase True (decompose conf ps) + shiftBounds <- divModEncoding (exprToSMTWith AbstractDivision) ps + pure $ base <> SMT2 (SMTScript shiftBounds) mempty mempty + +-- Note: we need a version that does NOT call simplify, +-- because we make use of it to verify the correctness of our simplification +-- passes through property-based testing. assertPropsHelperWith :: DivEncoding -> Bool -> [SMTEntry] -> [Prop] -> Err SMT2 assertPropsHelperWith divEnc simp extraDecls psPreConc = do encs <- mapM (propToSMTWith divEnc) psElim diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index 31cf6f28a..c817ada39 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,8 +1,8 @@ {- | Abstract div/mod encoding for two-phase SMT solving. -} module EVM.SMT.DivEncoding - ( assertProps - , assertPropsAbstract - , divModGroundTruth + ( divModGroundTruth + , divModEncoding + , divModAbstractDecls ) where import Data.Bits ((.&.), countTrailingZeros) @@ -10,18 +10,12 @@ import Data.Containers.ListUtils (nubOrd) import Data.List (groupBy, sortBy) import Data.Ord (comparing) import Data.Text.Lazy.Builder - -import EVM.Effects -import EVM.SMT +import qualified Data.Text.Lazy.Builder.Int +import EVM.SMT.Types import EVM.Traversals import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) import EVM.Types qualified as T -assertProps :: Config -> [Prop] -> Err SMT2 -assertProps conf ps = - if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps - else assertPropsHelperWith ConcreteDivision True [] (decompose conf ps) - -- | Uninterpreted function declarations for abstract div/mod. divModAbstractDecls :: [SMTEntry] divModAbstractDecls = @@ -30,8 +24,15 @@ divModAbstractDecls = , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] -exprToSMTAbst :: Expr a -> Err Builder -exprToSMTAbst = exprToSMTWith AbstractDivision +-- | Local helper for trivial SMT constructs +sp :: Builder -> Builder -> Builder +a `sp` b = a <> " " <> b + +zero :: Builder +zero = "(_ bv0 256)" + +wordAsBV :: forall a. Integral a => a -> Builder +wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" data DivModKind = IsDiv | IsMod deriving (Eq, Ord) @@ -56,10 +57,10 @@ absKey :: DivModOp -> AbsKey absKey (kind, a, b) = AbsKey a b kind -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. -declareAbs :: Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) -declareAbs groupIdx firstA firstB unsignedResult = do - aenc <- exprToSMTAbst firstA - benc <- exprToSMTAbst firstB +declareAbs :: (Expr EWord -> Err Builder) -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +declareAbs enc groupIdx firstA firstB unsignedResult = do + aenc <- enc firstA + benc <- enc firstB let absAEnc = smtAbsolute aenc absBEnc = smtAbsolute benc absAName = fromString $ "abs_a_" <> show groupIdx @@ -73,10 +74,10 @@ declareAbs groupIdx firstA firstB unsignedResult = do pure (decls, (absAName, absBName)) -- | Assert abstract(a,b) = signed result derived from unsigned result. -assertSignedEqualsUnsignedDerived :: Builder -> DivModOp -> Err SMTEntry -assertSignedEqualsUnsignedDerived unsignedResult (kind, a, b) = do - aenc <- exprToSMTAbst a - benc <- exprToSMTAbst b +assertSignedEqualsUnsignedDerived :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry +assertSignedEqualsUnsignedDerived enc unsignedResult (kind, a, b) = do + aenc <- enc a + benc <- enc b let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" abstract = "(" <> fname `sp` aenc `sp` benc <> ")" concrete = if isDiv kind @@ -84,21 +85,11 @@ assertSignedEqualsUnsignedDerived unsignedResult (kind, a, b) = do else signedFromUnsignedMod aenc benc unsignedResult pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Assert props with abstract div/mod (uninterpreted functions + encoding constraints). -assertPropsAbstract :: Config -> [Prop] -> Err SMT2 -assertPropsAbstract conf ps = do - let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls - base <- if not conf.simp then mkBase False ps - else mkBase True (decompose conf ps) - shiftBounds <- divModEncoding ps - pure $ base - <> SMT2 (SMTScript shiftBounds) mempty mempty - -- | Ground-truth axioms: for each sdiv/smod op, assert that the abstract -- uninterpreted function equals the real bvsdiv/bvsrem. -- e.g. (assert (= (abst_evm_bvsdiv a b) (bvsdiv a b))) -divModGroundTruth :: [Prop] -> Err [SMTEntry] -divModGroundTruth props = do +divModGroundTruth :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] +divModGroundTruth enc props = do let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivs then pure [] else do @@ -107,8 +98,8 @@ divModGroundTruth props = do where mkGroundTruthAxiom :: DivModOp -> Err SMTEntry mkGroundTruthAxiom (kind, a, b) = do - aenc <- exprToSMTAbst a - benc <- exprToSMTAbst b + aenc <- enc a + benc <- enc b let (abstFn, concFn) = if isDiv kind then ("abst_evm_bvsdiv", "bvsdiv") else ("abst_evm_bvsrem", "bvsrem") @@ -117,8 +108,8 @@ divModGroundTruth props = do "(" <> concFn `sp` aenc `sp` benc <> ")))" -- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). -divModEncoding :: [Prop] -> Err [SMTEntry] -divModEncoding props = do +divModEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] +divModEncoding enc props = do let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivs then pure [] else do @@ -141,7 +132,7 @@ divModEncoding props = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - (decls, (absAName, absBName)) <- declareAbs groupIdx firstA firstB unsignedResult + (decls, (absAName, absBName)) <- declareAbs enc groupIdx firstA firstB unsignedResult -- When the dividend is a left-shift (a = x << k, i.e. a = x * 2^k), -- we can bound the unsigned division result using cheap bitshift @@ -164,7 +155,7 @@ divModEncoding props = do <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] - axioms <- mapM (assertSignedEqualsUnsignedDerived unsignedResult) ops + axioms <- mapM (assertSignedEqualsUnsignedDerived enc unsignedResult) ops pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal abs inputs, their results are equal. diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 9b6ff7d0a..dcb0508e8 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -51,7 +51,6 @@ import EVM.Expr (simplifyProps) import EVM.Keccak qualified as Keccak (concreteKeccaks) import EVM.SMT -import EVM.SMT.DivEncoding import EVM.Types import Debug.Trace (traceM) @@ -139,7 +138,7 @@ checkSatWithProps sg props = do else liftIO $ do -- Two-phase solving with abstraction+refinement let smt2Abstract = assertPropsAbstract conf allProps - let refinement = divModGroundTruth allProps + let refinement = divModGroundTruth (exprToSMTWith AbstractDivision) allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) From bf156b3cfd365aac45613f4cbe60c76be16dea61 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 11:50:58 +0100 Subject: [PATCH 109/150] Fixing warning --- test/test.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/test/test.hs b/test/test.hs index 2c2bf6f5d..cd6a0fc92 100644 --- a/test/test.hs +++ b/test/test.hs @@ -55,7 +55,6 @@ import EVM.Format (hexText) import EVM.Precompiled import EVM.RLP import EVM.SMT -import EVM.SMT.DivEncoding import EVM.Solidity import EVM.Solvers import EVM.Stepper qualified as Stepper From 2763078bd883a084e223fd68202d05907bb693d9 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 11:57:25 +0100 Subject: [PATCH 110/150] Rename --- src/EVM/SMT.hs | 46 +++++++++++++++++++------------------- src/EVM/SMT/DivEncoding.hs | 2 +- src/EVM/SMT/Types.hs | 2 +- src/EVM/Solvers.hs | 2 +- test/test.hs | 2 +- 5 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 5fde484a3..6c4c0afee 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -6,7 +6,7 @@ module EVM.SMT ( module EVM.SMT.Types, module EVM.SMT.SMTLIB, - module EVM.SMT.DivEncoding, + module EVM.SMT.DivModEncoding, collapse, getVar, @@ -72,7 +72,7 @@ import EVM.Types import EVM.Effects import EVM.SMT.Types import EVM.SMT.SMTLIB -import EVM.SMT.DivEncoding +import EVM.SMT.DivModEncoding -- ** Encoding ** ---------------------------------------------------------------------------------- @@ -100,9 +100,9 @@ formatSMT2 (SMT2 (SMTScript entries) _ ps) = expr <> smt2 -- | Reads all intermediate variables from the builder state and produces SMT declaring them as constants declareIntermediates :: BufEnv -> StoreEnv -> Err [SMTEntry] -declareIntermediates = declareIntermediatesWith ConcreteDivision +declareIntermediates = declareIntermediatesWith ConcreteDivMod -declareIntermediatesWith :: DivEncoding -> BufEnv -> StoreEnv -> Err [SMTEntry] +declareIntermediatesWith :: DivModEncoding -> BufEnv -> StoreEnv -> Err [SMTEntry] declareIntermediatesWith enc bufs stores = do let encSs = Map.mapWithKey encodeStore stores encBs = Map.mapWithKey encodeBuf bufs @@ -135,22 +135,22 @@ decompose conf props = if conf.decomposeStorage && safeExprs && safeProps -- need unconcretized Props assertProps :: Config -> [Prop] -> Err SMT2 assertProps conf ps = - if not conf.simp then assertPropsHelperWith ConcreteDivision False [] ps - else assertPropsHelperWith ConcreteDivision True [] (decompose conf ps) + if not conf.simp then assertPropsHelperWith ConcreteDivMod False [] ps + else assertPropsHelperWith ConcreteDivMod True [] (decompose conf ps) -- | Assert props with abstract div/mod (uninterpreted functions + encoding constraints). assertPropsAbstract :: Config -> [Prop] -> Err SMT2 assertPropsAbstract conf ps = do - let mkBase s = assertPropsHelperWith AbstractDivision s divModAbstractDecls + let mkBase s = assertPropsHelperWith AbstractDivMod s divModAbstractDecls base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) - shiftBounds <- divModEncoding (exprToSMTWith AbstractDivision) ps + shiftBounds <- divModEncoding (exprToSMTWith AbstractDivMod) ps pure $ base <> SMT2 (SMTScript shiftBounds) mempty mempty -- Note: we need a version that does NOT call simplify, -- because we make use of it to verify the correctness of our simplification -- passes through property-based testing. -assertPropsHelperWith :: DivEncoding -> Bool -> [SMTEntry] -> [Prop] -> Err SMT2 +assertPropsHelperWith :: DivModEncoding -> Bool -> [SMTEntry] -> [Prop] -> Err SMT2 assertPropsHelperWith divEnc simp extraDecls psPreConc = do encs <- mapM (propToSMTWith divEnc) psElim intermediates <- declareIntermediatesWith divEnc bufs stores @@ -243,7 +243,7 @@ referencedVars expr = nubOrd $ foldTerm go [] expr Var s -> [fromText s] _ -> [] -referencedFrameContext :: DivEncoding -> TraversableTerm a => a -> [(Builder, [Prop])] +referencedFrameContext :: DivModEncoding -> TraversableTerm a => a -> [(Builder, [Prop])] referencedFrameContext enc expr = nubOrd $ foldTerm go [] expr where go :: Expr a -> [(Builder, [Prop])] @@ -378,7 +378,7 @@ declareConstrainAddrs names = SMT2 (SMTScript ([SMTComment "concrete and symboli -- The gas is a tuple of (prefix, index). Within each prefix, the gas is strictly decreasing as the -- index increases. This function gets a map of Prefix -> [Int], and for each prefix, -- enforces the order -enforceGasOrder :: DivEncoding -> [Prop] -> [SMTEntry] +enforceGasOrder :: DivModEncoding -> [Prop] -> [SMTEntry] enforceGasOrder enc ps = [SMTComment "gas ordering"] <> (concatMap (uncurry order) indices) where order :: TS.Text -> [Int] -> [SMTEntry] @@ -423,9 +423,9 @@ declareBlockContext names = do cexvars = (mempty :: CexVars){ blockContext = fmap (toLazyText . fst) names } assertSMT :: Prop -> Either String SMTEntry -assertSMT = assertSMTWith ConcreteDivision +assertSMT = assertSMTWith ConcreteDivMod -assertSMTWith :: DivEncoding -> Prop -> Either String SMTEntry +assertSMTWith :: DivModEncoding -> Prop -> Either String SMTEntry assertSMTWith enc p = do p' <- propToSMTWith enc p pure $ SMTCommand ("(assert " <> p' <> ")") @@ -436,7 +436,7 @@ wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" byteAsBV :: Word8 -> Builder byteAsBV b = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal b <> " 8)" -exprToSMTWith :: DivEncoding -> Expr a -> Err Builder +exprToSMTWith :: DivModEncoding -> Expr a -> Err Builder exprToSMTWith divEnc = \case Lit w -> pure $ wordAsBV w Var s -> pure $ fromText s @@ -631,8 +631,8 @@ exprToSMTWith divEnc = \case pure $ "(ite (= " <> benc <> " (_ bv0 256)) (_ bv0 256) " <> "(" <> op `sp` aenc `sp` benc <> "))" divModOp :: Builder -> Builder -> Expr x -> Expr y -> Err Builder divModOp concreteOp abstractOp a b = case divEnc of - ConcreteDivision -> op2CheckZero concreteOp a b - AbstractDivision -> op2 abstractOp a b + ConcreteDivMod -> op2CheckZero concreteOp a b + AbstractDivMod -> op2 abstractOp a b sp :: Builder -> Builder -> Builder a `sp` b = a <> " " <> b @@ -643,7 +643,7 @@ zero = "(_ bv0 256)" one :: Builder one = "(_ bv1 256)" -propToSMTWith :: DivEncoding -> Prop -> Err Builder +propToSMTWith :: DivModEncoding -> Prop -> Err Builder propToSMTWith divEnc = \case PEq a b -> op2 "=" a b PLT a b -> op2 "bvult" a b @@ -677,7 +677,7 @@ propToSMTWith divEnc = \case -- ** Helpers ** --------------------------------------------------------------------------------- -copySliceWith :: DivEncoding -> Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder +copySliceWith :: DivModEncoding -> Expr EWord -> Expr EWord -> Expr EWord -> Builder -> Builder -> Err Builder copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do sz <- internal size pure $ "(let ((src " <> src <> ")) " <> sz <> ")" @@ -694,7 +694,7 @@ copySliceWith divEnc srcOffset dstOffset (Lit size) src dst = do offset o e = exprToSMTWith divEnc $ Expr.add (Lit o) e copySliceWith _ _ _ _ _ _ = Left "CopySlice with a symbolically sized region not currently implemented, cannot execute SMT solver on this query" -expandExpWith :: DivEncoding -> Expr EWord -> W256 -> Err Builder +expandExpWith :: DivModEncoding -> Expr EWord -> W256 -> Err Builder expandExpWith divEnc base expnt -- in EVM, anything (including 0) to the power of 0 is 1 | expnt == 0 = pure one @@ -704,7 +704,7 @@ expandExpWith divEnc base expnt n <- expandExpWith divEnc base (expnt - 1) pure $ "(bvmul " <> b `sp` n <> ")" -concatBytesWith :: DivEncoding -> [Expr Byte] -> Err Builder +concatBytesWith :: DivModEncoding -> [Expr Byte] -> Err Builder concatBytesWith divEnc bytes = do case List.uncons $ reverse bytes of Nothing -> Left "unexpected empty bytes" @@ -717,7 +717,7 @@ concatBytesWith divEnc bytes = do byteSMT <- exprToSMTWith divEnc byte pure $ "(concat " <> byteSMT `sp` inner <> ")" -writeBytesWith :: DivEncoding -> ByteString -> Expr Buf -> Err Builder +writeBytesWith :: DivModEncoding -> ByteString -> Expr Buf -> Err Builder writeBytesWith divEnc bytes buf = do smtText <- exprToSMTWith divEnc buf let ret = BS.foldl wrap (0, smtText) bytes @@ -733,7 +733,7 @@ writeBytesWith divEnc bytes buf = do where !idx' = idx + 1 -encodeConcreteStore :: DivEncoding -> Map W256 W256 -> Err Builder +encodeConcreteStore :: DivModEncoding -> Map W256 W256 -> Err Builder encodeConcreteStore enc s = foldM encodeWrite ("((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000)") (Map.toList s) where encodeWrite :: Builder -> (W256, W256) -> Err Builder @@ -915,7 +915,7 @@ queryValue :: ValGetter -> Expr EWord -> MaybeIO W256 queryValue _ (Lit w) = pure w queryValue getVal w = do -- this exprToSMTWith should never fail, since we have already ran the solver, in refined mode - let expr = toLazyText $ fromRight' $ exprToSMTWith ConcreteDivision w + let expr = toLazyText $ fromRight' $ exprToSMTWith ConcreteDivMod w raw <- getVal expr hoistMaybe $ do valTxt <- extractValue raw diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivEncoding.hs index c817ada39..c5831cf45 100644 --- a/src/EVM/SMT/DivEncoding.hs +++ b/src/EVM/SMT/DivEncoding.hs @@ -1,5 +1,5 @@ {- | Abstract div/mod encoding for two-phase SMT solving. -} -module EVM.SMT.DivEncoding +module EVM.SMT.DivModEncoding ( divModGroundTruth , divModEncoding , divModAbstractDecls diff --git a/src/EVM/SMT/Types.hs b/src/EVM/SMT/Types.hs index b69252d29..3a595b079 100644 --- a/src/EVM/SMT/Types.hs +++ b/src/EVM/SMT/Types.hs @@ -11,7 +11,7 @@ import EVM.Types type MaybeIO = MaybeT IO -data DivEncoding = ConcreteDivision | AbstractDivision +data DivModEncoding = ConcreteDivMod | AbstractDivMod deriving (Show, Eq) data SMTEntry = SMTCommand Builder | SMTComment Builder diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index dcb0508e8..340c47315 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -138,7 +138,7 @@ checkSatWithProps sg props = do else liftIO $ do -- Two-phase solving with abstraction+refinement let smt2Abstract = assertPropsAbstract conf allProps - let refinement = divModGroundTruth (exprToSMTWith AbstractDivision) allProps + let refinement = divModGroundTruth (exprToSMTWith AbstractDivMod) allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) diff --git a/test/test.hs b/test/test.hs index cd6a0fc92..86e935a7d 100644 --- a/test/test.hs +++ b/test/test.hs @@ -4209,7 +4209,7 @@ tests = testGroup "hevm" [ testCase "encodeConcreteStore-overwrite" $ assertEqual "" (pure "(store (store ((as const Storage) #x0000000000000000000000000000000000000000000000000000000000000000) (_ bv1 256) (_ bv2 256)) (_ bv3 256) (_ bv4 256))") - (EVM.SMT.encodeConcreteStore ConcreteDivision $ Map.fromList [(W256 1, W256 2), (W256 3, W256 4)]) + (EVM.SMT.encodeConcreteStore ConcreteDivMod $ Map.fromList [(W256 1, W256 2), (W256 3, W256 4)]) ] , testGroup "calling-solvers" [ test "no-error-on-large-buf" $ do From 49296dd18b29f6946dbf0eb2ac7cf81fe3dbb93b Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 12:41:26 +0100 Subject: [PATCH 111/150] Fix name of file --- src/EVM/SMT/{DivEncoding.hs => DivModEncoding.hs} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/EVM/SMT/{DivEncoding.hs => DivModEncoding.hs} (100%) diff --git a/src/EVM/SMT/DivEncoding.hs b/src/EVM/SMT/DivModEncoding.hs similarity index 100% rename from src/EVM/SMT/DivEncoding.hs rename to src/EVM/SMT/DivModEncoding.hs From 503d110ec83854ffc622d161834c8fb5e3b7ee72 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 14:41:41 +0100 Subject: [PATCH 112/150] Fixing cabal Fix --- hevm.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hevm.cabal b/hevm.cabal index 90e60c99e..6369cac0f 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -98,7 +98,7 @@ library EVM.Dapp, EVM.Expr, EVM.SMT, - EVM.SMT.DivEncoding, + EVM.SMT.DivModEncoding, EVM.Solvers, EVM.Exec, EVM.Format, From 251aef0ff83c86f1428d897070d0c5cbe788994c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:14:12 +0100 Subject: [PATCH 113/150] No need for this --- hevm.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/hevm.cabal b/hevm.cabal index 6369cac0f..1cca17bfa 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -271,7 +271,6 @@ common test-common ghc-options: -threaded -with-rtsopts=-N build-depends: test-utils, - vector, other-modules: EVM.Test.Utils EVM.Test.BlockchainTests From c95d5f8e5e82afac3f0d97911d3ec5744c8ebe36 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:15:26 +0100 Subject: [PATCH 114/150] Fixing up cli test --- test/clitest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/clitest.hs b/test/clitest.hs index 681ecf7d8..f7ddc6b32 100644 --- a/test/clitest.hs +++ b/test/clitest.hs @@ -135,7 +135,7 @@ main = do |]) let hexStr = Types.bsToHex c (_, stdout, _) <- readProcessWithExitCode "cabal" ["run", "exe:hevm", "--", "symbolic", "--solver", "empty", "--code", hexStr] "" - stdout `shouldContain` "SMT solver says: Result unknown by SMT solver" + stdout `shouldContain` "SMT solver returned unknown" it "crash-of-hevm" $ do let hexStrA = "608060405234801561001057600080fd5b506004361061002b5760003560e01c8063efa2978514610030575b600080fd5b61004361003e3660046102ad565b610045565b005b60006100508561007a565b9050600061005d866100a8565b905080821461006e5761006e61034c565b50505050505050505050565b600061008761032e6103aa565b8261009457610197610098565b61013e5b6100a291906103e2565b92915050565b60006100b561032e6103aa565b6100be906103aa565b6100c7906103aa565b82806100d1575060005b806100da575060005b61013157605a6100ea60006103aa565b6100f3906103aa565b6100ff6001605a610404565b61010b6001605a610404565b61011891166101976103e2565b6101229190610493565b61012c9190610493565b610149565b604061013f8161013e6103e2565b6101499190610493565b61015391906103e2565b61016061032e60006103e2565b83801561016b575060015b15801590610177575060015b80156101a05750831515801561018b575060015b15158015610197575060015b806101a0575060005b610251576101976101b3605a602d610493565b602d60006101c2600182610493565b6101cd906001610404565b6101d8906001610404565b6101e1906103aa565b6101ea906103aa565b6101f491906103e2565b6101ff90605a610404565b604e61020c8160016103e2565b6102169190610493565b61022490600116605a610404565b1661022e906103aa565b61023891906103e2565b6102429190610493565b61024c9190610493565b610283565b604561025f8161013e6103e2565b6102699190610493565b60456102778161013e6103e2565b6102819190610493565b165b61028d91906103e2565b1692915050565b80358015155b81146100a257600080fd5b80358061029a565b600080600080600080600080610100898b0312156102ca57600080fd5b6102d48a8a610294565b97506102e38a60208b01610294565b96506102f28a60408b016102a5565b95506103018a60608b016102a5565b94506103108a60808b01610294565b935061031f8a60a08b016102a5565b925061032e8a60c08b01610294565b915061033d8a60e08b016102a5565b90509295985092959890939650565b7f4e487b7100000000000000000000000000000000000000000000000000000000600052600160045260246000fd5b7f4e487b7100000000000000000000000000000000000000000000000000000000600052601160045260246000fd5b60007f800000000000000000000000000000000000000000000000000000000000000082036103db576103db61037b565b5060000390565b818103600083128015838313168383129190911617156100a2576100a261037b565b60008261043a577f4e487b7100000000000000000000000000000000000000000000000000000000600052601260045260246000fd5b7f800000000000000000000000000000000000000000000000000000000000000082147fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff8414161561048e5761048e61037b565b500590565b80820160008212801584831290811690159190911617156100a2576100a261037b56fea26469706673582212200a37769e5bf4b8b890caac8ab643126d55feb821a0201d2f674203f23fa666ad64736f6c634300081e0033" From 0fb590c49173090bd664a82b4ff08f03d3ac5429 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:16:23 +0100 Subject: [PATCH 115/150] No need for these printings --- test/clitest.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/clitest.hs b/test/clitest.hs index f7ddc6b32..d74bb0566 100644 --- a/test/clitest.hs +++ b/test/clitest.hs @@ -200,8 +200,6 @@ main = do it "early-abort" $ do (exitcode, stdout, stderr) <- runForge "test/contracts/pass/early-abort.sol" ["--max-iterations", "1000"] putStrLn $ "Exit code: " ++ show exitcode - putStrLn stderr - putStrLn stdout it "rpc-cache" $ do (_, stdout, stderr) <- runForge "test/contracts/fail/rpc-test.sol" ["--rpc", "http://mock.mock", "--prefix", "test_attack_symbolic" From a4ef47e376a289487c12864f96abe8567818ebf7 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:23:36 +0100 Subject: [PATCH 116/150] Fixing this test --- test/clitest.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/clitest.hs b/test/clitest.hs index d74bb0566..c77e3dd65 100644 --- a/test/clitest.hs +++ b/test/clitest.hs @@ -198,8 +198,9 @@ main = do shouldBe fileExists True removeFile filename it "early-abort" $ do - (exitcode, stdout, stderr) <- runForge "test/contracts/pass/early-abort.sol" ["--max-iterations", "1000"] - putStrLn $ "Exit code: " ++ show exitcode + (_, stdout, _) <- runForge "test/contracts/pass/early-abort.sol" ["--max-iterations", "1000"] + stdout `shouldContain` "[FAIL]" + (T.count "Counterexample:" (T.pack stdout)) `shouldBe` 9 it "rpc-cache" $ do (_, stdout, stderr) <- runForge "test/contracts/fail/rpc-test.sol" ["--rpc", "http://mock.mock", "--prefix", "test_attack_symbolic" From 92df5804cd323789fa38500e80b642e1d140ca1e Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:34:27 +0100 Subject: [PATCH 117/150] Rename --- src/EVM/SMT/DivModEncoding.hs | 45 +++++++++++++++++------------------ 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index c5831cf45..280a0627e 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -1,4 +1,4 @@ -{- | Abstract div/mod encoding for two-phase SMT solving. -} +{- | Abstract div/mobsolud encoding for two-phase SMT solving. -} module EVM.SMT.DivModEncoding ( divModGroundTruth , divModEncoding @@ -39,7 +39,7 @@ data DivModKind = IsDiv | IsMod type DivModOp = (DivModKind, Expr EWord, Expr EWord) -data AbsKey = AbsKey (Expr EWord) (Expr EWord) DivModKind +data AbstractKey = AbstractKey (Expr EWord) (Expr EWord) DivModKind deriving (Eq, Ord) isDiv :: DivModKind -> Bool @@ -53,25 +53,25 @@ collectDivMods = \case T.SMod a b -> [(IsMod, a, b)] _ -> [] -absKey :: DivModOp -> AbsKey -absKey (kind, a, b) = AbsKey a b kind +abstractKey :: DivModOp -> AbstractKey +abstractKey (kind, a, b) = AbstractKey a b kind -- | Declare abs_a, abs_b, and unsigned result variables for a signed group. -declareAbs :: (Expr EWord -> Err Builder) -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) -declareAbs enc groupIdx firstA firstB unsignedResult = do +declareAbsolute :: (Expr EWord -> Err Builder) -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +declareAbsolute enc groupIdx firstA firstB unsignedResult = do aenc <- enc firstA benc <- enc firstB let absAEnc = smtAbsolute aenc absBEnc = smtAbsolute benc - absAName = fromString $ "abs_a_" <> show groupIdx - absBName = fromString $ "abs_b_" <> show groupIdx - let decls = [ SMTCommand $ "(declare-const" `sp` absAName `sp` "(_ BitVec 256))" - , SMTCommand $ "(declare-const" `sp` absBName `sp` "(_ BitVec 256))" + absoluteAName = fromString $ "absolute_a" <> show groupIdx + absoluteBName = fromString $ "absolute_b" <> show groupIdx + let decls = [ SMTCommand $ "(declare-const" `sp` absoluteAName `sp` "(_ BitVec 256))" + , SMTCommand $ "(declare-const" `sp` absoluteBName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` unsignedResult `sp` "(_ BitVec 256))" - , SMTCommand $ "(assert (=" `sp` absAName `sp` absAEnc <> "))" - , SMTCommand $ "(assert (=" `sp` absBName `sp` absBEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absoluteAName `sp` absAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absoluteBName `sp` absBEnc <> "))" ] - pure (decls, (absAName, absBName)) + pure (decls, (absoluteAName, absoluteBName)) -- | Assert abstract(a,b) = signed result derived from unsigned result. assertSignedEqualsUnsignedDerived :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry @@ -113,8 +113,7 @@ divModEncoding enc props = do let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivs then pure [] else do - let groups = groupBy (\a b -> absKey a == absKey b) - $ sortBy (comparing absKey) allDivs + let groups = groupBy (\a b -> abstractKey a == abstractKey b) $ sortBy (comparing abstractKey) allDivs indexedGroups = zip [0..] groups let links = mkCongruenceLinks indexedGroups entries <- concat <$> mapM (uncurry mkGroupEncoding) indexedGroups @@ -132,7 +131,7 @@ divModEncoding enc props = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - (decls, (absAName, absBName)) <- declareAbs enc groupIdx firstA firstB unsignedResult + (decls, (absoluteAName, absoluteBName)) <- declareAbsolute enc groupIdx firstA firstB unsignedResult -- When the dividend is a left-shift (a = x << k, i.e. a = x * 2^k), -- we can bound the unsigned division result using cheap bitshift @@ -146,12 +145,12 @@ divModEncoding enc props = do -- threshold = 2^k threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" -- shifted = |a| >> k = |a| / 2^k - shifted = "(bvlshr" `sp` absAName `sp` kLit <> ")" + shifted = "(bvlshr" `sp` absoluteAName `sp` kLit <> ")" in -- |b| >= 2^k => |a|/|b| <= |a|/2^k - [ SMTCommand $ "(assert (=> (bvuge" `sp` absBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + [ SMTCommand $ "(assert (=> (bvuge" `sp` absoluteBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" -- |b| < 2^k and b != 0 => |a|/|b| >= |a|/2^k , SMTCommand $ "(assert (=> " - <> "(and (bvult" `sp` absBName `sp` threshold <> ") (distinct " `sp` absBName `sp` zero <> "))" + <> "(and (bvult" `sp` absoluteBName `sp` threshold <> ") (distinct " `sp` absoluteBName `sp` zero <> "))" <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] @@ -168,10 +167,10 @@ mkCongruenceLinks indexedGroups = where allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] mkPairLinks prefix' ((i, _), (j, _)) = - let absAi = fromString $ "abs_a_" <> show i - absBi = fromString $ "abs_b_" <> show i - absAj = fromString $ "abs_a_" <> show j - absBj = fromString $ "abs_b_" <> show j + let absAi = fromString $ "absolute_a" <> show i + absBi = fromString $ "absolute_b" <> show i + absAj = fromString $ "absolute_a" <> show j + absBj = fromString $ "absolute_b" <> show j unsignedResultI = fromString $ prefix' <> "_" <> show i unsignedResultJ = fromString $ prefix' <> "_" <> show j in [ SMTCommand $ "(assert (=> " From 13ad8ded9779df41991ccbbd3fe673ce79a2baa9 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:37:06 +0100 Subject: [PATCH 118/150] Fixing val --- src/EVM/SMT/DivModEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 280a0627e..df7c5875f 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -157,7 +157,7 @@ divModEncoding enc props = do axioms <- mapM (assertSignedEqualsUnsignedDerived enc unsignedResult) ops pure $ decls <> shiftBounds <> axioms --- | Congruence: if two signed groups have equal abs inputs, their results are equal. +-- | Congruence: if two signed groups have equal absolute inputs, their results are equal. mkCongruenceLinks :: [(Int, [DivModOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsDiv] From 898fca9a01664e35a828d3da0fa5336d088da6c8 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:40:49 +0100 Subject: [PATCH 119/150] Named correctly --- src/EVM/SMT/DivModEncoding.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index df7c5875f..d5240a0c2 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -167,14 +167,14 @@ mkCongruenceLinks indexedGroups = where allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] mkPairLinks prefix' ((i, _), (j, _)) = - let absAi = fromString $ "absolute_a" <> show i - absBi = fromString $ "absolute_b" <> show i - absAj = fromString $ "absolute_a" <> show j - absBj = fromString $ "absolute_b" <> show j + let absoluteAi = fromString $ "absolute_a" <> show i + abosluteBi = fromString $ "absolute_b" <> show i + absoluteAj = fromString $ "absolute_a" <> show j + absoluteBj = fromString $ "absolute_b" <> show j unsignedResultI = fromString $ prefix' <> "_" <> show i unsignedResultJ = fromString $ prefix' <> "_" <> show j in [ SMTCommand $ "(assert (=> " - <> "(and (=" `sp` absAi `sp` absAj <> ") (=" `sp` absBi `sp` absBj <> "))" + <> "(and (=" `sp` absoluteAi `sp` absoluteAj <> ") (=" `sp` abosluteBi `sp` absoluteBj <> "))" <> "(=" `sp` unsignedResultI `sp` unsignedResultJ <> ")))" ] -- | (ite (= divisor 0) 0 result) From 1d63c63c141ed67e9e5626bec69fec421644f756 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 15:41:34 +0100 Subject: [PATCH 120/150] Fixing naming --- src/EVM/SMT/DivModEncoding.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index d5240a0c2..d28c5126a 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -171,11 +171,11 @@ mkCongruenceLinks indexedGroups = abosluteBi = fromString $ "absolute_b" <> show i absoluteAj = fromString $ "absolute_a" <> show j absoluteBj = fromString $ "absolute_b" <> show j - unsignedResultI = fromString $ prefix' <> "_" <> show i - unsignedResultJ = fromString $ prefix' <> "_" <> show j + absoluteResI = fromString $ prefix' <> "_" <> show i + absoluteRedJ = fromString $ prefix' <> "_" <> show j in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absoluteAi `sp` absoluteAj <> ") (=" `sp` abosluteBi `sp` absoluteBj <> "))" - <> "(=" `sp` unsignedResultI `sp` unsignedResultJ <> ")))" ] + <> "(=" `sp` absoluteResI `sp` absoluteRedJ <> ")))" ] -- | (ite (= divisor 0) 0 result) smtZeroGuard :: Builder -> Builder -> Builder From 4e064462dc75f5307b4e2104298c6e96cb6d083c Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 16:33:49 +0100 Subject: [PATCH 121/150] Renaming --- src/EVM/SMT/DivModEncoding.hs | 37 +++++++++++++++++------------------ 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index d28c5126a..29de917bf 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -90,10 +90,10 @@ assertSignedEqualsUnsignedDerived enc unsignedResult (kind, a, b) = do -- e.g. (assert (= (abst_evm_bvsdiv a b) (bvsdiv a b))) divModGroundTruth :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] divModGroundTruth enc props = do - let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props - if null allDivs then pure [] + let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props + if null allDivMods then pure [] else do - axioms <- mapM mkGroundTruthAxiom allDivs + axioms <- mapM mkGroundTruthAxiom allDivMods pure $ (SMTComment "division/modulo ground-truth refinement") : axioms where mkGroundTruthAxiom :: DivModOp -> Err SMTEntry @@ -110,20 +110,19 @@ divModGroundTruth enc props = do -- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). divModEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] divModEncoding enc props = do - let allDivs = nubOrd $ concatMap (foldProp collectDivMods []) props - if null allDivs then pure [] + let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props + if null allDivMods then pure [] else do - let groups = groupBy (\a b -> abstractKey a == abstractKey b) $ sortBy (comparing abstractKey) allDivs + let groups = groupBy (\a b -> abstractKey a == abstractKey b) $ sortBy (comparing abstractKey) allDivMods indexedGroups = zip [0..] groups let links = mkCongruenceLinks indexedGroups entries <- concat <$> mapM (uncurry mkGroupEncoding) indexedGroups pure $ (SMTComment "division/modulo encoding (abs + shift-bounds + congruence, no bvudiv)") : entries <> links where - -- | Extract shift amount k from SHL(k, _) or power-of-2 literals. - extractShift :: Expr EWord -> Maybe W256 - extractShift (SHL (Lit k) _) = Just k - extractShift (Lit n) | n > 0, n .&. (n - 1) == 0 = Just (fromIntegral $ countTrailingZeros n) - extractShift _ = Nothing + knownPow2Bound :: Expr EWord -> Maybe W256 + knownPow2Bound (SHL (Lit k) _) = Just k + knownPow2Bound (Lit n) | n > 0 = Just (fromIntegral $ countTrailingZeros n) + knownPow2Bound _ = Nothing mkGroupEncoding :: Int -> [DivModOp] -> Err [SMTEntry] mkGroupEncoding _ [] = pure [] @@ -131,7 +130,7 @@ divModEncoding enc props = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - (decls, (absoluteAName, absoluteBName)) <- declareAbsolute enc groupIdx firstA firstB unsignedResult + (decls, (absoluteA, absoluteB)) <- declareAbsolute enc groupIdx firstA firstB unsignedResult -- When the dividend is a left-shift (a = x << k, i.e. a = x * 2^k), -- we can bound the unsigned division result using cheap bitshift @@ -139,18 +138,18 @@ divModEncoding enc props = do -- The pivot point is |a| >> k (= |a| / 2^k): -- - If |b| >= 2^k: result <= |a| >> k (upper bound) -- - If |b| < 2^k and b != 0: result >= |a| >> k (lower bound) - let shiftBounds = case (isDiv', extractShift firstA) of + let shiftBounds = case (isDiv', knownPow2Bound firstA) of (True, Just k) -> let kLit = wordAsBV k - -- threshold = 2^k - threshold = "(bvshl (_ bv1 256) " <> kLit <> ")" + -- twoPowK = 2^k + twoPowK = "(bvshl (_ bv1 256) " <> kLit <> ")" -- shifted = |a| >> k = |a| / 2^k - shifted = "(bvlshr" `sp` absoluteAName `sp` kLit <> ")" + shifted = "(bvlshr" `sp` absoluteA `sp` kLit <> ")" in -- |b| >= 2^k => |a|/|b| <= |a|/2^k - [ SMTCommand $ "(assert (=> (bvuge" `sp` absoluteBName `sp` threshold <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" - -- |b| < 2^k and b != 0 => |a|/|b| >= |a|/2^k + [ SMTCommand $ "(assert (=> (bvuge" `sp` absoluteB `sp` twoPowK <> ") (bvule" `sp` unsignedResult `sp` shifted <> ")))" + -- |b| < 2^k and |b| != 0 => |a|/|b| >= |a|/2^k , SMTCommand $ "(assert (=> " - <> "(and (bvult" `sp` absoluteBName `sp` threshold <> ") (distinct " `sp` absoluteBName `sp` zero <> "))" + <> "(and (bvult" `sp` absoluteB `sp` twoPowK <> ") (distinct " `sp` absoluteB `sp` zero <> "))" <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] From f3213dd58aefd58ab47b01549ae495a14a804cab Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 17:16:04 +0100 Subject: [PATCH 122/150] Update name --- src/EVM/SMT/DivModEncoding.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 29de917bf..64a8fa8d6 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -61,21 +61,21 @@ declareAbsolute :: (Expr EWord -> Err Builder) -> Int -> Expr EWord -> Expr EWor declareAbsolute enc groupIdx firstA firstB unsignedResult = do aenc <- enc firstA benc <- enc firstB - let absAEnc = smtAbsolute aenc - absBEnc = smtAbsolute benc + let absoluteAEnc = smtAbsolute aenc + absoluteBEnc = smtAbsolute benc absoluteAName = fromString $ "absolute_a" <> show groupIdx absoluteBName = fromString $ "absolute_b" <> show groupIdx let decls = [ SMTCommand $ "(declare-const" `sp` absoluteAName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` absoluteBName `sp` "(_ BitVec 256))" , SMTCommand $ "(declare-const" `sp` unsignedResult `sp` "(_ BitVec 256))" - , SMTCommand $ "(assert (=" `sp` absoluteAName `sp` absAEnc <> "))" - , SMTCommand $ "(assert (=" `sp` absoluteBName `sp` absBEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absoluteAName `sp` absoluteAEnc <> "))" + , SMTCommand $ "(assert (=" `sp` absoluteBName `sp` absoluteBEnc <> "))" ] pure (decls, (absoluteAName, absoluteBName)) -- | Assert abstract(a,b) = signed result derived from unsigned result. -assertSignedEqualsUnsignedDerived :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry -assertSignedEqualsUnsignedDerived enc unsignedResult (kind, a, b) = do +assertAbstEqSignedResult :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry +assertAbstEqSignedResult enc unsignedResult (kind, a, b) = do aenc <- enc a benc <- enc b let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" @@ -126,7 +126,7 @@ divModEncoding enc props = do mkGroupEncoding :: Int -> [DivModOp] -> Err [SMTEntry] mkGroupEncoding _ [] = pure [] - mkGroupEncoding groupIdx ops@((firstKind, firstA, firstB) : _) = do + mkGroupEncoding groupIdx lhs@((firstKind, firstA, firstB) : _) = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx @@ -153,7 +153,7 @@ divModEncoding enc props = do <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] - axioms <- mapM (assertSignedEqualsUnsignedDerived enc unsignedResult) ops + axioms <- mapM (assertAbstEqSignedResult enc unsignedResult) lhs pure $ decls <> shiftBounds <> axioms -- | Congruence: if two signed groups have equal absolute inputs, their results are equal. From f087d98e629291e76bb06c5a7e3ac6587d9afb97 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 17:22:57 +0100 Subject: [PATCH 123/150] Update --- src/EVM/SMT/DivModEncoding.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 64a8fa8d6..9215588bc 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -73,7 +73,7 @@ declareAbsolute enc groupIdx firstA firstB unsignedResult = do ] pure (decls, (absoluteAName, absoluteBName)) --- | Assert abstract(a,b) = signed result derived from unsigned result. +-- | Assert "abstract sdiv/smod(a,b)" = signed result derived from unsigned result. assertAbstEqSignedResult :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry assertAbstEqSignedResult enc unsignedResult (kind, a, b) = do aenc <- enc a @@ -197,14 +197,18 @@ smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` smtIsNonNeg :: Builder -> Builder smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" --- | sdiv(a,b) from udiv(|a|,|b|): negate result if signs differ +-- | sdiv(a,b) = ITE(b = 0, 0, +-- ITE(sign(a) = sign(b), udiv(|a|,|b|), +-- -udiv(|a|,|b|))) signedFromUnsignedDiv :: Builder -> Builder -> Builder -> Builder signedFromUnsignedDiv aenc benc udivResult = smtZeroGuard benc $ "(ite" `sp` (smtSameSign aenc benc) `sp` udivResult `sp` (smtNeg udivResult) <> ")" --- | smod(a,b) from urem(|a|,|b|): result sign matches dividend. +-- | smod(a,b) = ITE(b = 0, 0, +-- ITE(a ≥ 0, urem(|a|,|b|), +-- -urem(|a|,|b|))) signedFromUnsignedMod :: Builder -> Builder -> Builder -> Builder signedFromUnsignedMod aenc benc uremResult = smtZeroGuard benc $ From 0ab6fb4707a3ad1324464837c8fa97927871e8be Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 17:44:14 +0100 Subject: [PATCH 124/150] Adding test, ifxing import, fixing printing --- hevm.cabal | 1 + src/EVM/Solvers.hs | 2 +- test/test.hs | 54 +++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 55 insertions(+), 2 deletions(-) diff --git a/hevm.cabal b/hevm.cabal index 1cca17bfa..a489e328d 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -303,6 +303,7 @@ test-suite test quickcheck-instances, regex, tasty-quickcheck, + vector, -- these tests require network access so we split them into a separate test -- suite to make it easy to skip them when running nix-build diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 340c47315..d2dd06efe 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -292,7 +292,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r ret <- sendAndCheck conf inst cmds $ \res -> do case res of "unsat" -> do - when conf.debug $ logWithTid "Abstract query is UNSAT." + when conf.debug $ logWithTid "Query is UNSAT." dealWithUnsat "sat" -> case refinement of Just refine -> do diff --git a/test/test.hs b/test/test.hs index 86e935a7d..5a0be3704 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1346,7 +1346,59 @@ tests = testGroup "hevm" assertBoolM "Expected counterexample" (any isCex res) ] , testGroup "Abstract-Arith" - [ testAbstractArith "sdiv-by-one" $ do + [ testCase "fast-prove" $ do + Just c <- solcRuntime "C" [i| + contract C { + bool public IS_TEST = true; + + int128 private constant MIN_64x64 = -0x80000000000000000000000000000000; + int128 private constant MAX_64x64 = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF; + + // ABDKMath64x64.fromInt(0) == 0 + int128 private constant ZERO_FP = 0; + // ABDKMath64x64.fromInt(1) == 1 << 64 + int128 private constant ONE_FP = 0x10000000000000000; + + // ABDKMath64x64.div + function div(int128 x, int128 y) internal pure returns (int128) { + unchecked { + require(y != 0); + int256 result = (int256(x) << 64) / y; + require(result >= MIN_64x64 && result <= MAX_64x64); + return int128(result); + } + } + + // ABDKMath64x64.abs + function abs(int128 x) internal pure returns (int128) { + unchecked { + require(x != MIN_64x64); + return x < 0 ? -x : x; + } + } + + // Property: |x / y| <= |x| when |y| >= 1, and |x / y| >= |x| when |y| < 1 + function prove_div_values(int128 x, int128 y) public pure { + require(y != ZERO_FP); + + int128 x_y = abs(div(x, y)); + + if (abs(y) >= ONE_FP) { + assert(x_y <= abs(x)); + } else { + assert(x_y >= abs(x)); + } + } + } |] + let sig = (Just $ Sig "prove_div_values(int128,int128)" [AbiIntType 128, AbiIntType 128]) + let testEnvAbstract = Env { config = testEnv.config { abstractArith = True } } + runEnv testEnvAbstract $ do + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + assertEqualM "Must be QED" res [] + runEnv testEnv $ do + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + liftIO $ assertBool "Must be unknown" (all isUnknown res) + , testAbstractArith "sdiv-by-one" $ do Just c <- solcRuntime "C" [i| contract C { function prove_sdiv_by_one(int256 a) external pure { From 1304d32580447c5e89b74022588ee31a5ea0c9db Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 17:50:06 +0100 Subject: [PATCH 125/150] Adding the tests --- test/test.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 55 insertions(+), 1 deletion(-) diff --git a/test/test.hs b/test/test.hs index 5a0be3704..ea16688b9 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1346,7 +1346,8 @@ tests = testGroup "hevm" assertBoolM "Expected counterexample" (any isCex res) ] , testGroup "Abstract-Arith" - [ testCase "fast-prove" $ do + -- "make verify-hevm T=prove_div_negative_divisor" in https://github.com/gustavo-grieco/abdk-math-64.64-verification + [ testCase "prove_div_values-abdk" $ do Just c <- solcRuntime "C" [i| contract C { bool public IS_TEST = true; @@ -1394,10 +1395,63 @@ tests = testGroup "hevm" let testEnvAbstract = Env { config = testEnv.config { abstractArith = True } } runEnv testEnvAbstract $ do (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + -- with abstract arith, we prove it assertEqualM "Must be QED" res [] runEnv testEnv $ do (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + -- without abstract arith, we time out liftIO $ assertBool "Must be unknown" (all isUnknown res) + -- "make verify-hevm T=prove_div_negative_divisor" in https://github.com/gustavo-grieco/abdk-math-64.64-verification + , testCase "prove_div_negative_divisor" $ do + Just c <- solcRuntime "C" [i| + contract C { + bool public IS_TEST = true; + + int128 private constant MIN_64x64 = -0x80000000000000000000000000000000; + int128 private constant MAX_64x64 = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF; + + // ABDKMath64x64.fromInt(0) == 0 + int128 private constant ZERO_FP = 0; + + // ABDKMath64x64.div + function div(int128 x, int128 y) internal pure returns (int128) { + unchecked { + require(y != 0); + int256 result = (int256(x) << 64) / y; + require(result >= MIN_64x64 && result <= MAX_64x64); + return int128(result); + } + } + + // ABDKMath64x64.neg + function neg(int128 x) internal pure returns (int128) { + unchecked { + require(x != MIN_64x64); + return -x; + } + } + + // Property: x / (-y) == -(x / y) + function prove_div_negative_divisor(int128 x, int128 y) public pure { + require(y < ZERO_FP); + + int128 x_y = div(x, y); + int128 x_minus_y = div(x, neg(y)); + + assert(x_y == neg(x_minus_y)); + } + } |] + let sig = (Just $ Sig "prove_div_negative_divisor(int128,int128)" [AbiIntType 128, AbiIntType 128]) + let testEnvAbstract = Env { config = testEnv.config { abstractArith = True } } + runEnv testEnvAbstract $ do + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + -- with abstract arith, we prove it + assertEqualM "Must be QED" res [] + runEnv testEnv $ do + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts + -- without abstract arith, we time out + liftIO $ assertBool "Must be unknown" (all isUnknown res) + , testAbstractArith "sdiv-by-one" $ do Just c <- solcRuntime "C" [i| contract C { From fcb8645f1a0ecc924389b612f163a43ccd23b2be Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 18:04:28 +0100 Subject: [PATCH 126/150] Cleaner --- src/EVM/Solvers.hs | 40 +++++++++++++--------------------------- 1 file changed, 13 insertions(+), 27 deletions(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index d2dd06efe..bfe5b2f14 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -104,7 +104,6 @@ data MultiData = MultiData data SingleData = SingleData SMT2 - (Maybe SMTScript) -- refinement for two-phase solving, if abst-ref is used (Maybe [Prop]) -- Props that generated the SMT2, if available. Used for caching (Chan SMTResult) -- result channel @@ -141,21 +140,22 @@ checkSatWithProps sg props = do let refinement = divModGroundTruth (exprToSMTWith AbstractDivMod) allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement - else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) + -- else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) + else do + let x = (getNonError smt2Abstract) <> (SMT2 (SMTScript (getNonError refinement)) mempty mempty) + liftIO $ checkSat sg (Just props) (Right x) -checkSatTwoPhase :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> Maybe SMTScript -> IO SMTResult -checkSatTwoPhase (SolverGroup taskq) props smt2 refinement = do +checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult +checkSat (SolverGroup taskq) props smt2 = do if isLeft smt2 then pure $ Error $ getError smt2 else do -- prepare result channel resChan <- newChan -- send task to solver group - writeChan taskq (TaskSingle (SingleData (getNonError smt2) refinement props resChan)) + writeChan taskq (TaskSingle (SingleData (getNonError smt2) props resChan)) -- collect result readChan resChan -checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult -checkSat sg props smt2 = checkSatTwoPhase sg props smt2 Nothing writeSMT2File :: SMT2 -> FilePath -> String -> IO () writeSMT2File smt2 path postfix = do @@ -191,13 +191,13 @@ withSolvers solver count timeout maxMemory cont = do Nothing -> do task <- liftIO $ readChan taskq case task of - TaskSingle (SingleData _ _ props r) | isJust props && supersetAny (fromList (fromJust props)) knownUnsat -> do + TaskSingle (SingleData _ props r) | isJust props && supersetAny (fromList (fromJust props)) knownUnsat -> do liftIO $ writeChan r Qed when conf.debug $ liftIO $ putStrLn " Qed found via cache!" orchestrate taskq cacheq sem knownUnsat fileCounter _ -> do runTask' <- case task of - TaskSingle (SingleData smt2 refinement props r) -> toIO $ getOneSol solver timeout maxMemory smt2 refinement props r cacheq sem fileCounter + TaskSingle (SingleData smt2 props r) -> toIO $ getOneSol solver timeout maxMemory smt2 props r cacheq sem fileCounter TaskMulti (MultiData smt2 multiSol r) -> toIO $ getMultiSol solver timeout maxMemory smt2 multiSol r sem fileCounter _ <- liftIO $ forkIO runTask' orchestrate taskq cacheq sem knownUnsat (fileCounter + 1) @@ -277,8 +277,8 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f ) getOneSol :: forall m . (MonadIO m, ReadConfig m) => - Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe SMTScript -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () -getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r cacheq sem fileCounter = do + Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () +getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) props r cacheq sem fileCounter = do conf <- readConfig liftIO $ bracket_ (waitQSem sem) @@ -294,20 +294,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r "unsat" -> do when conf.debug $ logWithTid "Query is UNSAT." dealWithUnsat - "sat" -> case refinement of - Just refine -> do - when conf.debug $ logWithTid "Abstract query is SAT, refining..." - when (conf.dumpQueries) $ writeSMT2File (smt2 <> (SMT2 refine mempty mempty)) "-ref." (show fileCounter) - sendAndCheck conf inst refine $ \sat2 -> do - case sat2 of - "unsat" -> do - when conf.debug $ logWithTid "Refined query is UNSAT." - dealWithUnsat - "sat" -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Refined query timeout" - "unknown" -> dealWithUnknown conf - _ -> dealWithIssue conf sat2 - Nothing -> dealWithModel conf inst + "sat" -> dealWithModel conf inst "timeout" -> pure $ Unknown "Abstract query timeout" "unknown" -> dealWithUnknown conf _ -> dealWithIssue conf res @@ -326,8 +313,7 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) refinement props r when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) pure Qed dealWithUnknown conf = do - let fullSMT2 = smt2 <> SMT2 (fromMaybe mempty refinement) mempty mempty - dumpUnsolved fullSMT2 fileCounter conf.dumpUnsolved + dumpUnsolved smt2 fileCounter conf.dumpUnsolved unknown conf "SMT solver returned unknown (maybe it got killed?)" dealWithModel conf inst = getModel inst cexvars >>= \case Just model -> pure $ Cex model From 1838ea7086a5d2e87e54e40afaf5676985e45216 Mon Sep 17 00:00:00 2001 From: Mate Soos Date: Wed, 18 Feb 2026 18:07:21 +0100 Subject: [PATCH 127/150] Cleanup --- src/EVM/Solvers.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index bfe5b2f14..9d15a6b81 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -140,7 +140,6 @@ checkSatWithProps sg props = do let refinement = divModGroundTruth (exprToSMTWith AbstractDivMod) allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement - -- else liftIO $ checkSatTwoPhase sg (Just props) smt2Abstract (Just $ SMTScript (getNonError refinement)) else do let x = (getNonError smt2Abstract) <> (SMT2 (SMTScript (getNonError refinement)) mempty mempty) liftIO $ checkSat sg (Just props) (Right x) From cf21972423b3150a059becdbd96a7f86811748e7 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 6 Apr 2026 12:18:00 +0200 Subject: [PATCH 128/150] import fix --- src/EVM/SMT/DivModEncoding.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 9215588bc..efce2f475 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -5,7 +5,7 @@ module EVM.SMT.DivModEncoding , divModAbstractDecls ) where -import Data.Bits ((.&.), countTrailingZeros) +import Data.Bits (countTrailingZeros) import Data.Containers.ListUtils (nubOrd) import Data.List (groupBy, sortBy) import Data.Ord (comparing) From 7aaefd010863fff8c9d4a035fb563508542c008b Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 6 Apr 2026 12:40:12 +0200 Subject: [PATCH 129/150] more fixes --- hevm.cabal | 2 ++ test/test.hs | 98 +--------------------------------------------------- 2 files changed, 3 insertions(+), 97 deletions(-) diff --git a/hevm.cabal b/hevm.cabal index ce38fbcb3..b270c5127 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -315,6 +315,8 @@ test-suite rpc-tests exitcode-stdio-1.0 main-is: rpc.hs + build-depends: + vector, test-suite ethereum-tests import: test-common diff --git a/test/test.hs b/test/test.hs index 1d557da58..8a3a55ed2 100644 --- a/test/test.hs +++ b/test/test.hs @@ -759,103 +759,7 @@ tests = testGroup "hevm" let exprSimp = map Expr.simplify paths assertBoolM "expected partial execution" (any isPartial exprSimp) ] - , testGroup "Dapp-Tests" - [ test "Trivial-Pass" $ do - let testFile = "test/contracts/pass/trivial.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Foundry" $ do - -- quick smokecheck to make sure that we can parse ForgeStdLib style build outputs - -- return is a pair of (No Cex, No Warnings) - let cases = - [ ("test/contracts/pass/trivial.sol", ".*", (True, True)) - , ("test/contracts/pass/dsProvePass.sol", ".*", (True, True)) - , ("test/contracts/pass/revertEmpty.sol", ".*", (True, True)) - , ("test/contracts/pass/revertString.sol", ".*", (True, True)) - , ("test/contracts/pass/requireEmpty.sol", ".*", (True, True)) - , ("test/contracts/pass/requireString.sol", ".*", (True, True)) - -- overapproximation - , ("test/contracts/pass/no-overapprox-staticcall.sol", ".*", (True, True)) - , ("test/contracts/pass/no-overapprox-delegatecall.sol", ".*", (True, True)) - -- failure cases - , ("test/contracts/fail/trivial.sol", ".*", (False, False)) - , ("test/contracts/fail/dsProveFail.sol", "prove_add", (False, True)) - , ("test/contracts/fail/dsProveFail.sol", "prove_multi", (False, True)) - -- all branches revert, which is a warning - , ("test/contracts/fail/dsProveFail.sol", "prove_trivial.*", (False, False)) - , ("test/contracts/fail/dsProveFail.sol", "prove_distributivity", (False, True)) - , ("test/contracts/fail/assertEq.sol", ".*", (False, True)) - -- bad cheatcode detected, hence the warning - , ("test/contracts/fail/bad-cheatcode.sol", ".*", (False, False)) - -- symbolic failures -- either the text or the selector is symbolic - , ("test/contracts/fail/symbolicFail.sol", "prove_conc_fail_allrev.*", (False, False)) - , ("test/contracts/fail/symbolicFail.sol", "prove_conc_fail_somerev.*", (False, True)) - , ("test/contracts/fail/symbolicFail.sol", "prove_symb_fail_allrev_text.*", (False, False)) - , ("test/contracts/fail/symbolicFail.sol", "prove_symb_fail_somerev_text.*", (False, True)) - , ("test/contracts/fail/symbolicFail.sol", "prove_symb_fail_allrev_selector.*", (False, False)) - , ("test/contracts/fail/symbolicFail.sol", "prove_symb_fail_somerev_selector.*", (False, True)) - -- vm.etch - , ("test/contracts/pass/etch.sol", "prove_etch.*", (True, True)) - , ("test/contracts/pass/etch.sol", "prove_deal.*", (True, True)) - , ("test/contracts/fail/etchFail.sol", "prove_etch_fail.*", (False, True)) - ] - forM_ cases $ \(testFile, match, expected) -> do - actual <- runForgeTestCustom testFile match Nothing Nothing False Fetch.noRpc - putStrLnM $ "Test result for " <> testFile <> " match: " <> T.unpack match <> ": " <> show actual - assertEqualM "Must match" expected actual - , test "Trivial-Fail" $ do - let testFile = "test/contracts/fail/trivial.sol" - runForgeTest testFile "prove_false" >>= assertEqualM "test result" (False, False) - , test "Abstract" $ do - let testFile = "test/contracts/pass/abstract.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Constantinople" $ do - let testFile = "test/contracts/pass/constantinople.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "ConstantinopleMin" $ do - let testFile = "test/contracts/pass/constantinople_min.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Fusaka" $ do - let testFile = "test/contracts/pass/fusaka.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Prove-Tests-Pass" $ do - let testFile = "test/contracts/pass/dsProvePass.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "prefix-check-for-dapp" $ do - let testFile = "test/contracts/fail/check-prefix.sol" - runForgeTest testFile "prove_trivial" >>= assertEqualM "test result" (False, False) - , test "transfer-dapp" $ do - let testFile = "test/contracts/pass/transfer.sol" - runForgeTest testFile "prove_transfer" >>= assertEqualM "should prove transfer" (True, True) - , test "nonce-issues" $ do - let testFile = "test/contracts/pass/nonce-issues.sol" - runForgeTest testFile "prove_prank_addr_exists" >>= assertEqualM "should not bail" (True, True) - runForgeTest testFile "prove_nonce_addr_nonexistent" >>= assertEqualM "should not bail" (True, True) - , test "Prove-Tests-Fail" $ do - let testFile = "test/contracts/fail/dsProveFail.sol" - runForgeTest testFile "prove_trivial" >>= assertEqualM "prove_trivial" (False, False) - runForgeTest testFile "prove_trivial_dstest" >>= assertEqualM "prove_trivial_dstest" (False, False) - runForgeTest testFile "prove_add" >>= assertEqualM "prove_add" (False, True) - runForgeTestCustom testFile "prove_smtTimeout" (Just 1) Nothing False Fetch.noRpc - >>= assertEqualM "prove_smtTimeout" (True, False) - runForgeTest testFile "prove_multi" >>= assertEqualM "prove_multi" (False, True) - runForgeTest testFile "prove_distributivity" >>= assertEqualM "prove_distributivity" (False, True) - , test "Loop-Tests" $ do - let testFile = "test/contracts/pass/loops.sol" - runForgeTestCustom testFile "prove_loop" Nothing (Just 10) False Fetch.noRpc >>= assertEqualM "test result" (True, False) - runForgeTestCustom testFile "prove_loop" Nothing (Just 100) False Fetch.noRpc >>= assertEqualM "test result" (False, False) - , test "Cheat-Codes-Pass" $ do - let testFile = "test/contracts/pass/cheatCodes.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, False) - , test "Cheat-Codes-Fork-Pass" $ do - let testFile = "test/contracts/pass/cheatCodesFork.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Unwind" $ do - let testFile = "test/contracts/pass/unwind.sol" - runForgeTest testFile ".*" >>= assertEqualM "test result" (True, True) - , test "Keccak" $ do - let testFile = "test/contracts/pass/keccak.sol" - runForgeTest testFile "prove_access" >>= assertEqualM "test result" (True, True) - ] + -- NOTE: Foundry/Dapp tests moved to EVM.Test.FoundryTests , testGroup "Arith" -- Tests adapted from halmos (tests/regression/test/Arith.t.sol, tests/solver/test/SignedDiv.t.sol, tests/solver/test/Math.t.sol) -- Run with abstractArith = True to exercise two-phase solving From 4b18b037ae9953981445b30602a28981428bdb39 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 6 Apr 2026 13:13:56 +0200 Subject: [PATCH 130/150] ignore math-mint-fail test --- test/test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/test.hs b/test/test.hs index 8a3a55ed2..6ca6c2a0d 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1178,7 +1178,7 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res - , testAbstractArith "math-mint-fail" $ do + , ignoreTestBecause "Abstract arithmetic cannot find counterexample for this case" $ testAbstractArith "math-mint-fail" $ do Just c <- solcRuntime "C" [i| contract C { function prove_mint(uint s, uint A1, uint S1) external pure { From b162bfa6f12f1ab55ea2fd3a44cf88d8ee280c23 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 17 Jun 2026 16:18:40 +0200 Subject: [PATCH 131/150] solvers: empty solver returns clean 'Result unknown by SMT solver' The 2-phase refactor's sendScript requires every command to return "success", which the empty solver (no-op process, no print-success) can't satisfy, so it failed before check-sat; the merge from main added SMT content that exposed this. Short-circuit EmptySolver in getOneSol to return Unknown with the same message main produces (and that the 'empty solver is always unknown' CLI test expects). The 'maybe it got killed' diagnostic stays on the real error paths. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/EVM/Solvers.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 9d15a6b81..4b41aaa61 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -277,6 +277,9 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f getOneSol :: forall m . (MonadIO m, ReadConfig m) => Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () +-- the empty solver answers every query "unknown" without spawning a process +getOneSol EmptySolver _ _ _ _ r _ _ _ = + liftIO $ writeChan r (Unknown "Result unknown by SMT solver") getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) props r cacheq sem fileCounter = do conf <- readConfig liftIO $ bracket_ From 60ccd590e8068c749882b91d4e5f25222d030ea7 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 17 Jun 2026 18:36:42 +0200 Subject: [PATCH 132/150] Abstract unsigned div/mod (bvudiv/bvurem) in two-phase SMT Extend the abstraction+refinement div/mod encoding to unsigned Div/Mod, mirroring the existing signed (SDiv/SMod) path: - Declare abst_evm_bvudiv / abst_evm_bvurem uninterpreted functions and route Div/Mod through divModOp so they honor AbstractDivMod (the concrete path stays byte-identical via op2CheckZero). - Split DivModKind into signed/unsigned variants so the absolute-value and sign-reconstruction machinery is never applied to unsigned operands, and signed/unsigned groups never share a congruence pool. - For unsigned, the magnitude is the raw operand (no smtAbsolute) and the reconstruction is just the EVM divide-by-zero guard around the result var. The ground-truth axiom is zero-guarded (ite (= b 0) 0 (bvudiv a b)) to match EVM's x/0 = 0 semantics, since SMT-LIB's native bvudiv/bvurem return non-zero on a zero divisor. Add unsigned tests to the Abstract-Arith group, including a vault-preview-shares example (ERC-4626-style (assets << 64) / price) that the shift-bounds encoding proves instantly but native bvudiv leaves at "unknown". Co-Authored-By: Claude Opus 4.8 (1M context) --- src/EVM/SMT.hs | 4 +- src/EVM/SMT/DivModEncoding.hs | 102 +++++++++++++++++++++++---------- test/test.hs | 104 ++++++++++++++++++++++++++++++++++ 3 files changed, 177 insertions(+), 33 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 6c4c0afee..17fee171e 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -514,9 +514,9 @@ exprToSMTWith divEnc = \case SAR a b -> op2 "bvashr" b a CLZ a -> op1 "clz256" a SEx a b -> op2 "signext" a b - Div a b -> op2CheckZero "bvudiv" a b + Div a b -> divModOp "bvudiv" "abst_evm_bvudiv" a b SDiv a b -> divModOp "bvsdiv" "abst_evm_bvsdiv" a b - Mod a b -> op2CheckZero "bvurem" a b + Mod a b -> divModOp "bvurem" "abst_evm_bvurem" a b SMod a b -> divModOp "bvsrem" "abst_evm_bvsrem" a b -- NOTE: this needs to do the MUL at a higher precision, then MOD, then downcast MulMod a b c -> do diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index efce2f475..eb8c4877a 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -22,6 +22,8 @@ divModAbstractDecls = [ SMTComment "abstract division/modulo (uninterpreted functions)" , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] -- | Local helper for trivial SMT constructs @@ -34,7 +36,11 @@ zero = "(_ bv0 256)" wordAsBV :: forall a. Integral a => a -> Builder wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" -data DivModKind = IsDiv | IsMod +-- | The four EVM division/modulo operations. The @S@-variants are signed +-- (SDiv/SMod), the @U@-variants unsigned (Div/Mod). Signed and unsigned ops +-- are kept in separate groups so the signed absolute-value/sign-reconstruction +-- machinery is never applied to unsigned operands (and vice versa). +data DivModKind = IsSDiv | IsSMod | IsUDiv | IsUMod deriving (Eq, Ord) type DivModOp = (DivModKind, Expr EWord, Expr EWord) @@ -43,26 +49,52 @@ data AbstractKey = AbstractKey (Expr EWord) (Expr EWord) DivModKind deriving (Eq, Ord) isDiv :: DivModKind -> Bool -isDiv IsDiv = True -isDiv _ = False +isDiv IsSDiv = True +isDiv IsUDiv = True +isDiv _ = False + +isSigned :: DivModKind -> Bool +isSigned IsSDiv = True +isSigned IsSMod = True +isSigned _ = False + +-- | Name of the uninterpreted function standing in for this op. +abstFnName :: DivModKind -> Builder +abstFnName IsSDiv = "abst_evm_bvsdiv" +abstFnName IsSMod = "abst_evm_bvsrem" +abstFnName IsUDiv = "abst_evm_bvudiv" +abstFnName IsUMod = "abst_evm_bvurem" + +-- | Name of the concrete SMT-LIB op refined against in phase two. +concFnName :: DivModKind -> Builder +concFnName IsSDiv = "bvsdiv" +concFnName IsSMod = "bvsrem" +concFnName IsUDiv = "bvudiv" +concFnName IsUMod = "bvurem" -- | Collect all div/mod operations from an expression. collectDivMods :: Expr a -> [DivModOp] collectDivMods = \case - T.SDiv a b -> [(IsDiv, a, b)] - T.SMod a b -> [(IsMod, a, b)] + T.SDiv a b -> [(IsSDiv, a, b)] + T.SMod a b -> [(IsSMod, a, b)] + T.Div a b -> [(IsUDiv, a, b)] + T.Mod a b -> [(IsUMod, a, b)] _ -> [] abstractKey :: DivModOp -> AbstractKey abstractKey (kind, a, b) = AbstractKey a b kind --- | Declare abs_a, abs_b, and unsigned result variables for a signed group. -declareAbsolute :: (Expr EWord -> Err Builder) -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) -declareAbsolute enc groupIdx firstA firstB unsignedResult = do +-- | Declare the magnitude variables and the unsigned result variable for a +-- group. For signed ops the magnitudes are the absolute values |a|, |b|; for +-- unsigned ops the operands are already non-negative, so the magnitude is the +-- operand itself (|x| = x). +declareAbsolute :: (Expr EWord -> Err Builder) -> DivModKind -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +declareAbsolute enc kind groupIdx firstA firstB unsignedResult = do aenc <- enc firstA benc <- enc firstB - let absoluteAEnc = smtAbsolute aenc - absoluteBEnc = smtAbsolute benc + let magnitude x = if isSigned kind then smtAbsolute x else x + absoluteAEnc = magnitude aenc + absoluteBEnc = magnitude benc absoluteAName = fromString $ "absolute_a" <> show groupIdx absoluteBName = fromString $ "absolute_b" <> show groupIdx let decls = [ SMTCommand $ "(declare-const" `sp` absoluteAName `sp` "(_ BitVec 256))" @@ -73,16 +105,19 @@ declareAbsolute enc groupIdx firstA firstB unsignedResult = do ] pure (decls, (absoluteAName, absoluteBName)) --- | Assert "abstract sdiv/smod(a,b)" = signed result derived from unsigned result. -assertAbstEqSignedResult :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry -assertAbstEqSignedResult enc unsignedResult (kind, a, b) = do +-- | Assert "abstract div/mod(a,b)" = result derived from the unsigned result +-- variable. Signed ops reconstruct the sign from |a|/|b|; unsigned ops need +-- only the EVM divide-by-zero guard, since the unsigned result is the answer. +assertAbstEqResult :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry +assertAbstEqResult enc unsignedResult (kind, a, b) = do aenc <- enc a benc <- enc b - let fname = if isDiv kind then "abst_evm_bvsdiv" else "abst_evm_bvsrem" - abstract = "(" <> fname `sp` aenc `sp` benc <> ")" - concrete = if isDiv kind - then signedFromUnsignedDiv aenc benc unsignedResult - else signedFromUnsignedMod aenc benc unsignedResult + let abstract = "(" <> abstFnName kind `sp` aenc `sp` benc <> ")" + concrete = case kind of + IsSDiv -> signedFromUnsignedDiv aenc benc unsignedResult + IsSMod -> signedFromUnsignedMod aenc benc unsignedResult + IsUDiv -> smtZeroGuard benc unsignedResult + IsUMod -> smtZeroGuard benc unsignedResult pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | Ground-truth axioms: for each sdiv/smod op, assert that the abstract @@ -100,12 +135,14 @@ divModGroundTruth enc props = do mkGroundTruthAxiom (kind, a, b) = do aenc <- enc a benc <- enc b - let (abstFn, concFn) = if isDiv kind - then ("abst_evm_bvsdiv", "bvsdiv") - else ("abst_evm_bvsrem", "bvsrem") - pure $ SMTCommand $ "(assert (=" `sp` - "(" <> abstFn `sp` aenc `sp` benc <> ")" `sp` - "(" <> concFn `sp` aenc `sp` benc <> ")))" + let abstract = "(" <> abstFnName kind `sp` aenc `sp` benc <> ")" + native = "(" <> concFnName kind `sp` aenc `sp` benc <> ")" + -- EVM defines x/0 = 0 and x%0 = 0, whereas SMT-LIB's native bvudiv/ + -- bvurem return non-zero on a zero divisor; guard the unsigned ops so + -- the axiom matches op2CheckZero and the encoding's zero guard. (The + -- signed reconstruction already applies the guard on its side.) + concrete = if isSigned kind then native else smtZeroGuard benc native + pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" -- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). divModEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] @@ -130,7 +167,7 @@ divModEncoding enc props = do let isDiv' = isDiv firstKind prefix = if isDiv' then "udiv" else "urem" unsignedResult = fromString $ prefix <> "_" <> show groupIdx - (decls, (absoluteA, absoluteB)) <- declareAbsolute enc groupIdx firstA firstB unsignedResult + (decls, (absoluteA, absoluteB)) <- declareAbsolute enc firstKind groupIdx firstA firstB unsignedResult -- When the dividend is a left-shift (a = x << k, i.e. a = x * 2^k), -- we can bound the unsigned division result using cheap bitshift @@ -153,16 +190,19 @@ divModEncoding enc props = do <> "(bvuge" `sp` unsignedResult `sp` shifted <> ")))" ] _ -> [] - axioms <- mapM (assertAbstEqSignedResult enc unsignedResult) lhs + axioms <- mapM (assertAbstEqResult enc unsignedResult) lhs pure $ decls <> shiftBounds <> axioms --- | Congruence: if two signed groups have equal absolute inputs, their results are equal. +-- | Congruence: if two groups of the same kind have equal magnitude inputs, +-- their results are equal. Signed and unsigned groups are linked separately so +-- a signed op is never tied to an unsigned op (and vice versa). mkCongruenceLinks :: [(Int, [DivModOp])] -> [SMTEntry] mkCongruenceLinks indexedGroups = - let signedDivGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsDiv] - signedModGroups = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == IsMod] - in concatMap (mkPairLinks "udiv") (allPairs signedDivGroups) - <> concatMap (mkPairLinks "urem") (allPairs signedModGroups) + let groupsOfKind want = [(i, ops) | (i, ops@((k,_,_):_)) <- indexedGroups , k == want] + in concatMap (mkPairLinks "udiv") (allPairs (groupsOfKind IsSDiv)) + <> concatMap (mkPairLinks "urem") (allPairs (groupsOfKind IsSMod)) + <> concatMap (mkPairLinks "udiv") (allPairs (groupsOfKind IsUDiv)) + <> concatMap (mkPairLinks "urem") (allPairs (groupsOfKind IsUMod)) where allPairs xs = [(a, b) | a <- xs, b <- xs, fst a < fst b] mkPairLinks prefix' ((i, _), (j, _)) = diff --git a/test/test.hs b/test/test.hs index 5a47c115e..c1bb515fa 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1215,6 +1215,110 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + -- Unsigned div/mod exercise the abst_evm_bvudiv / abst_evm_bvurem + -- uninterpreted functions and the two-phase refinement. + , testAbstractArith "udiv-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_by_one(uint256 a) external pure { + uint256 result = a / 1; + assert(result == a); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-by-zero" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_by_zero(uint256 a) external pure { + // EVM div-by-zero yields 0; Solidity's `/` reverts, so use raw DIV + uint256 result; + assembly { result := div(a, 0) } + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-self" $ do + -- symbolic divisor: a genuine abst_evm_bvudiv application + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_self(uint256 a) external pure { + require(a != 0); + uint256 result = a / a; + assert(result == 1); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "umod-by-one" $ do + Just c <- solcRuntime "C" [i| + contract C { + function prove_umod_by_one(uint256 a) external pure { + uint256 result = a % 1; + assert(result == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "umod-range" $ do + -- a % b < b for b != 0; needs the ground-truth refinement of bvurem + Just c <- solcRuntime "C" [i| + contract C { + function prove_umod_range(uint256 a, uint256 b) external pure { + require(b != 0); + uint256 result = a % b; + assert(result < b); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-le-dividend" $ do + -- a / b <= a for b != 0; refines bvudiv (symbolic divisor) + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_le_dividend(uint256 a, uint256 b) external pure { + require(b != 0); + uint256 r = a / b; + assert(r <= a); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "udiv-cex" $ do + -- false property: div(a,b) can be 0 (e.g. a=0). The abstract path must + -- still find a real counterexample after refinement. + Just c <- solcRuntime "C" [i| + contract C { + function prove_udiv_nonzero(uint256 a, uint256 b) external pure { + require(b != 0); + uint256 result = a / b; + assert(result != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) + , testAbstractArith "vault-preview-shares" $ do + -- ERC-4626-style share pricing in 64.64 fixed point: + -- shares = (assets * 2^64) / price + -- When each share costs at least 1.0 (price >= 2^64), a deposit can + -- never mint more shares than assets. The power-of-two dividend + -- (assets << 64) lets the shift-bounds encoding discharge this without + -- the bvudiv theory; native bvudiv leaves the solver at "unknown". + Just c <- solcRuntime "C" [i| + contract C { + function previewShares(uint256 assets, uint256 price) internal pure returns (uint256 shares) { + shares = (assets << 64) / price; + } + function prove_vault_no_inflation(uint256 assets, uint256 price) external pure { + require(price >= (1 << 64)); // >= 1.0 per share + require(assets < (1 << 128)); // assets << 64 stays within 256 bits + uint256 shares = previewShares(assets, price); + assert(shares <= assets); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res , ignoreTestBecause "Abstract arithmetic cannot find counterexample for this case" $ testAbstractArith "math-mint-fail" $ do Just c <- solcRuntime "C" [i| contract C { From fd944a42c0c53b5427854ebbede5fb67f271bb4a Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 17 Jun 2026 19:55:32 +0200 Subject: [PATCH 133/150] PoC: abstract symbolic multiplication (abst_evm_bvmul) with sound lemmas Extend the arithmetic abstraction to multiplication, so vault-style properties involving symbolic*symbolic products become provable while keeping hevm SOUND. Encoding (src/EVM/SMT/DivModEncoding.hs, src/EVM/SMT.hs): - Route only symbolic*symbolic Mul through an uninterpreted abst_evm_bvmul (concrete/0/1/power-of-two factors stay native). No mul ground truth, so the solver never bit-blasts a symbolic product. - Sound lemmas only: commutativity; 0/1 identities; div x mul link (quotient*divisor <= dividend); div monotonicity; and mul monotonicity guarded by a bound-free no-overflow predicate (high half of the 512-bit product is zero). Bounding (e.g. require(x < 2**128)) is supplied in Solidity, not hardcoded here. Soundness (src/EVM/Solvers.hs): - A QED is a real proof (the lemmas over-approximate real EVM arithmetic). - Because abst_evm_bvmul is uninterpreted, a SAT model may use product values inconsistent with real multiplication, so a counterexample cannot be trusted: when the mul abstraction is active, SAT is downgraded to Unknown. div-only counterexamples (div is exact via its ground truth) are unaffected. Tests (test/test.hs, group "Mul-Abstraction"): mul monotonicity, 0/1 identities, div x mul link, ERC-4626 share-price monotonicity (QED with abstraction, unknown natively); plus soundness cases: unbounded overflow must not yield a bogus QED, the cross-divisor round-trip's spurious model must not be reported as a counterexample, and div/constant-mul counterexamples remain reported. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/EVM/SMT.hs | 16 +++- src/EVM/SMT/DivModEncoding.hs | 108 +++++++++++++++++++++++++ src/EVM/Solvers.hs | 12 ++- test/test.hs | 145 ++++++++++++++++++++++++++++++++++ 4 files changed, 278 insertions(+), 3 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 17fee171e..3031b1eda 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -145,7 +145,8 @@ assertPropsAbstract conf ps = do base <- if not conf.simp then mkBase False ps else mkBase True (decompose conf ps) shiftBounds <- divModEncoding (exprToSMTWith AbstractDivMod) ps - pure $ base <> SMT2 (SMTScript shiftBounds) mempty mempty + mulLemmas <- mulEncoding (exprToSMTWith AbstractDivMod) ps + pure $ base <> SMT2 (SMTScript (shiftBounds <> mulLemmas)) mempty mempty -- Note: we need a version that does NOT call simplify, -- because we make use of it to verify the correctness of our simplification @@ -455,7 +456,12 @@ exprToSMTWith divEnc = \case Add a b -> op2 "bvadd" a b Sub a b -> op2 "bvsub" a b - Mul a b -> op2 "bvmul" a b + Mul a b -> case (a, b) of + -- only genuinely symbolic products are abstracted; a concrete factor + -- (0/1/power-of-two/constant) is handled natively / by the simplifier + (Lit _, _) -> op2 "bvmul" a b + (_, Lit _) -> op2 "bvmul" a b + _ -> mulOp a b Exp a b -> case a of Lit 0 -> do benc <- exprToSMT b @@ -633,6 +639,12 @@ exprToSMTWith divEnc = \case divModOp concreteOp abstractOp a b = case divEnc of ConcreteDivMod -> op2CheckZero concreteOp a b AbstractDivMod -> op2 abstractOp a b + -- symbolic*symbolic multiplication: native under ConcreteDivMod, an + -- uninterpreted function under AbstractDivMod (no zero guard needed). + mulOp :: Expr x -> Expr y -> Err Builder + mulOp a b = case divEnc of + ConcreteDivMod -> op2 "bvmul" a b + AbstractDivMod -> op2 "abst_evm_bvmul" a b sp :: Builder -> Builder -> Builder a `sp` b = a <> " " <> b diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index eb8c4877a..196a3864d 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -3,6 +3,8 @@ module EVM.SMT.DivModEncoding ( divModGroundTruth , divModEncoding , divModAbstractDecls + , mulEncoding + , hasAbstractMul ) where import Data.Bits (countTrailingZeros) @@ -24,6 +26,8 @@ divModAbstractDecls = , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTComment "abstract multiplication (kept fully uninterpreted: no ground truth)" + , SMTCommand "(declare-fun abst_evm_bvmul ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] -- | Local helper for trivial SMT constructs @@ -33,6 +37,17 @@ a `sp` b = a <> " " <> b zero :: Builder zero = "(_ bv0 256)" +one :: Builder +one = "(_ bv1 256)" + +-- | True iff x*y does not overflow 256 bits (high half of the 512-bit product +-- is zero). This is bound-free: it does NOT bake in any particular width +-- limit. Callers (e.g. a Solidity `require(x < 2**128)`) are responsible for +-- bounding operands so that this predicate is cheap for the solver to discharge. +mulNoOverflow :: Builder -> Builder -> Builder +mulNoOverflow x y = + "(= ((_ extract 511 256) (bvmul ((_ zero_extend 256) " <> x <> ") ((_ zero_extend 256) " <> y <> "))) " <> zero <> ")" + wordAsBV :: forall a. Integral a => a -> Builder wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" @@ -144,6 +159,99 @@ divModGroundTruth enc props = do concrete = if isSigned kind then native else smtZeroGuard benc native pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" +-- | Collect symbolic*symbolic multiplications (neither operand a literal). +-- Concrete factors (incl. 0/1/power-of-two) are handled natively by the +-- simplifier, so only genuinely symbolic products are abstracted. +collectMuls :: Expr a -> [(Expr EWord, Expr EWord)] +collectMuls = \case + T.Mul a b | notLit a, notLit b -> [(a, b)] + _ -> [] + where + notLit (Lit _) = False + notLit _ = True + +-- | True if any prop contains a symbolic*symbolic multiplication, i.e. the +-- multiplication abstraction is in play. Because abst_evm_bvmul is left +-- uninterpreted (no ground truth), a satisfying model may assign it values +-- inconsistent with real multiplication, so a counterexample cannot be +-- trusted; callers must downgrade SAT results to Unknown to stay SOUND. +hasAbstractMul :: [Prop] -> Bool +hasAbstractMul props = not $ null $ concatMap (foldProp collectMuls []) props + +-- | Lemmas for abstract multiplication. Multiplication is kept fully +-- uninterpreted (no ground truth, so the solver never bit-blasts a symbolic +-- product); we add only sound algebraic facts. Commutativity is free because +-- the simplifier canonically orders Mul operands, so abst_evm_bvmul(a,b) and +-- abst_evm_bvmul(b,a) are the same term. +-- +-- Step 1 lemma (sound unconditionally): quotient*divisor <= dividend, i.e. +-- abst_evm_bvmul(abst_evm_bvudiv(X,Y), Y) <= X +-- The product (X/Y)*Y <= X < 2^256 can never overflow, so no guard is needed. +-- This is what links the div and mul abstractions and chains nested divisions. +mulEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] +mulEncoding enc props = do + let udivs = [ (a, b) | (IsUDiv, a, b) <- nubOrd $ concatMap (foldProp collectDivMods []) props ] + muls = nubOrd $ concatMap (foldProp collectMuls []) props + -- products the div-link lemma introduces, e.g. (a/b)*b + linkMuls = [ (T.Div a b, b) | (a, b) <- udivs ] + allMuls = nubOrd (muls <> linkMuls) + if null udivs && null muls then pure [] + else do + comm <- mapM mkComm allMuls + links <- mapM mkDivMulLink udivs + zeroOne <- concat <$> mapM mkMulIdentities allMuls + mulMono <- concat <$> mapM mkMulMono (sharedPairs allMuls) + divMono <- concat <$> mapM mkDivMono (sharedPairs udivs) + pure $ (SMTComment "multiplication abstraction lemmas") + : (comm <> zeroOne <> links <> mulMono <> divMono) + where + -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that + -- lemma terms match the props regardless of the simplifier's operand order. + mkComm (a, b) = do + aenc <- enc a; benc <- enc b + let m1 = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" + m2 = "(abst_evm_bvmul" `sp` benc `sp` aenc <> ")" + pure $ SMTCommand $ "(assert (=" `sp` m1 `sp` m2 <> "))" + -- ordered pairs (x, y, z) where (x,z) and (y,z) both occur (shared 2nd operand) + sharedPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] + sharedPairs xs = [ (x, y, z) | (x, z) <- xs, (y, z') <- xs, z == z', x /= y ] + + -- mul monotonicity (guarded by no-overflow, hence sound): if neither x*z + -- nor y*z overflows then x <= y => x*z <= y*z. The guard is bound-free; + -- bounding operands (e.g. a Solidity require) keeps it cheap to discharge. + mkMulMono (x, y, z) = do + xenc <- enc x; yenc <- enc y; zenc <- enc z + let mxz = "(abst_evm_bvmul" `sp` xenc `sp` zenc <> ")" + myz = "(abst_evm_bvmul" `sp` yenc `sp` zenc <> ")" + pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc + <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] + + -- div monotonicity in the dividend (sound unconditionally): for a common + -- divisor z, x <= y => floor(x/z) <= floor(y/z). + mkDivMono (x, y, z) = do + xenc <- enc x; yenc <- enc y; zenc <- enc z + let dxz = "(abst_evm_bvudiv" `sp` xenc `sp` zenc <> ")" + dyz = "(abst_evm_bvudiv" `sp` yenc `sp` zenc <> ")" + pure [ SMTCommand $ "(assert (=> (bvule" `sp` xenc `sp` yenc <> ") (bvule" `sp` dxz `sp` dyz <> ")))" ] + -- quotient*divisor <= dividend + mkDivMulLink (a, b) = do + aenc <- enc a + benc <- enc b + let q = "(abst_evm_bvudiv" `sp` aenc `sp` benc <> ")" + qb = "(abst_evm_bvmul" `sp` q `sp` benc <> ")" + pure $ SMTCommand $ "(assert (bvule" `sp` qb `sp` aenc <> "))" + -- sound identities pinning the otherwise-free UF on 0/1 operands: + -- x*0 = 0, 0*y = 0, x*1 = x, 1*y = y + mkMulIdentities (a, b) = do + aenc <- enc a + benc <- enc b + let m = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" + pure [ SMTCommand $ "(assert (=> (=" `sp` aenc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` benc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` aenc `sp` one <> ") (=" `sp` m `sp` benc <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` benc `sp` one <> ") (=" `sp` m `sp` aenc <> ")))" + ] + -- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). divModEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] divModEncoding enc props = do diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 4b41aaa61..0d598c17e 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -142,7 +142,17 @@ checkSatWithProps sg props = do else if isLeft refinement then pure $ Error $ getError refinement else do let x = (getNonError smt2Abstract) <> (SMT2 (SMTScript (getNonError refinement)) mempty mempty) - liftIO $ checkSat sg (Just props) (Right x) + res <- checkSat sg (Just props) (Right x) + -- SOUNDNESS: multiplication is abstracted as an uninterpreted function + -- with no ground truth, so a satisfying model may use product values + -- that do not match real multiplication. A QED stays sound (the lemmas + -- over-approximate real arithmetic), but a counterexample may be + -- spurious and must never be reported as a real violation; with nothing + -- to validate it against, the only sound output is Unknown. + pure $ case res of + Cex _ | hasAbstractMul allProps -> + Unknown "counterexample unsound under multiplication abstraction (abst_evm_bvmul is uninterpreted)" + _ -> res checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult checkSat (SolverGroup taskq) props smt2 = do diff --git a/test/test.hs b/test/test.hs index c1bb515fa..6f6489d56 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1332,6 +1332,151 @@ tests = testGroup "hevm" (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Expected counterexample" (any isCex res) ] + , testGroup "Mul-Abstraction" + -- Symbolic*symbolic multiplication is abstracted as an uninterpreted + -- function (abst_evm_bvmul) with sound lemmas (commutativity, 0/1 + -- identities, quotient*divisor<=dividend, no-overflow-guarded monotonicity) + -- and NO ground truth. This proves vault-style properties native solving + -- cannot, while staying SOUND: a QED is a real proof; spurious or + -- overflow-dependent results are never reported as bugs (downgraded to + -- Unknown). Bounding (e.g. require(x < 2**128)) is supplied in Solidity. + [ testAbstractArith "mul-monotone" $ do + -- a1 <= a2 => a1*c <= a2*c, under no-overflow (mul-monotonicity lemma) + Just c <- solcRuntime "C" [i| + contract C { + function prove_mul_monotone(uint256 a1, uint256 a2, uint256 k) external pure { + require(a1 < (1<<128) && a2 < (1<<128) && k < (1<<128)); + require(a1 <= a2); + uint256 p1; uint256 p2; + assembly { p1 := mul(a1, k) p2 := mul(a2, k) } + assert(p1 <= p2); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "mul-by-zero" $ do + -- x*y == 0 when y == 0 (0-identity lemma; y is symbolic, not folded) + Just c <- solcRuntime "C" [i| + contract C { + function prove_mul_zero(uint256 x, uint256 y) external pure { + require(y == 0); + uint256 p; assembly { p := mul(x, y) } + assert(p == 0); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "mul-by-one" $ do + -- x*y == x when y == 1 (1-identity lemma) + Just c <- solcRuntime "C" [i| + contract C { + function prove_mul_one(uint256 x, uint256 y) external pure { + require(y == 1); + uint256 p; assembly { p := mul(x, y) } + assert(p == x); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "div-mul-link" $ do + -- (x/y)*y <= x for y != 0 (div x mul link lemma; needs commutativity) + Just c <- solcRuntime "C" [i| + contract C { + function prove_div_mul_link(uint256 x, uint256 y) external pure { + require(y != 0); + uint256 q; uint256 p; + assembly { q := div(x, y) p := mul(q, y) } + assert(p <= x); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testCase "vault-shares-monotonic" $ do + -- ERC-4626: more assets deposited => at least as many shares. Provable + -- WITH abstraction, native solving times out (unknown). + Just c <- solcRuntime "C" [i| + contract C { + uint256 public totalAssets; + uint256 public totalShares; + function prove_shares_monotonic(uint256 a1, uint256 a2) external view { + require(totalAssets != 0); + require(a1 < (1<<128) && a2 < (1<<128) && totalShares < (1<<128)); + require(a1 <= a2); + uint256 ts = totalShares; uint256 ta = totalAssets; + uint256 s1; uint256 s2; + assembly { s1 := div(mul(a1, ts), ta) s2 := div(mul(a2, ts), ta) } + assert(s1 <= s2); + } + } |] + let testEnvAbstract = Env { config = testEnv.config { abstractArith = True } } + runEnv testEnvAbstract $ do + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED with abstraction" [] res + runEnv testEnv $ do + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + liftIO $ assertBool "Must be unknown natively" (all isUnknown res) + , testAbstractArith "mul-overflow-not-unsound" $ do + -- SOUNDNESS: unbounded monotonicity is FALSE (raw mul wraps); the + -- no-overflow guard must prevent a (bogus) QED -> Unknown, never QED. + Just c <- solcRuntime "C" [i| + contract C { + function prove_mul_monotone_overflow(uint256 a1, uint256 a2, uint256 k) external pure { + require(a1 <= a2); + uint256 p1; uint256 p2; + assembly { p1 := mul(a1, k) p2 := mul(a2, k) } + assert(p1 <= p2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Must be Unknown, never QED (unsound proof avoided)" + (not (any isCex res) && any isUnknown res) + , testAbstractArith "roundtrip-spurious-cex-suppressed" $ do + -- SOUNDNESS: the cross-divisor round-trip cannot be discharged; the + -- uninterpreted mul yields a spurious model that must NOT be reported + -- as a counterexample -> Unknown. + Just c <- solcRuntime "C" [i| + contract C { + uint256 public totalAssets; + uint256 public totalShares; + function prove_roundtrip(uint256 assets) external view { + require(totalAssets != 0 && totalShares != 0); + require(assets < (1<<128) && totalShares < (1<<128) && totalAssets < (1<<128)); + uint256 ts = totalShares; uint256 ta = totalAssets; + uint256 shares; uint256 outv; + assembly { shares := div(mul(assets, ts), ta) outv := div(mul(shares, ta), ts) } + assert(outv <= assets); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Must be Unknown, never a spurious counterexample" + (not (any isCex res) && any isUnknown res) + , testAbstractArith "div-cex-preserved" $ do + -- No symbolic*symbolic mul => div is exact => a real counterexample is + -- still reported (the Cex->Unknown downgrade must be precise). + Just c <- solcRuntime "C" [i| + contract C { + function prove_div_cex(uint256 a, uint256 b) external pure { + require(b != 0); + uint256 q; assembly { q := div(a, b) } + assert(q != 0); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) + , testAbstractArith "constmul-cex-preserved" $ do + -- Multiplication by a constant is NOT abstracted, so a real + -- counterexample is still reported. + Just c <- solcRuntime "C" [i| + contract C { + function prove_constmul_cex(uint256 x) external pure { + require(x < (1<<128)); + uint256 p; assembly { p := mul(x, 3) } + assert(p != 6); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Expected counterexample" (any isCex res) + ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do Just c <- solcRuntime "C" From 09ff923b46fc4a29d1fb6d91e44fd37d54285f0d Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 17 Jun 2026 21:08:53 +0200 Subject: [PATCH 134/150] Add two sound lemmas: divisor-monotonicity and mulDiv bound Extends the set of vault-style properties the multiplication abstraction proves, beyond plain monotonicity. Both lemmas are sound (true of real EVM arithmetic) and were each validated to unlock their target via the CLI. - Division anti-monotonicity in the divisor: y1 <= y2 && y1 != 0 => x/y2 <= x/y1. Unlocks divisor-ordering ("a cheaper price gives at least as many units"). - mulDiv bound: for (x*y)/z, if y <= z (or x <= z) then the result is <= x (resp. <= y), guarded by no-overflow of x*z (resp. y*z). Unlocks the common DeFi pattern, e.g. a fee of feeBps/10000 never exceeds the principal. A third lemma (multiplication cancellation, m(x,z)<=m(y,z)=>x<=y) was tried and reverted: it does not help bound-style properties such as (x*s)/s <= x, because the abstract product is unpinned, so the division result is unbounded and the no-overflow guard never discharges. Those need the product pinned (i.e. bit-blasted), which the abstraction deliberately avoids. Soundness is unchanged: QED remains a real proof, and properties that the lemmas cannot discharge (or that are false) stay Unknown rather than producing a bogus proof or counterexample. Tests (group "Mul-Abstraction"): div-divisor-monotone, muldiv-fee-cap (QED), and muldiv-fee-uncapped-not-unsound (must stay Unknown). Co-Authored-By: Claude Opus 4.8 (1M context) --- src/EVM/SMT/DivModEncoding.hs | 40 ++++++++++++++++++++++++++++++++++- test/test.hs | 39 ++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 196a3864d..1f00ad619 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -195,6 +195,8 @@ mulEncoding enc props = do -- products the div-link lemma introduces, e.g. (a/b)*b linkMuls = [ (T.Div a b, b) | (a, b) <- udivs ] allMuls = nubOrd (muls <> linkMuls) + -- divisions whose dividend is an abstract product: (x*y)/z + mulDivs = [ (a, x, y, b) | (a, b) <- udivs, Just (x, y) <- [asMul a] ] if null udivs && null muls then pure [] else do comm <- mapM mkComm allMuls @@ -202,8 +204,10 @@ mulEncoding enc props = do zeroOne <- concat <$> mapM mkMulIdentities allMuls mulMono <- concat <$> mapM mkMulMono (sharedPairs allMuls) divMono <- concat <$> mapM mkDivMono (sharedPairs udivs) + divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivs) + mulDivB <- concat <$> mapM mkMulDivBound mulDivs pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -216,6 +220,21 @@ mulEncoding enc props = do sharedPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] sharedPairs xs = [ (x, y, z) | (x, z) <- xs, (y, z') <- xs, z == z', x /= y ] + -- ordered pairs (y1, y2, x) where (x,y1) and (x,y2) both occur (shared 1st + -- operand): divisions of the same dividend by different divisors. + divisorPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] + divisorPairs xs = [ (y1, y2, x) | (x, y1) <- xs, (x', y2) <- xs, x == x', y1 /= y2 ] + + -- div anti-monotonicity in the divisor (sound for nonzero divisors): a + -- bigger divisor yields a smaller-or-equal quotient. + -- y1 <= y2 && y1 != 0 => x/y2 <= x/y1 + mkDivisorMono (y1, y2, x) = do + y1e <- enc y1; y2e <- enc y2; xe <- enc x + let dxy1 = "(abst_evm_bvudiv" `sp` xe `sp` y1e <> ")" + dxy2 = "(abst_evm_bvudiv" `sp` xe `sp` y2e <> ")" + pure [ SMTCommand $ "(assert (=> (and (distinct" `sp` y1e `sp` zero <> ")" + <> " (bvule" `sp` y1e `sp` y2e <> ")) (bvule" `sp` dxy2 `sp` dxy1 <> ")))" ] + -- mul monotonicity (guarded by no-overflow, hence sound): if neither x*z -- nor y*z overflows then x <= y => x*z <= y*z. The guard is bound-free; -- bounding operands (e.g. a Solidity require) keeps it cheap to discharge. @@ -223,6 +242,7 @@ mulEncoding enc props = do xenc <- enc x; yenc <- enc y; zenc <- enc z let mxz = "(abst_evm_bvmul" `sp` xenc `sp` zenc <> ")" myz = "(abst_evm_bvmul" `sp` yenc `sp` zenc <> ")" + -- forward: x <= y => x*z <= y*z pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] @@ -233,6 +253,24 @@ mulEncoding enc props = do let dxz = "(abst_evm_bvudiv" `sp` xenc `sp` zenc <> ")" dyz = "(abst_evm_bvudiv" `sp` yenc `sp` zenc <> ")" pure [ SMTCommand $ "(assert (=> (bvule" `sp` xenc `sp` yenc <> ") (bvule" `sp` dxz `sp` dyz <> ")))" ] + -- recognise an abstract symbolic*symbolic product + asMul :: Expr EWord -> Maybe (Expr EWord, Expr EWord) + asMul (T.Mul x y) | notLit x, notLit y = Just (x, y) + asMul _ = Nothing + notLit (Lit _) = False + notLit _ = True + + -- mulDiv bound (sound under no-overflow of x*z): if one factor is <= the + -- divisor then dividing the product by it cannot exceed the other factor. + -- y <= z => (x*y)/z <= x x <= z => (x*y)/z <= y + -- `a` is the original product expr, so the div term matches the prop exactly. + mkMulDivBound (a, x, y, z) = do + ae <- enc a; xe <- enc x; ye <- enc y; ze <- enc z + let dv = "(abst_evm_bvudiv" `sp` ae `sp` ze <> ")" + pure [ SMTCommand $ "(assert (=> (and (bvule" `sp` ye `sp` ze <> ")" `sp` mulNoOverflow xe ze + <> ") (bvule" `sp` dv `sp` xe <> ")))" + , SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` ze <> ")" `sp` mulNoOverflow ye ze + <> ") (bvule" `sp` dv `sp` ye <> ")))" ] -- quotient*divisor <= dividend mkDivMulLink (a, b) = do aenc <- enc a diff --git a/test/test.hs b/test/test.hs index 6f6489d56..44ddf3e2c 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1476,6 +1476,45 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Expected counterexample" (any isCex res) + , testAbstractArith "div-divisor-monotone" $ do + -- a bigger divisor yields a smaller-or-equal quotient (div anti-monotonicity) + Just c <- solcRuntime "C" [i| + contract C { + function prove_divisor_monotone(uint256 amt, uint256 p1, uint256 p2) external pure { + require(p1 != 0 && p2 != 0); + require(p1 <= p2); + uint256 q1; uint256 q2; + assembly { q1 := div(amt, p1) q2 := div(amt, p2) } + assert(q2 <= q1); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "muldiv-fee-cap" $ do + -- a fee of feeBps/10000 never exceeds the principal (mulDiv bound) + Just c <- solcRuntime "C" [i| + contract C { + function prove_fee_le(uint256 amount, uint256 feeBps) external pure { + require(amount < (1<<128) && feeBps <= 10000); + uint256 fee; assembly { fee := div(mul(amount, feeBps), 10000) } + assert(fee <= amount); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "muldiv-fee-uncapped-not-unsound" $ do + -- SOUNDNESS: without the feeBps <= 100% bound the property is false; the + -- mulDiv guard must not fire, so this must NOT be proved. + Just c <- solcRuntime "C" [i| + contract C { + function prove_fee_uncapped(uint256 amount, uint256 feeBps) external pure { + require(amount < (1<<128)); + uint256 fee; assembly { fee := div(mul(amount, feeBps), 10000) } + assert(fee <= amount); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Must be Unknown, never QED" (not (any isCex res) && any isUnknown res) ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From d01b269ec91cec765d8746c89b653af0f212184a Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 17 Jun 2026 21:21:11 +0200 Subject: [PATCH 135/150] Fix operand-order sensitivity in mul-monotonicity lemma MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit CI (solc 0.8.31) canonicalises `a * b` with the shared operand FIRST (e.g. Mul (SLoad slot) (ReadWord arg)), whereas solc 0.8.2 put it second. mul-monotonicity paired products by a shared *second* operand only, so under the 0.8.31 ordering the lemma was not generated, the abstraction could not prove the property, and the spurious model was (soundly) downgraded to Unknown — making `vault-shares-monotonic` fail with "expected QED, got Unknown". Fix: feed both operand orders into the monotonicity pairing (multiplication is commutative and we already assert it, so the generated term links back to the one in the props). The division lemmas remain order-sensitive, as they must. Verified on the exact failing CI bytecode: now QED (was Unknown); full local regression unchanged. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/EVM/SMT/DivModEncoding.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 1f00ad619..5d904bb8e 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -202,7 +202,7 @@ mulEncoding enc props = do comm <- mapM mkComm allMuls links <- mapM mkDivMulLink udivs zeroOne <- concat <$> mapM mkMulIdentities allMuls - mulMono <- concat <$> mapM mkMulMono (sharedPairs allMuls) + mulMono <- concat <$> mapM mkMulMono (sharedPairs (bothOrders allMuls)) divMono <- concat <$> mapM mkDivMono (sharedPairs udivs) divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivs) mulDivB <- concat <$> mapM mkMulDivBound mulDivs @@ -216,6 +216,14 @@ mulEncoding enc props = do let m1 = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" m2 = "(abst_evm_bvmul" `sp` benc `sp` aenc <> ")" pure $ SMTCommand $ "(assert (=" `sp` m1 `sp` m2 <> "))" + -- Include both operand orders of each product. Multiplication is + -- commutative (and we assert that), but the simplifier/solc may order a + -- product's operands either way; considering both ensures monotonicity is + -- found regardless of ordering. Only used for the (commutative) mul lemmas, + -- never for the order-sensitive division lemmas. + bothOrders :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord)] + bothOrders xs = nubOrd (xs <> [ (b, a) | (a, b) <- xs ]) + -- ordered pairs (x, y, z) where (x,z) and (y,z) both occur (shared 2nd operand) sharedPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] sharedPairs xs = [ (x, y, z) | (x, z) <- xs, (y, z') <- xs, z == z', x /= y ] From 720a00e80831508b9b51cfb47416e7929fe500b3 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 00:49:21 +0200 Subject: [PATCH 136/150] Make no-overflow guard cheap and add const-mul monotonicity Two changes that let realistic vault queries (operand magnitudes ~2^100, e.g. token amounts up to 1e30) prove in seconds instead of timing out: 1. mulNoOverflow now uses the cheap *sufficient* condition `x <= 2^128-1 && y <= 2^128-1` instead of the exact bound-free predicate `extract 511 256 (bvmul (zext x) (zext y)) = 0`. The exact form forced the solver to bit-blast a full 512-bit multiply for every lemma instance, which was the dominant cost: monotonicity over operands bounded by 2^96+ timed out, while 2^64 proved instantly. The sufficient condition is sound (when it holds there is genuinely no overflow) and is the same width-budget idea Halmos uses. All realistic token amounts, share counts and conversion rates are far below 2^128. 2. New const-mul monotonicity lemma (mkConstMulMono): for a literal constant c, `x <= y => c*x <= c*y`. Multiplication by a constant stays a native bvmul, but a symbolic operand times a large constant (e.g. 1e27 in sUSDS rate conversions) is still costly to bit-blast and compare. Since c is concrete we compute the exact no-overflow bound floor((2^256-1)/c) at encode time, so the guard is a single constant comparison. This is what unblocks `value * 1e27 / rate`-style conversions, which div-monotonicity could not close without first ordering the two const-mul dividends. Adds a constmul-div-monotone test mirroring spark-psm convertToAssets(sUSDS). Existing Mul-Abstraction tests are unaffected (the 2^128-bounded ones discharge the cheap guard exactly; soundness tests stay Unknown/Cex). Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 63 +++++++++++++++++++++++++++++++---- test/test.hs | 21 ++++++++++++ 2 files changed, 77 insertions(+), 7 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 5d904bb8e..cedbd6c81 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -40,13 +40,29 @@ zero = "(_ bv0 256)" one :: Builder one = "(_ bv1 256)" --- | True iff x*y does not overflow 256 bits (high half of the 512-bit product --- is zero). This is bound-free: it does NOT bake in any particular width --- limit. Callers (e.g. a Solidity `require(x < 2**128)`) are responsible for --- bounding operands so that this predicate is cheap for the solver to discharge. +-- | Maximum value representable in 128 unsigned bits (2^128 - 1). +maxU128 :: Builder +maxU128 = "(_ bv340282366920938463463374607431768211455 256)" + +-- | A /sufficient/ condition for x*y not to overflow 256 bits: both operands +-- fit in 128 bits, so their product fits in 256 (since (2^128-1)^2 < 2^256). +-- +-- We deliberately use this cheap sufficient condition rather than the exact +-- no-overflow predicate @extract 511 256 (bvmul (zext x) (zext y)) = 0@. The +-- exact form forces the solver to bit-blast a full 512-bit multiply for every +-- lemma instance, which is the dominant cost and makes realistic vault queries +-- (operands ~2^100, e.g. token amounts up to 1e30) time out. Two comparisons +-- against a constant are essentially free by contrast. +-- +-- This is the same width-budget idea Halmos uses. It is SOUND: when the guard +-- holds there is genuinely no overflow, so any lemma it gates remains valid. +-- The cost is completeness — a product of operands above 2^128 that happens not +-- to overflow will not receive the lemma. All realistic token amounts, share +-- counts and conversion rates are far below 2^128, so this is not a limitation +-- in practice. mulNoOverflow :: Builder -> Builder -> Builder mulNoOverflow x y = - "(= ((_ extract 511 256) (bvmul ((_ zero_extend 256) " <> x <> ") ((_ zero_extend 256) " <> y <> "))) " <> zero <> ")" + "(and (bvule " <> x <> " " <> maxU128 <> ") (bvule " <> y <> " " <> maxU128 <> "))" wordAsBV :: forall a. Integral a => a -> Builder wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" @@ -170,6 +186,20 @@ collectMuls = \case notLit (Lit _) = False notLit _ = True +-- | Collect multiplications by a literal constant, @(c, x)@ for @c*x@ (either +-- operand order), excluding the trivial constants 0 and 1. These stay native +-- @bvmul@ (the value is concrete), but a symbolic operand times a large +-- constant is still costly to bit-blast and compare; const-mul monotonicity +-- (see 'mkConstMulMono') lets the solver order such products without doing so. +collectConstMuls :: Expr a -> [(W256, Expr EWord)] +collectConstMuls = \case + T.Mul (Lit c) x | notLit x, c /= 0, c /= 1 -> [(c, x)] + T.Mul x (Lit c) | notLit x, c /= 0, c /= 1 -> [(c, x)] + _ -> [] + where + notLit (Lit _) = False + notLit _ = True + -- | True if any prop contains a symbolic*symbolic multiplication, i.e. the -- multiplication abstraction is in play. Because abst_evm_bvmul is left -- uninterpreted (no ground truth), a satisfying model may assign it values @@ -192,12 +222,15 @@ mulEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] mulEncoding enc props = do let udivs = [ (a, b) | (IsUDiv, a, b) <- nubOrd $ concatMap (foldProp collectDivMods []) props ] muls = nubOrd $ concatMap (foldProp collectMuls []) props + constMuls = nubOrd $ concatMap (foldProp collectConstMuls []) props -- products the div-link lemma introduces, e.g. (a/b)*b linkMuls = [ (T.Div a b, b) | (a, b) <- udivs ] allMuls = nubOrd (muls <> linkMuls) -- divisions whose dividend is an abstract product: (x*y)/z mulDivs = [ (a, x, y, b) | (a, b) <- udivs, Just (x, y) <- [asMul a] ] - if null udivs && null muls then pure [] + -- pairs of const-muls sharing the same constant: (c, x, y) for c*x, c*y + constMulPairs = [ (c, x, y) | (c, x) <- constMuls, (c', y) <- constMuls, c == c', x /= y ] + if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls links <- mapM mkDivMulLink udivs @@ -206,8 +239,9 @@ mulEncoding enc props = do divMono <- concat <$> mapM mkDivMono (sharedPairs udivs) divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivs) mulDivB <- concat <$> mapM mkMulDivBound mulDivs + constMulMono <- mapM mkConstMulMono constMulPairs pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -254,6 +288,21 @@ mulEncoding enc props = do pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] + -- const-mul monotonicity (sound, no-overflow guarded): for a fixed literal + -- constant c, x <= y => c*x <= c*y. Because c is concrete we compute the + -- exact no-overflow bound floor((2^256-1)/c) at encode time, so the guard is + -- a single comparison against a constant (cheap) rather than a 512-bit + -- multiply. c*x stays a native bvmul; this lemma simply lets the solver + -- order two such products without bit-blasting the multiply. + mkConstMulMono (c, x, y) = do + xe <- enc x; ye <- enc y + let cbv = wordAsBV c + cx = "(bvmul" `sp` cbv `sp` xe <> ")" + cy = "(bvmul" `sp` cbv `sp` ye <> ")" + bnd = wordAsBV ((maxBound :: W256) `div` c) -- largest x with c*x < 2^256 + pure $ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" + <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" + -- div monotonicity in the dividend (sound unconditionally): for a common -- divisor z, x <= y => floor(x/z) <= floor(y/z). mkDivMono (x, y, z) = do diff --git a/test/test.hs b/test/test.hs index 44ddf3e2c..2f8032724 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1515,6 +1515,27 @@ tests = testGroup "hevm" } |] (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Must be Unknown, never QED" (not (any isCex res) && any isUnknown res) + , testAbstractArith "constmul-div-monotone" $ do + -- (v * 1e27) / rate is monotonic in v. The dividend is a multiplication + -- by a large literal (1e27), which stays a native bvmul; const-mul + -- monotonicity lets the solver order the two dividends without + -- bit-blasting that multiply, which is otherwise the bottleneck. + -- Mirrors spark-psm convertToAssets(sUSDS): value * 1e9 * 1e18 / rate. + Just c <- solcRuntime "C" [i| + contract C { + function prove_constmul_div_monotone(uint256 v1, uint256 v2, uint256 rate) external pure { + require(rate != 0); + require(v1 <= v2 && v2 < (1<<80)); + uint256 a1; uint256 a2; + assembly { + a1 := div(mul(v1, 1000000000000000000000000000), rate) + a2 := div(mul(v2, 1000000000000000000000000000), rate) + } + assert(a1 <= a2); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 9ae3456573a1933f93497286e803d90e621bccd4 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 00:58:32 +0200 Subject: [PATCH 137/150] Synthesize cancellation divisions to prove cross-divisor round-trips MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When an abstract product a*b has a factor that is also used as a divisor elsewhere in the query, synthesize the exact division (a*b)/factor and add it to the div set. The existing sound lemmas then bridge nested divisions: mulDiv-bound gives (a*b)/b <= a, and div-monotonicity carries that bound across a shared divisor. This proves the cross-divisor round-trip convertToAssetValue(convertToShares(x)) <= x, i.e. ((x*ts)/ta)*ta/ts <= x — the stateless core of inflation-attack safety — which single-level lemmas could not discharge (the bridging term (x*ts)/ts was simply absent from the query). Soundness: the synthetic terms are exact EVM divisions and every lemma asserted about them is a true fact, so a QED remains a real proof. Verified that the downgrade-soundness checks (mul-overflow-not-unsound, muldiv-fee-uncapped) still report Unknown and the counterexample tests still report Cex — the added lemmas are consistent (an inconsistency would have turned those into spurious QEDs). The former roundtrip-spurious-cex-suppressed test now proves the property, so it becomes the positive roundtrip-no-inflation test; downgrade soundness stays covered by the two *-not-unsound tests. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 22 +++++++++++++++++----- test/test.hs | 17 ++++++++++------- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index cedbd6c81..26f82c0f3 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -223,21 +223,33 @@ mulEncoding enc props = do let udivs = [ (a, b) | (IsUDiv, a, b) <- nubOrd $ concatMap (foldProp collectDivMods []) props ] muls = nubOrd $ concatMap (foldProp collectMuls []) props constMuls = nubOrd $ concatMap (foldProp collectConstMuls []) props + -- Cancellation: when an abstract product a*b has a factor that is reused + -- as a divisor elsewhere, synthesize the exact division (a*b)/factor. + -- Adding it to the div set lets the existing lemmas bridge nested + -- divisions: mulDiv-bound gives (a*b)/b <= a, and div-monotonicity carries + -- that bound across a shared divisor. This is what proves cross-divisor + -- round-trips like convertToAssetValue(convertToShares(x)) <= x (the + -- stateless core of inflation-attack safety), which single-level lemmas + -- cannot. The synthetic terms are exact EVM divisions, so this is SOUND. + divisors = nubOrd [ b | (_, b) <- udivs ] + synthDivs = nubOrd $ [ (T.Mul a b, b) | (a, b) <- muls, b `elem` divisors ] + <> [ (T.Mul a b, a) | (a, b) <- muls, a `elem` divisors ] + udivsAll = nubOrd (udivs <> synthDivs) -- products the div-link lemma introduces, e.g. (a/b)*b - linkMuls = [ (T.Div a b, b) | (a, b) <- udivs ] + linkMuls = [ (T.Div a b, b) | (a, b) <- udivsAll ] allMuls = nubOrd (muls <> linkMuls) -- divisions whose dividend is an abstract product: (x*y)/z - mulDivs = [ (a, x, y, b) | (a, b) <- udivs, Just (x, y) <- [asMul a] ] + mulDivs = [ (a, x, y, b) | (a, b) <- udivsAll, Just (x, y) <- [asMul a] ] -- pairs of const-muls sharing the same constant: (c, x, y) for c*x, c*y constMulPairs = [ (c, x, y) | (c, x) <- constMuls, (c', y) <- constMuls, c == c', x /= y ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls - links <- mapM mkDivMulLink udivs + links <- mapM mkDivMulLink udivsAll zeroOne <- concat <$> mapM mkMulIdentities allMuls mulMono <- concat <$> mapM mkMulMono (sharedPairs (bothOrders allMuls)) - divMono <- concat <$> mapM mkDivMono (sharedPairs udivs) - divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivs) + divMono <- concat <$> mapM mkDivMono (sharedPairs udivsAll) + divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivsAll) mulDivB <- concat <$> mapM mkMulDivBound mulDivs constMulMono <- mapM mkConstMulMono constMulPairs pure $ (SMTComment "multiplication abstraction lemmas") diff --git a/test/test.hs b/test/test.hs index 2f8032724..31d372621 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1430,10 +1430,14 @@ tests = testGroup "hevm" (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Must be Unknown, never QED (unsound proof avoided)" (not (any isCex res) && any isUnknown res) - , testAbstractArith "roundtrip-spurious-cex-suppressed" $ do - -- SOUNDNESS: the cross-divisor round-trip cannot be discharged; the - -- uninterpreted mul yields a spurious model that must NOT be reported - -- as a counterexample -> Unknown. + , testAbstractArith "roundtrip-no-inflation" $ do + -- The cross-divisor round-trip convertToAssetValue(convertToShares(x)), + -- i.e. ((x*ts)/ta)*ta/ts <= x, is the stateless core of inflation-attack + -- safety: converting a value to shares and back never yields more than + -- you started with. It needs two nested divisions to be related, which + -- the cancellation synthesis (the synthetic (x*ts)/ts term plus div + -- monotonicity) discharges. SOUND: shares*ta <= x*ts (div-mul-link), so + -- floor(shares*ta/ts) <= floor(x*ts/ts) = x. Just c <- solcRuntime "C" [i| contract C { uint256 public totalAssets; @@ -1447,9 +1451,8 @@ tests = testGroup "hevm" assert(outv <= assets); } } |] - (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertBoolM "Must be Unknown, never a spurious counterexample" - (not (any isCex res) && any isUnknown res) + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res , testAbstractArith "div-cex-preserved" $ do -- No symbolic*symbolic mul => div is exact => a real counterexample is -- still reported (the Cex->Unknown downgrade must be precise). From 4c702b96a054af199b32e49fd32e7f07de64cdf2 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 01:14:58 +0200 Subject: [PATCH 138/150] Use z3 for the two harder Mul-Abstraction proofs The round-trip (cancellation synthesis) and the const-mul-div monotonicity (large 1e27 constant multiply) are reliably discharged by z3 but not by bitwuzla. Both solvers are sound; this is purely a capability pick. Since withBitwuzlaSolver runs with no SMT timeout, an unprovable-for-bitwuzla query would hang the test rather than fail fast, so prefer the solver verified to close these. Co-Authored-By: Claude Opus 4.8 --- test/test.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/test/test.hs b/test/test.hs index 31d372621..6b8470b6b 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1451,7 +1451,8 @@ tests = testGroup "hevm" assert(outv <= assets); } } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + -- z3 closes the nested cross-divisor round-trip reliably here. + (_, res) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res , testAbstractArith "div-cex-preserved" $ do -- No symbolic*symbolic mul => div is exact => a real counterexample is @@ -1537,7 +1538,9 @@ tests = testGroup "hevm" assert(a1 <= a2); } } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + -- z3 discharges the large-constant (1e27) multiply that bitwuzla + -- struggles with here; both are sound, this is purely a capability pick. + (_, res) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res ] , testGroup "max-iterations" From e9d6496dfada0f6b96c59e5c2f974a3a34687e82 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 07:29:55 +0200 Subject: [PATCH 139/150] Use bitwuzla for the round-trip/const-mul tests; add checked-real-code round-trip MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reverts the round-trip and const-mul-div tests from z3 back to bitwuzla. The earlier switch was made when bitwuzla was missing from the local PATH and every query spuriously returned unknown; with bitwuzla actually present it discharges all of these in well under a second (and is the bit-vector solver hevm defaults to). On the checked-arithmetic round-trip bitwuzla is in fact the *stronger* solver — z3 is the one that struggles there. Adds roundtrip-checked-realcode: the inflation-attack round-trip on real-code- shaped Solidity — ordinary checked arithmetic (so each `*` carries the 0.8 overflow guard div(mul(a,b),a)) and the conversions are real functions called as in the contract. Confirms the cancellation synthesis survives the overflow-guard divisions, i.e. the property proves on the code as written, not only on raw assembly ops. Co-Authored-By: Claude Opus 4.8 --- test/test.hs | 34 +++++++++++++++++++++++++++++----- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/test/test.hs b/test/test.hs index 6b8470b6b..25eb7131f 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1451,8 +1451,34 @@ tests = testGroup "hevm" assert(outv <= assets); } } |] - -- z3 closes the nested cross-divisor round-trip reliably here. - (_, res) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "roundtrip-checked-realcode" $ do + -- Same round-trip on real-code-shaped Solidity: ordinary checked + -- arithmetic (so each `*` carries the 0.8 overflow guard div(mul(a,b),a)) + -- and the conversions are real functions that read storage, called as in + -- the contract. Confirms the cancellation synthesis survives the extra + -- overflow-guard divisions, i.e. the property proves on the code as + -- written, not only on raw assembly ops. + Just c <- solcRuntime "C" [i| + contract C { + uint256 public totalShares; + uint256 public totalAssets; + function convertToShares(uint256 assetValue) public view returns (uint256) { + if (totalAssets != 0) return assetValue * totalShares / totalAssets; + return assetValue; + } + function convertToAssetValue(uint256 numShares) public view returns (uint256) { + if (totalShares != 0) return numShares * totalAssets / totalShares; + return numShares; + } + function prove_roundtrip(uint256 x) external view { + require(totalShares != 0 && totalAssets != 0); + require(x < (1<<128) && totalShares < (1<<128) && totalAssets < (1<<128)); + assert(convertToAssetValue(convertToShares(x)) <= x); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res , testAbstractArith "div-cex-preserved" $ do -- No symbolic*symbolic mul => div is exact => a real counterexample is @@ -1538,9 +1564,7 @@ tests = testGroup "hevm" assert(a1 <= a2); } } |] - -- z3 discharges the large-constant (1e27) multiply that bitwuzla - -- struggles with here; both are sound, this is purely a capability pick. - (_, res) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res ] , testGroup "max-iterations" From 2ed340e62edd1c50889e6defe30fe69c84bdabd9 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 08:14:03 +0200 Subject: [PATCH 140/150] Keep the PoC abstract: drop domain-specific references and a redundant test - Reword the no-overflow guard comment in generic terms (large operands ~2^100) instead of naming specific token/amount domains. - Drop the spark-specific note from the const-mul-div test comment. - Remove the redundant roundtrip-checked-realcode test: roundtrip-no-inflation already covers the cross-divisor round-trip; the cancellation synthesis still discharges Solidity's overflow-guard divisions (described in the encoding). No functional change to the abstraction; comments and test surface only. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 11 +++++------ test/test.hs | 28 ---------------------------- 2 files changed, 5 insertions(+), 34 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 26f82c0f3..045e0216b 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -50,16 +50,15 @@ maxU128 = "(_ bv340282366920938463463374607431768211455 256)" -- We deliberately use this cheap sufficient condition rather than the exact -- no-overflow predicate @extract 511 256 (bvmul (zext x) (zext y)) = 0@. The -- exact form forces the solver to bit-blast a full 512-bit multiply for every --- lemma instance, which is the dominant cost and makes realistic vault queries --- (operands ~2^100, e.g. token amounts up to 1e30) time out. Two comparisons --- against a constant are essentially free by contrast. +-- lemma instance, which is the dominant cost and makes queries with large +-- operands (~2^100) time out. Two comparisons against a constant are +-- essentially free by contrast. -- -- This is the same width-budget idea Halmos uses. It is SOUND: when the guard -- holds there is genuinely no overflow, so any lemma it gates remains valid. -- The cost is completeness — a product of operands above 2^128 that happens not --- to overflow will not receive the lemma. All realistic token amounts, share --- counts and conversion rates are far below 2^128, so this is not a limitation --- in practice. +-- to overflow will not receive the lemma. Callers bound operands (e.g. a +-- Solidity @require(x < 2**128)@) so the guard discharges cheaply. mulNoOverflow :: Builder -> Builder -> Builder mulNoOverflow x y = "(and (bvule " <> x <> " " <> maxU128 <> ") (bvule " <> y <> " " <> maxU128 <> "))" diff --git a/test/test.hs b/test/test.hs index 25eb7131f..d54621955 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1453,33 +1453,6 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res - , testAbstractArith "roundtrip-checked-realcode" $ do - -- Same round-trip on real-code-shaped Solidity: ordinary checked - -- arithmetic (so each `*` carries the 0.8 overflow guard div(mul(a,b),a)) - -- and the conversions are real functions that read storage, called as in - -- the contract. Confirms the cancellation synthesis survives the extra - -- overflow-guard divisions, i.e. the property proves on the code as - -- written, not only on raw assembly ops. - Just c <- solcRuntime "C" [i| - contract C { - uint256 public totalShares; - uint256 public totalAssets; - function convertToShares(uint256 assetValue) public view returns (uint256) { - if (totalAssets != 0) return assetValue * totalShares / totalAssets; - return assetValue; - } - function convertToAssetValue(uint256 numShares) public view returns (uint256) { - if (totalShares != 0) return numShares * totalAssets / totalShares; - return numShares; - } - function prove_roundtrip(uint256 x) external view { - require(totalShares != 0 && totalAssets != 0); - require(x < (1<<128) && totalShares < (1<<128) && totalAssets < (1<<128)); - assert(convertToAssetValue(convertToShares(x)) <= x); - } - } |] - (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts - assertEqualM "Must be QED" [] res , testAbstractArith "div-cex-preserved" $ do -- No symbolic*symbolic mul => div is exact => a real counterexample is -- still reported (the Cex->Unknown downgrade must be precise). @@ -1550,7 +1523,6 @@ tests = testGroup "hevm" -- by a large literal (1e27), which stays a native bvmul; const-mul -- monotonicity lets the solver order the two dividends without -- bit-blasting that multiply, which is otherwise the bottleneck. - -- Mirrors spark-psm convertToAssets(sUSDS): value * 1e9 * 1e18 / rate. Just c <- solcRuntime "C" [i| contract C { function prove_constmul_div_monotone(uint256 v1, uint256 v2, uint256 rate) external pure { From e46f281f4320403ed18c88a575fcb53b6ba9e7e8 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 14:27:53 +0200 Subject: [PATCH 141/150] Add const-cancellation lemma: (c*x)/c == x for literal c Multiplication by a literal constant stays a native bvmul, but the surrounding division is abstracted (uninterpreted), so a divide-by-the-same-constant wrapper like `amount * 1e18 / 1e18` (e.g. ERC-4626 precision scaling) is not provably the identity. This lemma pins it: for a division (c*x)/c by the same literal c, assert the result is x, guarded by the exact no-overflow bound floor((2^256-1)/c) computed at encode time (a single constant comparison, like const-mul-mono). Sound: (c*x)/c == x exactly whenever c*x does not overflow, which the guard ensures. The lemma only fires when the divisor literal equals the multiplier literal, so a near-miss like (x*1e18)/(1e18+1) is left uninterpreted (verified: it still yields a counterexample, not a spurious QED). Adds a const-cancel test. This discharges constant-precision wrappers in isolation; it does not by itself close the largest composite queries (e.g. a full previewDeposit/convertToAssets round-trip), where the surrounding structure remains beyond the solver. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 27 ++++++++++++++++++++++++++- test/test.hs | 16 ++++++++++++++++ 2 files changed, 42 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 045e0216b..5d5385e63 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -241,6 +241,9 @@ mulEncoding enc props = do mulDivs = [ (a, x, y, b) | (a, b) <- udivsAll, Just (x, y) <- [asMul a] ] -- pairs of const-muls sharing the same constant: (c, x, y) for c*x, c*y constMulPairs = [ (c, x, y) | (c, x) <- constMuls, (c', y) <- constMuls, c == c', x /= y ] + -- const cancellation: divisions (c*x)/c by the SAME literal constant c. + -- (a, c, x): a is the division's dividend (c*x), divided by Lit c. + constCancels = [ (a, c, x) | (a, b) <- udivsAll, Just (c, x) <- [asConstMul a], b == Lit c ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls @@ -251,8 +254,9 @@ mulEncoding enc props = do divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivsAll) mulDivB <- concat <$> mapM mkMulDivBound mulDivs constMulMono <- mapM mkConstMulMono constMulPairs + constCancel <- mapM mkConstCancel constCancels pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -314,6 +318,27 @@ mulEncoding enc props = do pure $ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" + -- const cancellation (sound, no-overflow guarded): dividing a product by the + -- same literal constant it was multiplied by is the identity, (c*x)/c == x. + -- The multiply by a constant stays a native bvmul but the divide is + -- abstracted (uninterpreted), so without this the wrapper c*x/c that appears + -- in precision scaling (e.g. amount * 1e18 / 1e18 in _getUsdsValue) is not + -- provably the identity. `a` is the dividend expr (c*x) so the abst_evm_bvudiv + -- term matches the prop exactly; the exact no-overflow bound floor((2^256-1)/c) + -- is computed at encode time, so the guard is a single constant comparison. + mkConstCancel (a, c, x) = do + ae <- enc a; xe <- enc x + let cbv = wordAsBV c + dv = "(abst_evm_bvudiv" `sp` ae `sp` cbv <> ")" + bnd = wordAsBV ((maxBound :: W256) `div` c) -- largest x with c*x < 2^256 + pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` xe <> ")))" + + -- recognise multiplication by a non-trivial literal constant: c*x or x*c. + asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) + asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) + asConstMul (T.Mul x (Lit c)) | notLit x, c /= 0, c /= 1 = Just (c, x) + asConstMul _ = Nothing + -- div monotonicity in the dividend (sound unconditionally): for a common -- divisor z, x <= y => floor(x/z) <= floor(y/z). mkDivMono (x, y, z) = do diff --git a/test/test.hs b/test/test.hs index d54621955..42907afc5 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1538,6 +1538,22 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + , testAbstractArith "const-cancel" $ do + -- (x * c) / c == x for a literal c (const-cancellation lemma). The + -- multiply by c stays a native bvmul but the divide is abstracted + -- (uninterpreted), so without the lemma this identity is not provable. + -- This is what discharges precision-scaling wrappers like + -- `amount * 1e18 / 1e18` that otherwise block round-trip properties. + Just c <- solcRuntime "C" [i| + contract C { + function prove_const_cancel(uint256 x) external pure { + require(x < (1<<128)); + uint256 y; assembly { y := div(mul(x, 1000000000000000000), 1000000000000000000) } + assert(y == x); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 368d771fd26f1ee92812d524d209ef5653742488 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 16:33:32 +0200 Subject: [PATCH 142/150] Generalize const-cancel and add nested-division collapse Two sound lemmas that discharge precision-scaling closed forms (exact-value spec-conformance), which the abstraction otherwise leaves uninterpreted: 1. Generalize const cancellation from (c*x)/c == x to (c1*x)/c2 == (c1/c2)*x when the literal divisor c2 divides the literal multiplier c1 (c2 | c1). The same-constant case (c1==c2, k=1) is unchanged; the general case covers lossless scaling between decimals, e.g. amount*1e18/1e6 == amount*1e12. Guarded by the exact no-overflow bound floor((2^256-1)/c1). 2. Nested-division collapse: (A/c1)/c2 == A/(c1*c2) for literals c1,c2 whose product fits in 256 bits. A floor identity, sound unconditionally; collapses chained constant divisions like x*rate/1e9/1e18 to x*rate/1e27. Both verified sound (correct form proves; a wrong constant yields a counterexample, never a spurious QED) and non-regressing. Adds const-cancel-scaled and nested-div-collapse tests. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 58 +++++++++++++++++++++++++---------- test/test.hs | 31 +++++++++++++++++++ 2 files changed, 72 insertions(+), 17 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 5d5385e63..ae4374886 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -241,9 +241,20 @@ mulEncoding enc props = do mulDivs = [ (a, x, y, b) | (a, b) <- udivsAll, Just (x, y) <- [asMul a] ] -- pairs of const-muls sharing the same constant: (c, x, y) for c*x, c*y constMulPairs = [ (c, x, y) | (c, x) <- constMuls, (c', y) <- constMuls, c == c', x /= y ] - -- const cancellation: divisions (c*x)/c by the SAME literal constant c. - -- (a, c, x): a is the division's dividend (c*x), divided by Lit c. - constCancels = [ (a, c, x) | (a, b) <- udivsAll, Just (c, x) <- [asConstMul a], b == Lit c ] + -- const cancellation: a product c1*x divided by a literal c2 that divides + -- c1 collapses to (c1/c2)*x. (a, c1, c2, x): a is the dividend (c1*x). The + -- same-constant case (c1==c2) gives just x; the general case (c2 | c1) + -- covers lossless precision scaling like x*1e18/1e6 == x*1e12. + constCancels = [ (a, c1, c2, x) + | (a, b) <- udivsAll, Just (c1, x) <- [asConstMul a] + , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] + -- nested-division collapse: (A/c1)/c2 == A/(c1*c2) for literals c1,c2 whose + -- product fits in 256 bits. A floor identity (sound unconditionally). E.g. + -- x*rate/1e9/1e18 == x*rate/1e27. + nestedDivs = [ (innerA, c1, c2) + | (a, b) <- udivsAll, Lit c2 <- [b] + , T.Div innerA (Lit c1) <- [a] + , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls @@ -255,8 +266,9 @@ mulEncoding enc props = do mulDivB <- concat <$> mapM mkMulDivBound mulDivs constMulMono <- mapM mkConstMulMono constMulPairs constCancel <- mapM mkConstCancel constCancels + nestedDiv <- mapM mkNestedDiv nestedDivs pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -318,20 +330,32 @@ mulEncoding enc props = do pure $ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" - -- const cancellation (sound, no-overflow guarded): dividing a product by the - -- same literal constant it was multiplied by is the identity, (c*x)/c == x. - -- The multiply by a constant stays a native bvmul but the divide is - -- abstracted (uninterpreted), so without this the wrapper c*x/c that appears - -- in precision scaling (e.g. amount * 1e18 / 1e18 in _getUsdsValue) is not - -- provably the identity. `a` is the dividend expr (c*x) so the abst_evm_bvudiv - -- term matches the prop exactly; the exact no-overflow bound floor((2^256-1)/c) - -- is computed at encode time, so the guard is a single constant comparison. - mkConstCancel (a, c, x) = do + -- const cancellation (sound, no-overflow guarded): a product c1*x divided by + -- a literal c2 that divides c1 collapses to (c1/c2)*x. The multiply by a + -- constant stays a native bvmul but the divide is abstracted (uninterpreted), + -- so without this the precision-scaling wrapper c1*x/c2 (e.g. amount*1e18/1e18 + -- in _getUsdsValue, or amount*1e18/1e6 in _getUsdcValue) is not provably its + -- closed form. `a` is the dividend expr (c1*x) so the abst_evm_bvudiv term + -- matches the prop exactly; c2 | c1 makes c1/c2 exact, and the no-overflow + -- bound floor((2^256-1)/c1) is computed at encode time (one comparison). + mkConstCancel (a, c1, c2, x) = do ae <- enc a; xe <- enc x - let cbv = wordAsBV c - dv = "(abst_evm_bvudiv" `sp` ae `sp` cbv <> ")" - bnd = wordAsBV ((maxBound :: W256) `div` c) -- largest x with c*x < 2^256 - pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` xe <> ")))" + let c2bv = wordAsBV c2 + k = c1 `div` c2 -- exact, since c2 | c1 + rhs = if k == 1 then xe else "(bvmul" `sp` wordAsBV k `sp` xe <> ")" + dv = "(abst_evm_bvudiv" `sp` ae `sp` c2bv <> ")" + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" + + -- nested-division collapse (sound, floor identity): (A/c1)/c2 == A/(c1*c2) for + -- literal c1,c2 with c1*c2 < 2^256. Lets the solver simplify chained constant + -- divisions such as x*rate/1e9/1e18 to x*rate/1e27. No operand bound needed. + mkNestedDiv (innerA, c1, c2) = do + ae <- enc innerA + let inner = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c1 <> ")" + outer = "(abst_evm_bvudiv" `sp` inner `sp` wordAsBV c2 <> ")" + collapsed = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV (c1 * c2) <> ")" + pure $ SMTCommand $ "(assert (=" `sp` outer `sp` collapsed <> "))" -- recognise multiplication by a non-trivial literal constant: c*x or x*c. asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) diff --git a/test/test.hs b/test/test.hs index 42907afc5..b84c5f52b 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1554,6 +1554,37 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + , testAbstractArith "const-cancel-scaled" $ do + -- generalized const-cancel: (c1*x)/c2 == (c1/c2)*x when c2 | c1. + -- (x*1e18)/1e6 == x*1e12 — discharges lossless precision scaling between + -- different decimals (e.g. _getUsdcValue). + Just c <- solcRuntime "C" [i| + contract C { + function prove_const_cancel_scaled(uint256 x) external pure { + require(x < (1<<80)); + uint256 y; uint256 z; + assembly { y := div(mul(x, 1000000000000000000), 1000000) z := mul(x, 1000000000000) } + assert(y == z); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "nested-div-collapse" $ do + -- (A/c1)/c2 == A/(c1*c2) for literals c1,c2 (floor identity). With A a + -- symbolic product the divisions are abstracted, so the lemma is what + -- collapses chained constant divisions like x*rate/1e9/1e18 to x*rate/1e27. + Just c <- solcRuntime "C" [i| + contract C { + function prove_nested_div_collapse(uint256 a, uint256 b) external pure { + uint256 lhs; uint256 rhs; + assembly { let p := mul(a, b) + lhs := div(div(p, 1000000000), 1000000000000000000) + rhs := div(p, 1000000000000000000000000000) } + assert(lhs == rhs); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 41969b454a84c77fe077b71ea71b2ca05cb7dfa1 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 20:24:04 +0200 Subject: [PATCH 143/150] Add fraction-reduce lemma: (c1*x)/c2 == x/(c2/c1) for c1 | c2 Mirror of the generalized const-cancel (which needs c2 | c1): this covers the c1 | c2 direction (multiply by a small constant, divide by a large one), e.g. x*1e6/1e18 == x/1e12 -- precision scaling DOWN (the convert-to-usdc step). Sound because, under the no-overflow guard x <= (2^256-1)/c1, c1*x is exact and floor(c1*x/(c1*k)) = floor(x/k). Adds fraction-reduce and fraction-reduce-cex unit tests. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 29 ++++++++++++++++++++++++++++- test/test.hs | 31 +++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index ae4374886..030a47eb0 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -255,6 +255,15 @@ mulEncoding enc props = do | (a, b) <- udivsAll, Lit c2 <- [b] , T.Div innerA (Lit c1) <- [a] , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] + -- fraction-reduce: a product c1*x divided by a literal c2 that c1 divides + -- collapses to x/(c2/c1). The mirror of const-cancel (c2 | c1); this is the + -- c1 | c2 case (multiply by small, divide by large) such as x*1e6/1e18 == + -- x/1e12 (precision scaling DOWN, the convert-to-usdc direction). Excludes + -- c1==c2, which const-cancel already covers (collapsing to x). + fracReduces = [ (a, c1, c2, x) + | (a, b) <- udivsAll, Just (c1, x) <- [asConstMul a] + , Lit c2 <- [b], c2 /= 0, c1 /= 0 + , c2 `mod` c1 == 0, c2 /= c1 ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls @@ -267,8 +276,9 @@ mulEncoding enc props = do constMulMono <- mapM mkConstMulMono constMulPairs constCancel <- mapM mkConstCancel constCancels nestedDiv <- mapM mkNestedDiv nestedDivs + fracReduce <- mapM mkFracReduce fracReduces pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -357,6 +367,23 @@ mulEncoding enc props = do collapsed = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV (c1 * c2) <> ")" pure $ SMTCommand $ "(assert (=" `sp` outer `sp` collapsed <> "))" + -- fraction-reduce (sound, no-overflow guarded): a product c1*x divided by a + -- literal c2 that c1 divides collapses to x/(c2/c1). The mirror of const + -- cancellation: const-cancel needs c2 | c1 (multiply by large, divide by + -- small, e.g. x*1e18/1e6 == x*1e12); this needs c1 | c2 (multiply by small, + -- divide by large, e.g. x*1e6/1e18 == x/1e12 — the convert-to-usdc precision + -- step). Sound because, under the no-overflow guard, c1*x is exact and + -- floor(c1*x / (c1*k)) = floor(x/k). `a` is the dividend (c1*x) so the + -- abst_evm_bvudiv term matches the prop; c1 | c2 makes c2/c1 exact and the + -- bound floor((2^256-1)/c1) is computed at encode time (one comparison). + mkFracReduce (a, c1, c2, x) = do + ae <- enc a; xe <- enc x + let k = c2 `div` c1 -- exact and >= 2, since c1 | c2 and c2 /= c1 + dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x)/c2 + rhs = "(abst_evm_bvudiv" `sp` xe `sp` wordAsBV k <> ")" -- x/(c2/c1) + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" + -- recognise multiplication by a non-trivial literal constant: c*x or x*c. asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) diff --git a/test/test.hs b/test/test.hs index b84c5f52b..2128e0bb8 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1585,6 +1585,37 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertEqualM "Must be QED" [] res + , testAbstractArith "fraction-reduce" $ do + -- fraction-reduce: (c1*x)/c2 == x/(c2/c1) when c1 | c2 (mirror of + -- const-cancel, which needs c2 | c1). (x*1e6)/1e18 == x/1e12 — discharges + -- the precision step that scales DOWN to fewer decimals (convert-to-usdc). + Just c <- solcRuntime "C" [i| + contract C { + function prove_fraction_reduce(uint256 x) external pure { + require(x < (1<<128)); + uint256 y; uint256 z; + assembly { y := div(mul(x, 1000000), 1000000000000000000) z := div(x, 1000000000000) } + assert(y == z); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "fraction-reduce-cex" $ do + -- soundness guard: the fraction-reduce lemma must not over-prove. A wrong + -- closed form ((x*1e6)/1e18 == x/1e12 + 1) is false for every x, so it + -- must NOT come back QED (the lemma pins the LHS to x/1e12, exposing the + -- off-by-one as a real counterexample rather than a spurious proof). + Just c <- solcRuntime "C" [i| + contract C { + function prove_fraction_reduce_wrong(uint256 x) external pure { + require(x < (1<<128)); + uint256 y; uint256 z; + assembly { y := div(mul(x, 1000000), 1000000000000000000) z := add(div(x, 1000000000000), 1) } + assert(y == z); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Wrong closed form must not be QED" (not (null res)) ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 46bcd0da6e19def0d058ed91a20ceadbd6e60233 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Thu, 18 Jun 2026 23:16:47 +0200 Subject: [PATCH 144/150] Add ceilDiv-cancel lemma: ceilDiv(c1*x, c2) == (c1/c2)*x for c2 | c1 The ceilDiv sibling of const-cancel. OpenZeppelin Math.ceilDiv(c1*x, c2) is (c1*x == 0) ? 0 : (c1*x - 1)/c2 + 1, so the abstracted divide is over the (c1*x - 1) dividend. When c2 | c1 the product is always a multiple of c2, so ceil == floor and the whole ceilDiv collapses to (c1/c2)*x. The lemma pins the inner divide: for x >= 1, (c1*x - 1)/c2 == (c1/c2)*x - 1 (sound: c1*x = c2*m*x, floor((c2*m*x - 1)/c2) = m*x - 1), under the encode-time no-overflow bound floor((2^256-1)/c1). Discharges round-up multiply-up swap-out closed forms (e.g. previewSwapExactOut usds->usdc == amountOut*1e12). Adds ceildiv-cancel and ceildiv-cancel-cex unit tests. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 31 ++++++++++++++++++++++++++++++- test/test.hs | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 030a47eb0..a4387ce18 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -264,6 +264,15 @@ mulEncoding enc props = do | (a, b) <- udivsAll, Just (c1, x) <- [asConstMul a] , Lit c2 <- [b], c2 /= 0, c1 /= 0 , c2 `mod` c1 == 0, c2 /= c1 ] + -- ceilDiv-cancel: OpenZeppelin Math.ceilDiv(c1*x, c2) is + -- (c1*x == 0) ? 0 : (c1*x - 1)/c2 + 1, so the abstracted divide is over the + -- (c1*x - 1) dividend. When c2 | c1 the product c1*x is always a multiple of + -- c2, hence ceil == floor and the whole ceilDiv collapses to (c1/c2)*x. We + -- pin the inner divide: (a, c1, c2, x) with a == (c1*x) - 1. + ceilDivCancels = [ (a, c1, c2, x) + | (a, b) <- udivsAll, T.Sub inner (Lit 1) <- [a] + , Just (c1, x) <- [asConstMul inner] + , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls @@ -277,8 +286,9 @@ mulEncoding enc props = do constCancel <- mapM mkConstCancel constCancels nestedDiv <- mapM mkNestedDiv nestedDivs fracReduce <- mapM mkFracReduce fracReduces + ceilDivCancel <- mapM mkCeilDivCancel ceilDivCancels pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce <> ceilDivCancel) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -384,6 +394,25 @@ mulEncoding enc props = do bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" + -- ceilDiv-cancel (sound, guarded): pins the abstracted divide inside + -- OpenZeppelin's Math.ceilDiv(c1*x, c2) = (c1*x - 1)/c2 + 1 (the c1*x != 0 + -- branch). `a` is the (c1*x - 1) dividend. When c2 | c1, write c1 = c2*m: then + -- c1*x = c2*(m*x), so floor((c2*m*x - 1)/c2) = m*x - 1 (for m*x >= 1). Adding + -- the ceilDiv's +1 gives m*x = (c1/c2)*x exactly. Guarded by x >= 1 (the ceilDiv + -- ITE handles x==0 on its own branch) and the encode-time no-overflow bound + -- floor((2^256-1)/c1). This is the ceilDiv sibling of const-cancel; it + -- discharges the round-up swap-out closed forms (e.g. previewSwapExactOut + -- usds->usdc == amountOut*1e12). + mkCeilDivCancel (a, c1, c2, x) = do + ae <- enc a; xe <- enc x + let m = c1 `div` c2 -- exact, since c2 | c1 + mx = if m == 1 then xe else "(bvmul" `sp` wordAsBV m `sp` xe <> ")" + dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x - 1)/c2 + rhs = "(bvsub" `sp` mx `sp` one <> ")" -- (c1/c2)*x - 1 + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure $ SMTCommand $ "(assert (=> (and (bvuge" `sp` xe `sp` one <> ")" + <> " (bvule" `sp` xe `sp` bnd <> ")) (=" `sp` dv `sp` rhs <> ")))" + -- recognise multiplication by a non-trivial literal constant: c*x or x*c. asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) diff --git a/test/test.hs b/test/test.hs index 2128e0bb8..d4e0b89f4 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1616,6 +1616,41 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Wrong closed form must not be QED" (not (null res)) + , testAbstractArith "ceildiv-cancel" $ do + -- ceilDiv-cancel: Math.ceilDiv(c1*x, c2) == (c1/c2)*x when c2 | c1 (the + -- product is always divisible, so round-up equals round-down). The divide is + -- abstracted over the (c1*x - 1) dividend, so the lemma pins it. Discharges + -- the round-up multiply-up in previewSwapExactOut (e.g. usds->usdc == x*1e12). + Just c <- solcRuntime "C" [i| + contract C { + function ceilDiv(uint256 a, uint256 b) internal pure returns (uint256) { + return a == 0 ? 0 : (a - 1) / b + 1; + } + function prove_ceildiv_cancel(uint256 x) external pure { + require(x < (1<<128)); + uint256 y = ceilDiv(x * 1000000000000000000, 1000000); + uint256 z; unchecked { z = x * 1000000000000; } + assert(y == z); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "ceildiv-cancel-cex" $ do + -- soundness guard: a wrong closed form (off by one) must NOT be QED. + Just c <- solcRuntime "C" [i| + contract C { + function ceilDiv(uint256 a, uint256 b) internal pure returns (uint256) { + return a == 0 ? 0 : (a - 1) / b + 1; + } + function prove_ceildiv_cancel_wrong(uint256 x) external pure { + require(x < (1<<128)); + uint256 y = ceilDiv(x * 1000000000000000000, 1000000); + uint256 z; unchecked { z = x * 1000000000000 + 1; } + assert(y == z); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Wrong closed form must not be QED" (not (null res)) ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 64c9640a9f4cb00ea0d7381fb40cde9970c020d4 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Fri, 19 Jun 2026 13:43:30 +0200 Subject: [PATCH 145/150] Add scaled-product telescoping lemma; collapse nested divides into the div set MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two related additions to the multiplication abstraction: 1. Scaled-product telescoping (sound, no-overflow guarded): for products sharing a factor a whose other factors differ by a literal k that the common divisor c divides, floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c). This is the only lemma that relates two DISTINCT abstract products, so it discharges value-change accounting identities such as susds*rate/1e27 - susds == susds*(rate-1e27)/1e27 (rate and rate-1e27 otherwise give unrelated abst_evm_bvmul terms). Sound because a*b = a*(b-k) + a*k and a*k is an exact multiple of c, shifting the floor by exactly a*(k/c). Validated: SMT soundness (m=1 and m=2) and wrong-RHS rejection, plus necessity/efficacy against the existing lemma set. 2. Collapse a nested constant division (A/c1)/c2 into a synthetic single divide A/(c1*c2) added to the div set, so the single-divide lemmas (telescoping, const-cancel, fraction-reduce) match code that splits precision across two divides — e.g. _getSUsdsValue's x*rate/1e9/1e18, whose collapsed x*rate/1e27 is what those lemmas key on. Sound: nested-div-collapse already asserts the two forms equal, so the synthetic divide is exact. Additive (never removes a term), so it cannot introduce a false QED. Tests: scaled-product-telescope (QED) and scaled-product-telescope-not-unsound (wrong difference stays Unknown, never QED) in the Mul-Abstraction group. Co-Authored-By: Claude Opus 4.8 --- src/EVM/SMT/DivModEncoding.hs | 53 +++++++++++++++++++++++++++++++++-- test/test.hs | 35 +++++++++++++++++++++++ 2 files changed, 86 insertions(+), 2 deletions(-) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index a4387ce18..46b72d78d 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -233,7 +233,18 @@ mulEncoding enc props = do divisors = nubOrd [ b | (_, b) <- udivs ] synthDivs = nubOrd $ [ (T.Mul a b, b) | (a, b) <- muls, b `elem` divisors ] <> [ (T.Mul a b, a) | (a, b) <- muls, a `elem` divisors ] - udivsAll = nubOrd (udivs <> synthDivs) + -- Collapse a nested constant division (A/c1)/c2 into a synthetic single divide + -- A/(c1*c2), and add it to the div set. Sound because nested-div-collapse below + -- asserts the two forms equal, so the synthetic divide is exact. This lets the + -- single-divide lemmas (telescoping, const-cancel, fraction-reduce) match code + -- that splits precision across two divides — e.g. _getSUsdsValue's x*rate/1e9/1e18, + -- whose collapsed x*rate/1e27 is what those lemmas key on. + collapsedDivs = nubOrd + [ (innerA, Lit (c1 * c2)) + | (a, b) <- udivs <> synthDivs, Lit c2 <- [b] + , T.Div innerA (Lit c1) <- [a] + , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] + udivsAll = nubOrd (udivs <> synthDivs <> collapsedDivs) -- products the div-link lemma introduces, e.g. (a/b)*b linkMuls = [ (T.Div a b, b) | (a, b) <- udivsAll ] allMuls = nubOrd (muls <> linkMuls) @@ -273,6 +284,21 @@ mulEncoding enc props = do | (a, b) <- udivsAll, T.Sub inner (Lit 1) <- [a] , Just (c1, x) <- [asConstMul inner] , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] + -- scaled-product telescoping (sound, no-overflow guarded): two abstract + -- products sharing a factor a, whose other factors differ by a literal k that + -- the common divisor c divides, have an EXACT quotient difference: + -- (a*b)/c - (a*(b-k))/c == a*(k/c). This is the only lemma that relates two + -- DISTINCT abstract products, so it discharges value-change accounting + -- identities such as susds*rate/1e27 - susds == susds*(rate-1e27)/1e27 (rate + -- and rate-1e27 give unrelated abst_evm_bvmul terms otherwise). (a, b, k, c): + -- full product a*b, stepped product a*(b-k), divisor c, with c | k. + telescopes = nubOrd + [ (a, b, k, c) + | (sd, Lit c) <- udivsAll, c /= 0 + , Just (f1, f2) <- [asMul sd] + , (a, T.Sub b (Lit k)) <- [(f1, f2), (f2, f1)] + , k /= 0, k `mod` c == 0 + , any (`elem` udivsAll) [ (T.Mul a b, Lit c), (T.Mul b a, Lit c) ] ] if null udivs && null muls && null constMuls then pure [] else do comm <- mapM mkComm allMuls @@ -287,8 +313,9 @@ mulEncoding enc props = do nestedDiv <- mapM mkNestedDiv nestedDivs fracReduce <- mapM mkFracReduce fracReduces ceilDivCancel <- mapM mkCeilDivCancel ceilDivCancels + telescope <- mapM mkTelescope telescopes pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce <> ceilDivCancel) + : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce <> ceilDivCancel <> telescope) where -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that -- lemma terms match the props regardless of the simplifier's operand order. @@ -413,6 +440,28 @@ mulEncoding enc props = do pure $ SMTCommand $ "(assert (=> (and (bvuge" `sp` xe `sp` one <> ")" <> " (bvule" `sp` xe `sp` bnd <> ")) (=" `sp` dv `sp` rhs <> ")))" + -- scaled-product telescoping (sound, no-overflow guarded). For products sharing + -- factor a whose other factors differ by a literal k with c | k: + -- floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c). + -- Sound because a*b = a*(b-k) + a*k and a*k is an exact multiple of c (c | k), so + -- removing it shifts the floor by exactly a*(k/c). This is the only lemma pinning + -- the EXACT difference of two distinct abstract products; it discharges + -- value-change accounting like susds*rate/1e27 - susds == susds*(rate-1e27)/1e27. + -- Guarded by no-overflow on a*b (so a*(b-k), a*k all fit) and b >= k (so b-k is a + -- true difference, no wraparound). + mkTelescope (a, b, k, c) = do + ae <- enc a; be <- enc b + let m = k `div` c -- exact, since c | k + cbv = wordAsBV c + full = "(abst_evm_bvmul" `sp` ae `sp` be <> ")" + stepped = "(abst_evm_bvmul" `sp` ae `sp` ("(bvsub" `sp` be `sp` wordAsBV k <> ")") <> ")" + dFull = "(abst_evm_bvudiv" `sp` full `sp` cbv <> ")" + dStep = "(abst_evm_bvudiv" `sp` stepped `sp` cbv <> ")" + coeff = if m == 1 then ae else "(bvmul" `sp` wordAsBV m `sp` ae <> ")" + rhs = "(bvadd" `sp` dStep `sp` coeff <> ")" + pure $ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow ae be + <> " (bvuge" `sp` be `sp` wordAsBV k <> ")) (=" `sp` dFull `sp` rhs <> ")))" + -- recognise multiplication by a non-trivial literal constant: c*x or x*c. asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) diff --git a/test/test.hs b/test/test.hs index d4e0b89f4..e032b1cd6 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1651,6 +1651,41 @@ tests = testGroup "hevm" } |] (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Wrong closed form must not be QED" (not (null res)) + , testAbstractArith "scaled-product-telescope" $ do + -- scaled-product telescoping: a*b/c - a*(b-k)/c == a*(k/c) when c | k (here + -- c == k == 1e27, so the coefficient is a). This is the ONLY lemma that + -- relates two DISTINCT abstract products (a*b and a*(b-1e27), both + -- symbolic*symbolic), so it discharges value-change accounting identities + -- like s*rate/1e27 - s == s*(rate-1e27)/1e27 (the third assertion of an + -- ERC4626 conversionRate test). + Just c <- solcRuntime "C" [i| + contract C { + function prove_telescope(uint256 s, uint256 q) external pure { + require(s <= 1000000000000000000000000000000); // 1e30 + require(q >= 1000000000000000000000000000); // 1e27 + require(q <= 1000000000000000000000000000000); // 1e30 + assert(s * q / 1000000000000000000000000000 - s + == s * (q - 1000000000000000000000000000) / 1000000000000000000000000000); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertEqualM "Must be QED" [] res + , testAbstractArith "scaled-product-telescope-not-unsound" $ do + -- soundness guard: a wrong difference (+1) must stay Unknown, never QED. + -- Both products are abstract, so a violation downgrades SAT->Unknown rather + -- than producing a trusted Cex; the lemma must not over-prove the off-by-one. + Just c <- solcRuntime "C" [i| + contract C { + function prove_telescope_wrong(uint256 s, uint256 q) external pure { + require(s <= 1000000000000000000000000000000); + require(q >= 1000000000000000000000000000); + require(q <= 1000000000000000000000000000000); + assert(s * q / 1000000000000000000000000000 - s + == s * (q - 1000000000000000000000000000) / 1000000000000000000000000000 + 1); + } + } |] + (_, res) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "Wrong difference must be Unknown, never QED" (not (any isCex res) && any isUnknown res) ] , testGroup "max-iterations" [ test "concrete-loops-reached" $ do From 50cd32fad433b08eae0145ff173de06b8351cc20 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 22 Jun 2026 09:20:52 +0200 Subject: [PATCH 146/150] Refactor div/mod abstraction into a dedicated lemma catalogue Split the 624-line DivModEncoding into three modules, following the EVM.Expr simplifier idiom (pattern-directed rules + per-constructor emit), so the lemmas live in one reviewable file: - EVM.SMT.AbstractBase: shared SMT primitives, signed helpers, the div/mod taxonomy, term collectors/matchers, and `saturate` (the abstract-term closure that was tangled in mulEncoding's `let`). - EVM.SMT.AbstractLemmas: the lemma catalogue and review surface. A `LemmaInst` sum type, `collectLemmas` (triggers), and `emitLemma` (SMT emission + soundness notes), one banner per lemma. GHC exhaustiveness now forces every constructor to have an emitter, replacing the old silent positional concat. - EVM.SMT.DivModEncoding: slimmed to orchestration (mulEncoding) plus the div/mod ground-truth encoding. Behavior-preserving: emitter bodies are verbatim and the emission order is unchanged, so generated queries are identical. Public API unchanged. Validated: lib + exe build clean (GHC 9.6.6); seven representative lemma properties (const-cancel, scaled const-cancel, frac-reduce, nested-div, mul-mono, mul-div-bound, telescope) prove under --abstract-arith, and a false identity correctly fails, so soundness is preserved. Co-Authored-By: Claude Opus 4.8 --- hevm.cabal | 2 + src/EVM/SMT/AbstractBase.hs | 297 ++++++++++++++++++++ src/EVM/SMT/AbstractLemmas.hs | 275 ++++++++++++++++++ src/EVM/SMT/DivModEncoding.hs | 513 ++-------------------------------- 4 files changed, 605 insertions(+), 482 deletions(-) create mode 100644 src/EVM/SMT/AbstractBase.hs create mode 100644 src/EVM/SMT/AbstractLemmas.hs diff --git a/hevm.cabal b/hevm.cabal index 5ee2388f8..536850885 100644 --- a/hevm.cabal +++ b/hevm.cabal @@ -125,6 +125,8 @@ library EVM.CheatsTH, EVM.SMT.Types, EVM.SMT.SMTLIB, + EVM.SMT.AbstractBase, + EVM.SMT.AbstractLemmas, Paths_hevm autogen-modules: Paths_hevm diff --git a/src/EVM/SMT/AbstractBase.hs b/src/EVM/SMT/AbstractBase.hs new file mode 100644 index 000000000..1bac9907a --- /dev/null +++ b/src/EVM/SMT/AbstractBase.hs @@ -0,0 +1,297 @@ +{- | + Module: EVM.SMT.AbstractBase + Description: Shared vocabulary for the abstract arithmetic encoding. + + This is the base layer both 'EVM.SMT.AbstractLemmas' (the lemma catalogue) and + 'EVM.SMT.DivModEncoding' (the orchestration + div/mod ground truth) build on. It + holds, with no dependency on either of them: + + * the SMT-LIB builder primitives ('sp', 'zero', 'mulNoOverflow', 'wordAsBV', …) + and signed helpers ('smtAbsolute', 'signedFromUnsignedDiv', …); + * the div/mod operation taxonomy ('DivModKind' and friends); + * the term collectors ('collectDivMods', 'collectMuls', 'collectConstMuls') and + shape matchers ('asMul', 'asConstMul'); + * the abstract-term /saturation/ ('saturate'), which closes the set of div/mul + terms the lemmas range over (synthetic divisions, nested-division collapse, + div-mul link products) into an 'AbstractCtx'. + + Keeping this separate breaks the import cycle: @DivModEncoding@ imports + @AbstractLemmas@, so the primitives the lemmas need cannot live in + @DivModEncoding@. +-} +module EVM.SMT.AbstractBase + ( -- * Encoder alias + Enc + -- * UF declarations + , divModAbstractDecls + -- * SMT-LIB builder primitives + , sp + , zero + , one + , maxU128 + , mulNoOverflow + , wordAsBV + -- * Div/mod taxonomy + , DivModKind(..) + , DivModOp + , AbstractKey(..) + , isDiv + , isSigned + , abstFnName + , concFnName + , abstractKey + -- * Collectors and shape matchers + , collectDivMods + , collectMuls + , collectConstMuls + , hasAbstractMul + , asMul + , asConstMul + -- * Signed reconstruction helpers + , smtZeroGuard + , smtAbsolute + , smtNeg + , smtSameSign + , smtIsNonNeg + , signedFromUnsignedDiv + , signedFromUnsignedMod + -- * Abstract-term saturation + , AbstractCtx(..) + , saturate + ) where + +import Data.Containers.ListUtils (nubOrd) +import Data.Text.Lazy.Builder +import qualified Data.Text.Lazy.Builder.Int + +import EVM.SMT.Types +import EVM.Traversals +import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit)) +import EVM.Types qualified as T + +-- | The expression-to-SMT encoder threaded through every emitter. +type Enc = Expr EWord -> Err Builder + +-- | Uninterpreted function declarations for abstract div/mod. +divModAbstractDecls :: [SMTEntry] +divModAbstractDecls = + [ SMTComment "abstract division/modulo (uninterpreted functions)" + , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + , SMTComment "abstract multiplication (kept fully uninterpreted: no ground truth)" + , SMTCommand "(declare-fun abst_evm_bvmul ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" + ] + +-- | Local helper for trivial SMT constructs +sp :: Builder -> Builder -> Builder +a `sp` b = a <> " " <> b + +zero :: Builder +zero = "(_ bv0 256)" + +one :: Builder +one = "(_ bv1 256)" + +-- | Maximum value representable in 128 unsigned bits (2^128 - 1). +maxU128 :: Builder +maxU128 = "(_ bv340282366920938463463374607431768211455 256)" + +-- | A /sufficient/ condition for x*y not to overflow 256 bits: both operands +-- fit in 128 bits, so their product fits in 256 (since (2^128-1)^2 < 2^256). +-- +-- We deliberately use this cheap sufficient condition rather than the exact +-- no-overflow predicate @extract 511 256 (bvmul (zext x) (zext y)) = 0@. The +-- exact form forces the solver to bit-blast a full 512-bit multiply for every +-- lemma instance, which is the dominant cost and makes queries with large +-- operands (~2^100) time out. Two comparisons against a constant are +-- essentially free by contrast. +-- +-- This is the same width-budget idea Halmos uses. It is SOUND: when the guard +-- holds there is genuinely no overflow, so any lemma it gates remains valid. +-- The cost is completeness — a product of operands above 2^128 that happens not +-- to overflow will not receive the lemma. Callers bound operands (e.g. a +-- Solidity @require(x < 2**128)@) so the guard discharges cheaply. +mulNoOverflow :: Builder -> Builder -> Builder +mulNoOverflow x y = + "(and (bvule " <> x <> " " <> maxU128 <> ") (bvule " <> y <> " " <> maxU128 <> "))" + +wordAsBV :: forall a. Integral a => a -> Builder +wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" + +-- | The four EVM division/modulo operations. The @S@-variants are signed +-- (SDiv/SMod), the @U@-variants unsigned (Div/Mod). Signed and unsigned ops +-- are kept in separate groups so the signed absolute-value/sign-reconstruction +-- machinery is never applied to unsigned operands (and vice versa). +data DivModKind = IsSDiv | IsSMod | IsUDiv | IsUMod + deriving (Eq, Ord) + +type DivModOp = (DivModKind, Expr EWord, Expr EWord) + +data AbstractKey = AbstractKey (Expr EWord) (Expr EWord) DivModKind + deriving (Eq, Ord) + +isDiv :: DivModKind -> Bool +isDiv IsSDiv = True +isDiv IsUDiv = True +isDiv _ = False + +isSigned :: DivModKind -> Bool +isSigned IsSDiv = True +isSigned IsSMod = True +isSigned _ = False + +-- | Name of the uninterpreted function standing in for this op. +abstFnName :: DivModKind -> Builder +abstFnName IsSDiv = "abst_evm_bvsdiv" +abstFnName IsSMod = "abst_evm_bvsrem" +abstFnName IsUDiv = "abst_evm_bvudiv" +abstFnName IsUMod = "abst_evm_bvurem" + +-- | Name of the concrete SMT-LIB op refined against in phase two. +concFnName :: DivModKind -> Builder +concFnName IsSDiv = "bvsdiv" +concFnName IsSMod = "bvsrem" +concFnName IsUDiv = "bvudiv" +concFnName IsUMod = "bvurem" + +abstractKey :: DivModOp -> AbstractKey +abstractKey (kind, a, b) = AbstractKey a b kind + +-- | Collect all div/mod operations from an expression. +collectDivMods :: Expr a -> [DivModOp] +collectDivMods = \case + T.SDiv a b -> [(IsSDiv, a, b)] + T.SMod a b -> [(IsSMod, a, b)] + T.Div a b -> [(IsUDiv, a, b)] + T.Mod a b -> [(IsUMod, a, b)] + _ -> [] + +-- | Collect symbolic*symbolic multiplications (neither operand a literal). +-- Concrete factors (incl. 0/1/power-of-two) are handled natively by the +-- simplifier, so only genuinely symbolic products are abstracted. +collectMuls :: Expr a -> [(Expr EWord, Expr EWord)] +collectMuls = \case + T.Mul a b | notLit a, notLit b -> [(a, b)] + _ -> [] + +-- | Collect multiplications by a literal constant, @(c, x)@ for @c*x@ (either +-- operand order), excluding the trivial constants 0 and 1. These stay native +-- @bvmul@ (the value is concrete), but a symbolic operand times a large +-- constant is still costly to bit-blast and compare; const-mul monotonicity +-- lets the solver order such products without doing so. +collectConstMuls :: Expr a -> [(W256, Expr EWord)] +collectConstMuls = \case + T.Mul (Lit c) x | notLit x, c /= 0, c /= 1 -> [(c, x)] + T.Mul x (Lit c) | notLit x, c /= 0, c /= 1 -> [(c, x)] + _ -> [] + +-- | True if any prop contains a symbolic*symbolic multiplication, i.e. the +-- multiplication abstraction is in play. Because abst_evm_bvmul is left +-- uninterpreted (no ground truth), a satisfying model may assign it values +-- inconsistent with real multiplication, so a counterexample cannot be +-- trusted; callers must downgrade SAT results to Unknown to stay SOUND. +hasAbstractMul :: [Prop] -> Bool +hasAbstractMul props = not $ null $ concatMap (foldProp collectMuls []) props + +-- | Recognise an abstract symbolic*symbolic product. +asMul :: Expr EWord -> Maybe (Expr EWord, Expr EWord) +asMul (T.Mul x y) | notLit x, notLit y = Just (x, y) +asMul _ = Nothing + +-- | Recognise multiplication by a non-trivial literal constant: c*x or x*c. +asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) +asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) +asConstMul (T.Mul x (Lit c)) | notLit x, c /= 0, c /= 1 = Just (c, x) +asConstMul _ = Nothing + +notLit :: Expr a -> Bool +notLit (Lit _) = False +notLit _ = True + +-- | (ite (= divisor 0) 0 result) +smtZeroGuard :: Builder -> Builder -> Builder +smtZeroGuard divisor nonZeroResult = + "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" + +-- | |x| as SMT: ite(x >= 0, x, 0 - x). +smtAbsolute :: Builder -> Builder +smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" + +-- | -x as SMT. +smtNeg :: Builder -> Builder +smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" + +-- | True if a and b have the same sign +smtSameSign :: Builder -> Builder -> Builder +smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" + +-- | x >= 0. +smtIsNonNeg :: Builder -> Builder +smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" + +-- | sdiv(a,b) = ITE(b = 0, 0, +-- ITE(sign(a) = sign(b), udiv(|a|,|b|), +-- -udiv(|a|,|b|))) +signedFromUnsignedDiv :: Builder -> Builder -> Builder -> Builder +signedFromUnsignedDiv aenc benc udivResult = + smtZeroGuard benc $ + "(ite" `sp` (smtSameSign aenc benc) `sp` + udivResult `sp` (smtNeg udivResult) <> ")" + +-- | smod(a,b) = ITE(b = 0, 0, +-- ITE(a ≥ 0, urem(|a|,|b|), +-- -urem(|a|,|b|))) +signedFromUnsignedMod :: Builder -> Builder -> Builder -> Builder +signedFromUnsignedMod aenc benc uremResult = + smtZeroGuard benc $ + "(ite" `sp` (smtIsNonNeg aenc) `sp` + uremResult `sp` (smtNeg uremResult) <> ")" + +-- | The saturated set of abstract arithmetic terms a property mentions, closed +-- under the synthetic terms the lemmas need to fire. Built once by 'saturate'; +-- the lemma catalogue ('EVM.SMT.AbstractLemmas') ranges over these fields. +data AbstractCtx = AbstractCtx + { acUDivs :: [(Expr EWord, Expr EWord)] + -- ^ Unsigned divisions, saturated: the raw @(a,b)@ for @a/b@ found in the + -- props, plus synthetic divisions and nested-division collapses (see below). + , acMuls :: [(Expr EWord, Expr EWord)] + -- ^ Symbolic*symbolic products, saturated with the div-mul link products + -- @(a/b)*b@ introduced by the link lemma. + , acConstMuls :: [(W256, Expr EWord)] + -- ^ Products @c*x@ by a non-trivial literal constant. + } + +-- | Close the set of div/mul terms the lemmas range over. +-- +-- Beyond the raw products and divisions a prop mentions, three synthetic +-- families are added so single-level lemmas can bridge multi-level code (all +-- SOUND — each synthetic term is an exact EVM operation that some lemma below +-- then equates to its closed form): +-- +-- * /synthetic divisions/: when an abstract product @a*b@ reuses a factor that +-- is a divisor elsewhere, add @(a*b)/factor@ — lets mulDiv-bound and +-- div-monotonicity bridge cross-divisor round-trips. +-- * /nested-division collapse/: a nested constant division @(A/c1)/c2@ also +-- contributes a single @A/(c1*c2)@, so the single-divide lemmas match code +-- that splits precision across two divides. +-- * /div-mul link products/: every division @a/b@ contributes the product +-- @(a/b)*b@ that the link lemma bounds by @a@. +saturate :: [Prop] -> AbstractCtx +saturate props = + let udivs = [ (a, b) | (IsUDiv, a, b) <- nubOrd $ concatMap (foldProp collectDivMods []) props ] + muls = nubOrd $ concatMap (foldProp collectMuls []) props + constMuls = nubOrd $ concatMap (foldProp collectConstMuls []) props + divisors = nubOrd [ b | (_, b) <- udivs ] + synthDivs = nubOrd $ [ (T.Mul a b, b) | (a, b) <- muls, b `elem` divisors ] + <> [ (T.Mul a b, a) | (a, b) <- muls, a `elem` divisors ] + collapsedDivs = nubOrd + [ (innerA, Lit (c1 * c2)) + | (a, b) <- udivs <> synthDivs, Lit c2 <- [b] + , T.Div innerA (Lit c1) <- [a] + , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] + udivsAll = nubOrd (udivs <> synthDivs <> collapsedDivs) + linkMuls = [ (T.Div a b, b) | (a, b) <- udivsAll ] + allMuls = nubOrd (muls <> linkMuls) + in AbstractCtx { acUDivs = udivsAll, acMuls = allMuls, acConstMuls = constMuls } diff --git a/src/EVM/SMT/AbstractLemmas.hs b/src/EVM/SMT/AbstractLemmas.hs new file mode 100644 index 000000000..0eafe68fa --- /dev/null +++ b/src/EVM/SMT/AbstractLemmas.hs @@ -0,0 +1,275 @@ +{- | + Module: EVM.SMT.AbstractLemmas + Description: The catalogue of sound algebraic lemmas for abstract arithmetic. + + This is the review surface. Multiplication is kept fully uninterpreted (no + ground truth, so the solver never bit-blasts a symbolic product); we add only + /sound/ algebraic facts about @abst_evm_bvmul@/@abst_evm_bvudiv@. Each lemma + appears in three aligned places, under a shared banner: + + 1. a 'LemmaInst' constructor (its arguments), + 2. a clause in 'collectLemmas' (when it fires — the trigger), and + 3. a clause in 'emitLemma' (the SMT it emits + why it is sound). + + To audit soundness, read 'emitLemma': every emitted assertion is true of + ordinary multiplication/division, so anything the solver derives from them + holds for the real operations too. To add a lemma, add a constructor, a + 'collectLemmas' clause, and an 'emitLemma' clause — GHC's exhaustiveness + checker forces the third once you add the first. + + The emission order in 'collectLemmas' is family-by-family and is preserved + from the original monolithic encoder, so the generated query is unchanged. +-} +module EVM.SMT.AbstractLemmas + ( LemmaInst(..) + , collectLemmas + , emitLemma + ) where + +import Data.Containers.ListUtils (nubOrd) + +import EVM.SMT.AbstractBase +import EVM.SMT.Types (SMTEntry(..)) +import EVM.Types (EType(EWord), Err, W256, Expr, Expr(Lit)) +import EVM.Types qualified as T + +-- | A single firing of a lemma family, carrying the sub-terms it matched. +-- Field meanings are documented at the corresponding 'emitLemma' clause. +data LemmaInst + = Comm (Expr EWord) (Expr EWord) -- ^ a*b = b*a + | Identity (Expr EWord) (Expr EWord) -- ^ x*0, 0*y, x*1, 1*y + | DivMulLink (Expr EWord) (Expr EWord) -- ^ (a/b)*b <= a + | MulMono (Expr EWord) (Expr EWord) (Expr EWord) -- ^ x<=y => x*z<=y*z + | DivMono (Expr EWord) (Expr EWord) (Expr EWord) -- ^ x<=y => x/z<=y/z + | DivisorMono (Expr EWord) (Expr EWord) (Expr EWord) -- ^ y1<=y2 => x/y2<=x/y1 + | MulDivBound (Expr EWord) (Expr EWord) (Expr EWord) (Expr EWord) -- ^ (x*y)/z <= x or y + | ConstMulMono W256 (Expr EWord) (Expr EWord) -- ^ x<=y => c*x<=c*y + | ConstCancel (Expr EWord) W256 W256 (Expr EWord) -- ^ (c1*x)/c2 == (c1/c2)*x + | NestedDiv (Expr EWord) W256 W256 -- ^ (A/c1)/c2 == A/(c1*c2) + | FracReduce (Expr EWord) W256 W256 (Expr EWord) -- ^ (c1*x)/c2 == x/(c2/c1) + | CeilDivCancel (Expr EWord) W256 W256 (Expr EWord) -- ^ ceilDiv(c1*x,c2) inner divide + | Telescope (Expr EWord) (Expr EWord) W256 W256 -- ^ (a*b)/c - (a*(b-k))/c == a*(k/c) + deriving (Eq, Ord) + +-- | Every lemma instance triggered by the saturated term set, in the order the +-- assertions are emitted. One clause per family; see 'emitLemma' for the math. +collectLemmas :: AbstractCtx -> [LemmaInst] +collectLemmas ctx = + -- commutativity + 0/1 identities over every product + [ Comm a b | (a, b) <- ctx.acMuls ] + <> [ Identity a b | (a, b) <- ctx.acMuls ] + -- the div<->mul link, one per division + <> [ DivMulLink a b | (a, b) <- ctx.acUDivs ] + -- monotonicities over shared-operand pairs + <> [ MulMono x y z | (x, y, z) <- sharedPairs (bothOrders (ctx.acMuls)) ] + <> [ DivMono x y z | (x, y, z) <- sharedPairs (ctx.acUDivs) ] + <> [ DivisorMono y1 y2 x | (y1, y2, x) <- divisorPairs (ctx.acUDivs) ] + -- product-over-divisor bound, for divisions whose dividend is a product + <> [ MulDivBound a x y b | (a, b) <- ctx.acUDivs, Just (x, y) <- [asMul a] ] + -- const-mul monotonicity over const-products sharing the same constant + <> [ ConstMulMono c x y | (c, x) <- ctx.acConstMuls, (c', y) <- ctx.acConstMuls, c == c', x /= y ] + -- constant cancellation / fraction reduction over constant divisions + <> [ ConstCancel a c1 c2 x + | (a, b) <- ctx.acUDivs, Just (c1, x) <- [asConstMul a] + , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] + <> [ NestedDiv innerA c1 c2 + | (a, b) <- ctx.acUDivs, Lit c2 <- [b] + , T.Div innerA (Lit c1) <- [a] + , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] + <> [ FracReduce a c1 c2 x + | (a, b) <- ctx.acUDivs, Just (c1, x) <- [asConstMul a] + , Lit c2 <- [b], c2 /= 0, c1 /= 0, c2 `mod` c1 == 0, c2 /= c1 ] + <> [ CeilDivCancel a c1 c2 x + | (a, b) <- ctx.acUDivs, T.Sub inner (Lit 1) <- [a] + , Just (c1, x) <- [asConstMul inner] + , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] + -- scaled-product telescoping (the only cross-product lemma) + <> [ Telescope a b k c | (a, b, k, c) <- telescopes ] + where + telescopes = nubOrd + [ (a, b, k, c) + | (sd, Lit c) <- ctx.acUDivs, c /= 0 + , Just (f1, f2) <- [asMul sd] + , (a, T.Sub b (Lit k)) <- [(f1, f2), (f2, f1)] + , k /= 0, k `mod` c == 0 + , any (`elem` ctx.acUDivs) [ (T.Mul a b, Lit c), (T.Mul b a, Lit c) ] ] + +-- | Emit the SMT assertion(s) for a single lemma instance. Each clause is the +-- sound fact, with its no-overflow / divisor guard where one is required. +emitLemma :: Enc -> LemmaInst -> Err [SMTEntry] + +-- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so lemma +-- terms match the props regardless of the simplifier's operand order. +emitLemma enc (Comm a b) = do + aenc <- enc a; benc <- enc b + let m1 = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" + m2 = "(abst_evm_bvmul" `sp` benc `sp` aenc <> ")" + pure [ SMTCommand $ "(assert (=" `sp` m1 `sp` m2 <> "))" ] + +-- sound identities pinning the otherwise-free UF on 0/1 operands: +-- x*0 = 0, 0*y = 0, x*1 = x, 1*y = y +emitLemma enc (Identity a b) = do + aenc <- enc a; benc <- enc b + let m = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" + pure [ SMTCommand $ "(assert (=> (=" `sp` aenc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` benc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` aenc `sp` one <> ") (=" `sp` m `sp` benc <> ")))" + , SMTCommand $ "(assert (=> (=" `sp` benc `sp` one <> ") (=" `sp` m `sp` aenc <> ")))" + ] + +-- div<->mul link (sound unconditionally): quotient*divisor <= dividend, i.e. +-- abst_evm_bvmul(abst_evm_bvudiv(a,b), b) <= a. +-- (a/b)*b <= a < 2^256 can never overflow, so no guard. This links the div and +-- mul abstractions and chains nested divisions. +emitLemma enc (DivMulLink a b) = do + aenc <- enc a; benc <- enc b + let q = "(abst_evm_bvudiv" `sp` aenc `sp` benc <> ")" + qb = "(abst_evm_bvmul" `sp` q `sp` benc <> ")" + pure [ SMTCommand $ "(assert (bvule" `sp` qb `sp` aenc <> "))" ] + +-- mul monotonicity (guarded by no-overflow, hence sound): if neither x*z nor +-- y*z overflows then x <= y => x*z <= y*z. The guard is bound-free; bounding +-- operands (e.g. a Solidity require) keeps it cheap to discharge. +emitLemma enc (MulMono x y z) = do + xenc <- enc x; yenc <- enc y; zenc <- enc z + let mxz = "(abst_evm_bvmul" `sp` xenc `sp` zenc <> ")" + myz = "(abst_evm_bvmul" `sp` yenc `sp` zenc <> ")" + pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc + <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] + +-- div monotonicity in the dividend (sound unconditionally): for a common +-- divisor z, x <= y => floor(x/z) <= floor(y/z). +emitLemma enc (DivMono x y z) = do + xenc <- enc x; yenc <- enc y; zenc <- enc z + let dxz = "(abst_evm_bvudiv" `sp` xenc `sp` zenc <> ")" + dyz = "(abst_evm_bvudiv" `sp` yenc `sp` zenc <> ")" + pure [ SMTCommand $ "(assert (=> (bvule" `sp` xenc `sp` yenc <> ") (bvule" `sp` dxz `sp` dyz <> ")))" ] + +-- div anti-monotonicity in the divisor (sound for nonzero divisors): a bigger +-- divisor yields a smaller-or-equal quotient. +-- y1 <= y2 && y1 != 0 => x/y2 <= x/y1 +emitLemma enc (DivisorMono y1 y2 x) = do + y1e <- enc y1; y2e <- enc y2; xe <- enc x + let dxy1 = "(abst_evm_bvudiv" `sp` xe `sp` y1e <> ")" + dxy2 = "(abst_evm_bvudiv" `sp` xe `sp` y2e <> ")" + pure [ SMTCommand $ "(assert (=> (and (distinct" `sp` y1e `sp` zero <> ")" + <> " (bvule" `sp` y1e `sp` y2e <> ")) (bvule" `sp` dxy2 `sp` dxy1 <> ")))" ] + +-- mulDiv bound (sound under no-overflow of x*z): if one factor is <= the +-- divisor then dividing the product by it cannot exceed the other factor. +-- y <= z => (x*y)/z <= x x <= z => (x*y)/z <= y +-- `a` is the original product expr, so the div term matches the prop exactly. +emitLemma enc (MulDivBound a x y z) = do + ae <- enc a; xe <- enc x; ye <- enc y; ze <- enc z + let dv = "(abst_evm_bvudiv" `sp` ae `sp` ze <> ")" + pure [ SMTCommand $ "(assert (=> (and (bvule" `sp` ye `sp` ze <> ")" `sp` mulNoOverflow xe ze + <> ") (bvule" `sp` dv `sp` xe <> ")))" + , SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` ze <> ")" `sp` mulNoOverflow ye ze + <> ") (bvule" `sp` dv `sp` ye <> ")))" ] + +-- const-mul monotonicity (sound, no-overflow guarded): for a fixed literal +-- constant c, x <= y => c*x <= c*y. Because c is concrete we compute the exact +-- no-overflow bound floor((2^256-1)/c) at encode time, so the guard is a single +-- comparison against a constant. c*x stays a native bvmul; this lemma just lets +-- the solver order two such products without bit-blasting the multiply. +emitLemma enc (ConstMulMono c x y) = do + xe <- enc x; ye <- enc y + let cbv = wordAsBV c + cx = "(bvmul" `sp` cbv `sp` xe <> ")" + cy = "(bvmul" `sp` cbv `sp` ye <> ")" + bnd = wordAsBV ((maxBound :: W256) `div` c) -- largest x with c*x < 2^256 + pure [ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" + <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" ] + +-- const cancellation (sound, no-overflow guarded): a product c1*x divided by a +-- literal c2 that divides c1 collapses to (c1/c2)*x. The multiply by a constant +-- stays a native bvmul but the divide is abstracted, so without this the +-- precision-scaling wrapper c1*x/c2 (e.g. amount*1e18/1e6 in _getUsdcValue) is +-- not provably its closed form. `a` is the dividend (c1*x); c2 | c1 makes c1/c2 +-- exact, and the bound floor((2^256-1)/c1) is computed at encode time. +emitLemma enc (ConstCancel a c1 c2 x) = do + ae <- enc a; xe <- enc x + let c2bv = wordAsBV c2 + k = c1 `div` c2 -- exact, since c2 | c1 + rhs = if k == 1 then xe else "(bvmul" `sp` wordAsBV k `sp` xe <> ")" + dv = "(abst_evm_bvudiv" `sp` ae `sp` c2bv <> ")" + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure [ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" ] + +-- nested-division collapse (sound, floor identity): (A/c1)/c2 == A/(c1*c2) for +-- literal c1,c2 with c1*c2 < 2^256. Lets the solver simplify chained constant +-- divisions such as x*rate/1e9/1e18 to x*rate/1e27. No operand bound needed. +emitLemma enc (NestedDiv innerA c1 c2) = do + ae <- enc innerA + let inner = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c1 <> ")" + outer = "(abst_evm_bvudiv" `sp` inner `sp` wordAsBV c2 <> ")" + collapsed = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV (c1 * c2) <> ")" + pure [ SMTCommand $ "(assert (=" `sp` outer `sp` collapsed <> "))" ] + +-- fraction-reduce (sound, no-overflow guarded): a product c1*x divided by a +-- literal c2 that c1 divides collapses to x/(c2/c1). The mirror of const-cancel: +-- const-cancel needs c2 | c1 (multiply by large, divide by small); this needs +-- c1 | c2 (multiply by small, divide by large, e.g. x*1e6/1e18 == x/1e12 — the +-- convert-to-usdc precision step). Under the guard c1*x is exact and +-- floor(c1*x / (c1*k)) = floor(x/k). `a` is the dividend (c1*x). +emitLemma enc (FracReduce a c1 c2 x) = do + ae <- enc a; xe <- enc x + let k = c2 `div` c1 -- exact and >= 2, since c1 | c2 and c2 /= c1 + dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x)/c2 + rhs = "(abst_evm_bvudiv" `sp` xe `sp` wordAsBV k <> ")" -- x/(c2/c1) + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure [ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" ] + +-- ceilDiv-cancel (sound, guarded): pins the abstracted divide inside +-- OpenZeppelin's Math.ceilDiv(c1*x, c2) = (c1*x - 1)/c2 + 1 (the c1*x != 0 +-- branch). `a` is the (c1*x - 1) dividend. When c2 | c1, write c1 = c2*m: then +-- c1*x = c2*(m*x), so floor((c2*m*x - 1)/c2) = m*x - 1 (for m*x >= 1). Adding the +-- ceilDiv's +1 gives m*x = (c1/c2)*x exactly. Guarded by x >= 1 (the ceilDiv ITE +-- handles x==0) and the encode-time no-overflow bound floor((2^256-1)/c1). +emitLemma enc (CeilDivCancel a c1 c2 x) = do + ae <- enc a; xe <- enc x + let m = c1 `div` c2 -- exact, since c2 | c1 + mx = if m == 1 then xe else "(bvmul" `sp` wordAsBV m `sp` xe <> ")" + dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x - 1)/c2 + rhs = "(bvsub" `sp` mx `sp` one <> ")" -- (c1/c2)*x - 1 + bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 + pure [ SMTCommand $ "(assert (=> (and (bvuge" `sp` xe `sp` one <> ")" + <> " (bvule" `sp` xe `sp` bnd <> ")) (=" `sp` dv `sp` rhs <> ")))" ] + +-- scaled-product telescoping (sound, no-overflow guarded). For products sharing +-- factor a whose other factors differ by a literal k with c | k: +-- floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c). +-- Sound because a*b = a*(b-k) + a*k and a*k is an exact multiple of c, so +-- removing it shifts the floor by exactly a*(k/c). The only lemma pinning the +-- EXACT difference of two distinct abstract products; discharges value-change +-- accounting like susds*rate/1e27 - susds == susds*(rate-1e27)/1e27. Guarded by +-- no-overflow on a*b and b >= k (so b-k is a true difference, no wraparound). +emitLemma enc (Telescope a b k c) = do + ae <- enc a; be <- enc b + let m = k `div` c -- exact, since c | k + cbv = wordAsBV c + full = "(abst_evm_bvmul" `sp` ae `sp` be <> ")" + stepped = "(abst_evm_bvmul" `sp` ae `sp` ("(bvsub" `sp` be `sp` wordAsBV k <> ")") <> ")" + dFull = "(abst_evm_bvudiv" `sp` full `sp` cbv <> ")" + dStep = "(abst_evm_bvudiv" `sp` stepped `sp` cbv <> ")" + coeff = if m == 1 then ae else "(bvmul" `sp` wordAsBV m `sp` ae <> ")" + rhs = "(bvadd" `sp` dStep `sp` coeff <> ")" + pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow ae be + <> " (bvuge" `sp` be `sp` wordAsBV k <> ")) (=" `sp` dFull `sp` rhs <> ")))" ] + +-- | Include both operand orders of each product. Multiplication is commutative +-- (and we assert that), but the simplifier/solc may order a product's operands +-- either way; considering both ensures monotonicity is found regardless of +-- ordering. Only used for the (commutative) mul lemmas. +bothOrders :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord)] +bothOrders xs = nubOrd (xs <> [ (b, a) | (a, b) <- xs ]) + +-- | Ordered pairs (x, y, z) where (x,z) and (y,z) both occur (shared 2nd +-- operand): products by a common factor, or divisions by a common divisor. +sharedPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] +sharedPairs xs = [ (x, y, z) | (x, z) <- xs, (y, z') <- xs, z == z', x /= y ] + +-- | Ordered pairs (y1, y2, x) where (x,y1) and (x,y2) both occur (shared 1st +-- operand): divisions of the same dividend by different divisors. +divisorPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] +divisorPairs xs = [ (y1, y2, x) | (x, y1) <- xs, (x', y2) <- xs, x == x', y1 /= y2 ] diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 46b72d78d..6689db067 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -1,4 +1,12 @@ -{- | Abstract div/mobsolud encoding for two-phase SMT solving. -} +{- | Abstract div/mod encoding for two-phase SMT solving. + + Orchestration layer. The shared vocabulary (primitives, collectors, + 'saturate') lives in "EVM.SMT.AbstractBase"; the multiplication lemma + catalogue lives in "EVM.SMT.AbstractLemmas". This module wires them together + ('mulEncoding') and holds the div/mod /ground-truth/ encoding — the phase that + refines the abstract uninterpreted functions against real bvudiv/bvsdiv using + absolute values, shift bounds, and congruence. +-} module EVM.SMT.DivModEncoding ( divModGroundTruth , divModEncoding @@ -11,114 +19,32 @@ import Data.Bits (countTrailingZeros) import Data.Containers.ListUtils (nubOrd) import Data.List (groupBy, sortBy) import Data.Ord (comparing) -import Data.Text.Lazy.Builder -import qualified Data.Text.Lazy.Builder.Int -import EVM.SMT.Types -import EVM.Traversals -import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) -import EVM.Types qualified as T - --- | Uninterpreted function declarations for abstract div/mod. -divModAbstractDecls :: [SMTEntry] -divModAbstractDecls = - [ SMTComment "abstract division/modulo (uninterpreted functions)" - , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTComment "abstract multiplication (kept fully uninterpreted: no ground truth)" - , SMTCommand "(declare-fun abst_evm_bvmul ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - ] - --- | Local helper for trivial SMT constructs -sp :: Builder -> Builder -> Builder -a `sp` b = a <> " " <> b - -zero :: Builder -zero = "(_ bv0 256)" - -one :: Builder -one = "(_ bv1 256)" - --- | Maximum value representable in 128 unsigned bits (2^128 - 1). -maxU128 :: Builder -maxU128 = "(_ bv340282366920938463463374607431768211455 256)" - --- | A /sufficient/ condition for x*y not to overflow 256 bits: both operands --- fit in 128 bits, so their product fits in 256 (since (2^128-1)^2 < 2^256). --- --- We deliberately use this cheap sufficient condition rather than the exact --- no-overflow predicate @extract 511 256 (bvmul (zext x) (zext y)) = 0@. The --- exact form forces the solver to bit-blast a full 512-bit multiply for every --- lemma instance, which is the dominant cost and makes queries with large --- operands (~2^100) time out. Two comparisons against a constant are --- essentially free by contrast. --- --- This is the same width-budget idea Halmos uses. It is SOUND: when the guard --- holds there is genuinely no overflow, so any lemma it gates remains valid. --- The cost is completeness — a product of operands above 2^128 that happens not --- to overflow will not receive the lemma. Callers bound operands (e.g. a --- Solidity @require(x < 2**128)@) so the guard discharges cheaply. -mulNoOverflow :: Builder -> Builder -> Builder -mulNoOverflow x y = - "(and (bvule " <> x <> " " <> maxU128 <> ") (bvule " <> y <> " " <> maxU128 <> "))" - -wordAsBV :: forall a. Integral a => a -> Builder -wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" - --- | The four EVM division/modulo operations. The @S@-variants are signed --- (SDiv/SMod), the @U@-variants unsigned (Div/Mod). Signed and unsigned ops --- are kept in separate groups so the signed absolute-value/sign-reconstruction --- machinery is never applied to unsigned operands (and vice versa). -data DivModKind = IsSDiv | IsSMod | IsUDiv | IsUMod - deriving (Eq, Ord) - -type DivModOp = (DivModKind, Expr EWord, Expr EWord) - -data AbstractKey = AbstractKey (Expr EWord) (Expr EWord) DivModKind - deriving (Eq, Ord) - -isDiv :: DivModKind -> Bool -isDiv IsSDiv = True -isDiv IsUDiv = True -isDiv _ = False - -isSigned :: DivModKind -> Bool -isSigned IsSDiv = True -isSigned IsSMod = True -isSigned _ = False - --- | Name of the uninterpreted function standing in for this op. -abstFnName :: DivModKind -> Builder -abstFnName IsSDiv = "abst_evm_bvsdiv" -abstFnName IsSMod = "abst_evm_bvsrem" -abstFnName IsUDiv = "abst_evm_bvudiv" -abstFnName IsUMod = "abst_evm_bvurem" +import Data.Text.Lazy.Builder (Builder, fromString) --- | Name of the concrete SMT-LIB op refined against in phase two. -concFnName :: DivModKind -> Builder -concFnName IsSDiv = "bvsdiv" -concFnName IsSMod = "bvsrem" -concFnName IsUDiv = "bvudiv" -concFnName IsUMod = "bvurem" - --- | Collect all div/mod operations from an expression. -collectDivMods :: Expr a -> [DivModOp] -collectDivMods = \case - T.SDiv a b -> [(IsSDiv, a, b)] - T.SMod a b -> [(IsSMod, a, b)] - T.Div a b -> [(IsUDiv, a, b)] - T.Mod a b -> [(IsUMod, a, b)] - _ -> [] +import EVM.SMT.AbstractBase +import EVM.SMT.AbstractLemmas (collectLemmas, emitLemma) +import EVM.SMT.Types +import EVM.Traversals (foldProp) +import EVM.Types (Prop, EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) -abstractKey :: DivModOp -> AbstractKey -abstractKey (kind, a, b) = AbstractKey a b kind +-- | Lemmas for abstract multiplication. Multiplication is kept fully +-- uninterpreted (no ground truth, so the solver never bit-blasts a symbolic +-- product); we add only the sound algebraic facts catalogued in +-- "EVM.SMT.AbstractLemmas". 'saturate' closes the term set the lemmas range +-- over; 'collectLemmas' picks the instances; 'emitLemma' renders each to SMT. +mulEncoding :: Enc -> [Prop] -> Err [SMTEntry] +mulEncoding enc props = do + let ctx = saturate props + if null ctx.acUDivs && null ctx.acMuls && null ctx.acConstMuls then pure [] + else do + lemmas <- concat <$> mapM (emitLemma enc) (collectLemmas ctx) + pure $ (SMTComment "multiplication abstraction lemmas") : lemmas -- | Declare the magnitude variables and the unsigned result variable for a -- group. For signed ops the magnitudes are the absolute values |a|, |b|; for -- unsigned ops the operands are already non-negative, so the magnitude is the -- operand itself (|x| = x). -declareAbsolute :: (Expr EWord -> Err Builder) -> DivModKind -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) +declareAbsolute :: Enc -> DivModKind -> Int -> Expr EWord -> Expr EWord -> Builder -> Err ([SMTEntry], (Builder, Builder)) declareAbsolute enc kind groupIdx firstA firstB unsignedResult = do aenc <- enc firstA benc <- enc firstB @@ -138,7 +64,7 @@ declareAbsolute enc kind groupIdx firstA firstB unsignedResult = do -- | Assert "abstract div/mod(a,b)" = result derived from the unsigned result -- variable. Signed ops reconstruct the sign from |a|/|b|; unsigned ops need -- only the EVM divide-by-zero guard, since the unsigned result is the answer. -assertAbstEqResult :: (Expr EWord -> Err Builder) -> Builder -> DivModOp -> Err SMTEntry +assertAbstEqResult :: Enc -> Builder -> DivModOp -> Err SMTEntry assertAbstEqResult enc unsignedResult (kind, a, b) = do aenc <- enc a benc <- enc b @@ -153,7 +79,7 @@ assertAbstEqResult enc unsignedResult (kind, a, b) = do -- | Ground-truth axioms: for each sdiv/smod op, assert that the abstract -- uninterpreted function equals the real bvsdiv/bvsrem. -- e.g. (assert (= (abst_evm_bvsdiv a b) (bvsdiv a b))) -divModGroundTruth :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] +divModGroundTruth :: Enc -> [Prop] -> Err [SMTEntry] divModGroundTruth enc props = do let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivMods then pure [] @@ -174,346 +100,8 @@ divModGroundTruth enc props = do concrete = if isSigned kind then native else smtZeroGuard benc native pure $ SMTCommand $ "(assert (=" `sp` abstract `sp` concrete <> "))" --- | Collect symbolic*symbolic multiplications (neither operand a literal). --- Concrete factors (incl. 0/1/power-of-two) are handled natively by the --- simplifier, so only genuinely symbolic products are abstracted. -collectMuls :: Expr a -> [(Expr EWord, Expr EWord)] -collectMuls = \case - T.Mul a b | notLit a, notLit b -> [(a, b)] - _ -> [] - where - notLit (Lit _) = False - notLit _ = True - --- | Collect multiplications by a literal constant, @(c, x)@ for @c*x@ (either --- operand order), excluding the trivial constants 0 and 1. These stay native --- @bvmul@ (the value is concrete), but a symbolic operand times a large --- constant is still costly to bit-blast and compare; const-mul monotonicity --- (see 'mkConstMulMono') lets the solver order such products without doing so. -collectConstMuls :: Expr a -> [(W256, Expr EWord)] -collectConstMuls = \case - T.Mul (Lit c) x | notLit x, c /= 0, c /= 1 -> [(c, x)] - T.Mul x (Lit c) | notLit x, c /= 0, c /= 1 -> [(c, x)] - _ -> [] - where - notLit (Lit _) = False - notLit _ = True - --- | True if any prop contains a symbolic*symbolic multiplication, i.e. the --- multiplication abstraction is in play. Because abst_evm_bvmul is left --- uninterpreted (no ground truth), a satisfying model may assign it values --- inconsistent with real multiplication, so a counterexample cannot be --- trusted; callers must downgrade SAT results to Unknown to stay SOUND. -hasAbstractMul :: [Prop] -> Bool -hasAbstractMul props = not $ null $ concatMap (foldProp collectMuls []) props - --- | Lemmas for abstract multiplication. Multiplication is kept fully --- uninterpreted (no ground truth, so the solver never bit-blasts a symbolic --- product); we add only sound algebraic facts. Commutativity is free because --- the simplifier canonically orders Mul operands, so abst_evm_bvmul(a,b) and --- abst_evm_bvmul(b,a) are the same term. --- --- Step 1 lemma (sound unconditionally): quotient*divisor <= dividend, i.e. --- abst_evm_bvmul(abst_evm_bvudiv(X,Y), Y) <= X --- The product (X/Y)*Y <= X < 2^256 can never overflow, so no guard is needed. --- This is what links the div and mul abstractions and chains nested divisions. -mulEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] -mulEncoding enc props = do - let udivs = [ (a, b) | (IsUDiv, a, b) <- nubOrd $ concatMap (foldProp collectDivMods []) props ] - muls = nubOrd $ concatMap (foldProp collectMuls []) props - constMuls = nubOrd $ concatMap (foldProp collectConstMuls []) props - -- Cancellation: when an abstract product a*b has a factor that is reused - -- as a divisor elsewhere, synthesize the exact division (a*b)/factor. - -- Adding it to the div set lets the existing lemmas bridge nested - -- divisions: mulDiv-bound gives (a*b)/b <= a, and div-monotonicity carries - -- that bound across a shared divisor. This is what proves cross-divisor - -- round-trips like convertToAssetValue(convertToShares(x)) <= x (the - -- stateless core of inflation-attack safety), which single-level lemmas - -- cannot. The synthetic terms are exact EVM divisions, so this is SOUND. - divisors = nubOrd [ b | (_, b) <- udivs ] - synthDivs = nubOrd $ [ (T.Mul a b, b) | (a, b) <- muls, b `elem` divisors ] - <> [ (T.Mul a b, a) | (a, b) <- muls, a `elem` divisors ] - -- Collapse a nested constant division (A/c1)/c2 into a synthetic single divide - -- A/(c1*c2), and add it to the div set. Sound because nested-div-collapse below - -- asserts the two forms equal, so the synthetic divide is exact. This lets the - -- single-divide lemmas (telescoping, const-cancel, fraction-reduce) match code - -- that splits precision across two divides — e.g. _getSUsdsValue's x*rate/1e9/1e18, - -- whose collapsed x*rate/1e27 is what those lemmas key on. - collapsedDivs = nubOrd - [ (innerA, Lit (c1 * c2)) - | (a, b) <- udivs <> synthDivs, Lit c2 <- [b] - , T.Div innerA (Lit c1) <- [a] - , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] - udivsAll = nubOrd (udivs <> synthDivs <> collapsedDivs) - -- products the div-link lemma introduces, e.g. (a/b)*b - linkMuls = [ (T.Div a b, b) | (a, b) <- udivsAll ] - allMuls = nubOrd (muls <> linkMuls) - -- divisions whose dividend is an abstract product: (x*y)/z - mulDivs = [ (a, x, y, b) | (a, b) <- udivsAll, Just (x, y) <- [asMul a] ] - -- pairs of const-muls sharing the same constant: (c, x, y) for c*x, c*y - constMulPairs = [ (c, x, y) | (c, x) <- constMuls, (c', y) <- constMuls, c == c', x /= y ] - -- const cancellation: a product c1*x divided by a literal c2 that divides - -- c1 collapses to (c1/c2)*x. (a, c1, c2, x): a is the dividend (c1*x). The - -- same-constant case (c1==c2) gives just x; the general case (c2 | c1) - -- covers lossless precision scaling like x*1e18/1e6 == x*1e12. - constCancels = [ (a, c1, c2, x) - | (a, b) <- udivsAll, Just (c1, x) <- [asConstMul a] - , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] - -- nested-division collapse: (A/c1)/c2 == A/(c1*c2) for literals c1,c2 whose - -- product fits in 256 bits. A floor identity (sound unconditionally). E.g. - -- x*rate/1e9/1e18 == x*rate/1e27. - nestedDivs = [ (innerA, c1, c2) - | (a, b) <- udivsAll, Lit c2 <- [b] - , T.Div innerA (Lit c1) <- [a] - , c1 /= 0, c2 /= 0, toInteger c1 * toInteger c2 < 2 ^ (256 :: Int) ] - -- fraction-reduce: a product c1*x divided by a literal c2 that c1 divides - -- collapses to x/(c2/c1). The mirror of const-cancel (c2 | c1); this is the - -- c1 | c2 case (multiply by small, divide by large) such as x*1e6/1e18 == - -- x/1e12 (precision scaling DOWN, the convert-to-usdc direction). Excludes - -- c1==c2, which const-cancel already covers (collapsing to x). - fracReduces = [ (a, c1, c2, x) - | (a, b) <- udivsAll, Just (c1, x) <- [asConstMul a] - , Lit c2 <- [b], c2 /= 0, c1 /= 0 - , c2 `mod` c1 == 0, c2 /= c1 ] - -- ceilDiv-cancel: OpenZeppelin Math.ceilDiv(c1*x, c2) is - -- (c1*x == 0) ? 0 : (c1*x - 1)/c2 + 1, so the abstracted divide is over the - -- (c1*x - 1) dividend. When c2 | c1 the product c1*x is always a multiple of - -- c2, hence ceil == floor and the whole ceilDiv collapses to (c1/c2)*x. We - -- pin the inner divide: (a, c1, c2, x) with a == (c1*x) - 1. - ceilDivCancels = [ (a, c1, c2, x) - | (a, b) <- udivsAll, T.Sub inner (Lit 1) <- [a] - , Just (c1, x) <- [asConstMul inner] - , Lit c2 <- [b], c2 /= 0, c1 `mod` c2 == 0 ] - -- scaled-product telescoping (sound, no-overflow guarded): two abstract - -- products sharing a factor a, whose other factors differ by a literal k that - -- the common divisor c divides, have an EXACT quotient difference: - -- (a*b)/c - (a*(b-k))/c == a*(k/c). This is the only lemma that relates two - -- DISTINCT abstract products, so it discharges value-change accounting - -- identities such as susds*rate/1e27 - susds == susds*(rate-1e27)/1e27 (rate - -- and rate-1e27 give unrelated abst_evm_bvmul terms otherwise). (a, b, k, c): - -- full product a*b, stepped product a*(b-k), divisor c, with c | k. - telescopes = nubOrd - [ (a, b, k, c) - | (sd, Lit c) <- udivsAll, c /= 0 - , Just (f1, f2) <- [asMul sd] - , (a, T.Sub b (Lit k)) <- [(f1, f2), (f2, f1)] - , k /= 0, k `mod` c == 0 - , any (`elem` udivsAll) [ (T.Mul a b, Lit c), (T.Mul b a, Lit c) ] ] - if null udivs && null muls && null constMuls then pure [] - else do - comm <- mapM mkComm allMuls - links <- mapM mkDivMulLink udivsAll - zeroOne <- concat <$> mapM mkMulIdentities allMuls - mulMono <- concat <$> mapM mkMulMono (sharedPairs (bothOrders allMuls)) - divMono <- concat <$> mapM mkDivMono (sharedPairs udivsAll) - divDivisorMono <- concat <$> mapM mkDivisorMono (divisorPairs udivsAll) - mulDivB <- concat <$> mapM mkMulDivBound mulDivs - constMulMono <- mapM mkConstMulMono constMulPairs - constCancel <- mapM mkConstCancel constCancels - nestedDiv <- mapM mkNestedDiv nestedDivs - fracReduce <- mapM mkFracReduce fracReduces - ceilDivCancel <- mapM mkCeilDivCancel ceilDivCancels - telescope <- mapM mkTelescope telescopes - pure $ (SMTComment "multiplication abstraction lemmas") - : (comm <> zeroOne <> links <> mulMono <> divMono <> divDivisorMono <> mulDivB <> constMulMono <> constCancel <> nestedDiv <> fracReduce <> ceilDivCancel <> telescope) - where - -- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so that - -- lemma terms match the props regardless of the simplifier's operand order. - mkComm (a, b) = do - aenc <- enc a; benc <- enc b - let m1 = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" - m2 = "(abst_evm_bvmul" `sp` benc `sp` aenc <> ")" - pure $ SMTCommand $ "(assert (=" `sp` m1 `sp` m2 <> "))" - -- Include both operand orders of each product. Multiplication is - -- commutative (and we assert that), but the simplifier/solc may order a - -- product's operands either way; considering both ensures monotonicity is - -- found regardless of ordering. Only used for the (commutative) mul lemmas, - -- never for the order-sensitive division lemmas. - bothOrders :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord)] - bothOrders xs = nubOrd (xs <> [ (b, a) | (a, b) <- xs ]) - - -- ordered pairs (x, y, z) where (x,z) and (y,z) both occur (shared 2nd operand) - sharedPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] - sharedPairs xs = [ (x, y, z) | (x, z) <- xs, (y, z') <- xs, z == z', x /= y ] - - -- ordered pairs (y1, y2, x) where (x,y1) and (x,y2) both occur (shared 1st - -- operand): divisions of the same dividend by different divisors. - divisorPairs :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord, Expr EWord)] - divisorPairs xs = [ (y1, y2, x) | (x, y1) <- xs, (x', y2) <- xs, x == x', y1 /= y2 ] - - -- div anti-monotonicity in the divisor (sound for nonzero divisors): a - -- bigger divisor yields a smaller-or-equal quotient. - -- y1 <= y2 && y1 != 0 => x/y2 <= x/y1 - mkDivisorMono (y1, y2, x) = do - y1e <- enc y1; y2e <- enc y2; xe <- enc x - let dxy1 = "(abst_evm_bvudiv" `sp` xe `sp` y1e <> ")" - dxy2 = "(abst_evm_bvudiv" `sp` xe `sp` y2e <> ")" - pure [ SMTCommand $ "(assert (=> (and (distinct" `sp` y1e `sp` zero <> ")" - <> " (bvule" `sp` y1e `sp` y2e <> ")) (bvule" `sp` dxy2 `sp` dxy1 <> ")))" ] - - -- mul monotonicity (guarded by no-overflow, hence sound): if neither x*z - -- nor y*z overflows then x <= y => x*z <= y*z. The guard is bound-free; - -- bounding operands (e.g. a Solidity require) keeps it cheap to discharge. - mkMulMono (x, y, z) = do - xenc <- enc x; yenc <- enc y; zenc <- enc z - let mxz = "(abst_evm_bvmul" `sp` xenc `sp` zenc <> ")" - myz = "(abst_evm_bvmul" `sp` yenc `sp` zenc <> ")" - -- forward: x <= y => x*z <= y*z - pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc - <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] - - -- const-mul monotonicity (sound, no-overflow guarded): for a fixed literal - -- constant c, x <= y => c*x <= c*y. Because c is concrete we compute the - -- exact no-overflow bound floor((2^256-1)/c) at encode time, so the guard is - -- a single comparison against a constant (cheap) rather than a 512-bit - -- multiply. c*x stays a native bvmul; this lemma simply lets the solver - -- order two such products without bit-blasting the multiply. - mkConstMulMono (c, x, y) = do - xe <- enc x; ye <- enc y - let cbv = wordAsBV c - cx = "(bvmul" `sp` cbv `sp` xe <> ")" - cy = "(bvmul" `sp` cbv `sp` ye <> ")" - bnd = wordAsBV ((maxBound :: W256) `div` c) -- largest x with c*x < 2^256 - pure $ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" - <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" - - -- const cancellation (sound, no-overflow guarded): a product c1*x divided by - -- a literal c2 that divides c1 collapses to (c1/c2)*x. The multiply by a - -- constant stays a native bvmul but the divide is abstracted (uninterpreted), - -- so without this the precision-scaling wrapper c1*x/c2 (e.g. amount*1e18/1e18 - -- in _getUsdsValue, or amount*1e18/1e6 in _getUsdcValue) is not provably its - -- closed form. `a` is the dividend expr (c1*x) so the abst_evm_bvudiv term - -- matches the prop exactly; c2 | c1 makes c1/c2 exact, and the no-overflow - -- bound floor((2^256-1)/c1) is computed at encode time (one comparison). - mkConstCancel (a, c1, c2, x) = do - ae <- enc a; xe <- enc x - let c2bv = wordAsBV c2 - k = c1 `div` c2 -- exact, since c2 | c1 - rhs = if k == 1 then xe else "(bvmul" `sp` wordAsBV k `sp` xe <> ")" - dv = "(abst_evm_bvudiv" `sp` ae `sp` c2bv <> ")" - bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 - pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" - - -- nested-division collapse (sound, floor identity): (A/c1)/c2 == A/(c1*c2) for - -- literal c1,c2 with c1*c2 < 2^256. Lets the solver simplify chained constant - -- divisions such as x*rate/1e9/1e18 to x*rate/1e27. No operand bound needed. - mkNestedDiv (innerA, c1, c2) = do - ae <- enc innerA - let inner = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c1 <> ")" - outer = "(abst_evm_bvudiv" `sp` inner `sp` wordAsBV c2 <> ")" - collapsed = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV (c1 * c2) <> ")" - pure $ SMTCommand $ "(assert (=" `sp` outer `sp` collapsed <> "))" - - -- fraction-reduce (sound, no-overflow guarded): a product c1*x divided by a - -- literal c2 that c1 divides collapses to x/(c2/c1). The mirror of const - -- cancellation: const-cancel needs c2 | c1 (multiply by large, divide by - -- small, e.g. x*1e18/1e6 == x*1e12); this needs c1 | c2 (multiply by small, - -- divide by large, e.g. x*1e6/1e18 == x/1e12 — the convert-to-usdc precision - -- step). Sound because, under the no-overflow guard, c1*x is exact and - -- floor(c1*x / (c1*k)) = floor(x/k). `a` is the dividend (c1*x) so the - -- abst_evm_bvudiv term matches the prop; c1 | c2 makes c2/c1 exact and the - -- bound floor((2^256-1)/c1) is computed at encode time (one comparison). - mkFracReduce (a, c1, c2, x) = do - ae <- enc a; xe <- enc x - let k = c2 `div` c1 -- exact and >= 2, since c1 | c2 and c2 /= c1 - dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x)/c2 - rhs = "(abst_evm_bvudiv" `sp` xe `sp` wordAsBV k <> ")" -- x/(c2/c1) - bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 - pure $ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" - - -- ceilDiv-cancel (sound, guarded): pins the abstracted divide inside - -- OpenZeppelin's Math.ceilDiv(c1*x, c2) = (c1*x - 1)/c2 + 1 (the c1*x != 0 - -- branch). `a` is the (c1*x - 1) dividend. When c2 | c1, write c1 = c2*m: then - -- c1*x = c2*(m*x), so floor((c2*m*x - 1)/c2) = m*x - 1 (for m*x >= 1). Adding - -- the ceilDiv's +1 gives m*x = (c1/c2)*x exactly. Guarded by x >= 1 (the ceilDiv - -- ITE handles x==0 on its own branch) and the encode-time no-overflow bound - -- floor((2^256-1)/c1). This is the ceilDiv sibling of const-cancel; it - -- discharges the round-up swap-out closed forms (e.g. previewSwapExactOut - -- usds->usdc == amountOut*1e12). - mkCeilDivCancel (a, c1, c2, x) = do - ae <- enc a; xe <- enc x - let m = c1 `div` c2 -- exact, since c2 | c1 - mx = if m == 1 then xe else "(bvmul" `sp` wordAsBV m `sp` xe <> ")" - dv = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c2 <> ")" -- (c1*x - 1)/c2 - rhs = "(bvsub" `sp` mx `sp` one <> ")" -- (c1/c2)*x - 1 - bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 - pure $ SMTCommand $ "(assert (=> (and (bvuge" `sp` xe `sp` one <> ")" - <> " (bvule" `sp` xe `sp` bnd <> ")) (=" `sp` dv `sp` rhs <> ")))" - - -- scaled-product telescoping (sound, no-overflow guarded). For products sharing - -- factor a whose other factors differ by a literal k with c | k: - -- floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c). - -- Sound because a*b = a*(b-k) + a*k and a*k is an exact multiple of c (c | k), so - -- removing it shifts the floor by exactly a*(k/c). This is the only lemma pinning - -- the EXACT difference of two distinct abstract products; it discharges - -- value-change accounting like susds*rate/1e27 - susds == susds*(rate-1e27)/1e27. - -- Guarded by no-overflow on a*b (so a*(b-k), a*k all fit) and b >= k (so b-k is a - -- true difference, no wraparound). - mkTelescope (a, b, k, c) = do - ae <- enc a; be <- enc b - let m = k `div` c -- exact, since c | k - cbv = wordAsBV c - full = "(abst_evm_bvmul" `sp` ae `sp` be <> ")" - stepped = "(abst_evm_bvmul" `sp` ae `sp` ("(bvsub" `sp` be `sp` wordAsBV k <> ")") <> ")" - dFull = "(abst_evm_bvudiv" `sp` full `sp` cbv <> ")" - dStep = "(abst_evm_bvudiv" `sp` stepped `sp` cbv <> ")" - coeff = if m == 1 then ae else "(bvmul" `sp` wordAsBV m `sp` ae <> ")" - rhs = "(bvadd" `sp` dStep `sp` coeff <> ")" - pure $ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow ae be - <> " (bvuge" `sp` be `sp` wordAsBV k <> ")) (=" `sp` dFull `sp` rhs <> ")))" - - -- recognise multiplication by a non-trivial literal constant: c*x or x*c. - asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) - asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) - asConstMul (T.Mul x (Lit c)) | notLit x, c /= 0, c /= 1 = Just (c, x) - asConstMul _ = Nothing - - -- div monotonicity in the dividend (sound unconditionally): for a common - -- divisor z, x <= y => floor(x/z) <= floor(y/z). - mkDivMono (x, y, z) = do - xenc <- enc x; yenc <- enc y; zenc <- enc z - let dxz = "(abst_evm_bvudiv" `sp` xenc `sp` zenc <> ")" - dyz = "(abst_evm_bvudiv" `sp` yenc `sp` zenc <> ")" - pure [ SMTCommand $ "(assert (=> (bvule" `sp` xenc `sp` yenc <> ") (bvule" `sp` dxz `sp` dyz <> ")))" ] - -- recognise an abstract symbolic*symbolic product - asMul :: Expr EWord -> Maybe (Expr EWord, Expr EWord) - asMul (T.Mul x y) | notLit x, notLit y = Just (x, y) - asMul _ = Nothing - notLit (Lit _) = False - notLit _ = True - - -- mulDiv bound (sound under no-overflow of x*z): if one factor is <= the - -- divisor then dividing the product by it cannot exceed the other factor. - -- y <= z => (x*y)/z <= x x <= z => (x*y)/z <= y - -- `a` is the original product expr, so the div term matches the prop exactly. - mkMulDivBound (a, x, y, z) = do - ae <- enc a; xe <- enc x; ye <- enc y; ze <- enc z - let dv = "(abst_evm_bvudiv" `sp` ae `sp` ze <> ")" - pure [ SMTCommand $ "(assert (=> (and (bvule" `sp` ye `sp` ze <> ")" `sp` mulNoOverflow xe ze - <> ") (bvule" `sp` dv `sp` xe <> ")))" - , SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` ze <> ")" `sp` mulNoOverflow ye ze - <> ") (bvule" `sp` dv `sp` ye <> ")))" ] - -- quotient*divisor <= dividend - mkDivMulLink (a, b) = do - aenc <- enc a - benc <- enc b - let q = "(abst_evm_bvudiv" `sp` aenc `sp` benc <> ")" - qb = "(abst_evm_bvmul" `sp` q `sp` benc <> ")" - pure $ SMTCommand $ "(assert (bvule" `sp` qb `sp` aenc <> "))" - -- sound identities pinning the otherwise-free UF on 0/1 operands: - -- x*0 = 0, 0*y = 0, x*1 = x, 1*y = y - mkMulIdentities (a, b) = do - aenc <- enc a - benc <- enc b - let m = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" - pure [ SMTCommand $ "(assert (=> (=" `sp` aenc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" - , SMTCommand $ "(assert (=> (=" `sp` benc `sp` zero <> ") (=" `sp` m `sp` zero <> ")))" - , SMTCommand $ "(assert (=> (=" `sp` aenc `sp` one <> ") (=" `sp` m `sp` benc <> ")))" - , SMTCommand $ "(assert (=> (=" `sp` benc `sp` one <> ") (=" `sp` m `sp` aenc <> ")))" - ] - -- | Encode div/mod operations using abs values, shift-bounds, and congruence (no bvudiv). -divModEncoding :: (Expr EWord -> Err Builder) -> [Prop] -> Err [SMTEntry] +divModEncoding :: Enc -> [Prop] -> Err [SMTEntry] divModEncoding enc props = do let allDivMods = nubOrd $ concatMap (foldProp collectDivMods []) props if null allDivMods then pure [] @@ -583,42 +171,3 @@ mkCongruenceLinks indexedGroups = in [ SMTCommand $ "(assert (=> " <> "(and (=" `sp` absoluteAi `sp` absoluteAj <> ") (=" `sp` abosluteBi `sp` absoluteBj <> "))" <> "(=" `sp` absoluteResI `sp` absoluteRedJ <> ")))" ] - --- | (ite (= divisor 0) 0 result) -smtZeroGuard :: Builder -> Builder -> Builder -smtZeroGuard divisor nonZeroResult = - "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" - --- | |x| as SMT: ite(x >= 0, x, 0 - x). -smtAbsolute :: Builder -> Builder -smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" - --- | -x as SMT. -smtNeg :: Builder -> Builder -smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" - --- | True if a and b have the same sign -smtSameSign :: Builder -> Builder -> Builder -smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" - --- | x >= 0. -smtIsNonNeg :: Builder -> Builder -smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" - --- | sdiv(a,b) = ITE(b = 0, 0, --- ITE(sign(a) = sign(b), udiv(|a|,|b|), --- -udiv(|a|,|b|))) -signedFromUnsignedDiv :: Builder -> Builder -> Builder -> Builder -signedFromUnsignedDiv aenc benc udivResult = - smtZeroGuard benc $ - "(ite" `sp` (smtSameSign aenc benc) `sp` - udivResult `sp` (smtNeg udivResult) <> ")" - --- | smod(a,b) = ITE(b = 0, 0, --- ITE(a ≥ 0, urem(|a|,|b|), --- -urem(|a|,|b|))) -signedFromUnsignedMod :: Builder -> Builder -> Builder -> Builder -signedFromUnsignedMod aenc benc uremResult = - smtZeroGuard benc $ - "(ite" `sp` (smtIsNonNeg aenc) `sp` - uremResult `sp` (smtNeg uremResult) <> ")" From 81a6588aee60d86817314d806ce6f554f624744f Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 22 Jun 2026 14:32:31 +0200 Subject: [PATCH 147/150] Add uint256 abstract mul regression --- test/test.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/test/test.hs b/test/test.hs index e032b1cd6..c68561456 100644 --- a/test/test.hs +++ b/test/test.hs @@ -1430,6 +1430,23 @@ tests = testGroup "hevm" (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts assertBoolM "Must be Unknown, never QED (unsound proof avoided)" (not (any isCex res) && any isUnknown res) + , testAbstractArith "mul-uint256-monotone-not-unsound" $ do + -- Same lemma shape as the uint128-bounded proof, but with full-width + -- uint256 inputs. The 128-bit no-overflow guard must not be assumed from + -- the type alone, so this can only be Unknown under abstract mul: never a + -- bogus QED and never a trusted counterexample from the uninterpreted UF. + Just c <- solcRuntime "C" [i| + contract C { + function prove_mul_uint256_monotone(uint256 a1, uint256 a2, uint256 k) external pure { + require(a1 <= a2); + uint256 p1; uint256 p2; + assembly { p1 := mul(a1, k) p2 := mul(a2, k) } + assert(p1 <= p2); + } + } |] + (_, res) <- withShortBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts + assertBoolM "uint256 abstract mul must be Unknown, never QED or Cex" + (not (null res) && all isUnknown res) , testAbstractArith "roundtrip-no-inflation" $ do -- The cross-divisor round-trip convertToAssetValue(convertToShares(x)), -- i.e. ((x*ts)/ta)*ta/ts <= x, is the stateless core of inflation-attack @@ -4597,4 +4614,3 @@ expectedConcVals nm val = case val of _ -> internalError $ "unsupported Abi type " <> show nm <> " val: " <> show val <> " val type: " <> showAlter val where mkWord = word . encodeAbiValue - From d5ae200f4ae1e738f2e326487157d957b4ca7786 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 24 Jun 2026 11:20:18 +0200 Subject: [PATCH 148/150] reduced code --- src/EVM/SMT/AbstractBase.hs | 4 -- src/EVM/Solvers.hs | 108 ++++++++++++++---------------------- 2 files changed, 43 insertions(+), 69 deletions(-) diff --git a/src/EVM/SMT/AbstractBase.hs b/src/EVM/SMT/AbstractBase.hs index 1bac9907a..e238b55cf 100644 --- a/src/EVM/SMT/AbstractBase.hs +++ b/src/EVM/SMT/AbstractBase.hs @@ -28,7 +28,6 @@ module EVM.SMT.AbstractBase , sp , zero , one - , maxU128 , mulNoOverflow , wordAsBV -- * Div/mod taxonomy @@ -50,9 +49,6 @@ module EVM.SMT.AbstractBase -- * Signed reconstruction helpers , smtZeroGuard , smtAbsolute - , smtNeg - , smtSameSign - , smtIsNonNeg , signedFromUnsignedDiv , signedFromUnsignedMod -- * Abstract-term saturation diff --git a/src/EVM/Solvers.hs b/src/EVM/Solvers.hs index 0d598c17e..11e9a555e 100644 --- a/src/EVM/Solvers.hs +++ b/src/EVM/Solvers.hs @@ -22,7 +22,7 @@ import Prelude hiding (LT, GT) import GHC.Natural import GHC.IO.Handle (Handle, hFlush, hSetBuffering, BufferMode(..)) import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan) -import Control.Concurrent (forkIO, killThread, myThreadId) +import Control.Concurrent (forkIO, killThread) import Control.Concurrent.QSem (QSem, newQSem, waitQSem, signalQSem) import Control.Exception (bracket, bracket_, try, IOException) import Control.Concurrent.STM (writeTChan, newTChan, TChan, tryReadTChan, atomically) @@ -52,7 +52,6 @@ import EVM.Expr (simplifyProps) import EVM.Keccak qualified as Keccak (concreteKeccaks) import EVM.SMT import EVM.Types -import Debug.Trace (traceM) -- In megabytes, i.e. 1GB @@ -104,8 +103,8 @@ data MultiData = MultiData data SingleData = SingleData SMT2 - (Maybe [Prop]) -- Props that generated the SMT2, if available. Used for caching - (Chan SMTResult) -- result channel + (Maybe [Prop]) + (Chan SMTResult) -- result channel -- returns True if a is a superset of any of the sets in bs supersetAny :: Set Prop -> [Set Prop] -> Bool @@ -135,25 +134,26 @@ checkSatWithProps sg props = do if isLeft smt2 then pure $ Error $ getError smt2 else liftIO $ checkSat sg (Just props) smt2 else liftIO $ do - -- Two-phase solving with abstraction+refinement + -- Two-phase solving: assert the abstract (uninterpreted) div/mod/mul plus + -- the sound lemmas, then append the div/mod ground truth as refinement. let smt2Abstract = assertPropsAbstract conf allProps let refinement = divModGroundTruth (exprToSMTWith AbstractDivMod) allProps if isLeft smt2Abstract then pure $ Error $ getError smt2Abstract else if isLeft refinement then pure $ Error $ getError refinement else do - let x = (getNonError smt2Abstract) <> (SMT2 (SMTScript (getNonError refinement)) mempty mempty) + let x = getNonError smt2Abstract <> SMT2 (SMTScript (getNonError refinement)) mempty mempty res <- checkSat sg (Just props) (Right x) -- SOUNDNESS: multiplication is abstracted as an uninterpreted function -- with no ground truth, so a satisfying model may use product values - -- that do not match real multiplication. A QED stays sound (the lemmas - -- over-approximate real arithmetic), but a counterexample may be - -- spurious and must never be reported as a real violation; with nothing - -- to validate it against, the only sound output is Unknown. + -- inconsistent with real multiplication. A QED stays sound (the lemmas + -- over-approximate), but a counterexample may be spurious, so downgrade + -- it to Unknown. pure $ case res of Cex _ | hasAbstractMul allProps -> Unknown "counterexample unsound under multiplication abstraction (abst_evm_bvmul is uninterpreted)" _ -> res +-- When props is Nothing, the cache will not be filled or used checkSat :: SolverGroup -> Maybe [Prop] -> Err SMT2 -> IO SMTResult checkSat (SolverGroup taskq) props smt2 = do if isLeft smt2 then pure $ Error $ getError smt2 @@ -165,7 +165,6 @@ checkSat (SolverGroup taskq) props smt2 = do -- collect result readChan resChan - writeSMT2File :: SMT2 -> FilePath -> String -> IO () writeSMT2File smt2 path postfix = do let content = formatSMT2 smt2 <> "\n\n(check-sat)" @@ -273,7 +272,7 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - out <- sendScript conf inst cmds + out <- sendScript inst cmds case out of Left err -> do when conf.debug $ putStrLn $ "Issue while writing SMT to solver (maybe it got killed)?: " <> (T.unpack err) @@ -285,8 +284,7 @@ getMultiSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) multiSol r sem f ) ) -getOneSol :: forall m . (MonadIO m, ReadConfig m) => - Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () +getOneSol :: (MonadIO m, ReadConfig m) => Solver -> Maybe Natural -> Natural -> SMT2 -> Maybe [Prop] -> Chan SMTResult -> TChan CacheEntry -> QSem -> Int -> m () -- the empty solver answers every query "unknown" without spawning a process getOneSol EmptySolver _ _ _ _ r _ _ _ = liftIO $ writeChan r (Unknown "Result unknown by SMT solver") @@ -296,58 +294,40 @@ getOneSol solver timeout maxMemory smt2@(SMT2 cmds cexvars _) props r cacheq sem (waitQSem sem) (signalQSem sem) (do + when (conf.dumpQueries) $ writeSMT2File smt2 "." (show fileCounter) bracket (spawnSolver solver timeout maxMemory) (stopSolver) (\inst -> do - when (conf.dumpQueries) $ writeSMT2File smt2 "-abst." (show fileCounter) - ret <- sendAndCheck conf inst cmds $ \res -> do - case res of - "unsat" -> do - when conf.debug $ logWithTid "Query is UNSAT." - dealWithUnsat - "sat" -> dealWithModel conf inst - "timeout" -> pure $ Unknown "Abstract query timeout" - "unknown" -> dealWithUnknown conf - _ -> dealWithIssue conf res - writeChan r ret + out <- sendScript inst cmds + case out of + Left e -> writeChan r (Unknown $ "Issue while writing SMT to solver (maybe it got killed?): " <> T.unpack e) + Right () -> do + sat <- sendCommand inst $ SMTCommand "(check-sat)" + res <- do + case sat of + "unsat" -> do + when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) + pure Qed + "timeout" -> pure $ Unknown "Result timeout by SMT solver" + "unknown" -> do + dumpUnsolved smt2 fileCounter conf.dumpUnsolved + pure $ Unknown "Result unknown by SMT solver" + "sat" -> do + mmodel <- getModel inst cexvars + case mmodel of + Just model -> pure $ Cex model + Nothing -> pure $ Unknown "Solver died while extracting model" + _ -> let supportIssue = + ("does not yet support" `T.isInfixOf` sat) + || ("unsupported" `T.isInfixOf` sat) + || ("not support" `T.isInfixOf` sat) + in case supportIssue of + True -> pure . Error $ "SMT solver reported unsupported operation: " <> T.unpack sat + False -> pure . Unknown $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat + writeChan r res ) ) - where - sendAndCheck conf inst dat cont = do - out <- liftIO $ sendScript conf inst dat - case out of - Left e -> unknown conf $ "Issue while writing SMT to solver (maybe it got killed)?: " <> T.unpack e - Right () -> do - res <- liftIO $ sendCommand inst $ SMTCommand "(check-sat)" - cont res - dealWithUnsat = do - when (isJust props) $ liftIO . atomically $ writeTChan cacheq (CacheEntry (fromJust props)) - pure Qed - dealWithUnknown conf = do - dumpUnsolved smt2 fileCounter conf.dumpUnsolved - unknown conf "SMT solver returned unknown (maybe it got killed?)" - dealWithModel conf inst = getModel inst cexvars >>= \case - Just model -> pure $ Cex model - Nothing -> unknown conf "Solver died while extracting model." - dealWithIssue conf sat = do - let supportIssue = ("does not yet support" `T.isInfixOf` sat) - || ("unsupported" `T.isInfixOf` sat) - || ("not support" `T.isInfixOf` sat) - case supportIssue of - True -> do - let txt = "SMT solver reported unsupported operation: " <> T.unpack sat - when conf.debug $ logWithTid txt - pure $ Error txt - False -> unknown conf $ "Unable to parse SMT solver output (maybe it got killed?): " <> T.unpack sat - unknown conf msg = do - when conf.debug $ logWithTid msg - pure $ Unknown msg - -logWithTid :: MonadIO m => String -> m () -logWithTid msg = do - tid <- liftIO myThreadId - traceM $ "[" <> show tid <> "] " <> msg dumpUnsolved :: SMT2 -> Int -> Maybe FilePath -> IO () dumpUnsolved fullSmt fileCounter dump = do @@ -537,8 +517,8 @@ stopSolver :: SolverInstance -> IO () stopSolver (SolverInstance _ stdin stdout process) = cleanupProcess (Just stdin, Just stdout, Nothing, process) -- | Sends a list of commands to the solver. Returns the first error, if there was one. -sendScript :: Config -> SolverInstance -> SMTScript -> IO (Either Text ()) -sendScript conf solver (SMTScript entries) = do +sendScript :: SolverInstance -> SMTScript -> IO (Either Text ()) +sendScript solver (SMTScript entries) = do go entries where go [] = pure $ Right () @@ -547,9 +527,7 @@ sendScript conf solver (SMTScript entries) = do out <- sendCommand solver c case out of "success" -> go cs - e -> do - when conf.debug $ putStrLn $ "Error while writing SMT to solver: " <> T.unpack e <> " -- Command was: " <> T.unpack (toLazyText command) - pure $ Left $ "Solver returned an error:\n" <> e <> "\nwhile sending the following command: " <> toLazyText command + e -> pure $ Left $ "Solver returned an error:\n" <> e <> "\nwhile sending the following command: " <> toLazyText command -- | Returns Nothing if the solver died or returned an error checkCommand :: SolverInstance -> SMTEntry -> IO (Maybe ()) From 6349a3a98a400f9b5feae86a0001733b659b1c8b Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Wed, 24 Jun 2026 13:44:11 +0200 Subject: [PATCH 149/150] reduced code --- src/EVM/SMT/AbstractBase.hs | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/src/EVM/SMT/AbstractBase.hs b/src/EVM/SMT/AbstractBase.hs index e238b55cf..74550cafb 100644 --- a/src/EVM/SMT/AbstractBase.hs +++ b/src/EVM/SMT/AbstractBase.hs @@ -165,23 +165,12 @@ collectDivMods = \case _ -> [] -- | Collect symbolic*symbolic multiplications (neither operand a literal). --- Concrete factors (incl. 0/1/power-of-two) are handled natively by the --- simplifier, so only genuinely symbolic products are abstracted. collectMuls :: Expr a -> [(Expr EWord, Expr EWord)] -collectMuls = \case - T.Mul a b | notLit a, notLit b -> [(a, b)] - _ -> [] - --- | Collect multiplications by a literal constant, @(c, x)@ for @c*x@ (either --- operand order), excluding the trivial constants 0 and 1. These stay native --- @bvmul@ (the value is concrete), but a symbolic operand times a large --- constant is still costly to bit-blast and compare; const-mul monotonicity --- lets the solver order such products without doing so. +collectMuls = maybe [] pure . asMul + +-- | Collect multiplications by a non-trivial literal constant @(c, x)@. collectConstMuls :: Expr a -> [(W256, Expr EWord)] -collectConstMuls = \case - T.Mul (Lit c) x | notLit x, c /= 0, c /= 1 -> [(c, x)] - T.Mul x (Lit c) | notLit x, c /= 0, c /= 1 -> [(c, x)] - _ -> [] +collectConstMuls = maybe [] pure . asConstMul -- | True if any prop contains a symbolic*symbolic multiplication, i.e. the -- multiplication abstraction is in play. Because abst_evm_bvmul is left @@ -191,13 +180,17 @@ collectConstMuls = \case hasAbstractMul :: [Prop] -> Bool hasAbstractMul props = not $ null $ concatMap (foldProp collectMuls []) props --- | Recognise an abstract symbolic*symbolic product. -asMul :: Expr EWord -> Maybe (Expr EWord, Expr EWord) +-- | Recognise an abstract symbolic*symbolic product (neither operand a literal). +-- Concrete factors (incl. 0/1/power-of-two) are handled natively by the +-- simplifier, so only genuinely symbolic products are abstracted. +asMul :: Expr a -> Maybe (Expr EWord, Expr EWord) asMul (T.Mul x y) | notLit x, notLit y = Just (x, y) asMul _ = Nothing --- | Recognise multiplication by a non-trivial literal constant: c*x or x*c. -asConstMul :: Expr EWord -> Maybe (W256, Expr EWord) +-- | Recognise multiplication by a non-trivial literal constant: c*x or x*c +-- (excluding 0 and 1). These stay native @bvmul@, but const-mul monotonicity +-- lets the solver order such products without bit-blasting the multiply. +asConstMul :: Expr a -> Maybe (W256, Expr EWord) asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) asConstMul (T.Mul x (Lit c)) | notLit x, c /= 0, c /= 1 = Just (c, x) asConstMul _ = Nothing From cec6e3813d59eeb733dd5c3d0bf3d2bca11c856b Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Mon, 20 Jul 2026 18:36:25 +0200 Subject: [PATCH 150/150] smt: dedupe builder helpers into SMT.SMTLIB, trim abstraction comments Review feedback on #1075: sp/zero/one/wordAsBV now live once in EVM.SMT.SMTLIB (re-exported by EVM.SMT, so downstream imports are unchanged); the abstract UF declarations sit under a single comment; obvious comments removed and wordy ones tightened across AbstractBase, AbstractLemmas and DivModEncoding, keeping the per-lemma soundness notes. Co-Authored-By: Claude Fable 5 --- src/EVM/SMT.hs | 18 +---- src/EVM/SMT/AbstractBase.hs | 142 ++++++++++------------------------ src/EVM/SMT/AbstractLemmas.hs | 118 ++++++++++++---------------- src/EVM/SMT/DivModEncoding.hs | 1 + src/EVM/SMT/SMTLIB.hs | 20 ++++- 5 files changed, 111 insertions(+), 188 deletions(-) diff --git a/src/EVM/SMT.hs b/src/EVM/SMT.hs index 3031b1eda..3ad0e7a9c 100644 --- a/src/EVM/SMT.hs +++ b/src/EVM/SMT.hs @@ -18,9 +18,6 @@ module EVM.SMT decompose, exprToSMTWith, encodeConcreteStore, - sp, - zero, - one, propToSMTWith, parseVar, parseEAddr, @@ -30,8 +27,7 @@ module EVM.SMT getVars, queryMaxReads, getBufs, - getStore, - wordAsBV + getStore ) where import Prelude hiding (LT, GT, Foldable(..)) @@ -431,9 +427,6 @@ assertSMTWith enc p = do p' <- propToSMTWith enc p pure $ SMTCommand ("(assert " <> p' <> ")") -wordAsBV :: forall a. Integral a => a -> Builder -wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" - byteAsBV :: Word8 -> Builder byteAsBV b = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal b <> " 8)" @@ -646,15 +639,6 @@ exprToSMTWith divEnc = \case ConcreteDivMod -> op2 "bvmul" a b AbstractDivMod -> op2 "abst_evm_bvmul" a b -sp :: Builder -> Builder -> Builder -a `sp` b = a <> " " <> b - -zero :: Builder -zero = "(_ bv0 256)" - -one :: Builder -one = "(_ bv1 256)" - propToSMTWith :: DivModEncoding -> Prop -> Err Builder propToSMTWith divEnc = \case PEq a b -> op2 "=" a b diff --git a/src/EVM/SMT/AbstractBase.hs b/src/EVM/SMT/AbstractBase.hs index 74550cafb..b800f67b1 100644 --- a/src/EVM/SMT/AbstractBase.hs +++ b/src/EVM/SMT/AbstractBase.hs @@ -2,34 +2,17 @@ Module: EVM.SMT.AbstractBase Description: Shared vocabulary for the abstract arithmetic encoding. - This is the base layer both 'EVM.SMT.AbstractLemmas' (the lemma catalogue) and - 'EVM.SMT.DivModEncoding' (the orchestration + div/mod ground truth) build on. It - holds, with no dependency on either of them: - - * the SMT-LIB builder primitives ('sp', 'zero', 'mulNoOverflow', 'wordAsBV', …) - and signed helpers ('smtAbsolute', 'signedFromUnsignedDiv', …); - * the div/mod operation taxonomy ('DivModKind' and friends); - * the term collectors ('collectDivMods', 'collectMuls', 'collectConstMuls') and - shape matchers ('asMul', 'asConstMul'); - * the abstract-term /saturation/ ('saturate'), which closes the set of div/mul - terms the lemmas range over (synthetic divisions, nested-division collapse, - div-mul link products) into an 'AbstractCtx'. - - Keeping this separate breaks the import cycle: @DivModEncoding@ imports - @AbstractLemmas@, so the primitives the lemmas need cannot live in - @DivModEncoding@. + Base layer for 'EVM.SMT.AbstractLemmas' (the lemma catalogue) and + 'EVM.SMT.DivModEncoding' (orchestration + div/mod ground truth): the div/mod + taxonomy, term collectors/matchers, signed-reconstruction helpers, and the + term /saturation/ ('saturate') that closes the set of div/mul terms the + lemmas range over. Lives below both so neither needs to import the other for + these definitions. -} module EVM.SMT.AbstractBase - ( -- * Encoder alias - Enc - -- * UF declarations + ( Enc , divModAbstractDecls - -- * SMT-LIB builder primitives - , sp - , zero - , one , mulNoOverflow - , wordAsBV -- * Div/mod taxonomy , DivModKind(..) , DivModOp @@ -58,8 +41,8 @@ module EVM.SMT.AbstractBase import Data.Containers.ListUtils (nubOrd) import Data.Text.Lazy.Builder -import qualified Data.Text.Lazy.Builder.Int +import EVM.SMT.SMTLIB (sp, zero) import EVM.SMT.Types import EVM.Traversals import EVM.Types (Prop(..), EType(EWord), Err, W256, Expr, Expr(Lit)) @@ -68,58 +51,33 @@ import EVM.Types qualified as T -- | The expression-to-SMT encoder threaded through every emitter. type Enc = Expr EWord -> Err Builder --- | Uninterpreted function declarations for abstract div/mod. +-- | Uninterpreted-function declarations standing in for div/mod/mul. The +-- div/mod UFs are refined against the native ops in phase two; abst_evm_bvmul +-- is kept fully uninterpreted (no ground truth), constrained only by the +-- lemmas in "EVM.SMT.AbstractLemmas". divModAbstractDecls :: [SMTEntry] divModAbstractDecls = - [ SMTComment "abstract division/modulo (uninterpreted functions)" + [ SMTComment "abstract division/modulo/multiplication (uninterpreted functions; mul has no ground truth)" , SMTCommand "(declare-fun abst_evm_bvsdiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvsrem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvudiv ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" , SMTCommand "(declare-fun abst_evm_bvurem ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" - , SMTComment "abstract multiplication (kept fully uninterpreted: no ground truth)" , SMTCommand "(declare-fun abst_evm_bvmul ((_ BitVec 256) (_ BitVec 256)) (_ BitVec 256))" ] --- | Local helper for trivial SMT constructs -sp :: Builder -> Builder -> Builder -a `sp` b = a <> " " <> b - -zero :: Builder -zero = "(_ bv0 256)" - -one :: Builder -one = "(_ bv1 256)" - --- | Maximum value representable in 128 unsigned bits (2^128 - 1). -maxU128 :: Builder -maxU128 = "(_ bv340282366920938463463374607431768211455 256)" - -- | A /sufficient/ condition for x*y not to overflow 256 bits: both operands --- fit in 128 bits, so their product fits in 256 (since (2^128-1)^2 < 2^256). --- --- We deliberately use this cheap sufficient condition rather than the exact --- no-overflow predicate @extract 511 256 (bvmul (zext x) (zext y)) = 0@. The --- exact form forces the solver to bit-blast a full 512-bit multiply for every --- lemma instance, which is the dominant cost and makes queries with large --- operands (~2^100) time out. Two comparisons against a constant are --- essentially free by contrast. --- --- This is the same width-budget idea Halmos uses. It is SOUND: when the guard --- holds there is genuinely no overflow, so any lemma it gates remains valid. --- The cost is completeness — a product of operands above 2^128 that happens not --- to overflow will not receive the lemma. Callers bound operands (e.g. a --- Solidity @require(x < 2**128)@) so the guard discharges cheaply. +-- fit in 128 bits. Deliberately cheaper than the exact predicate +-- @extract 511 256 (bvmul (zext x) (zext y)) = 0@, which forces a 512-bit +-- multiply per lemma instance and times out on large operands. SOUND: when the +-- guard holds there is genuinely no overflow; the cost is completeness for +-- operands above 2^128 (callers bound operands, e.g. @require(x < 2**128)@). mulNoOverflow :: Builder -> Builder -> Builder mulNoOverflow x y = "(and (bvule " <> x <> " " <> maxU128 <> ") (bvule " <> y <> " " <> maxU128 <> "))" + where maxU128 = "(_ bv340282366920938463463374607431768211455 256)" -wordAsBV :: forall a. Integral a => a -> Builder -wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" - --- | The four EVM division/modulo operations. The @S@-variants are signed --- (SDiv/SMod), the @U@-variants unsigned (Div/Mod). Signed and unsigned ops --- are kept in separate groups so the signed absolute-value/sign-reconstruction --- machinery is never applied to unsigned operands (and vice versa). +-- | The four EVM division/modulo operations, kept in signed/unsigned groups so +-- the sign-reconstruction machinery is never applied to unsigned operands. data DivModKind = IsSDiv | IsSMod | IsUDiv | IsUMod deriving (Eq, Ord) @@ -155,7 +113,6 @@ concFnName IsUMod = "bvurem" abstractKey :: DivModOp -> AbstractKey abstractKey (kind, a, b) = AbstractKey a b kind --- | Collect all div/mod operations from an expression. collectDivMods :: Expr a -> [DivModOp] collectDivMods = \case T.SDiv a b -> [(IsSDiv, a, b)] @@ -164,32 +121,27 @@ collectDivMods = \case T.Mod a b -> [(IsUMod, a, b)] _ -> [] --- | Collect symbolic*symbolic multiplications (neither operand a literal). collectMuls :: Expr a -> [(Expr EWord, Expr EWord)] collectMuls = maybe [] pure . asMul --- | Collect multiplications by a non-trivial literal constant @(c, x)@. collectConstMuls :: Expr a -> [(W256, Expr EWord)] collectConstMuls = maybe [] pure . asConstMul --- | True if any prop contains a symbolic*symbolic multiplication, i.e. the --- multiplication abstraction is in play. Because abst_evm_bvmul is left --- uninterpreted (no ground truth), a satisfying model may assign it values --- inconsistent with real multiplication, so a counterexample cannot be --- trusted; callers must downgrade SAT results to Unknown to stay SOUND. +-- | True if any prop contains a symbolic*symbolic multiplication. Because +-- abst_evm_bvmul has no ground truth, a satisfying model may assign it values +-- inconsistent with real multiplication; callers must downgrade SAT to Unknown +-- to stay sound. (UNSAT — the proof direction — is unaffected.) hasAbstractMul :: [Prop] -> Bool hasAbstractMul props = not $ null $ concatMap (foldProp collectMuls []) props --- | Recognise an abstract symbolic*symbolic product (neither operand a literal). --- Concrete factors (incl. 0/1/power-of-two) are handled natively by the --- simplifier, so only genuinely symbolic products are abstracted. +-- | An abstracted symbolic*symbolic product. Products with a concrete factor +-- are handled natively, so only genuinely symbolic products are abstracted. asMul :: Expr a -> Maybe (Expr EWord, Expr EWord) asMul (T.Mul x y) | notLit x, notLit y = Just (x, y) asMul _ = Nothing --- | Recognise multiplication by a non-trivial literal constant: c*x or x*c --- (excluding 0 and 1). These stay native @bvmul@, but const-mul monotonicity --- lets the solver order such products without bit-blasting the multiply. +-- | A product by a non-trivial literal constant: c*x or x*c (excluding 0, 1). +-- These stay native @bvmul@; the const-mul lemmas range over them. asConstMul :: Expr a -> Maybe (W256, Expr EWord) asConstMul (T.Mul (Lit c) x) | notLit x, c /= 0, c /= 1 = Just (c, x) asConstMul (T.Mul x (Lit c)) | notLit x, c /= 0, c /= 1 = Just (c, x) @@ -199,24 +151,20 @@ notLit :: Expr a -> Bool notLit (Lit _) = False notLit _ = True --- | (ite (= divisor 0) 0 result) +-- | (ite (= divisor 0) 0 result) — the EVM's x/0 = 0 convention. smtZeroGuard :: Builder -> Builder -> Builder smtZeroGuard divisor nonZeroResult = "(ite (=" `sp` divisor `sp` zero <> ")" `sp` zero `sp` nonZeroResult <> ")" --- | |x| as SMT: ite(x >= 0, x, 0 - x). smtAbsolute :: Builder -> Builder smtAbsolute x = "(ite (bvsge" `sp` x `sp` zero <> ")" `sp` x `sp` "(bvsub" `sp` zero `sp` x <> "))" --- | -x as SMT. smtNeg :: Builder -> Builder smtNeg x = "(bvsub" `sp` zero `sp` x <> ")" --- | True if a and b have the same sign smtSameSign :: Builder -> Builder -> Builder smtSameSign a b = "(=" `sp` "(bvslt" `sp` a `sp` zero <> ")" `sp` "(bvslt" `sp` b `sp` zero <> "))" --- | x >= 0. smtIsNonNeg :: Builder -> Builder smtIsNonNeg x = "(bvsge" `sp` x `sp` zero <> ")" @@ -238,33 +186,27 @@ signedFromUnsignedMod aenc benc uremResult = "(ite" `sp` (smtIsNonNeg aenc) `sp` uremResult `sp` (smtNeg uremResult) <> ")" --- | The saturated set of abstract arithmetic terms a property mentions, closed --- under the synthetic terms the lemmas need to fire. Built once by 'saturate'; --- the lemma catalogue ('EVM.SMT.AbstractLemmas') ranges over these fields. +-- | The saturated set of abstract arithmetic terms a property mentions, built +-- once by 'saturate'; the lemma catalogue ranges over these fields. data AbstractCtx = AbstractCtx { acUDivs :: [(Expr EWord, Expr EWord)] - -- ^ Unsigned divisions, saturated: the raw @(a,b)@ for @a/b@ found in the - -- props, plus synthetic divisions and nested-division collapses (see below). + -- ^ Unsigned divisions, including the synthetic ones added by 'saturate'. , acMuls :: [(Expr EWord, Expr EWord)] - -- ^ Symbolic*symbolic products, saturated with the div-mul link products - -- @(a/b)*b@ introduced by the link lemma. + -- ^ Symbolic*symbolic products, including the div-mul link products. , acConstMuls :: [(W256, Expr EWord)] -- ^ Products @c*x@ by a non-trivial literal constant. } --- | Close the set of div/mul terms the lemmas range over. --- --- Beyond the raw products and divisions a prop mentions, three synthetic --- families are added so single-level lemmas can bridge multi-level code (all --- SOUND — each synthetic term is an exact EVM operation that some lemma below --- then equates to its closed form): +-- | Close the set of div/mul terms the lemmas range over. Beyond the raw terms +-- a prop mentions, three synthetic families are added so single-level lemmas +-- can bridge multi-level code (SOUND — each synthetic term is an exact EVM +-- operation some lemma then equates to its closed form): -- --- * /synthetic divisions/: when an abstract product @a*b@ reuses a factor that --- is a divisor elsewhere, add @(a*b)/factor@ — lets mulDiv-bound and +-- * /synthetic divisions/: when a product @a*b@ reuses a factor that is a +-- divisor elsewhere, add @(a*b)/factor@ — lets mulDiv-bound and -- div-monotonicity bridge cross-divisor round-trips. --- * /nested-division collapse/: a nested constant division @(A/c1)/c2@ also --- contributes a single @A/(c1*c2)@, so the single-divide lemmas match code --- that splits precision across two divides. +-- * /nested-division collapse/: @(A/c1)/c2@ also contributes @A/(c1*c2)@, so +-- single-divide lemmas match code that splits precision across two divides. -- * /div-mul link products/: every division @a/b@ contributes the product -- @(a/b)*b@ that the link lemma bounds by @a@. saturate :: [Prop] -> AbstractCtx diff --git a/src/EVM/SMT/AbstractLemmas.hs b/src/EVM/SMT/AbstractLemmas.hs index 0eafe68fa..d28fb7147 100644 --- a/src/EVM/SMT/AbstractLemmas.hs +++ b/src/EVM/SMT/AbstractLemmas.hs @@ -2,23 +2,14 @@ Module: EVM.SMT.AbstractLemmas Description: The catalogue of sound algebraic lemmas for abstract arithmetic. - This is the review surface. Multiplication is kept fully uninterpreted (no - ground truth, so the solver never bit-blasts a symbolic product); we add only - /sound/ algebraic facts about @abst_evm_bvmul@/@abst_evm_bvudiv@. Each lemma - appears in three aligned places, under a shared banner: - - 1. a 'LemmaInst' constructor (its arguments), - 2. a clause in 'collectLemmas' (when it fires — the trigger), and - 3. a clause in 'emitLemma' (the SMT it emits + why it is sound). - - To audit soundness, read 'emitLemma': every emitted assertion is true of - ordinary multiplication/division, so anything the solver derives from them - holds for the real operations too. To add a lemma, add a constructor, a - 'collectLemmas' clause, and an 'emitLemma' clause — GHC's exhaustiveness - checker forces the third once you add the first. - - The emission order in 'collectLemmas' is family-by-family and is preserved - from the original monolithic encoder, so the generated query is unchanged. + Multiplication is kept fully uninterpreted (no ground truth, so the solver + never bit-blasts a symbolic product); we add only /sound/ algebraic facts + about @abst_evm_bvmul@/@abst_evm_bvudiv@. Each lemma is a 'LemmaInst' + constructor, a 'collectLemmas' clause (its trigger) and an 'emitLemma' + clause (the SMT it emits + why it is sound); GHC's exhaustiveness checker + ties the three together. To audit soundness, read 'emitLemma': every + emitted assertion is true of ordinary arithmetic, so anything derived from + them holds for the real operations too. -} module EVM.SMT.AbstractLemmas ( LemmaInst(..) @@ -29,12 +20,12 @@ module EVM.SMT.AbstractLemmas import Data.Containers.ListUtils (nubOrd) import EVM.SMT.AbstractBase +import EVM.SMT.SMTLIB (sp, zero, one, wordAsBV) import EVM.SMT.Types (SMTEntry(..)) import EVM.Types (EType(EWord), Err, W256, Expr, Expr(Lit)) import EVM.Types qualified as T -- | A single firing of a lemma family, carrying the sub-terms it matched. --- Field meanings are documented at the corresponding 'emitLemma' clause. data LemmaInst = Comm (Expr EWord) (Expr EWord) -- ^ a*b = b*a | Identity (Expr EWord) (Expr EWord) -- ^ x*0, 0*y, x*1, 1*y @@ -51,8 +42,8 @@ data LemmaInst | Telescope (Expr EWord) (Expr EWord) W256 W256 -- ^ (a*b)/c - (a*(b-k))/c == a*(k/c) deriving (Eq, Ord) --- | Every lemma instance triggered by the saturated term set, in the order the --- assertions are emitted. One clause per family; see 'emitLemma' for the math. +-- | Every lemma instance triggered by the saturated term set, in emission +-- order. One clause per family; see 'emitLemma' for the math. collectLemmas :: AbstractCtx -> [LemmaInst] collectLemmas ctx = -- commutativity + 0/1 identities over every product @@ -98,16 +89,15 @@ collectLemmas ctx = -- sound fact, with its no-overflow / divisor guard where one is required. emitLemma :: Enc -> LemmaInst -> Err [SMTEntry] --- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a). Needed so lemma --- terms match the props regardless of the simplifier's operand order. +-- commutativity: abst_evm_bvmul(a,b) = abst_evm_bvmul(b,a), so lemma terms +-- match the props regardless of operand order. emitLemma enc (Comm a b) = do aenc <- enc a; benc <- enc b let m1 = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" m2 = "(abst_evm_bvmul" `sp` benc `sp` aenc <> ")" pure [ SMTCommand $ "(assert (=" `sp` m1 `sp` m2 <> "))" ] --- sound identities pinning the otherwise-free UF on 0/1 operands: --- x*0 = 0, 0*y = 0, x*1 = x, 1*y = y +-- 0/1 identities pinning the otherwise-free UF: x*0 = 0*y = 0, x*1 = x, 1*y = y emitLemma enc (Identity a b) = do aenc <- enc a; benc <- enc b let m = "(abst_evm_bvmul" `sp` aenc `sp` benc <> ")" @@ -117,19 +107,17 @@ emitLemma enc (Identity a b) = do , SMTCommand $ "(assert (=> (=" `sp` benc `sp` one <> ") (=" `sp` m `sp` aenc <> ")))" ] --- div<->mul link (sound unconditionally): quotient*divisor <= dividend, i.e. --- abst_evm_bvmul(abst_evm_bvudiv(a,b), b) <= a. --- (a/b)*b <= a < 2^256 can never overflow, so no guard. This links the div and --- mul abstractions and chains nested divisions. +-- div<->mul link (sound unconditionally, (a/b)*b <= a < 2^256 cannot +-- overflow): quotient*divisor <= dividend. Links the div and mul abstractions +-- and chains nested divisions. emitLemma enc (DivMulLink a b) = do aenc <- enc a; benc <- enc b let q = "(abst_evm_bvudiv" `sp` aenc `sp` benc <> ")" qb = "(abst_evm_bvmul" `sp` q `sp` benc <> ")" pure [ SMTCommand $ "(assert (bvule" `sp` qb `sp` aenc <> "))" ] --- mul monotonicity (guarded by no-overflow, hence sound): if neither x*z nor --- y*z overflows then x <= y => x*z <= y*z. The guard is bound-free; bounding --- operands (e.g. a Solidity require) keeps it cheap to discharge. +-- mul monotonicity (no-overflow guarded, hence sound): +-- x <= y => x*z <= y*z emitLemma enc (MulMono x y z) = do xenc <- enc x; yenc <- enc y; zenc <- enc z let mxz = "(abst_evm_bvmul" `sp` xenc `sp` zenc <> ")" @@ -137,8 +125,8 @@ emitLemma enc (MulMono x y z) = do pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow xenc zenc `sp` mulNoOverflow yenc zenc <> " (bvule" `sp` xenc `sp` yenc <> ")) (bvule" `sp` mxz `sp` myz <> ")))" ] --- div monotonicity in the dividend (sound unconditionally): for a common --- divisor z, x <= y => floor(x/z) <= floor(y/z). +-- div monotonicity in the dividend (sound unconditionally): +-- x <= y => floor(x/z) <= floor(y/z) emitLemma enc (DivMono x y z) = do xenc <- enc x; yenc <- enc y; zenc <- enc z let dxz = "(abst_evm_bvudiv" `sp` xenc `sp` zenc <> ")" @@ -167,11 +155,10 @@ emitLemma enc (MulDivBound a x y z) = do , SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` ze <> ")" `sp` mulNoOverflow ye ze <> ") (bvule" `sp` dv `sp` ye <> ")))" ] --- const-mul monotonicity (sound, no-overflow guarded): for a fixed literal --- constant c, x <= y => c*x <= c*y. Because c is concrete we compute the exact --- no-overflow bound floor((2^256-1)/c) at encode time, so the guard is a single --- comparison against a constant. c*x stays a native bvmul; this lemma just lets --- the solver order two such products without bit-blasting the multiply. +-- const-mul monotonicity (sound, no-overflow guarded): x <= y => c*x <= c*y. +-- c is concrete, so the exact bound floor((2^256-1)/c) is computed at encode +-- time and the guard is one comparison. c*x stays a native bvmul; the lemma +-- lets the solver order two such products without bit-blasting the multiply. emitLemma enc (ConstMulMono c x y) = do xe <- enc x; ye <- enc y let cbv = wordAsBV c @@ -181,12 +168,9 @@ emitLemma enc (ConstMulMono c x y) = do pure [ SMTCommand $ "(assert (=> (and (bvule" `sp` xe `sp` bnd <> ") (bvule" `sp` ye `sp` bnd <> ")" <> " (bvule" `sp` xe `sp` ye <> ")) (bvule" `sp` cx `sp` cy <> ")))" ] --- const cancellation (sound, no-overflow guarded): a product c1*x divided by a --- literal c2 that divides c1 collapses to (c1/c2)*x. The multiply by a constant --- stays a native bvmul but the divide is abstracted, so without this the --- precision-scaling wrapper c1*x/c2 (e.g. amount*1e18/1e6 in _getUsdcValue) is --- not provably its closed form. `a` is the dividend (c1*x); c2 | c1 makes c1/c2 --- exact, and the bound floor((2^256-1)/c1) is computed at encode time. +-- const cancellation (sound, no-overflow guarded): (c1*x)/c2 == (c1/c2)*x +-- when c2 | c1 — the precision-scaling wrapper, e.g. amount*1e18/1e6. +-- `a` is the dividend expr (c1*x), kept so the div term matches the prop. emitLemma enc (ConstCancel a c1 c2 x) = do ae <- enc a; xe <- enc x let c2bv = wordAsBV c2 @@ -196,9 +180,9 @@ emitLemma enc (ConstCancel a c1 c2 x) = do bnd = wordAsBV ((maxBound :: W256) `div` c1) -- largest x with c1*x < 2^256 pure [ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" ] --- nested-division collapse (sound, floor identity): (A/c1)/c2 == A/(c1*c2) for --- literal c1,c2 with c1*c2 < 2^256. Lets the solver simplify chained constant --- divisions such as x*rate/1e9/1e18 to x*rate/1e27. No operand bound needed. +-- nested-division collapse (sound floor identity, no guard needed): +-- (A/c1)/c2 == A/(c1*c2) for literal c1,c2 with c1*c2 < 2^256, +-- e.g. x*rate/1e9/1e18 == x*rate/1e27. emitLemma enc (NestedDiv innerA c1 c2) = do ae <- enc innerA let inner = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV c1 <> ")" @@ -206,12 +190,10 @@ emitLemma enc (NestedDiv innerA c1 c2) = do collapsed = "(abst_evm_bvudiv" `sp` ae `sp` wordAsBV (c1 * c2) <> ")" pure [ SMTCommand $ "(assert (=" `sp` outer `sp` collapsed <> "))" ] --- fraction-reduce (sound, no-overflow guarded): a product c1*x divided by a --- literal c2 that c1 divides collapses to x/(c2/c1). The mirror of const-cancel: --- const-cancel needs c2 | c1 (multiply by large, divide by small); this needs --- c1 | c2 (multiply by small, divide by large, e.g. x*1e6/1e18 == x/1e12 — the --- convert-to-usdc precision step). Under the guard c1*x is exact and --- floor(c1*x / (c1*k)) = floor(x/k). `a` is the dividend (c1*x). +-- fraction-reduce (sound, no-overflow guarded): (c1*x)/c2 == x/(c2/c1) when +-- c1 | c2 — the mirror of const-cancel (multiply by small, divide by large, +-- e.g. x*1e6/1e18 == x/1e12). Under the guard c1*x is exact, and +-- floor(c1*x / (c1*k)) = floor(x/k). emitLemma enc (FracReduce a c1 c2 x) = do ae <- enc a; xe <- enc x let k = c2 `div` c1 -- exact and >= 2, since c1 | c2 and c2 /= c1 @@ -221,11 +203,10 @@ emitLemma enc (FracReduce a c1 c2 x) = do pure [ SMTCommand $ "(assert (=> (bvule" `sp` xe `sp` bnd <> ") (=" `sp` dv `sp` rhs <> ")))" ] -- ceilDiv-cancel (sound, guarded): pins the abstracted divide inside --- OpenZeppelin's Math.ceilDiv(c1*x, c2) = (c1*x - 1)/c2 + 1 (the c1*x != 0 --- branch). `a` is the (c1*x - 1) dividend. When c2 | c1, write c1 = c2*m: then --- c1*x = c2*(m*x), so floor((c2*m*x - 1)/c2) = m*x - 1 (for m*x >= 1). Adding the --- ceilDiv's +1 gives m*x = (c1/c2)*x exactly. Guarded by x >= 1 (the ceilDiv ITE --- handles x==0) and the encode-time no-overflow bound floor((2^256-1)/c1). +-- OpenZeppelin's Math.ceilDiv(c1*x, c2) = (c1*x - 1)/c2 + 1. When c2 | c1, +-- write c1 = c2*m: floor((c2*m*x - 1)/c2) = m*x - 1 for m*x >= 1, so with the +-- ceilDiv's +1 the quote is exactly (c1/c2)*x. Guarded by x >= 1 (the ceilDiv +-- ITE handles x==0) and no-overflow. `a` is the (c1*x - 1) dividend expr. emitLemma enc (CeilDivCancel a c1 c2 x) = do ae <- enc a; xe <- enc x let m = c1 `div` c2 -- exact, since c2 | c1 @@ -236,14 +217,13 @@ emitLemma enc (CeilDivCancel a c1 c2 x) = do pure [ SMTCommand $ "(assert (=> (and (bvuge" `sp` xe `sp` one <> ")" <> " (bvule" `sp` xe `sp` bnd <> ")) (=" `sp` dv `sp` rhs <> ")))" ] --- scaled-product telescoping (sound, no-overflow guarded). For products sharing --- factor a whose other factors differ by a literal k with c | k: --- floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c). --- Sound because a*b = a*(b-k) + a*k and a*k is an exact multiple of c, so --- removing it shifts the floor by exactly a*(k/c). The only lemma pinning the --- EXACT difference of two distinct abstract products; discharges value-change --- accounting like susds*rate/1e27 - susds == susds*(rate-1e27)/1e27. Guarded by --- no-overflow on a*b and b >= k (so b-k is a true difference, no wraparound). +-- scaled-product telescoping (sound, no-overflow guarded). For products +-- sharing factor a whose other factors differ by a literal k with c | k: +-- floor(a*b/c) == floor(a*(b-k)/c) + a*(k/c) +-- Sound: a*b = a*(b-k) + a*k and a*k is an exact multiple of c, so removing it +-- shifts the floor by exactly a*(k/c). The only lemma pinning the EXACT +-- difference of two abstract products (value-change accounting, e.g. +-- susds*rate/1e27 - susds). b >= k in the guard rules out wraparound in b-k. emitLemma enc (Telescope a b k c) = do ae <- enc a; be <- enc b let m = k `div` c -- exact, since c | k @@ -257,10 +237,8 @@ emitLemma enc (Telescope a b k c) = do pure [ SMTCommand $ "(assert (=> (and" `sp` mulNoOverflow ae be <> " (bvuge" `sp` be `sp` wordAsBV k <> ")) (=" `sp` dFull `sp` rhs <> ")))" ] --- | Include both operand orders of each product. Multiplication is commutative --- (and we assert that), but the simplifier/solc may order a product's operands --- either way; considering both ensures monotonicity is found regardless of --- ordering. Only used for the (commutative) mul lemmas. +-- | Both operand orders of each product, so monotonicity fires regardless of +-- how the simplifier ordered the operands. bothOrders :: [(Expr EWord, Expr EWord)] -> [(Expr EWord, Expr EWord)] bothOrders xs = nubOrd (xs <> [ (b, a) | (a, b) <- xs ]) diff --git a/src/EVM/SMT/DivModEncoding.hs b/src/EVM/SMT/DivModEncoding.hs index 6689db067..74304bdaa 100644 --- a/src/EVM/SMT/DivModEncoding.hs +++ b/src/EVM/SMT/DivModEncoding.hs @@ -23,6 +23,7 @@ import Data.Text.Lazy.Builder (Builder, fromString) import EVM.SMT.AbstractBase import EVM.SMT.AbstractLemmas (collectLemmas, emitLemma) +import EVM.SMT.SMTLIB (sp, zero, wordAsBV) import EVM.SMT.Types import EVM.Traversals (foldProp) import EVM.Types (Prop, EType(EWord), Err, W256, Expr, Expr(Lit), Expr(SHL)) diff --git a/src/EVM/SMT/SMTLIB.hs b/src/EVM/SMT/SMTLIB.hs index e10325c91..bf64a759e 100644 --- a/src/EVM/SMT/SMTLIB.hs +++ b/src/EVM/SMT/SMTLIB.hs @@ -2,15 +2,33 @@ module EVM.SMT.SMTLIB ( prelude, toText, - hasDuplicateCommands + hasDuplicateCommands, + -- * Builder primitives + sp, + zero, + one, + wordAsBV ) where import Data.Containers.ListUtils (nubOrd) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder +import qualified Data.Text.Lazy.Builder.Int import EVM.SMT.Types +sp :: Builder -> Builder -> Builder +a `sp` b = a <> " " <> b + +zero :: Builder +zero = "(_ bv0 256)" + +one :: Builder +one = "(_ bv1 256)" + +wordAsBV :: forall a. Integral a => a -> Builder +wordAsBV w = "(_ bv" <> Data.Text.Lazy.Builder.Int.decimal w <> " 256)" + prelude :: SMT2 prelude = SMT2 src mempty mempty where