# Changeset View

Changeset View

# Standalone View

Standalone View

# testsuite/tests/codeGen/should_run/cgrun082.hs

- This file was added.

1 | {-# OPTIONS_GHC -O2 #-} | ||||
---|---|---|---|---|---|

2 | {-# OPTIONS_GHC -msse #-} | ||||

3 | {-# OPTIONS_GHC -msse2 #-} | ||||

4 | {-# OPTIONS_GHC -msse4 #-} | ||||

5 | {-# LANGUAGE MagicHash #-} | ||||

6 | {-# LANGUAGE UnboxedTuples #-} | ||||

7 | -- tests for SSE based vector operations | ||||

8 | | ||||

9 | import GHC.Exts | ||||

10 | | ||||

11 | data FloatX4 = FX4# FloatX4# | ||||

12 | | ||||

13 | instance Show FloatX4 where | ||||

14 | show (FX4# f) = case (unpackFloatX4# f) of | ||||

15 | (# a, b, c, d #) -> show ((F# a), (F# b), (F# c), (F# d)) | ||||

16 | | ||||

17 | | ||||

18 | instance Eq FloatX4 where | ||||

19 | (FX4# a) == (FX4# b) | ||||

20 | = case (unpackFloatX4# a) of | ||||

21 | (# a1, a2, a3, a4 #) -> | ||||

22 | case (unpackFloatX4# b) of | ||||

23 | (# b1, b2, b3, b4 #) -> (F# a1) == (F# b1) && | ||||

24 | (F# a2) == (F# b2) && | ||||

25 | (F# a3) == (F# b3) && | ||||

26 | (F# a4) == (F# b4) | ||||

27 | | ||||

28 | data DoubleX2 = DX2# DoubleX2# | ||||

29 | | ||||

30 | instance Show DoubleX2 where | ||||

31 | show (DX2# d) = case (unpackDoubleX2# d) of | ||||

32 | (# a, b #) -> show ((D# a), (D# b)) | ||||

33 | | ||||

34 | | ||||

35 | instance Eq DoubleX2 where | ||||

36 | (DX2# a) == (DX2# b) | ||||

37 | = case (unpackDoubleX2# a) of | ||||

38 | (# a1, a2 #) -> | ||||

39 | case (unpackDoubleX2# b) of | ||||

40 | (# b1, b2 #) -> (D# a1) == (D# b1) && | ||||

41 | (D# a2) == (D# b2) | ||||

42 | | ||||

43 | main :: IO () | ||||

44 | main = do | ||||

45 | | ||||

46 | -- !!! test broadcasting, packing and unpacking for vector types | ||||

47 | -- FloatX4# | ||||

48 | case unpackFloatX4# (broadcastFloatX4# 1.5#) of | ||||

49 | (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d) | ||||

50 | case unpackFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) of | ||||

51 | (# a, b, c, d #) -> print (F# a, F# b, F# c, F# d) | ||||

52 | | ||||

53 | -- DoubleX2# | ||||

54 | case unpackDoubleX2# (broadcastDoubleX2# 6.5##) of | ||||

55 | (# a, b #) -> print (D# a, D# b) | ||||

56 | case unpackDoubleX2# (packDoubleX2# (# 8.9##,7.2## #)) of | ||||

57 | (# a, b #) -> print (D# a, D# b) | ||||

58 | | ||||

59 | | ||||

60 | -- !!! test the lifting of unlifted vector types and | ||||

61 | -- defining various typeclass instances for the lifted types | ||||

62 | | ||||

63 | print (FX4# (broadcastFloatX4# 1.5#)) | ||||

64 | print $ (FX4# (broadcastFloatX4# 1.5#)) == (FX4# (broadcastFloatX4# 2.5#)) | ||||

65 | print $ (FX4# (broadcastFloatX4# 3.5#)) == (FX4# (broadcastFloatX4# 3.5#)) | ||||

66 | | ||||

67 | print (DX2# (broadcastDoubleX2# 2.5##)) | ||||

68 | print $ (DX2# | ||||

69 | (broadcastDoubleX2# 1.5##)) == (DX2# (broadcastDoubleX2# 2.5##)) | ||||

70 | print $ (DX2# | ||||

71 | (broadcastDoubleX2# 3.5##)) == (DX2# (broadcastDoubleX2# 3.5##)) | ||||

72 | | ||||

73 | | ||||

74 | -- !!! test arithmetic vector operations | ||||

75 | print (FX4# (plusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) | ||||

76 | (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #)))) | ||||

77 | print (FX4# (minusFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) | ||||

78 | (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #)))) | ||||

79 | print (FX4# (timesFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) | ||||

80 | (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #)))) | ||||

81 | print (FX4# (divideFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)) | ||||

82 | (packFloatX4# (# 8.2#,6.3#, 4.7#, 9.2# #)))) | ||||

83 | print (FX4# (negateFloatX4# (packFloatX4# (# 4.5#,7.8#, 2.3#, 6.5# #)))) | ||||

84 | | ||||

85 | print (DX2# (plusDoubleX2# (broadcastDoubleX2# 1.3##) | ||||

86 | (broadcastDoubleX2# 2.2##))) | ||||

87 | print (DX2# (minusDoubleX2# (broadcastDoubleX2# 3.5##) | ||||

88 | (broadcastDoubleX2# 2.2##))) | ||||

89 | print (DX2# (timesDoubleX2# (broadcastDoubleX2# 2.4##) | ||||

90 | (broadcastDoubleX2# 2.2##))) | ||||

91 | print (DX2# (divideDoubleX2# (broadcastDoubleX2# 9.2##) | ||||

92 | (broadcastDoubleX2# 4.0##))) | ||||

93 | print (DX2# (negateDoubleX2# (broadcastDoubleX2# 3.5##))) |