Bagley shootout. Was: Lightningspeed haskell

[Jan Kort]

I implemented the programs for hash1 and hash2, but I had to
make a lot of changes to FiniteMap to get them to work:
- I changed foldl to foldl' (as defined in Hugs).
- I made foldFM strict (like foldl').
- I made the datatype FiniteMap strict (put !'s everywhere).
I put the programs below, maybe there is a better way to do this.

  Jan

-- Hash1
module Main(main) where

import FiniteMap
import System

writeHex' :: Int -> String
writeHex' 0 = ""
writeHex' n
  = c:writeHex' y
    where
      x = n `mod` 16
      y = n `div` 16
      c | x <= 9    = toEnum ((fromEnum '0') + x)
        | otherwise = toEnum ((fromEnum 'A') + x - 10)

writeHex :: Int -> String
writeHex n
  | n > 0     = reverse (writeHex' n)
  | n == 0    = "0"
  | otherwise = '-':(reverse (writeHex' (-n)))

main :: IO()
main = do {
    [arg] <- getArgs;
    let
        n  = read arg
        fm = listToFM [(writeHex i,i) | i <- [1..n]]
        c  = sum [if elemFM (show i) fm then 1 else 0 | i <- reverse [1..n]]
    in
        putStrLn (show c);



-- Hash2
module Main(main) where

import FiniteMap
import System
import Maybe

foldl'           :: (a -> b -> a) -> a -> [b] -> a
foldl' _ a []     = a
foldl' f a (x:xs) = (foldl' f $! f a x) xs

f :: FiniteMap Int Int -> FiniteMap Int Int -> Int -> FiniteMap Int Int
f hash1 hash2 k
  | isJust elt2 = addToFM hash2 k (fromJust elt1 + fromJust elt2)
  | otherwise   = addToFM hash2 k (fromJust elt1)
    where
      elt1 = lookupFM hash1 k
      elt2 = lookupFM hash2 k

main :: IO()
main = do {
    [arg] <- getArgs;
    let
        n       = read arg
        hash1   = listToFM [(i,i) | i <- [1..10000]]
        keys    = concat (take n (repeat (keysFM hash1)))
        hash2   = foldl' (f hash1) emptyFM keys;
        h1_1    = fromJust (lookupFM hash1 1)
        h1_9999 = fromJust (lookupFM hash1 9999)
        h2_1    = fromJust (lookupFM hash2 1)
        h2_9999 = fromJust (lookupFM hash2 9999)
    in
        putStrLn (show h1_1 ++ " " ++ show h1_9999 ++ " " ++
                  show h2_1 ++ " " ++ show h2_9999);
}