Merge pull request #203 from arcz/witch

Replace num/fromIntegral with witch

Author: arcz

hevm-cli/hevm-cli.hs

@@ -25,6 +25,7 @@ import Data.Word (Word64)
 import GHC.Conc (getNumProcessors)
 import Numeric.Natural (Natural)
 import Optics.Core ((&), (%), set)
+import Witch (unsafeInto)
 import Options.Generic as Options
 import Paths_hevm qualified as Paths
 import System.IO (stderr)
@@ -277,7 +278,7 @@ main = do
     Test {} -> do
       root <- getRoot cmd
       withCurrentDirectory root $ do
-        cores <- num <$> getNumProcessors
+        cores <- unsafeInto <$> getNumProcessors
         solver <- getSolver cmd
         withSolvers solver cores cmd.smttimeout $ \solvers -> do
           buildOut <- readBuildOutput root (getProjectType cmd)
@@ -381,7 +382,7 @@ assert cmd = do
   calldata <- buildCalldata cmd
   preState <- symvmFromCommand cmd calldata
   let errCodes = fromMaybe defaultPanicCodes cmd.assertions
-  cores <- num <$> getNumProcessors
+  cores <- unsafeInto <$> getNumProcessors
   let solverCount = fromMaybe cores cmd.numSolvers
   solver <- getSolver cmd
   withSolvers solver solverCount cmd.smttimeout $ \solvers -> do

hevm.cabal

@@ -186,7 +186,8 @@ library
     spool                             >= 0.1 && < 0.2,
     stm                               >= 2.5.0 && < 2.6.0,
     spawn                             >= 0.3 && < 0.4,
-    filepattern                       >= 0.1.2 && < 0.2
+    filepattern                       >= 0.1.2 && < 0.2,
+    witch                             >= 1.1 && < 1.3
   if !os(windows)
     build-depends:
       brick                           >= 1.4 && < 1.5,
@@ -242,7 +243,8 @@ executable hevm
     stm,
     spawn,
     optics-core,
-    githash                       >= 0.1.6 && < 0.2
+    githash                       >= 0.1.6 && < 0.2,
+    witch
   if os(windows)
     buildable: False
 
@@ -294,7 +296,8 @@ common test-base
     smt2-parser >= 0.1.0.1,
     operational,
     optics-core,
-    optics-extra
+    optics-extra,
+    witch
 
 library test-utils
   import:

src/EVM.hs

@@ -87,6 +87,7 @@ import Test.QuickCheck hiding ((.&.), label)
 import Text.Megaparsec qualified as P
 import Text.Megaparsec.Char qualified as P
 import Text.ParserCombinators.ReadP
+import Witch (unsafeInto, into)
 
 data AbiValue
   = AbiUInt         Int Word256
@@ -216,7 +217,7 @@ getAbi t = label (Text.unpack (abiTypeSolidity t)) $
     AbiArrayDynamicType t' -> do
       AbiUInt _ n <- label "array length" (getAbi (AbiUIntType 256))
       AbiArrayDynamic t' <$>
-        label "array body" (getAbiSeq (fromIntegral n) (repeat t'))
+        label "array body" (getAbiSeq (unsafeInto n) (repeat t'))
 
     AbiTupleType ts ->
       AbiTuple <$> getAbiSeq (Vector.length ts) (Vector.toList ts)
@@ -228,7 +229,7 @@ putAbi :: AbiValue -> Put
 putAbi = \case
   AbiUInt _ x ->
     forM_ (reverse [0 .. 7]) $ \i ->
-      putWord32be (fromIntegral (shiftR x (i * 32) .&. 0xffffffff))
+      putWord32be (unsafeInto (shiftR x (i * 32) .&. 0xffffffff))
 
   AbiInt n x   -> putAbi (AbiUInt n (fromIntegral x))
   AbiAddress x -> putAbi (AbiUInt 160 (fromIntegral x))
@@ -240,7 +241,7 @@ putAbi = \case
 
   AbiBytesDynamic xs -> do
     let n = BS.length xs
-    putAbi (AbiUInt 256 (fromIntegral n))
+    putAbi (AbiUInt 256 (unsafeInto n))
     putAbi (AbiBytes n xs)
 
   AbiString s ->
@@ -325,7 +326,7 @@ putAbiSeq xs =
       case abiKind (abiValueType x) of
         Static -> do putAbi x
                      putHeads offset xs'
-        Dynamic -> do putAbi (AbiUInt 256 (fromIntegral offset))
+        Dynamic -> do putAbi (AbiUInt 256 (unsafeInto offset))
                       putHeads (offset + abiTailSize x) xs'
 
 encodeAbiValue :: AbiValue -> BS.ByteString
@@ -387,7 +388,7 @@ basicType v =
 pack32 :: Int -> [Word32] -> Word256
 pack32 n xs =
   sum [ shiftL x ((n - i) * 32)
-      | (x, i) <- zip (map fromIntegral xs) [1..] ]
+      | (x, i) <- zip (map into xs) [1..] ]
 
 asUInt :: Integral i => Int -> (i -> a) -> Get a
 asUInt n f = y <$> getAbi (AbiUIntType n)
@@ -508,7 +509,7 @@ parseAbiValue :: AbiType -> ReadP AbiValue
 parseAbiValue (AbiUIntType n) = do W256 w <- readS_to_P reads
                                    pure $ AbiUInt n w
 parseAbiValue (AbiIntType n) = do W256 w <- readS_to_P reads
-                                  pure $ AbiInt n (num w)
+                                  pure $ AbiInt n (unsafeInto w)
 parseAbiValue AbiAddressType = AbiAddress <$> readS_to_P reads
 parseAbiValue AbiBoolType = (do W256 w <- readS_to_P reads
                                 pure $ AbiBool (w /= 0))
@@ -570,7 +571,7 @@ decodeBuf tps buf
 
 decodeStaticArgs :: Int -> Int -> Expr Buf -> [Expr EWord]
 decodeStaticArgs offset numArgs b =
-  [readWord (Lit . num $ i) b | i <- [offset,(offset+32) .. (offset + (numArgs-1)*32)]]
+  [readWord (Lit . unsafeInto $ i) b | i <- [offset,(offset+32) .. (offset + (numArgs-1)*32)]]
 
 
 -- A modification of 'arbitrarySizedBoundedIntegral' quickcheck library

src/EVM/ABI.hs

@@ -8,6 +8,7 @@ import Data.ByteString (ByteString, (!?))
 import Data.ByteString qualified as BS
 import Data.Maybe (fromMaybe)
 import Data.Word (Word8)
+import Witch (unsafeInto)
 
 wordAt :: Int -> ByteString -> W256
 wordAt i bs =
@@ -28,23 +29,23 @@ byteStringSliceWithDefaultZeroes offset size bs =
     in bs' <> BS.replicate (size - BS.length bs') 0
 
 
-sliceMemory :: (Integral a, Integral b) => a -> b -> ByteString -> ByteString
+sliceMemory :: W256 -> W256 -> ByteString -> ByteString
 sliceMemory o s =
-  byteStringSliceWithDefaultZeroes (num o) (num s)
+  byteStringSliceWithDefaultZeroes (unsafeInto o) (unsafeInto s)
 
 writeMemory :: ByteString -> W256 -> W256 -> W256 -> ByteString -> ByteString
 writeMemory bs1 n src dst bs0 =
   let
-    (a, b) = BS.splitAt (num dst) bs0
-    a'     = BS.replicate (num dst - BS.length a) 0
+    (a, b) = BS.splitAt (unsafeInto dst) bs0
+    a'     = BS.replicate (unsafeInto dst - BS.length a) 0
     -- sliceMemory should work for both cases, but we are using 256 bit
     -- words, whereas ByteString is only defined up to 64 bit. For large n,
     -- src, dst this will cause problems (often in GeneralStateTests).
     -- Later we could reimplement ByteString for 256 bit arguments.
-    c      = if src > num (BS.length bs1)
-             then BS.replicate (num n) 0
+    c      = if src > unsafeInto (BS.length bs1)
+             then BS.replicate (unsafeInto n) 0
              else sliceMemory src n bs1
-    b'     = BS.drop (num n) b
+    b'     = BS.drop (unsafeInto n) b
   in
     a <> a' <> c <> b'
 
@@ -64,8 +65,8 @@ x0 ^ y0 | y0 < 0    = errorWithoutStackTrace "Negative exponent"
                   | otherwise   = g (x * x) ((y - 1) `shiftR` 1) (x * z)
 
 createAddress :: Addr -> W256 -> Addr
-createAddress a n = num $ keccak' $ rlpList [rlpAddrFull a, rlpWord256 n]
+createAddress a n = unsafeInto $ keccak' $ rlpList [rlpAddrFull a, rlpWord256 n]
 
 create2Address :: Addr -> W256 -> ByteString -> Addr
-create2Address a s b = num $ keccak' $ mconcat
+create2Address a s b = unsafeInto $ keccak' $ mconcat
   [BS.singleton 0xff, word160Bytes a, word256Bytes s, word256Bytes $ keccak' b]

src/EVM/Concrete.hs

@@ -19,6 +19,7 @@ import Data.Sequence qualified as Seq
 import Data.Text (Text, isPrefixOf, pack, unpack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Vector qualified as V
+import Witch (unsafeInto)
 
 data DappInfo = DappInfo
   { root       :: FilePath
@@ -173,7 +174,7 @@ lookupCode (RuntimeCode (SymbolicRuntimeCode c)) a = let
 compareCode :: ByteString -> Code -> Bool
 compareCode raw (Code template locs) =
   let holes' = sort [(start, len) | (Reference start len) <- locs]
-      insert at' len' bs = writeMemory (BS.replicate len' 0) (fromIntegral len') 0 (fromIntegral at') bs
+      insert at' len' bs = writeMemory (BS.replicate len' 0) (unsafeInto len') 0 (unsafeInto at') bs
       refined = foldr (\(start, len) acc -> insert start len acc) raw holes'
   in BS.length raw == BS.length template && template == refined
 

src/EVM/Dapp.hs

@@ -3,7 +3,7 @@ module EVM.Debug where
 import EVM (bytecode)
 import EVM.Expr (bufLength)
 import EVM.Solidity (SrcMap(..), SourceCache(..))
-import EVM.Types (Contract, Addr)
+import EVM.Types (Contract(..), Addr)
 
 import Control.Arrow (second)
 import Data.ByteString (ByteString)
@@ -12,6 +12,7 @@ import Data.Map (Map)
 import Data.Map qualified as Map
 import Optics.Core
 import Text.PrettyPrint.ANSI.Leijen
+import Witch (unsafeInto)
 
 data Mode = Debug | Run | JsonTrace deriving (Eq, Show)
 
@@ -27,9 +28,9 @@ prettyContract :: Contract -> Doc
 prettyContract c =
   object
     [ (text "codesize", text . show $ (bufLength (c ^. bytecode)))
-    , (text "codehash", text (show (c ^. #codehash)))
-    , (text "balance", int (fromIntegral (c ^. #balance)))
-    , (text "nonce", int (fromIntegral (c ^. #nonce)))
+    , (text "codehash", text (show c.codehash))
+    , (text "balance", int (unsafeInto c.balance))
+    , (text "nonce", int (unsafeInto c.nonce))
     ]
 
 prettyContracts :: Map Addr Contract -> Doc

src/EVM/Debug.hs

@@ -30,6 +30,7 @@ import EVM.SymExec
 import EVM.Types
 import EVM.UnitTest
 import GHC.Conc
+import Witch (unsafeInto)
 
 checkEquiv :: (Typeable a) => Expr a -> Expr a -> IO ()
 checkEquiv a b = withSolvers Z3 1 Nothing $ \s -> do
@@ -40,7 +41,7 @@ checkEquiv a b = withSolvers Z3 1 Nothing $ \s -> do
 runDappTest :: FilePath -> IO ()
 runDappTest root =
   withCurrentDirectory root $ do
-    cores <- num <$> getNumProcessors
+    cores <- unsafeInto <$> getNumProcessors
     let testFile = root <> "/out/dapp.sol.json"
     Right (BuildOutput contracts _) <- readSolc DappTools root testFile
     withSolvers Z3 cores Nothing $ \solvers -> do