{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} module Main where import Data.Word import Data.List (findIndex) import GHC.Exts -- Having a wrapper gives us two things: -- * it's easier to test everything (no need for code using raw primops) -- * we test the deriving mechanism for Word16# data TestWord16 = T16 Word16# deriving (Eq, Ord) mkT16 :: Word -> TestWord16 mkT16 (W# a) = T16 (wordToWord16# a) main :: IO () main = do let input = [ (a, b) | a <- allWord16, b <- allWord16 ] -- -- (==) -- let expected = [ a == b | (a, b) <- input ] actual = [ mkT16 a == mkT16 b | (a, b) <- input ] checkResults "(==)" input expected actual -- -- (/=) -- let expected = [ a /= b | (a, b) <- input ] actual = [ mkT16 a /= mkT16 b | (a, b) <- input ] checkResults "(/=)" input expected actual -- -- (<) -- let expected = [ a < b | (a, b) <- input ] actual = [ mkT16 a < mkT16 b | (a, b) <- input ] checkResults "(<)" input expected actual -- -- (>) -- let expected = [ a > b | (a, b) <- input ] actual = [ mkT16 a > mkT16 b | (a, b) <- input ] checkResults "(>)" input expected actual -- -- (<=) -- let expected = [ a <= b | (a, b) <- input ] actual = [ mkT16 a <= mkT16 b | (a, b) <- input ] checkResults "(<=)" input expected actual -- -- (>=) -- let expected = [ a >= b | (a, b) <- input ] actual = [ mkT16 a >= mkT16 b | (a, b) <- input ] checkResults "(>=)" input expected actual checkResults :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () checkResults test inputs expected actual = case findIndex (\(e, a) -> e /= a) (zip expected actual) of Nothing -> putStrLn $ "Pass: " ++ test Just i -> error $ "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) ++ " expected: " ++ show (expected !! i) ++ " but got: " ++ show (actual !! i) -- testing across the entire Word16 range blows the memory, -- hence choosing a smaller range allWord16 :: [Word] allWord16 = [ 0 .. 100 ]