commit f3f58ca5a3d5992afdd13b559003b0aba433dd27
parent 05576c52bf4eb3bdda52fb0a3570efd51bb871b9
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 18 Jan 2025 19:58:07 +0400
lib: misc optimizations
In particular: never inline to_script, which can cause GHC to panic.
Diffstat:
4 files changed, 138 insertions(+), 116 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -3,7 +3,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -18,7 +18,13 @@ import qualified Data.Primitive.ByteArray as BA
import GHC.Generics
deriving stock instance Generic S.Script
-deriving newtype instance NFData S.Script
+instance NFData S.Script
+
+deriving stock instance Generic S.Term
+instance NFData S.Term
+
+deriving stock instance Generic S.Opcode
+instance NFData S.Opcode
ba_to_bs :: Benchmark
ba_to_bs = env setup $ \ba ->
@@ -39,8 +45,8 @@ bs_to_ba :: Benchmark
bs_to_ba = bench "bs_to_ba" $ nf S.bs_to_ba (BS.replicate 1024 0x00)
to_script :: Benchmark
-to_script = bench "to_script" $ nf S.to_script script where
- script = [
+to_script = bench "to_script" $ nf S.to_script terms where
+ terms = [
OPCODE OP_DUP,OPCODE OP_HASH160,OPCODE OP_PUSHBYTES_20,BYTE 0x89,BYTE 0xab
, BYTE 0xcd,BYTE 0xef,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab
, BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba,BYTE 0xab,BYTE 0xba
@@ -48,11 +54,18 @@ to_script = bench "to_script" $ nf S.to_script script where
, OPCODE OP_CHECKSIG
]
+from_script :: Benchmark
+from_script = bench "from_script" $ nf S.from_script script where
+ b16 = "76a91489abcdefabbaabbaabbaabbaabbaabbaabbaabba88ac"
+ script = case S.from_base16 b16 of
+ Nothing -> error "invalid script"
+ Just !s -> s
main :: IO ()
main = defaultMain [
ba_to_bs
, bs_to_ba
+ , to_script
+ , from_script
]
-
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,4 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+
module Main where
+import qualified Bitcoin.Prim.Script as S
+import qualified Data.ByteString as BS
+import qualified Weigh as W
+
main :: IO ()
-main = pure ()
+main = W.mainWith $ do
+ W.func "bs_to_ba" S.bs_to_ba (BS.replicate 1024 0x00)
diff --git a/lib/Bitcoin/Prim/Script.hs b/lib/Bitcoin/Prim/Script.hs
@@ -104,8 +104,8 @@ instance Show WitnessScriptHash where
-- | Terms of the Script language (either opcodes or bytes).
data Term =
- OPCODE Opcode
- | BYTE Word8
+ OPCODE {-# UNPACK #-} !Opcode
+ | BYTE {-# UNPACK #-} !Word8
deriving Eq
instance Show Term where
@@ -393,52 +393,51 @@ to_script :: [Term] -> Script
to_script = Script . bs_to_ba . BS.pack . fmap term_to_byte where
term_to_byte :: Term -> Word8
term_to_byte = \case
- OPCODE op -> fi (fromEnum op)
- BYTE w8 -> w8
+ OPCODE !op -> fi (fromEnum op)
+ BYTE !w8 -> w8
{-# INLINE term_to_byte #-}
-
--- XX seems slow
+{-# NOINLINE to_script #-} -- don't even think about it
-- | Unpack a 'Script' into a list of Script terms.
from_script :: Script -> [Term]
from_script (Script bs) = go 0 where
- l = BA.sizeofByteArray bs
+ !l = BA.sizeofByteArray bs
- read_pay cur end
+ read_pay !cur !end
| cur == end = go cur
| otherwise = BYTE (BA.indexByteArray bs cur) : read_pay (cur + 1) end
go j
| j == l = mempty
| otherwise =
- let op = toEnum (fi (BA.indexByteArray bs j :: Word8)) :: Opcode
+ let !op = toEnum (fi (BA.indexByteArray bs j :: Word8)) :: Opcode
in case pushbytes op of
- Just i -> OPCODE op : read_pay (j + 1) (j + 1 + i)
+ Just !i -> OPCODE op : read_pay (j + 1) (j + 1 + i)
Nothing -> OPCODE op : case op of
OP_PUSHDATA1 ->
- let len_idx = j + 1
- pay_len = BA.indexByteArray bs len_idx :: Word8
+ let !len_idx = j + 1
+ !pay_len = BA.indexByteArray bs len_idx :: Word8
in BYTE pay_len
: read_pay (len_idx + 1) (len_idx + 1 + fi pay_len)
OP_PUSHDATA2 ->
- let len_idx = j + 1
- w8_0 = BA.indexByteArray bs len_idx :: Word8
- w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8
- pay_len = fi w8_0 .|. fi w8_1 `B.shiftL` 8 :: Word16
+ let !len_idx = j + 1
+ !w8_0 = BA.indexByteArray bs len_idx :: Word8
+ !w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8
+ !pay_len = fi w8_0 .|. fi w8_1 `B.shiftL` 8 :: Word16
in BYTE w8_0 : BYTE w8_1
: read_pay (len_idx + 2) (len_idx + 2 + fi pay_len)
OP_PUSHDATA4 ->
- let len_idx = j + 1
- w8_0 = BA.indexByteArray bs len_idx :: Word8
- w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8
- w8_2 = BA.indexByteArray bs (len_idx + 2) :: Word8
- w8_3 = BA.indexByteArray bs (len_idx + 3) :: Word8
- pay_len = fi w8_0
- .|. fi w8_1 `B.shiftL` 8
- .|. fi w8_2 `B.shiftL` 16
- .|. fi w8_3 `B.shiftL` 24 :: Word32
+ let !len_idx = j + 1
+ !w8_0 = BA.indexByteArray bs len_idx :: Word8
+ !w8_1 = BA.indexByteArray bs (len_idx + 1) :: Word8
+ !w8_2 = BA.indexByteArray bs (len_idx + 2) :: Word8
+ !w8_3 = BA.indexByteArray bs (len_idx + 3) :: Word8
+ !pay_len = fi w8_0
+ .|. fi w8_1 `B.shiftL` 8
+ .|. fi w8_2 `B.shiftL` 16
+ .|. fi w8_3 `B.shiftL` 24 :: Word32
in BYTE w8_0 : BYTE w8_1 : BYTE w8_2 : BYTE w8_3
: read_pay (len_idx + 4) (len_idx + 4 + fi pay_len)
@@ -463,81 +462,81 @@ to_witness_scripthash (Script bs)
-- convert a pushbytes opcode to its corresponding int
pushbytes :: Opcode -> Maybe Int
pushbytes = \case
- OP_PUSHBYTES_0 -> Just 00
- OP_PUSHBYTES_1 -> Just 01
- OP_PUSHBYTES_2 -> Just 02
- OP_PUSHBYTES_3 -> Just 03
- OP_PUSHBYTES_4 -> Just 04
- OP_PUSHBYTES_5 -> Just 05
- OP_PUSHBYTES_6 -> Just 06
- OP_PUSHBYTES_7 -> Just 07
- OP_PUSHBYTES_8 -> Just 08
- OP_PUSHBYTES_9 -> Just 09
- OP_PUSHBYTES_10 -> Just 10
- OP_PUSHBYTES_11 -> Just 11
- OP_PUSHBYTES_12 -> Just 12
- OP_PUSHBYTES_13 -> Just 13
- OP_PUSHBYTES_14 -> Just 14
- OP_PUSHBYTES_15 -> Just 15
- OP_PUSHBYTES_16 -> Just 16
- OP_PUSHBYTES_17 -> Just 17
- OP_PUSHBYTES_18 -> Just 18
- OP_PUSHBYTES_19 -> Just 19
- OP_PUSHBYTES_20 -> Just 20
- OP_PUSHBYTES_21 -> Just 21
- OP_PUSHBYTES_22 -> Just 22
- OP_PUSHBYTES_23 -> Just 23
- OP_PUSHBYTES_24 -> Just 24
- OP_PUSHBYTES_25 -> Just 25
- OP_PUSHBYTES_26 -> Just 26
- OP_PUSHBYTES_27 -> Just 27
- OP_PUSHBYTES_28 -> Just 28
- OP_PUSHBYTES_29 -> Just 29
- OP_PUSHBYTES_30 -> Just 30
- OP_PUSHBYTES_31 -> Just 31
- OP_PUSHBYTES_32 -> Just 32
- OP_PUSHBYTES_33 -> Just 33
- OP_PUSHBYTES_34 -> Just 34
- OP_PUSHBYTES_35 -> Just 35
- OP_PUSHBYTES_36 -> Just 36
- OP_PUSHBYTES_37 -> Just 37
- OP_PUSHBYTES_38 -> Just 38
- OP_PUSHBYTES_39 -> Just 39
- OP_PUSHBYTES_40 -> Just 40
- OP_PUSHBYTES_41 -> Just 41
- OP_PUSHBYTES_42 -> Just 42
- OP_PUSHBYTES_43 -> Just 43
- OP_PUSHBYTES_44 -> Just 44
- OP_PUSHBYTES_45 -> Just 45
- OP_PUSHBYTES_46 -> Just 46
- OP_PUSHBYTES_47 -> Just 47
- OP_PUSHBYTES_48 -> Just 48
- OP_PUSHBYTES_49 -> Just 49
- OP_PUSHBYTES_50 -> Just 50
- OP_PUSHBYTES_51 -> Just 51
- OP_PUSHBYTES_52 -> Just 52
- OP_PUSHBYTES_53 -> Just 53
- OP_PUSHBYTES_54 -> Just 54
- OP_PUSHBYTES_55 -> Just 55
- OP_PUSHBYTES_56 -> Just 56
- OP_PUSHBYTES_57 -> Just 57
- OP_PUSHBYTES_58 -> Just 58
- OP_PUSHBYTES_59 -> Just 59
- OP_PUSHBYTES_60 -> Just 60
- OP_PUSHBYTES_61 -> Just 61
- OP_PUSHBYTES_62 -> Just 62
- OP_PUSHBYTES_63 -> Just 63
- OP_PUSHBYTES_64 -> Just 64
- OP_PUSHBYTES_65 -> Just 65
- OP_PUSHBYTES_66 -> Just 66
- OP_PUSHBYTES_67 -> Just 67
- OP_PUSHBYTES_68 -> Just 68
- OP_PUSHBYTES_69 -> Just 69
- OP_PUSHBYTES_70 -> Just 70
- OP_PUSHBYTES_71 -> Just 71
- OP_PUSHBYTES_72 -> Just 72
- OP_PUSHBYTES_73 -> Just 73
- OP_PUSHBYTES_74 -> Just 74
- OP_PUSHBYTES_75 -> Just 75
+ OP_PUSHBYTES_0 -> Just $! 00
+ OP_PUSHBYTES_1 -> Just $! 01
+ OP_PUSHBYTES_2 -> Just $! 02
+ OP_PUSHBYTES_3 -> Just $! 03
+ OP_PUSHBYTES_4 -> Just $! 04
+ OP_PUSHBYTES_5 -> Just $! 05
+ OP_PUSHBYTES_6 -> Just $! 06
+ OP_PUSHBYTES_7 -> Just $! 07
+ OP_PUSHBYTES_8 -> Just $! 08
+ OP_PUSHBYTES_9 -> Just $! 09
+ OP_PUSHBYTES_10 -> Just $! 10
+ OP_PUSHBYTES_11 -> Just $! 11
+ OP_PUSHBYTES_12 -> Just $! 12
+ OP_PUSHBYTES_13 -> Just $! 13
+ OP_PUSHBYTES_14 -> Just $! 14
+ OP_PUSHBYTES_15 -> Just $! 15
+ OP_PUSHBYTES_16 -> Just $! 16
+ OP_PUSHBYTES_17 -> Just $! 17
+ OP_PUSHBYTES_18 -> Just $! 18
+ OP_PUSHBYTES_19 -> Just $! 19
+ OP_PUSHBYTES_20 -> Just $! 20
+ OP_PUSHBYTES_21 -> Just $! 21
+ OP_PUSHBYTES_22 -> Just $! 22
+ OP_PUSHBYTES_23 -> Just $! 23
+ OP_PUSHBYTES_24 -> Just $! 24
+ OP_PUSHBYTES_25 -> Just $! 25
+ OP_PUSHBYTES_26 -> Just $! 26
+ OP_PUSHBYTES_27 -> Just $! 27
+ OP_PUSHBYTES_28 -> Just $! 28
+ OP_PUSHBYTES_29 -> Just $! 29
+ OP_PUSHBYTES_30 -> Just $! 30
+ OP_PUSHBYTES_31 -> Just $! 31
+ OP_PUSHBYTES_32 -> Just $! 32
+ OP_PUSHBYTES_33 -> Just $! 33
+ OP_PUSHBYTES_34 -> Just $! 34
+ OP_PUSHBYTES_35 -> Just $! 35
+ OP_PUSHBYTES_36 -> Just $! 36
+ OP_PUSHBYTES_37 -> Just $! 37
+ OP_PUSHBYTES_38 -> Just $! 38
+ OP_PUSHBYTES_39 -> Just $! 39
+ OP_PUSHBYTES_40 -> Just $! 40
+ OP_PUSHBYTES_41 -> Just $! 41
+ OP_PUSHBYTES_42 -> Just $! 42
+ OP_PUSHBYTES_43 -> Just $! 43
+ OP_PUSHBYTES_44 -> Just $! 44
+ OP_PUSHBYTES_45 -> Just $! 45
+ OP_PUSHBYTES_46 -> Just $! 46
+ OP_PUSHBYTES_47 -> Just $! 47
+ OP_PUSHBYTES_48 -> Just $! 48
+ OP_PUSHBYTES_49 -> Just $! 49
+ OP_PUSHBYTES_50 -> Just $! 50
+ OP_PUSHBYTES_51 -> Just $! 51
+ OP_PUSHBYTES_52 -> Just $! 52
+ OP_PUSHBYTES_53 -> Just $! 53
+ OP_PUSHBYTES_54 -> Just $! 54
+ OP_PUSHBYTES_55 -> Just $! 55
+ OP_PUSHBYTES_56 -> Just $! 56
+ OP_PUSHBYTES_57 -> Just $! 57
+ OP_PUSHBYTES_58 -> Just $! 58
+ OP_PUSHBYTES_59 -> Just $! 59
+ OP_PUSHBYTES_60 -> Just $! 60
+ OP_PUSHBYTES_61 -> Just $! 61
+ OP_PUSHBYTES_62 -> Just $! 62
+ OP_PUSHBYTES_63 -> Just $! 63
+ OP_PUSHBYTES_64 -> Just $! 64
+ OP_PUSHBYTES_65 -> Just $! 65
+ OP_PUSHBYTES_66 -> Just $! 66
+ OP_PUSHBYTES_67 -> Just $! 67
+ OP_PUSHBYTES_68 -> Just $! 68
+ OP_PUSHBYTES_69 -> Just $! 69
+ OP_PUSHBYTES_70 -> Just $! 70
+ OP_PUSHBYTES_71 -> Just $! 71
+ OP_PUSHBYTES_72 -> Just $! 72
+ OP_PUSHBYTES_73 -> Just $! 73
+ OP_PUSHBYTES_74 -> Just $! 74
+ OP_PUSHBYTES_75 -> Just $! 75
_ -> Nothing
diff --git a/test/Main.hs b/test/Main.hs
@@ -20,11 +20,6 @@ import qualified Test.Tasty.QuickCheck as Q
newtype BS = BS BS.ByteString
deriving (Eq, Show)
-bytes_list :: Int -> Q.Gen [Word8]
-bytes_list k = do
- l <- Q.chooseInt (0, k)
- Q.vectorOf l Q.arbitrary
-
bytes :: Int -> Q.Gen BS.ByteString
bytes k = do
l <- Q.chooseInt (0, k)
@@ -38,9 +33,10 @@ instance Q.Arbitrary BS where
instance Q.Arbitrary BA.ByteArray where
arbitrary = do
- b <- bytes_list 10_000
- pure (BA.byteArrayFromList b)
+ b <- bytes 10_000
+ pure (bs_to_ba b)
+-- do not use for testing things intended to run on 'real' scripts
instance Q.Arbitrary Script where
arbitrary = fmap Script Q.arbitrary
@@ -61,6 +57,11 @@ to_script_inverts_from_script s =
let script = to_script (from_script s)
in script == s
+foo :: Script -> Bool
+foo s =
+ let terms = from_script s
+ in length terms >= 0
+
-- main -----------------------------------------------------------------------
main :: IO ()
@@ -70,7 +71,8 @@ main = defaultMain $
Q.withMaxSuccess 500 ba_to_bs_inverts_bs_to_ba
, Q.testProperty "from_base16 . to_base16 ~ id" $
Q.withMaxSuccess 500 from_base16_inverts_to_base16
- -- XX slow
+ -- XX need better arbitrary for script; otherwise we'll push insane amounts
+ -- of data
-- , Q.testProperty "to_script . from_script ~ id" $
-- Q.withMaxSuccess 100 to_script_inverts_from_script
]
@@ -97,4 +99,4 @@ script_terms = [
redeemscript_base16 :: BS.ByteString
redeemscript_base16 = "5221038282263212c609d9ea2a6e3e172de238d8c39cabe56f3f9e451d2c4c7739ba8721031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f2102b4632d08485ff1df2db55b9dafd23347d1c47a457072a1e87be26896549a873753ae"
-
+--
