# Changeset View

Changeset View

# Standalone View

Standalone View

# testsuite/tests/primops/should_run/ArithWord8.hs

- This file was added.

1 | {-# LANGUAGE BangPatterns #-} | ||||
---|---|---|---|---|---|

2 | {-# LANGUAGE MagicHash #-} | ||||

3 | {-# LANGUAGE UnboxedTuples #-} | ||||

4 | | ||||

5 | module Main where | ||||

6 | | ||||

7 | import Data.Word | ||||

8 | import Data.Bits | ||||

9 | import Data.List | ||||

10 | import GHC.Prim | ||||

11 | import GHC.Exts | ||||

12 | | ||||

13 | main :: IO () | ||||

14 | main = do | ||||

15 | | ||||

16 | -- | ||||

17 | -- Check if passing Word8# on the stack works (16 parameter function will | ||||

18 | -- need to use stack for some of the them) | ||||

19 | -- | ||||

20 | let input = | ||||

21 | [ ( (a + 0), (a + 1), (a + 2), (a + 3), | ||||

22 | (a + 4), (a + 5), (a + 6), (a + 7), | ||||

23 | (a + 8), (a + 9), (a + 10), (a + 11), | ||||

24 | (a + 12), (a + 13), (a + 14), (a + 15) ) | ||||

25 | | a <- allWord8 | ||||

26 | ] | ||||

27 | expected = | ||||

28 | [ toWord8 | ||||

29 | (a + b + c + d + e + f + g + h + | ||||

30 | i + j + k + l + m + n + o + p) | ||||

31 | | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input | ||||

32 | ] | ||||

33 | actual = | ||||

34 | [ addMany a b c d e f g h i j k l m n o p | ||||

35 | | (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) <- input | ||||

36 | ] | ||||

37 | checkResults "passing Word8# on the stack" input expected actual | ||||

38 | | ||||

39 | -- | ||||

40 | -- notWord8# | ||||

41 | -- | ||||

42 | let input = allWord8 | ||||

43 | expected = [ toWord8 (complement a) | a <- input ] | ||||

44 | actual = [ apply1 notWord8# a | a <- input ] | ||||

45 | checkResults "notWord8#" input expected actual | ||||

46 | | ||||

47 | -- | ||||

48 | -- plusWord8# | ||||

49 | -- | ||||

50 | let input = [ (a, b) | a <- allWord8, b <- allWord8 ] | ||||

51 | expected = [ toWord8 (a + b) | (a, b) <- input ] | ||||

52 | actual = [ apply2 plusWord8# a b | (a, b) <- input ] | ||||

53 | checkResults "plusWord8#" input expected actual | ||||

54 | | ||||

55 | -- | ||||

56 | -- subWord8# | ||||

57 | -- | ||||

58 | let input = [ (a, b) | a <- allWord8, b <- allWord8 ] | ||||

59 | expected = [ toWord8 (a - b) | (a, b) <- input ] | ||||

60 | actual = [ apply2 subWord8# a b | (a, b) <- input ] | ||||

61 | checkResults "subWord8#" input expected actual | ||||

62 | | ||||

63 | -- | ||||

64 | -- timesWord8# | ||||

65 | -- | ||||

66 | let input = [ (a, b) | a <- allWord8, b <- allWord8 ] | ||||

67 | expected = [ toWord8 (a * b) | (a, b) <- input ] | ||||

68 | actual = [ apply2 timesWord8# a b | (a, b) <- input ] | ||||

69 | checkResults "timesWord8#" input expected actual | ||||

70 | | ||||

71 | -- | ||||

72 | -- remWord8# | ||||

73 | -- | ||||

74 | let input = | ||||

75 | -- Don't divide by 0. | ||||

76 | [ (a, b) | a <- allWord8, b <- allWord8 , b /= 0 ] | ||||

77 | expected = [ toWord8 (a `rem` b) | (a, b) <- input ] | ||||

78 | actual = [ apply2 remWord8# a b | (a, b) <- input ] | ||||

79 | checkResults "remWord8#" input expected actual | ||||

80 | | ||||

81 | -- | ||||

82 | -- quotWord8# | ||||

83 | -- | ||||

84 | let input = | ||||

85 | [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ] | ||||

86 | expected = [ toWord8 (a `quot` b) | (a, b) <- input ] | ||||

87 | actual = [ apply2 quotWord8# a b | (a, b) <- input ] | ||||

88 | checkResults "quotWord8#" input expected actual | ||||

89 | | ||||

90 | -- | ||||

91 | -- quotRemWord8# | ||||

92 | -- | ||||

93 | let input = | ||||

94 | [ (a, b) | a <- allWord8, b <- allWord8, b /= 0 ] | ||||

95 | expected = | ||||

96 | [ (toWord8 q, toWord8 r) | (a, b) <- input | ||||

97 | , let (q, r) = a `quotRem` b | ||||

98 | ] | ||||

99 | actual = [ apply3 quotRemWord8# a b | (a, b) <- input ] | ||||

100 | checkResults "quotRemWord8#" input expected actual | ||||

101 | | ||||

102 | | ||||

103 | checkResults | ||||

104 | :: (Eq a, Eq b, Show a, Show b) => String -> [a] -> [b] -> [b] -> IO () | ||||

105 | checkResults test inputs expected actual = | ||||

106 | case findIndex (\(e, a) -> e /= a) (zip expected actual) of | ||||

107 | Nothing -> putStrLn $ "Pass: " ++ test | ||||

108 | Just i -> error $ | ||||

109 | "FAILED: " ++ test ++ " for input: " ++ show (inputs !! i) | ||||

110 | ++ " expected: " ++ show (expected !! i) | ||||

111 | ++ " but got: " ++ show (actual !! i) | ||||

112 | | ||||

113 | allWord8 :: [Word] | ||||

114 | allWord8 = [ minWord8 .. maxWord8 ] | ||||

115 | | ||||

116 | minWord8 :: Word | ||||

117 | minWord8 = fromIntegral (minBound :: Word8) | ||||

118 | | ||||

119 | maxWord8 :: Word | ||||

120 | maxWord8 = fromIntegral (maxBound :: Word8) | ||||

121 | | ||||

122 | toWord8 :: Word -> Word | ||||

123 | toWord8 a = fromIntegral (fromIntegral a :: Word8) | ||||

124 | | ||||

125 | addMany# | ||||

126 | :: Word8# -> Word8# -> Word8# -> Word8# | ||||

127 | -> Word8# -> Word8# -> Word8# -> Word8# | ||||

128 | -> Word8# -> Word8# -> Word8# -> Word8# | ||||

129 | -> Word8# -> Word8# -> Word8# -> Word8# | ||||

130 | -> Word8# | ||||

131 | addMany# a b c d e f g h i j k l m n o p = | ||||

132 | a `plusWord8#` b `plusWord8#` c `plusWord8#` d `plusWord8#` | ||||

133 | e `plusWord8#` f `plusWord8#` g `plusWord8#` h `plusWord8#` | ||||

134 | i `plusWord8#` j `plusWord8#` k `plusWord8#` l `plusWord8#` | ||||

135 | m `plusWord8#` n `plusWord8#` o `plusWord8#` p | ||||

136 | {-# NOINLINE addMany# #-} | ||||

137 | | ||||

138 | addMany | ||||

139 | :: Word -> Word -> Word -> Word | ||||

140 | -> Word -> Word -> Word -> Word | ||||

141 | -> Word -> Word -> Word -> Word | ||||

142 | -> Word -> Word -> Word -> Word | ||||

143 | -> Word | ||||

144 | addMany (W# a) (W# b) (W# c) (W# d) | ||||

145 | (W# e) (W# f) (W# g) (W# h) | ||||

146 | (W# i) (W# j) (W# k) (W# l) | ||||

147 | (W# m) (W# n) (W# o) (W# p) | ||||

148 | = W# (extendWord8# word8) | ||||

149 | where | ||||

150 | !word8 = | ||||

151 | addMany# | ||||

152 | (narrowWord8# a) (narrowWord8# b) (narrowWord8# c) (narrowWord8# d) | ||||

153 | (narrowWord8# e) (narrowWord8# f) (narrowWord8# g) (narrowWord8# h) | ||||

154 | (narrowWord8# i) (narrowWord8# j) (narrowWord8# k) (narrowWord8# l) | ||||

155 | (narrowWord8# m) (narrowWord8# n) (narrowWord8# o) (narrowWord8# p) | ||||

156 | {-# NOINLINE addMany #-} | ||||

157 | | ||||

158 | -- Convenient and also tests higher order functions on Word8# | ||||

159 | apply1 :: (Word8# -> Word8#) -> Word -> Word | ||||

160 | apply1 opToTest (W# a) = W# (extendWord8# (opToTest (narrowWord8# a))) | ||||

161 | {-# NOINLINE apply1 #-} | ||||

162 | | ||||

163 | apply2 :: (Word8# -> Word8# -> Word8#) -> Word -> Word -> Word | ||||

164 | apply2 opToTest (W# a) (W# b) = | ||||

165 | let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) | ||||

166 | r = opToTest sa sb | ||||

167 | in W# (extendWord8# r) | ||||

168 | {-# NOINLINE apply2 #-} | ||||

169 | | ||||

170 | apply3 | ||||

171 | :: (Word8# -> Word8# -> (# Word8#, Word8# #)) -> Word -> Word -> (Word, Word) | ||||

172 | apply3 opToTest (W# a) (W# b) = | ||||

173 | let (# sa, sb #) = (# narrowWord8# a, narrowWord8# b #) | ||||

174 | (# ra, rb #) = opToTest sa sb | ||||

175 | in (W# (extendWord8# ra), W# (extendWord8# rb)) | ||||

176 | {-# NOINLINE apply3 #-} | ||||

177 | | ||||

178 | instance | ||||

179 | (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, | ||||

180 | Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o, Eq p) | ||||

181 | => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where | ||||

182 | (a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1, p1) == | ||||

183 | (a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2, p2) = | ||||

184 | a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && | ||||

185 | e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && | ||||

186 | i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && | ||||

187 | m1 == m2 && n1 == n2 && o1 == o2 && p1 == p2 | ||||

188 | | ||||

189 | instance | ||||

190 | (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, | ||||

191 | Show i, Show j, Show k, Show l, Show m, Show n, Show o, Show p) | ||||

192 | => Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) where | ||||

193 | show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) = | ||||

194 | "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ "," ++ show d ++ | ||||

195 | "," ++ show e ++ "," ++ show f ++ "," ++ show g ++ "," ++ show h ++ | ||||

196 | "," ++ show i ++ "," ++ show j ++ "," ++ show k ++ "," ++ show l ++ | ||||

197 | "," ++ show m ++ "," ++ show n ++ "," ++ show o ++ "," ++ show p ++ | ||||

198 | ")" |