Introduce Int16# and Word16#

This builds off of D4475.

Bumps binary submodule.

Reviewers: carter, AndreasK, hvr, goldfire, bgamari, simonmar

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D5006

11 files changed, 598 insertions, 5 deletions

diff --git a/testsuite/tests/primops/should_run/ArithInt16.hs b/testsuite/tests/primops/should_run/ArithInt16.hs
new file mode 100644
index 0000000000..26d937042e
--- /dev/null
+++ b/testsuite/tests/primops/should_run/ArithInt16.hs
@@ -0,0 +1,197 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import Data.Int
+import Data.List
+import GHC.Prim
+import GHC.Exts
+
+main :: IO ()
+main = do
+
+    --
+    -- Check if passing Int16# on the stack works (16 parameter function will
+    -- need to use stack for some of the them)
+    --
+    let input =
+            [ ( (a + 0), (a + 1), (a + 2), (a + 3),
+                (a + 4), (a + 5), (a + 6), (a + 7),
+                (a + 8), (a + 9), (a + 10), (a + 11),
+                (a + 12), (a + 13), (a + 14), (a + 15) )
+            | a <- allInt16
+            ]
+        expected =
+            [ toInt16
+                  (a + b + c + d + e + f + g + h +
+                   i + j + k + l + m + n + o + p)
+            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input
+            ]
+        actual =
+            [ addMany a b c d e f g h i j k l m n o p
+            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input
+            ]
+    checkResults "passing Int16# on the stack" input expected actual
+
+    --
+    -- negateInt16#
+    --
+    let input = allInt16
+        expected = [ toInt16 (negate a) | a <- input ]
+        actual = [ apply1 negateInt16# a | a <- input ]
+    checkResults "negateInt16#" input expected actual
+
+    --
+    -- plusInt16#
+    --
+    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]
+        expected = [ toInt16 (a + b) | (a, b) <- input ]
+        actual = [ apply2 plusInt16# a b | (a, b) <- input ]
+    checkResults "plusInt16#" input expected actual
+
+    -- --
+    -- -- subInt16#
+    -- --
+    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]
+        expected = [ toInt16 (a - b) | (a, b) <- input ]
+        actual = [ apply2 subInt16# a b | (a, b) <- input ]
+    checkResults "subInt16#" input expected actual
+
+    --
+    -- timesInt16#
+    --
+    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]
+        expected = [ toInt16 (a * b) | (a, b) <- input ]
+        actual = [ apply2 timesInt16# a b | (a, b) <- input ]
+    checkResults "timesInt16#" input expected actual
+
+    --
+    -- remInt16#
+    --
+    let input =
+            [ (a, b) | a <- allInt16, b <- allInt16
+            -- Don't divide by 0 or cause overflow
+            , b /= 0, not (a == -32768 && b == -1)
+            ]
+        expected = [ toInt16 (a `rem` b) | (a, b) <- input ]
+        actual = [ apply2 remInt16# a b | (a, b) <- input ]
+    checkResults "remInt16#" input expected actual
+
+    --
+    -- quotInt16#
+    --
+    let input =
+            [ (a, b) | a <- allInt16, b <- allInt16
+            , b /= 0, not (a == -32768 && b == -1)
+            ]
+        expected = [ toInt16 (a `quot` b) | (a, b) <- input ]
+        actual = [ apply2 quotInt16# a b | (a, b) <- input ]
+    checkResults "quotInt16#" input expected actual
+
+    --
+    -- quotRemInt16#
+    --
+    let input =
+            [ (a, b) | a <- allInt16, b <- allInt16
+            , b /= 0, not (a == -32768 && b == -1)
+            ]
+        expected =
+            [ (toInt16 q, toInt16 r)  | (a, b) <- input
+            , let (q, r) = a `quotRem` b
+            ]
+        actual = [ apply3 quotRemInt16# a b | (a, b) <- input ]
+    checkResults "quotRemInt16#" 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 Int16 range blows the memory,
+-- hence choosing a smaller range
+allInt16 :: [Int]
+allInt16 = [ -50 .. 50 ]
+
+toInt16 :: Int -> Int
+toInt16 a = fromIntegral (fromIntegral a :: Int16)
+
+addMany#
+    :: Int16# -> Int16# -> Int16# -> Int16#
+    -> Int16# -> Int16# -> Int16# -> Int16#
+    -> Int16# -> Int16# -> Int16# -> Int16#
+    -> Int16# -> Int16# -> Int16# -> Int16#
+    -> Int16#
+addMany# a b c d e f g h i j k l m n o p =
+    a `plusInt16#` b `plusInt16#` c `plusInt16#` d `plusInt16#`
+    e `plusInt16#` f `plusInt16#` g `plusInt16#` h `plusInt16#`
+    i `plusInt16#` j `plusInt16#` k `plusInt16#` l `plusInt16#`
+    m `plusInt16#` n `plusInt16#` o `plusInt16#` p
+{-# NOINLINE addMany# #-}
+
+addMany
+    :: Int -> Int -> Int -> Int
+    -> Int -> Int -> Int -> Int
+    -> Int -> Int -> Int -> Int
+    -> Int -> Int -> Int -> Int
+    -> Int
+addMany (I# a) (I# b) (I# c) (I# d)
+        (I# e) (I# f) (I# g) (I# h)
+        (I# i) (I# j) (I# k) (I# l)
+        (I# m) (I# n) (I# o) (I# p)
+            = I# (extendInt16# int16)
+  where
+    !int16 = addMany#
+                (narrowInt16# a) (narrowInt16# b) (narrowInt16# c) (narrowInt16# d)
+                (narrowInt16# e) (narrowInt16# f) (narrowInt16# g) (narrowInt16# h)
+                (narrowInt16# i) (narrowInt16# j) (narrowInt16# k) (narrowInt16# l)
+                (narrowInt16# m) (narrowInt16# n) (narrowInt16# o) (narrowInt16# p)
+{-# NOINLINE addMany #-}
+
+-- Convenient and also tests higher order functions on Int16#
+apply1 :: (Int16# -> Int16#) -> Int -> Int
+apply1 opToTest (I# a) = I# (extendInt16# (opToTest (narrowInt16# a)))
+{-# NOINLINE apply1 #-}
+
+apply2 :: (Int16# -> Int16# -> Int16#) -> Int -> Int -> Int
+apply2 opToTest (I# a) (I# b) =
+    let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)
+        r = opToTest sa sb
+    in I# (extendInt16# r)
+{-# NOINLINE apply2 #-}
+
+apply3 :: (Int16# -> Int16# -> (# Int16#, Int16# #)) -> Int -> Int -> (Int, Int)
+apply3 opToTest (I# a) (I# b) =
+    let (# sa, sb #) = (# narrowInt16# a, narrowInt16# b #)
+        (# ra, rb #) = opToTest sa sb
+    in (I# (extendInt16# ra), I# (extendInt16# rb))
+{-# NOINLINE apply3 #-}
+
+instance
+        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,
+         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)
+      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
+    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==
+        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =
+            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&
+            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&
+            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&
+            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2
+
+instance
+        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
+         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)
+      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
+    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =
+        "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++
+        "," ++ show e ++ "," ++ show f ++ "," ++ show g ++ "," ++ show h ++
+        "," ++ show i ++ "," ++ show j ++ "," ++ show k ++ "," ++ show l ++
+        "," ++ show m ++ "," ++ show n ++ "," ++ show o ++ "," ++ show p ++
+        ")"
diff --git a/testsuite/tests/primops/should_run/ArithInt16.stdout b/testsuite/tests/primops/should_run/ArithInt16.stdout
new file mode 100644
index 0000000000..3a8cc45976
--- /dev/null
+++ b/testsuite/tests/primops/should_run/ArithInt16.stdout
@@ -0,0 +1,8 @@
+Pass: passing Int16# on the stack
+Pass: negateInt16#
+Pass: plusInt16#
+Pass: subInt16#
+Pass: timesInt16#
+Pass: remInt16#
+Pass: quotInt16#
+Pass: quotRemInt16#
diff --git a/testsuite/tests/primops/should_run/ArithWord16.hs b/testsuite/tests/primops/should_run/ArithWord16.hs
new file mode 100644
index 0000000000..ff86d95339
--- /dev/null
+++ b/testsuite/tests/primops/should_run/ArithWord16.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import Data.Word
+import Data.Bits
+import Data.List
+import GHC.Prim
+import GHC.Exts
+
+main :: IO ()
+main = do
+
+    --
+    -- Check if passing Word16# on the stack works (16 parameter function will
+    -- need to use stack for some of the them)
+    --
+    let input =
+            [ ( (a + 0), (a + 1), (a + 2), (a + 3),
+                (a + 4), (a + 5), (a + 6), (a + 7),
+                (a + 8), (a + 9), (a + 10), (a + 11),
+                (a + 12), (a + 13), (a + 14), (a + 15) )
+            | a <- allWord16
+            ]
+        expected =
+            [ toWord16
+                  (a + b + c + d + e + f + g + h +
+                   i + j + k + l + m + n + o + p)
+            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input
+            ]
+        actual =
+            [ addMany a b c d e f g h i j k l m n o p
+            | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input
+            ]
+    checkResults "passing Word16# on the stack" input expected actual
+
+    --
+    -- notWord16#
+    --
+    let input = allWord16
+        expected = [ toWord16 (complement a) | a <- input ]
+        actual = [ apply1 notWord16# a | a <- input ]
+    checkResults "notWord16#" input expected actual
+
+    --
+    -- plusWord16#
+    --
+    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]
+        expected = [ toWord16 (a + b) | (a, b) <- input ]
+        actual = [ apply2 plusWord16# a b | (a, b) <- input ]
+    checkResults "plusWord16#" input expected actual
+
+    --
+    -- subWord16#
+    --
+    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]
+        expected = [ toWord16 (a - b) | (a, b) <- input ]
+        actual = [ apply2 subWord16# a b | (a, b) <- input ]
+    checkResults "subWord16#" input expected actual
+
+    --
+    -- timesWord16#
+    --
+    let input = [ (a, b) | a <- allWord16, b <- allWord16 ]
+        expected = [ toWord16 (a * b) | (a, b) <- input ]
+        actual = [ apply2 timesWord16# a b | (a, b) <- input ]
+    checkResults "timesWord16#" input expected actual
+
+    --
+    -- remWord16#
+    --
+    let input =
+            -- Don't divide by 0.
+            [ (a, b) | a <- allWord16, b <- allWord16 , b /= 0 ]
+        expected = [ toWord16 (a `rem` b) | (a, b) <- input ]
+        actual = [ apply2 remWord16# a b | (a, b) <- input ]
+    checkResults "remWord16#" input expected actual
+
+    --
+    -- quotWord16#
+    --
+    let input =
+            [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ]
+        expected = [ toWord16 (a `quot` b) | (a, b) <- input ]
+        actual = [ apply2 quotWord16# a b | (a, b) <- input ]
+    checkResults "quotWord16#" input expected actual
+
+    --
+    -- quotRemWord16#
+    --
+    let input =
+            [ (a, b) | a <- allWord16, b <- allWord16, b /= 0 ]
+        expected =
+            [ (toWord16 q, toWord16 r)  | (a, b) <- input
+            , let (q, r) = a `quotRem` b
+            ]
+        actual = [ apply3 quotRemWord16# a b | (a, b) <- input ]
+    checkResults "quotRemWord16#" 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 ]
+
+toWord16 :: Word -> Word
+toWord16 a = fromIntegral (fromIntegral a :: Word16)
+
+addMany#
+    :: Word16# -> Word16# -> Word16# -> Word16#
+    -> Word16# -> Word16# -> Word16# -> Word16#
+    -> Word16# -> Word16# -> Word16# -> Word16#
+    -> Word16# -> Word16# -> Word16# -> Word16#
+    -> Word16#
+addMany# a b c d e f g h i j k l m n o p =
+    a `plusWord16#` b `plusWord16#` c `plusWord16#` d `plusWord16#`
+    e `plusWord16#` f `plusWord16#` g `plusWord16#` h `plusWord16#`
+    i `plusWord16#` j `plusWord16#` k `plusWord16#` l `plusWord16#`
+    m `plusWord16#` n `plusWord16#` o `plusWord16#` p
+{-# NOINLINE addMany# #-}
+
+addMany
+    :: Word -> Word -> Word -> Word
+    -> Word -> Word -> Word -> Word
+    -> Word -> Word -> Word -> Word
+    -> Word -> Word -> Word -> Word
+    -> Word
+addMany (W# a) (W# b) (W# c) (W# d)
+        (W# e) (W# f) (W# g) (W# h)
+        (W# i) (W# j) (W# k) (W# l)
+        (W# m) (W# n) (W# o) (W# p)
+            = W# (extendWord16# word16)
+  where
+    !word16 =
+        addMany#
+            (narrowWord16# a) (narrowWord16# b) (narrowWord16# c) (narrowWord16# d)
+            (narrowWord16# e) (narrowWord16# f) (narrowWord16# g) (narrowWord16# h)
+            (narrowWord16# i) (narrowWord16# j) (narrowWord16# k) (narrowWord16# l)
+            (narrowWord16# m) (narrowWord16# n) (narrowWord16# o) (narrowWord16# p)
+{-# NOINLINE addMany #-}
+
+-- Convenient and also tests higher order functions on Word16#
+apply1 :: (Word16# -> Word16#) -> Word -> Word
+apply1 opToTest (W# a) = W# (extendWord16# (opToTest (narrowWord16# a)))
+{-# NOINLINE apply1 #-}
+
+apply2 :: (Word16# -> Word16# -> Word16#) -> Word -> Word -> Word
+apply2 opToTest (W# a) (W# b) =
+    let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)
+        r = opToTest sa sb
+    in W# (extendWord16# r)
+{-# NOINLINE apply2 #-}
+
+apply3
+  :: (Word16# -> Word16# -> (# Word16#, Word16# #)) -> Word -> Word -> (Word, Word)
+apply3 opToTest (W# a) (W# b) =
+    let (# sa, sb #) = (# narrowWord16# a, narrowWord16# b #)
+        (# ra, rb #) = opToTest sa sb
+    in (W# (extendWord16# ra), W# (extendWord16# rb))
+{-# NOINLINE apply3 #-}
+
+instance
+        (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h,
+         Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p)
+      => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
+    (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) ==
+        (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) =
+            a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 &&
+            e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 &&
+            i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 &&
+            m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2
+
+instance
+        (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
+         Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p)
+      => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where
+    show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) =
+        "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++
+        "," ++ show e ++ "," ++ show f ++ "," ++ show g ++ "," ++ show h ++
+        "," ++ show i ++ "," ++ show j ++ "," ++ show k ++ "," ++ show l ++
+        "," ++ show m ++ "," ++ show n ++ "," ++ show o ++ "," ++ show p ++
+        ")"
diff --git a/testsuite/tests/primops/should_run/ArithWord16.stdout b/testsuite/tests/primops/should_run/ArithWord16.stdout
new file mode 100644
index 0000000000..f8ba30ef4f
--- /dev/null
+++ b/testsuite/tests/primops/should_run/ArithWord16.stdout
@@ -0,0 +1,8 @@
+Pass: passing Word16# on the stack
+Pass: notWord16#
+Pass: plusWord16#
+Pass: subWord16#
+Pass: timesWord16#
+Pass: remWord16#
+Pass: quotWord16#
+Pass: quotRemWord16#
diff --git a/testsuite/tests/primops/should_run/CmpInt16.hs b/testsuite/tests/primops/should_run/CmpInt16.hs
new file mode 100644
index 0000000000..79588cb9b3
--- /dev/null
+++ b/testsuite/tests/primops/should_run/CmpInt16.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import Data.Int
+import Data.List
+import GHC.Prim
+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 Int16#
+data TestInt16 = T16 Int16#
+    deriving (Eq, Ord)
+
+mkT16 :: Int -> TestInt16
+mkT16 (I# a) = T16 (narrowInt16# a)
+
+main :: IO ()
+main = do
+    let input = [ (a, b) | a <- allInt16, b <- allInt16 ]
+
+    --
+    -- (==)
+    --
+    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 Int16 range blows the memory,
+-- hence choosing a smaller range
+allInt16 :: [Int]
+allInt16 = [ -50 .. 50 ]
diff --git a/testsuite/tests/primops/should_run/CmpInt16.stdout b/testsuite/tests/primops/should_run/CmpInt16.stdout
new file mode 100644
index 0000000000..191d2b4b26
--- /dev/null
+++ b/testsuite/tests/primops/should_run/CmpInt16.stdout
@@ -0,0 +1,6 @@
+Pass: (==)
+Pass: (/=)
+Pass: (<)
+Pass: (>)
+Pass: (<=)
+Pass: (>=)
diff --git a/testsuite/tests/primops/should_run/CmpWord16.hs b/testsuite/tests/primops/should_run/CmpWord16.hs
new file mode 100644
index 0000000000..7adc270afc
--- /dev/null
+++ b/testsuite/tests/primops/should_run/CmpWord16.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import Data.Word
+import Data.List
+import GHC.Prim
+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 (narrowWord16# 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 ]
diff --git a/testsuite/tests/primops/should_run/CmpWord16.stdout b/testsuite/tests/primops/should_run/CmpWord16.stdout
new file mode 100644
index 0000000000..191d2b4b26
--- /dev/null
+++ b/testsuite/tests/primops/should_run/CmpWord16.stdout
@@ -0,0 +1,6 @@
+Pass: (==)
+Pass: (/=)
+Pass: (<)
+Pass: (>)
+Pass: (<=)
+Pass: (>=)
diff --git a/testsuite/tests/primops/should_run/ShowPrim.hs b/testsuite/tests/primops/should_run/ShowPrim.hs
index 5670032f4a..e11a4934e6 100644
--- a/testsuite/tests/primops/should_run/ShowPrim.hs
+++ b/testsuite/tests/primops/should_run/ShowPrim.hs
@@ -4,11 +4,19 @@ module Main where
 
 import GHC.Exts
 
-data Test = Test Int8# Word8#
+data Test1 = Test1 Int8# Word8#
     deriving (Show)
 
-test1 :: Test
-test1 = Test (narrowInt8# 1#) (narrowWord8# 2##)
+data Test2 = Test2 Int16# Word16#
+    deriving (Show)
+
+test1 :: Test1
+test1 = Test1 (narrowInt8# 1#) (narrowWord8# 2##)
+
+test2 :: Test2
+test2 = Test2 (narrowInt16# 1#) (narrowWord16# 2##)
 
 main :: IO ()
-main = print test1
+main = do
+  print test1
+  print test2
diff --git a/testsuite/tests/primops/should_run/ShowPrim.stdout b/testsuite/tests/primops/should_run/ShowPrim.stdout
index 5720effb8b..e2801b44fb 100644
--- a/testsuite/tests/primops/should_run/ShowPrim.stdout
+++ b/testsuite/tests/primops/should_run/ShowPrim.stdout
@@ -1 +1,2 @@
-Test (narrowInt8# 1#) (narrowWord8# 2##)
+Test1 (narrowInt8# 1#) (narrowWord8# 2##)
+Test2 (narrowInt16# 1#) (narrowWord16# 2##)
diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T
index c7cdd348bf..46954e3c58 100644
--- a/testsuite/tests/primops/should_run/all.T
+++ b/testsuite/tests/primops/should_run/all.T
@@ -18,3 +18,8 @@ test('ArithWord8', omit_ways(['ghci']), compile_and_run, [''])
 test('CmpInt8', normal, compile_and_run, [''])
 test('CmpWord8', normal, compile_and_run, [''])
 test('ShowPrim', normal, compile_and_run, [''])
+
+test('ArithInt16', normal, compile_and_run, [''])
+test('ArithWord16', normal, compile_and_run, [''])
+test('CmpInt16', normal, compile_and_run, [''])
+test('CmpWord16', normal, compile_and_run, [''])
\ No newline at end of file