[Haskell-cafe] Performance and STUArrays

[Dominic Steinitz]

I've been playing around some more trying improve the performance of the SHA1 
implmentation in the crypto library. I've isolated one of the functions and 
implemented it using

a) unfold

and

b) STUArray

The STUArray implementation is about twice as fast but I was expecting an 
order of magnitude improvement given I thought I would have been allocating 
16 x 80 new 32 bit words with unfold but nothing with the STUArray. 

Should I have been disappointed?

dom at heisenberg:~/sha12> time ./arrTest 17 STUArray > /dev/null

real    0m11.102s
user    0m9.129s
sys     0m0.112s
dom at heisenberg:~/sha12> time ./arrTest 17 Unfold > /dev/null

real    0m18.381s
user    0m16.361s
sys     0m0.212s

Dominic.

import Data.Bits
import Data.List
import Data.Word
import Control.Monad.ST
import Data.Array.ST
import System
import System.IO

data Word160 = Word160 !Word32 !Word32 !Word32 !Word32 !Word32
   deriving (Eq, Show)

ss :: Word160
ss = Word160 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0

test :: [Word32]
test = [0x61626380, 0x00000000, 0x00000000, 0x00000000,
        0x00000000, 0x00000000, 0x00000000, 0x00000000,
        0x00000000, 0x00000000, 0x00000000, 0x00000000,
        0x00000000, 0x00000000, 0x00000000, 0x00000018]

tests :: Int -> [[Word32]]
tests n = map (\n -> n:[0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0, 
0x0, 0x0, 0x0, 0x18]) [1..2^n]

rotL :: Bits b => Int -> b -> b
rotL = flip rotateL

v1 :: a -> [Word32] -> [Word32]
v1 ss xs = take 80 (n xs)
   where
      h [w0, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15] 
=
         Just (w0,[w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, 
w14, w15, (rotL 1 (w0 `xor` w2 `xor` w8 `xor` w13))])
      n = unfoldr h

v2 ss xs = vs
   where
      us =
         do w <- newArray (0,79) 0 :: ST s (STUArray s Int Word32)
            let initLoop 15 = writeArray w 15 (xs!!15)
                initLoop n = 
                   do writeArray w n (xs!!n)
                      initLoop (n+1)
                mainLoop 79 = nextW 79
                mainLoop n =
                   do nextW n
                      mainLoop (n+1)
                nextW n = 
                   do wm16 <- readArray w (n-16)
                      wm14 <- readArray w (n-14)
                      wm8  <- readArray w (n-8)
                      wm3  <- readArray w (n-3)
                      writeArray w n (rotL 1 (wm3 `xor` wm8 `xor` wm14 `xor` 
wm16))
            initLoop 0
            mainLoop 16
            getElems w
      vs = runST us

test1 n = map (v1 ss) (tests n)
test2 n = map (v2 ss) (tests n)

data TestType = Unfold | STUArray
   deriving (Eq, Read, Show)

main =
   do progName <- getProgName
      args <- getArgs
      if length args /= 2
         then putStrLn ("Usage: " ++ progName ++ " <testSize> <testType>")
         else do let n = read (args!!0)
                     t = read (args!!1)
                 if t == Unfold
                    then putStrLn (show (test1 n))
                    else putStrLn (show (test2 n))