From 038d31adceb19bb5b80db16014d489ea9740a734 Mon Sep 17 00:00:00 2001 From: gustavo-grieco Date: Fri, 30 Jan 2026 21:10:09 +0100 Subject: [PATCH 001/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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/127] 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)