From 608bf3323a1661e279aa3514f56b754393e367e9 Mon Sep 17 00:00:00 2001
From: effectfully <effectfully@gmail.com>
Date: Wed, 4 Dec 2024 10:58:31 +0100
Subject: [PATCH] [Evaluation] [Performance] Use 'unsafeShiftL' instead of '*'

Added CHANGELOG entry
---
 ...39_bezirg_use_unsafeShiftL_instead_of_multiply.md |  3 +++
 .../src/Data/RandomAccessList/SkewBinary.hs          | 12 +++++++-----
 2 files changed, 10 insertions(+), 5 deletions(-)
 create mode 100644 plutus-core/changelog.d/20241217_134339_bezirg_use_unsafeShiftL_instead_of_multiply.md

diff --git a/plutus-core/changelog.d/20241217_134339_bezirg_use_unsafeShiftL_instead_of_multiply.md b/plutus-core/changelog.d/20241217_134339_bezirg_use_unsafeShiftL_instead_of_multiply.md
new file mode 100644
index 00000000000..8ef40b783ae
--- /dev/null
+++ b/plutus-core/changelog.d/20241217_134339_bezirg_use_unsafeShiftL_instead_of_multiply.md
@@ -0,0 +1,3 @@
+### Changed
+
+- In #6737 made the the CEK creation operation marginally faster by resorting to bit manipulation
diff --git a/plutus-core/index-envs/src/Data/RandomAccessList/SkewBinary.hs b/plutus-core/index-envs/src/Data/RandomAccessList/SkewBinary.hs
index 3ea4835c3b8..dd3e41464d2 100644
--- a/plutus-core/index-envs/src/Data/RandomAccessList/SkewBinary.hs
+++ b/plutus-core/index-envs/src/Data/RandomAccessList/SkewBinary.hs
@@ -17,7 +17,7 @@ module Data.RandomAccessList.SkewBinary
     , uncons
     ) where
 
-import Data.Bits (unsafeShiftR)
+import Data.Bits (setBit, unsafeShiftL, unsafeShiftR)
 import Data.Word
 import GHC.Exts
 
@@ -51,8 +51,8 @@ null Nil = True
 null _   = False
 {-# INLINE null #-}
 
-{-# complete Cons, Nil #-}
-{-# complete BHead, Nil #-}
+{-# COMPLETE Cons, Nil #-}
+{-# COMPLETE BHead, Nil #-}
 
 -- /O(1)/
 pattern Cons :: a -> RAList a -> RAList a
@@ -62,8 +62,10 @@ pattern Cons x xs <- (uncons -> Just (x, xs)) where
 -- O(1) worst-case
 cons :: a -> RAList a -> RAList a
 cons x = \case
-    (BHead w1 t1 (BHead w2 t2 ts')) | w1 == w2 -> BHead (2*w1+1) (Node x t1 t2) ts'
-    ts                                         -> BHead 1 (Leaf x) ts
+    (BHead w1 t1 (BHead w2 t2 ts')) | w1 == w2 ->
+        -- 'unsafeShiftL w1 1 `setBit`0' is supposed to be a faster version of '(2*w1)+1'
+        BHead (unsafeShiftL w1 1 `setBit` 0) (Node x t1 t2) ts'
+    ts -> BHead 1 (Leaf x) ts
 {-# INLINE cons #-}
 
 -- /O(1)/