[internal] random little changes to keep faster toHex from cryptohash as compiled code for later use

Crypto/Internal/CompatPrim.hs

@@ -14,21 +14,37 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
 module Crypto.Internal.CompatPrim
     ( be32Prim
+    , le32Prim
     , byteswap32Prim
     , booleanPrim
+    , convert4To32
     ) where
 
 import GHC.Prim
 
-#ifdef ARCH_IS_LITTLE_ENDIAN
+-- | byteswap Word# to or from Big Endian
+--
+-- on a big endian machine, this function is a nop.
 be32Prim :: Word# -> Word#
+#ifdef ARCH_IS_LITTLE_ENDIAN
 be32Prim = byteswap32Prim
 #else
 be32Prim w = w
 #endif
 
+-- | byteswap Word# to or from Little Endian
+--
+-- on a little endian machine, this function is a nop.
+le32Prim :: Word# -> Word#
+#ifdef ARCH_IS_LITTLE_ENDIAN
+le32Prim w = w
+#else
+le32Prim = byteswap32Prim
+#endif
+
 byteswap32Prim :: Word# -> Word#
 #if __GLASGOW_HASKELL__ >= 708
 byteswap32Prim w = byteSwap32# w
@@ -41,6 +57,22 @@ byteswap32Prim w =
      in or# a (or# b (or# c d))
 #endif
 
+-- | combine 4 word8 [a,b,c,d] to a word32 representing [a,b,c,d]
+convert4To32 :: (# Word#, Word#, Word#, Word# #) -> Word#
+convert4To32 (# a, b, c, d #) = or# (or# c1 c2) (or# c3 c4)
+  where
+#ifdef ARCH_IS_LITTLE_ENDIAN
+        !c1 = uncheckedShiftL# a 24#
+        !c2 = uncheckedShiftL# b 16#
+        !c3 = uncheckedShiftL# c 8#
+        !c4 = d
+#else
+        !c1 = uncheckedShiftL# d 24#
+        !c2 = uncheckedShiftL# c 16#
+        !c3 = uncheckedShiftL# b 8#
+        !c4 = a
+#endif
+
 #if __GLASGOW_HASKELL__ >= 708
 booleanPrim :: Int# -> Bool
 booleanPrim v = tagToEnum# v

Crypto/Internal/Hex.hs

@@ -15,16 +15,18 @@
 module Crypto.Internal.Hex
     ( showHexadecimal
     , toHexadecimal
+    , toHexadecimal4
     ) where
 
 import Crypto.Internal.Compat
+import Crypto.Internal.CompatPrim
 import Data.Word
 import GHC.Prim
 import GHC.Types
 import GHC.Word
 import Control.Monad
 import Foreign.Storable
-import Foreign.Ptr (Ptr)
+import Foreign.Ptr (Ptr, plusPtr)
 
 showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a) -> Int -> String
 showHexadecimal withPtr = doChunks 0
@@ -70,6 +72,26 @@ toHexadecimal bout bin n = loop 0
                 pokeByteOff bout (i * 2 + 1) (W8# w2)
                 loop (i+1)
 
+-- | convert to hexadecimal going 2 by 2
+--
+-- experimental. untested
+toHexadecimal4 :: Ptr Word32 -> Ptr Word8 -> Int -> IO ()
+toHexadecimal4 bout bin n = loop 0
+  where loop i
+            | i == n = return ()
+            | otherwise = do
+                (W8# w1) <- peekByteOff bin i
+                (W8# w2) <- peekByteOff bin (i+1)
+                let r = W32# (convertByte4 w1 w2)
+                poke (bout `plusPtr` (i * 2)) r
+                loop (i+2)
+
+convertByte4 :: Word# -> Word# -> Word#
+convertByte4 a b = convert4To32 (# b2, b1, a2, a1 #)
+  where
+        !(# a1, a2 #) = convertByte a
+        !(# b1, b2 #) = convertByte b
+
 convertByte :: Word# -> (# Word#, Word# #)
 convertByte b = (# r tableHi b, r tableLo b #)
   where