diff --git a/ConstMath/Pass.hs b/ConstMath/Pass.hs --- a/ConstMath/Pass.hs +++ b/ConstMath/Pass.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} @@ -24,20 +25,21 @@ subBind :: Opts -> String -> CoreBind -> CoreM CoreBind subBind opts tab (NonRec b rhs) = do - traceMsg opts $ tab ++ "Non-recursive binding named " ++ showSDoc (ppr b) + tracePretty opts (tab ++ "Non-recursive binding named ") b rhs' <- subExpr opts tab rhs return (NonRec b rhs') subBind opts _tab bndr@(Rec pairs) = do _ <- mapM (uncurry $ printRecBind opts) pairs return bndr +printRecBind :: Opts -> CoreBndr -> Expr CoreBndr -> CoreM () printRecBind opts b _e = do - traceMsg opts $ "Recursive binding " ++ showSDoc (ppr b) + tracePretty opts "Recursive binding " b subExpr :: Opts -> String -> CoreExpr -> CoreM CoreExpr subExpr opts tab expr@(Type t) = do - traceMsg opts $ tab ++ "Type " ++ showSDoc (ppr t) + tracePretty opts (tab ++ "Type ") t return expr subExpr opts tab expr@(Coercion _co) = do @@ -45,15 +47,15 @@ return expr subExpr opts tab expr@(Lit lit) = do - traceMsg opts $ tab ++ "Lit " ++ showSDoc (ppr lit) + tracePretty opts (tab ++ "Lit ") lit return expr subExpr opts tab expr@(Var v) = do - traceMsg opts $ tab ++ "Var " ++ showSDoc (ppr v) + tracePretty opts (tab ++ "Var ") v return expr subExpr opts tab (App f a) = do - traceMsg opts $ tab ++ "App " ++ showSDoc (ppr f) + tracePretty opts (tab ++ "App ") f f' <- subExpr opts (tab ++ "< ") f a' <- subExpr opts (tab ++ "> ") a collapse opts (App f' a') @@ -99,25 +101,36 @@ -> CoreExpr -> CoreM CoreExpr mkUnaryCollapseIEEE fnE opts expr@(App f1 (App f2 (Lit lit))) - | isDHash f2, MachDouble d <- lit = evalUnaryIEEE d mkDoubleLitDouble - | isFHash f2, MachFloat d <- lit = evalUnaryIEEE d mkFloatLitFloat + | isDHash f2, MachDouble d <- lit = e d mkDoubleLitDouble + | isFHash f2, MachFloat d <- lit = e d mkFloatLitFloat where - evalUnaryIEEE d mkLit = do - let sub = fnE (fromRational d) - maybe (return expr) - (return . App f2 . mkLit) - =<< maybeIEEE opts (fromJust $ funcName f1) sub + e d = evalUnaryIEEE opts fnE f1 f2 d expr mkUnaryCollapseIEEE _ _ expr = return expr +evalUnaryIEEE :: (Fractional a, RealFloat b) + => Opts + -> (a -> b) + -> CoreExpr + -> CoreExpr + -> Rational + -> CoreExpr + -> (b -> Arg Var) + -> CoreM (CoreExpr) +evalUnaryIEEE opts fnE f1 f2 d expr mkLit = do + let sub = fnE (fromRational d) + maybe (return expr) + (return . App f2 . mkLit) + =<< maybeIEEE opts (fromJust $ funcName f1) sub + mkUnaryCollapseNum :: (forall a . Num a => (a -> a)) -> Opts -> CoreExpr -> CoreM CoreExpr -mkUnaryCollapseNum fnE _opts (App _f1 (App f2 (Lit lit))) +mkUnaryCollapseNum fnE opts expr@(App f1 (App f2 (Lit lit))) | isDHash f2, MachDouble d <- lit = - evalUnaryNum fromRational d mkDoubleLitDouble + evalUnaryIEEE opts fnE f1 f2 d expr mkDoubleLitDouble | isFHash f2, MachFloat d <- lit = - evalUnaryNum fromRational d mkFloatLitFloat + evalUnaryIEEE opts fnE f1 f2 d expr mkFloatLitFloat | isIHash f2, MachInt d <- lit = evalUnaryNum fromIntegral d mkIntLitInt | isWHash f2, MachWord d <- lit = @@ -198,7 +211,7 @@ binarySub nm fn = CMSub nm (mkBinaryCollapse fn) funcName :: CoreExpr -> Maybe String -funcName = listToMaybe . words . showSDoc . ppr +funcName = listToMaybe . words . prettyExpr isFHash :: CoreExpr -> Bool isFHash = maybe False ((==) "GHC.Types.F#") . funcName @@ -258,3 +271,28 @@ traceMsg opts s | traced opts = putMsgS s | otherwise = return () + +tracePretty :: Outputable a => Opts -> String -> a -> CoreM () +tracePretty opts s x = do + p <- pretty x + traceMsg opts (s ++ p) + +---------------------------------------------------------------------- + +pretty :: Outputable a => a -> CoreM String +#if __GLASGOW_HASKELL__ >= 706 +pretty x = do + dflags <- getDynFlags + return $ showSDoc dflags (ppr x) +#else +pretty = return . showSDoc . ppr +#endif + +prettyExpr :: CoreExpr -> String +prettyExpr (Var var) = m ++ (unpackFS . occNameFS . nameOccName $ n) + where + n = varName var + m | isExternalName n = (moduleNameString . moduleName . nameModule $ n) ++ "." + | otherwise = "" +prettyExpr (App f _) = prettyExpr f +prettyExpr _ = "" diff --git a/ConstMath/Types.hs b/ConstMath/Types.hs --- a/ConstMath/Types.hs +++ b/ConstMath/Types.hs @@ -18,7 +18,7 @@ deriving (Eq, Show) setVerbosity :: Verbosity -> Opts -> Opts -setVerbosity cmVerbosity opts = Opts{cmVerbosity} +setVerbosity cmVerbosity opts = opts{cmVerbosity} defaultOpts :: Opts defaultOpts = Opts None diff --git a/const-math-ghc-plugin.cabal b/const-math-ghc-plugin.cabal --- a/const-math-ghc-plugin.cabal +++ b/const-math-ghc-plugin.cabal @@ -1,5 +1,5 @@ name: const-math-ghc-plugin -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Compiler plugin for constant math elimination description: This library implements elimination of constant math expressions. @@ -12,6 +12,12 @@ build-type: Simple cabal-version: >=1.8 +-- tests/*.hs shouldn't have to go here, but the source files +-- for the test-suite stanzas don't get picked up by 'cabal sdist'. +Extra-source-files: + tests/*.hs + tests/Makefile + library exposed-modules: ConstMath.Plugin ConstMath.Rules @@ -21,11 +27,17 @@ containers, ghc >= 7.4 +Test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Make.hs + build-depends: base < 5, + directory, + process + ------------------------------------------------------------------------ -- Git repo -- source-repository head type: git location: git://github.com/kfish/const-math-ghc-plugin.git - - diff --git a/tests/1603.hs b/tests/1603.hs new file mode 100644 --- /dev/null +++ b/tests/1603.hs @@ -0,0 +1,7 @@ +module Main where + +main = print (syn [-1]) + +syn :: [Int] -> [Int] +syn (d:ds) = rem d 0x40000000 : syn ds +syn [] = [] diff --git a/tests/3676.hs b/tests/3676.hs new file mode 100644 --- /dev/null +++ b/tests/3676.hs @@ -0,0 +1,32 @@ +-- test conversion of funny numbers through Rational (#3676) + +main = mapM_ putStrLn $ concat $ + [map (show.d2d) doubles1, + map (show.d2f) doubles1, + map (show.d2r) doubles1, + map (show.f2d) floats1, + map (show.f2f) floats1, + map (show.f2r) floats1, + map (show.d2d) doubles2, + map (show.d2f) doubles2, + map (show.d2r) doubles2, + map (show.f2d) floats2, + map (show.f2f) floats2, + map (show.f2r) floats2 + ] + +d2d = realToFrac :: Double -> Double +d2f = realToFrac :: Double -> Float +d2r = realToFrac :: Double -> Rational +f2d = realToFrac :: Float -> Double +f2f = realToFrac :: Float -> Float +f2r = realToFrac :: Float -> Rational + +doubles1 = [0/0, 1/0, -1/0, 0/(-1)] :: [Double] +floats1 = [0/0, 1/0, -1/0, 0/(-1)] :: [Float] + +doubles2 = names :: [Double] +floats2 = names :: [Float] + +names :: Read a => [a] +names = map read ["NaN", "Infinity", "-Infinity", "-0"] diff --git a/tests/4381.hs b/tests/4381.hs new file mode 100644 --- /dev/null +++ b/tests/4381.hs @@ -0,0 +1,5 @@ +module Main where + +main = do + print (scaleFloat 30000 1) + print (scaleFloat (maxBound :: Int) 1) diff --git a/tests/4383.hs b/tests/4383.hs new file mode 100644 --- /dev/null +++ b/tests/4383.hs @@ -0,0 +1,1 @@ +main = print (0.5 ^ 1030) diff --git a/tests/Make.hs b/tests/Make.hs new file mode 100644 --- /dev/null +++ b/tests/Make.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Cmd +import System.Directory + +import Paths_const_math_ghc_plugin + +main = do + testdir <- getDataFileName "tests" + setCurrentDirectory testdir + system "make && make clean" diff --git a/tests/Makefile b/tests/Makefile new file mode 100644 --- /dev/null +++ b/tests/Makefile @@ -0,0 +1,52 @@ +GHC=ghc + +NOPLUGIN_OPTS=-O2 -fforce-recomp +#WITHPLUGIN_OPTS=$(NOPLUGIN_OPTS) -fplugin ConstMath.Plugin -fplugin-opt=ConstMath.Plugin:--trace +WITHPLUGIN_OPTS=$(NOPLUGIN_OPTS) -fplugin ConstMath.Plugin + +ERROR_TESTS= \ + 1603.hs \ + 3676.hs \ + 4381.hs \ + 4383.hs \ + arith001.hs \ + arith002.hs \ + arith003.hs \ + arith004.hs \ + arith005.hs \ + arith006.hs \ + arith007.hs \ + arith008.hs \ + arith009.hs \ + arith010.hs \ + arith011.hs \ + arith012.hs \ + arith013.hs \ + arith014.hs \ + arith015.hs \ + arith016.hs \ + arith017.hs \ + arith018.hs \ + arith019.hs \ + expfloat.hs \ + numrun009.hs \ + numrun010.hs \ + numrun011.hs \ + numrun012.hs \ + numrun013.hs \ + numrun014.hs + +check.%.hs: %.hs + @echo "Checking $< ..." + $(GHC) $(NOPLUGIN_OPTS) $< -o $*.noplugin.exe + ./$*.noplugin.exe 1>$*.noplugin.stdout 2>$*.noplugin.stderr + $(GHC) $(WITHPLUGIN_OPTS) $< -o $*.withplugin.exe + ./$*.withplugin.exe 1>$*.withplugin.stdout 2>$*.withplugin.stderr + @diff -u $*.noplugin.stdout $*.withplugin.stdout + @diff -u $*.noplugin.stderr $*.withplugin.stderr + -rm -f $*.noplugin.exe $*.withplugin.exe $*.noplugin.stdout $*.noplugin.stderr $*.withplugin.stdout $*.withplugin.stderr + +all :: $(patsubst %, check.%, $(ERROR_TESTS)) + +clean: + rm -f *.o *.hi *.exe *.stdout *.stderr diff --git a/tests/Sqrt.hs b/tests/Sqrt.hs new file mode 100644 --- /dev/null +++ b/tests/Sqrt.hs @@ -0,0 +1,3 @@ +module Sqrt where + +main = print (1.0 / sqrt 2.0) diff --git a/tests/arith001.hs b/tests/arith001.hs new file mode 100644 --- /dev/null +++ b/tests/arith001.hs @@ -0,0 +1,28 @@ +-- !!! conversions: Double <=> Rational/Integer things +-- +import Data.Ratio + +main = putStr (show r42 ++ "\n" ++ + show nu42 ++ ", " ++ + show de42 ++ "\n" ++ + show nu42d ++ ", " ++ + show de42d ++ "\n" ++ + show s2 ++ ", " ++ + show e2 ++ "\n" ++ + show s ++ ", " ++ + show e ++ "\n" ) + where + d42 :: Double + r42 :: Rational + nu42, de42 :: Integer + nu42d, de42d :: Double + + d42 = 42 + r42 = toRational d42 + nu42 = numerator r42 + de42 = denominator r42 + nu42d= fromInteger nu42 + de42d= fromInteger de42 + + (s,e)= decodeFloat (nu42d / de42d ) + (s2,e2) = decodeFloat d42 diff --git a/tests/arith002.hs b/tests/arith002.hs new file mode 100644 --- /dev/null +++ b/tests/arith002.hs @@ -0,0 +1,52 @@ +-- !!! basic Rational operations +-- +import Data.Ratio + +main + = putStr + (-- Ratio Ints + show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc] + ++ "\n" + -- the Ints + ++ show ((map numerator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]) + ++(map denominator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc])) + ++ "\n" + -- Booleans +-- ++ show [] +-- ++ "\n" + + -- Rationals (Ratio Integers) + ++ show [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc] + ++ "\n" + -- the Integers + ++ show ((map numerator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]) + ++(map denominator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc])) + ++ "\n" + -- Booleans +-- ++ show [] +-- ++ "\n" + ) + where + i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc :: Ratio Int + + i0a = 0 % 1 + i0b = (-0) % 1 + i0c = 0 % (-1) + i2a = 4 % 2 + i2b = (-4) % (-2) + im2a = (-4) % 2 + im2b = 4 % (-2) + i_pi = 22 % 7 + i_misc = 2 % 10000 + + r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc :: Rational + + r0a = 0 % 1 + r0b = (-0) % 1 + r0c = 0 % (-1) + r2a = 4 % 2 + r2b = (-4) % (-2) + rm2a = (-4) % 2 + rm2b = 4 % (-2) + r_pi = 22 % 7 + r_misc = 2 % 10000 diff --git a/tests/arith003.hs b/tests/arith003.hs new file mode 100644 --- /dev/null +++ b/tests/arith003.hs @@ -0,0 +1,84 @@ +-- $Id: arith003.hs,v 1.2 2002/01/25 13:40:39 simonmar Exp $ +-- +-- !!! test Int/Integer arithmetic operations from the Prelude. +-- + +main + = putStr + ( + showit (do_ops int_ops) ++ + showit (do_ops integer_ops) + ) + +showit :: (Show a, Integral a) => [(String, a, a, a)] -> String +showit stuff = concat + [ str ++ " " ++ show l ++ " " ++ show r ++ " = " ++ show result ++ "\n" + | (str, l, r, result) <- stuff + ] + +do_ops :: Integral a => [((a -> a -> a), String, [(a,a)])] + -> [(String, a, a, a)] +do_ops ops = [ (str, l, r, l `op` r) | (op,str,args) <- ops, (l,r) <- args ] + +small_operands, non_min_operands, operands, non_max_operands + :: Integral a => [a] +small_operands = [ 0, 1, -1, 2, -2 ] +operands = small_operands ++ [ fromIntegral minInt, fromIntegral maxInt ] +non_min_operands = small_operands ++ [ fromIntegral maxInt ] +non_max_operands = small_operands ++ [ fromIntegral minInt ] + +large_operands :: [ Integer ] +large_operands = operands ++ + [ fromIntegral minInt - 1, + fromIntegral maxInt + 1, + fromIntegral minInt * 2, + fromIntegral maxInt * 2, + fromIntegral minInt ^ 2, + fromIntegral maxInt ^ 2 + ] + +integer_ops :: [((Integer -> Integer -> Integer), String, [(Integer,Integer)])] +integer_ops = [ + ((+), "(+)", both_large), + ((-), "(-)", both_large), + (div, "div", large_non_zero_r), + (mod, "mod", large_non_zero_r), + (quot, "quot", large_non_zero_r), + (rem, "rem", large_non_zero_r), + (gcd, "gcd", large_either_non_zero), + (lcm, "lcm", large_either_non_zero) + ] + +int_ops :: [((Int -> Int -> Int), String, [(Int,Int)])] +int_ops = [ + ((+), "(+)", both_small), + ((-), "(-)", both_small), + ((^), "(^)", small_non_neg_r), + (div, "div", non_min_l_or_zero_r), + (mod, "mod", non_min_l_or_zero_r), + (quot, "quot", non_min_l_or_zero_r), + (rem, "rem", non_min_l_or_zero_r), + (gcd, "gcd", non_min_either_non_zero), + (lcm, "lcm", non_max_r_either_non_zero) + ] + +-- NOTE: when abs(minInt) is undefined (it is in GHC, because +-- abs(minInt) would be greater than maxInt), then gcd on Ints is also +-- undefined when either operand is minInt. + +both_small, non_zero_r, non_min_either_non_zero, non_min_l_or_zero_r, + non_max_r_either_non_zero, small_non_neg_r + :: Integral a => [(a,a)] + +both_small = [ (l,r) | l <- operands, r <- operands ] +both_large = [ (l,r) | l <- large_operands, r <- large_operands ] +large_non_zero_r = [ (l,r) | l <- operands, r <- large_operands, r /= 0 ] +non_zero_r = [ (l,r) | l <- operands, r <- operands, r /= 0 ] +non_min_either_non_zero = [ (l,r) | l <- non_min_operands, r <- non_min_operands, l /= 0 || r /= 0 ] +large_either_non_zero = [ (l,r) | l <- operands, r <- operands, l /= 0 || r /= 0 ] +small_non_neg_r = [ (l,r) | l <- operands, r <- small_operands, r >= 0 ] +non_min_l_or_zero_r = [ (l,r) | l <- non_min_operands, r <- operands, r /= 0 ] +non_max_r_either_non_zero = [ (l,r) | l <- operands, r <- non_max_operands, l /= 0 || r /= 0 ] + +minInt = minBound :: Int +maxInt = maxBound :: Int diff --git a/tests/arith004.hs b/tests/arith004.hs new file mode 100644 --- /dev/null +++ b/tests/arith004.hs @@ -0,0 +1,86 @@ +-- !!! test quot/rem/div/mod functions on Ints and Integers +-- +main + = putStr + (-- w/ Ints and Integers + show (unzipWith div ints_list) + ++ "\n" + ++ show (unzipWith div integers_list) + ++ "\n" + ++ show (unzipWith rem ints_list) + ++ "\n" + ++ show (unzipWith rem integers_list) + ++ "\n" + ++ show (unzipWith quot ints_list) + ++ "\n" + ++ show (unzipWith quot integers_list) + ++ "\n" + ++ show (unzipWith mod ints_list) + ++ "\n" + ++ show (unzipWith mod integers_list) + ++ "\n" + ++ show (unzipWith law1 ints_list) + ++ "\n" + ++ show (unzipWith law1 integers_list) + ++ "\n" + ++ show (unzipWith law2 ints_list) + ++ "\n" + ++ show (unzipWith law2 integers_list) + ++ "\n" + ) + where + ints_list :: [(Int, Int)] + integers_list :: [(Integer, Integer)] + + ints_list = [ + (0, 4), + (0, -8), + (7, 3), + (13, 4), + (13, -4), + (-13, 4), + (-13, -4), + (12345678, 10000), + (12345678, -10000), + (-12345678, 10000), + (-12345678, -10000), + (123456,10000), + (1234567,20000), + (12345678,-10000), + (123456789,10000), + (1234567890,-10000), + (-12345,10000), + (-123456789,-10000) + ] + + integers_list = [ + (0, 4), + (0, -8), + (7, 3), + (13, 4), + (13, -4), + (-13, 4), + (-13, -4), + (12345678, 10000), + (12345678, -10000), + (-12345678, 10000), + (-12345678, -10000), + (123456,10000), + (1234567,20000), + (12345678,-10000), + (123456789,10000), + (1234567890,-10000), + (-12345,10000), + (-123456789,-10000), + (12345678900,500000000), + (1234000000000000000000005678900,5001111111111111000000) + ] + +unzipWith :: (a -> b -> c) -> [(a,b)] -> [c] +unzipWith f [] = [] +unzipWith f ((x,y):zs) = f x y : unzipWith f zs + +law1, law2 :: Integral a => a -> a -> Bool + +law1 x y = (x `quot` y)*y + (x `rem` y) == x +law2 x y = (x `div` y)*y + (x `mod` y) == x diff --git a/tests/arith005.hs b/tests/arith005.hs new file mode 100644 --- /dev/null +++ b/tests/arith005.hs @@ -0,0 +1,60 @@ +-- !!! test RealFrac ops (ceiling/floor/etc.) on Floats/Doubles +-- +main = + putStr $ + unlines + [ -- just for fun, we show the floats to + -- exercise the code responsible. + 'A' : show (float_list :: [Float]) + , 'B' : show (double_list :: [Double]) + -- {Float,Double} inputs, {Int,Integer} outputs + , 'C' : show ((map ceiling small_float_list) :: [Int]) + , 'D' : show ((map ceiling float_list) :: [Integer]) + , 'E' : show ((map ceiling small_double_list) :: [Int]) + , 'F' : show ((map ceiling double_list) :: [Integer]) + , 'G' : show ((map floor small_float_list) :: [Int]) + , 'H' : show ((map floor float_list) :: [Integer]) + , 'I' : show ((map floor small_double_list) :: [Int]) + , 'J' : show ((map floor double_list) :: [Integer]) + , 'K' : show ((map truncate small_float_list) :: [Int]) + , 'L' : show ((map truncate float_list) :: [Integer]) + , 'M' : show ((map truncate small_double_list) :: [Int]) + , 'N' : show ((map truncate double_list) :: [Integer]) + , 'n' : show ((map round small_float_list) :: [Int]) + , 'O' : show ((map round float_list) :: [Integer]) + , 'P' : show ((map round small_double_list) :: [Int]) + , 'Q' : show ((map round double_list) :: [Integer]) + , 'R' : show ((map properFraction small_float_list) :: [(Int,Float)]) + , 'S' : show ((map properFraction float_list) :: [(Integer,Float)]) + , 'T' : show ((map properFraction small_double_list) :: [(Int,Double)]) + , 'U' : show ((map properFraction double_list) :: [(Integer,Double)]) + ] + where + -- these fit into an Int when truncated. Truncation when the + -- result does not fit into the target is undefined - not explicitly + -- so in Haskell 98, but that's the interpretation we've taken in GHC. + -- See bug #1254 + small_float_list :: [Float] + small_float_list = [ + 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, + -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, + 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi + ] + + float_list :: [Float] + float_list = small_float_list ++ [ + 1.18088e+11, 1.2111e+14 + ] + + -- these fit into an Int + small_double_list :: [Double] + small_double_list = [ + 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, + -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, + 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi + ] + + double_list :: [Double] + double_list = small_double_list ++ [ + 1.18088e+11, 1.2111e+14 + ] diff --git a/tests/arith006.hs b/tests/arith006.hs new file mode 100644 --- /dev/null +++ b/tests/arith006.hs @@ -0,0 +1,4 @@ +-- !!! printing Floats; was a bug in hbc (reported by andy) +-- + +main = print ((fromIntegral (42 :: Int)) :: Float) diff --git a/tests/arith007.hs b/tests/arith007.hs new file mode 100644 --- /dev/null +++ b/tests/arith007.hs @@ -0,0 +1,23 @@ +-- !!! test simple Integer things +-- + +f x y z = x y z + +main = do + putStr (shows integer_list "\n") + where + int_list :: [Int] + integer_list :: [Integer] + + int_list = (map fromInteger integer_list) + + integer_list = (map (* 2) + [1,3,5,7,9, + 11111111111111111111111111111, + 2222222222222222222222222222222222222, + 3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333, + -11111111111111111111111111111, + -2222222222222222222222222222222222222, + -3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 + ]) + diff --git a/tests/arith008.hs b/tests/arith008.hs new file mode 100644 --- /dev/null +++ b/tests/arith008.hs @@ -0,0 +1,24 @@ +-- !!! a random test from Nick North +-- (got this in mid-1993; don't remember why. WDP 95/02) +-- + +random_numbers :: (Int, Int, Int) -> [Float] +random_numbers (s1,s2,s3) + = map (snd . properFraction . combine) (iterate f (s1,s2,s3)) + where + combine :: (Int,Int,Int) -> Float + combine (a,b,c) = + fromIntegral(a)/30269 + fromIntegral(b)/30307 + + fromIntegral(c)/30323 + f (a,b,c) = + ((171*a) `mod` 30269, (172*b) `mod` 30307, (170*c) `mod` 30323) + +-- partain: changed to cvt spaces into newlines (easier to see bugs) +-- sof: define approp. version of showList to do this. +main = putStr (showL (showsPrec 0) (take 1000 (random_numbers (9807, 65, 32975))) "\n") + +showL showx [] = showString "[]" +showL showx (x:xs) = showChar '[' . showx x . showl xs + where + showl [] = showChar ']' + showl (x:xs) = showString ",\n" . showx x . showl xs diff --git a/tests/arith009.hs b/tests/arith009.hs new file mode 100644 --- /dev/null +++ b/tests/arith009.hs @@ -0,0 +1,6 @@ +-- a prefix minus precedence test + +f :: Int -> Int -> Int -> Int +f x y z = - x * y ^ z + +main = putStr (shows (f 5 2 3) "\n") diff --git a/tests/arith010.hs b/tests/arith010.hs new file mode 100644 --- /dev/null +++ b/tests/arith010.hs @@ -0,0 +1,11 @@ +-- Tests enumerations + +main = do + print [1..10] + print [10..1] -- [] + print [1,3..10] + print [10,8..1] + print ['a'..'f'] + print ['f'..'a'] -- [] + print ['a','c'..'m'] + print ['m','l'..'a'] diff --git a/tests/arith011.hs b/tests/arith011.hs new file mode 100644 --- /dev/null +++ b/tests/arith011.hs @@ -0,0 +1,174 @@ +-- !!! Testing Int and Word +module Main(main) where +import Data.Int +import Data.Word +import Data.Bits +import Data.Ix -- added SOF +import Control.Exception + +main :: IO () +main = test + +test :: IO () +test = do + testIntlike "Int" (0::Int) + testIntlike "Int8" (0::Int8) + testIntlike "Int16" (0::Int16) + testIntlike "Int32" (0::Int32) + testIntlike "Int64" (0::Int64) + testIntlike "Word8" (0::Word8) + testIntlike "Word16" (0::Word16) + testIntlike "Word32" (0::Word32) + testIntlike "Word64" (0::Word64) + testInteger + +testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO () +testIntlike name zero = do + putStrLn $ "--------------------------------" + putStrLn $ "--Testing " ++ name + putStrLn $ "--------------------------------" + testBounded zero + testEnum zero + testReadShow zero + testEq zero + testOrd zero + testNum zero + testReal zero + testIntegral zero + testConversions zero + testBits zero True + +testInteger = do + let zero = 0 :: Integer + putStrLn $ "--------------------------------" + putStrLn $ "--Testing Integer" + putStrLn $ "--------------------------------" + testEnum zero + testReadShow zero + testEq zero + testOrd zero + testNum zero + testReal zero + testIntegral zero + testBits zero False + +-- In all these tests, zero is a dummy element used to get +-- the overloading to work + +testBounded zero = do + putStrLn "testBounded" + print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero) + print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero) + +testEnum zero = do + putStrLn "testEnum" + print $ take 10 [zero .. ] -- enumFrom + print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen + print [zero .. toEnum 20] -- enumFromTo + print [zero, toEnum 2 .. toEnum 20] -- enumFromThenTo + +testConversions zero = do + putStrLn "testConversions" + putStr "Integer : " >> print (map fromIntegral numbers :: [Integer]) + putStr "Int : " >> print (map fromIntegral numbers :: [Int]) + putStr "Int8 : " >> print (map fromIntegral numbers :: [Int8]) + putStr "Int16 : " >> print (map fromIntegral numbers :: [Int16]) + putStr "Int32 : " >> print (map fromIntegral numbers :: [Int32]) + putStr "Int64 : " >> print (map fromIntegral numbers :: [Int64]) + putStr "Word8 : " >> print (map fromIntegral numbers :: [Word8]) + putStr "Word16 : " >> print (map fromIntegral numbers :: [Word16]) + putStr "Word32 : " >> print (map fromIntegral numbers :: [Word32]) + putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64]) + where numbers = [minBound, 0, maxBound] `asTypeOf` [zero] + +samples :: (Num a) => a -> [a] +samples zero = map fromInteger ([-3 .. -1]++[0 .. 3]) + +table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO () +table1 nm f xs = do + sequence [ f' x | x <- xs ] + putStrLn "#" + where + f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x)) + +table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO () +table2 nm op xs ys = do + sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " " + | x <- xs + ] + putStrLn "#" + where + op' x y = do s <- Control.Exception.catch + (evaluate (show (op x y))) + (\e -> return (show (e :: SomeException))) + putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s) + +testReadShow zero = do + putStrLn "testReadShow" + print xs + print (map read_show xs) + where + xs = samples zero + read_show x = (read (show x) `asTypeOf` zero) + +testEq zero = do + putStrLn "testEq" + table2 "==" (==) xs xs + table2 "/=" (/=) xs xs + where + xs = samples zero + +testOrd zero = do + putStrLn "testOrd" + table2 "<=" (<=) xs xs + table2 "< " (<) xs xs + table2 "> " (>) xs xs + table2 ">=" (>=) xs xs + table2 "`compare`" compare xs xs + where + xs = samples zero + +testNum zero = do + putStrLn "testNum" + table2 "+" (+) xs xs + table2 "-" (-) xs xs + table2 "*" (*) xs xs + table1 "negate" negate xs + where + xs = samples zero + +testReal zero = do + putStrLn "testReal" + table1 "toRational" toRational xs + where + xs = samples zero + +testIntegral zero = do + putStrLn "testIntegral" + table2 "`divMod` " divMod xs xs + table2 "`div` " div xs xs + table2 "`mod` " mod xs xs + table2 "`quotRem`" quotRem xs xs + table2 "`quot` " quot xs xs + table2 "`rem` " rem xs xs + where + xs = samples zero + +testBits zero do_bitsize = do + putStrLn "testBits" + table2 ".&. " (.&.) xs xs + table2 ".|. " (.|.) xs xs + table2 "`xor`" xor xs xs + table1 "complement" complement xs + table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64]) + table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64]) + table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64]) + table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3] + table2 "`setBit`" setBit xs ([0..3] ++ [32,64]) + table2 "`clearBit`" clearBit xs ([0..3] ++ [32,64]) + table2 "`complementBit`" complementBit xs ([0..3] ++ [32,64]) + table2 "`testBit`" testBit xs ([0..3] ++ [32,64]) + if do_bitsize then table1 "bitSize" bitSize xs else return () + table1 "isSigned" isSigned xs + where + xs = samples zero diff --git a/tests/arith012.hs b/tests/arith012.hs new file mode 100644 --- /dev/null +++ b/tests/arith012.hs @@ -0,0 +1,90 @@ +-- !!! Testing NumExts +module Main(main) where + +import Numeric +import Data.Char + +main :: IO () +main = tst + +tst :: IO () +tst = do + test_doubleToFloat + test_floatToDouble + test_showHex + test_showOct + test_showBin + +---- +-- Test data: +doubles :: [Double] +doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454, + 1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173, + 5342413403.40540423255] +ints :: [Int] +ints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245] + +integers :: [Integer] +integers = [ 0, 1, 255, 65513, 6029, 1024, 256, + 2343243543500233, 656194962055457832] +--- + +test_doubleToFloat :: IO () +test_doubleToFloat = do + test_banner "doubleToFloat" + putStrLn (show doubles) + putStrLn (show $ map doubleToFloat doubles) + +doubleToFloat :: Double -> Float +doubleToFloat = realToFrac + +floatToDouble :: Float -> Double +floatToDouble = realToFrac + +test_floatToDouble :: IO () +test_floatToDouble = do + test_banner "doubleToFloat" + putStrLn (show doubles) + putStrLn (show $ map doubleToFloat doubles) + putStrLn (show $ map (floatToDouble.doubleToFloat) doubles) + +test_showHex :: IO () +test_showHex = do + test_banner "showHex" + putStrLn (show ints) + putStrLn (showList' (map showHex ints)) + putStrLn (show integers) + putStrLn (showList' (map showHex integers)) + +test_showBin :: IO () +test_showBin = do + test_banner "showBin" + putStrLn (show ints) + putStrLn (showList' (map showBin ints)) + putStrLn (show integers) + putStrLn (showList' (map showBin integers)) + +showBin i = showIntAtBase 2 intToDigit i + +showList' :: [ShowS] -> String +showList' [] = "[]" +showList' (x:xs) = showChar '[' . x $ showl xs "" + where + showl [] = showChar ']' + showl (x:xs) = showChar ',' . x . showl xs + + +test_showOct :: IO () +test_showOct = do + test_banner "showOct" + putStrLn (show ints) + putStrLn (showList' (map showOct ints)) + putStrLn (show integers) + putStrLn (showList' (map showOct integers)) + +---- +test_banner :: String -> IO () +test_banner tst = do + putStrLn $ "--------------------------------" + putStrLn $ "--Testing " ++ tst + putStrLn $ "--------------------------------" diff --git a/tests/arith013.hs b/tests/arith013.hs new file mode 100644 --- /dev/null +++ b/tests/arith013.hs @@ -0,0 +1,13 @@ +-- Test gcdInt/gcdInteger + +import GHC.Real ( gcdInt ) +import GHC.Integer.GMP.Internals ( gcdInteger ) + +main :: IO () +main = do + test gcdInt [ -42, 0, 105 ] + test gcdInteger [-12193263111263526900, -42, 0, 105, 1234567890 ] + + +test :: (Show a, Integral a) => (a -> a -> a) -> [a] -> IO () +test f xs = mapM_ print [ (a, b, f a b) | a <- xs, b <- reverse xs, a /= 0 || b /= 0 ] diff --git a/tests/arith014.hs b/tests/arith014.hs new file mode 100644 --- /dev/null +++ b/tests/arith014.hs @@ -0,0 +1,11 @@ +-- Test behaviour of fromInteger when the target type is out of range. + +main :: IO () +main = + print [ + fromInteger maxInt2 :: Int, + fromInteger minInt2 :: Int + ] + +maxInt2 = fromIntegral (maxBound :: Int) * 2 :: Integer +minInt2 = fromIntegral (minBound + 1 :: Int) * 2 :: Integer diff --git a/tests/arith015.hs b/tests/arith015.hs new file mode 100644 --- /dev/null +++ b/tests/arith015.hs @@ -0,0 +1,5 @@ +main = do + print (map read strange_nums :: [Float]) + print (map read strange_nums :: [Double]) + where + strange_nums = ["Infinity","NaN", "-Infinity"] diff --git a/tests/arith016.hs b/tests/arith016.hs new file mode 100644 --- /dev/null +++ b/tests/arith016.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Exts ( Float(F#), + eqFloat#, neFloat#, ltFloat#, + leFloat#, gtFloat#, geFloat# + ) + +fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge :: (String, Float -> Float -> Bool) +fcmp_eq = ("==", \ (F# a) (F# b) -> a `eqFloat#` b) +fcmp_ne = ("/=", \ (F# a) (F# b) -> a `neFloat#` b) +fcmp_lt = ("< ", \ (F# a) (F# b) -> a `ltFloat#` b) +fcmp_le = ("<=", \ (F# a) (F# b) -> a `leFloat#` b) +fcmp_gt = ("> ", \ (F# a) (F# b) -> a `gtFloat#` b) +fcmp_ge = (">=", \ (F# a) (F# b) -> a `geFloat#` b) + +float_fns = [fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge] + +float_vals :: [Float] +float_vals = [0.0, 1.0, read "NaN"] + +float_text + = [show4 arg1 ++ " " ++ fn_name ++ " " ++ show4 arg2 ++ " = " ++ show (fn arg1 arg2) + | (fn_name, fn) <- float_fns, + arg1 <- float_vals, + arg2 <- float_vals + ] + where + show4 x = take 4 (show x ++ repeat ' ') + +main + = putStrLn (unlines float_text) diff --git a/tests/arith017.hs b/tests/arith017.hs new file mode 100644 --- /dev/null +++ b/tests/arith017.hs @@ -0,0 +1,10 @@ +-- !!! test for a bug in integer->{Int,Word}64 conversion in GHC 5.04.x + +import Data.Int +import Data.Word + +main = do + print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer)) + :: Data.Int.Int64) + print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer)) + :: Data.Word.Word64) diff --git a/tests/arith018.hs b/tests/arith018.hs new file mode 100644 --- /dev/null +++ b/tests/arith018.hs @@ -0,0 +1,12 @@ +-- exposes a bug in the native code generator in GHC 6.4.1. Division by +-- a power of 2 was being mis-optimsed to a direct shift. + +main = do + print (map f4 [(-20) .. (-1)]) + print (map f8 [(-20) .. (-1)]) + +f4 :: Int -> Int +f4 x = x `quot` 4 + +f8 :: Int -> Int +f8 x = x `quot` 8 diff --git a/tests/arith019.hs b/tests/arith019.hs new file mode 100644 --- /dev/null +++ b/tests/arith019.hs @@ -0,0 +1,10 @@ +-- demonstrates a bug in mulIntMayOflo in GHC 6.5 on 64-bit arches +-- (trac #867). +-- It thought it could represent 3049800625 * 3049800625 in an I#. + +i :: Integer +i = 3049800625 + +main :: IO () +main = print (i * i) + diff --git a/tests/expfloat.hs b/tests/expfloat.hs new file mode 100644 --- /dev/null +++ b/tests/expfloat.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE MagicHash #-} +-- tests that expFloat# works (had linking problems on Windows) + +import GHC.Exts + +main = do + print (F# (expFloat# 3.45#)) diff --git a/tests/numrun009.hs b/tests/numrun009.hs new file mode 100644 --- /dev/null +++ b/tests/numrun009.hs @@ -0,0 +1,17 @@ +-- !!! tests that minBound::Int is correctly handled (for Int & Integer + +-- (not necessarily Haskell 98: relies on Int being a 32-bit type.) + +main = do + print (-2147483648 :: Int) -- -2147483648 + print ((-2147483647)-1 :: Int) -- -2147483648 + print (-2147483648 :: Integer) -- -2147483648 + print ((-2147483648 :: Int) >= 0) -- False + print ((-2147483648 :: Integer) >= 0) -- False + print (-(-2147483648) :: Int) -- + print (abs (-2147483648) :: Int) -- + print (abs ((-2147483647)-1) :: Int) -- + print (abs (-2147483648) :: Integer) -- 2147483648 + print (abs ((-2147483647)-1) :: Integer) -- 2147483648 (wrong in 4.04) + print (fromInteger (-2147483648 :: Integer) :: Int) -- -2147483648 + print (fromInteger ((-2147483647)-1 :: Integer) :: Int) -- -2147483648 diff --git a/tests/numrun010.hs b/tests/numrun010.hs new file mode 100644 --- /dev/null +++ b/tests/numrun010.hs @@ -0,0 +1,13 @@ +-- !!! tests that local fixity declarations work + +-- If local fixity decls don't work you get "14" +-- The right answer is "11" + +val = 3 +! 4 *! 2 + where (+!) = (+) + (*!) = (*) + infixl 6 +! + infixl 7 *! + +main = print val + diff --git a/tests/numrun011.hs b/tests/numrun011.hs new file mode 100644 --- /dev/null +++ b/tests/numrun011.hs @@ -0,0 +1,2 @@ +import Data.Ratio +main = print (fromRational (1 % 85070591730234615865843651857942052864) :: Float) diff --git a/tests/numrun012.hs b/tests/numrun012.hs new file mode 100644 --- /dev/null +++ b/tests/numrun012.hs @@ -0,0 +1,35 @@ + +-- Test for trac #921 + +import GHC.Float +import Foreign +import Control.Monad + +main :: IO () +main = do -- The reported case + putStrLn (show (map log2 vals)) + -- Smaller failing cases + print (fromIntegral ((2^31) :: Int) :: Double) + if_not_32 $ print (round ((2^33) :: Double) :: Int) + print (fromIntegral ((2^31) :: Int) :: Float) + if_not_32 $ print (round ((2^33) :: Float) :: Int) + -- The underlying failing internal operations + print (int2Double (2^31)) + if_not_32 $ print (double2Int (2^33)) + print (int2Float (2^31)) + if_not_32 $ print (float2Int (2^33)) + where + -- the value of float2Int x where the result would be outside the + -- range of the target is undefined. We also take the view in GHC + -- that round and truncate are similarly undefined when the result + -- would be outside the range of the target type (see #1254) + if_not_32 = when (sizeOf (undefined::Int) > 4) + +log2 x = ceiling log_x + where log_x :: Double + log_x = logBase 2 (fromIntegral (max 1 x)) + +vals = [1, 2, 17, 259, 1000, 10000, + 2^30 + 9000, 2^31 - 1, 2^31 + 1, + 2^32 - 1, 2^32 + 1] + diff --git a/tests/numrun013.hs b/tests/numrun013.hs new file mode 100644 --- /dev/null +++ b/tests/numrun013.hs @@ -0,0 +1,17 @@ + +-- Test for trac #1042 + +import Control.Exception +import Data.Int +import Prelude hiding (catch) + +main :: IO () +main = do print ((minBound :: Int) `div` (-1)) `myCatch` print + print ((minBound :: Int8) `div` (-1)) `myCatch` print + print ((minBound :: Int16) `div` (-1)) `myCatch` print + print ((minBound :: Int32) `div` (-1)) `myCatch` print + print ((minBound :: Int64) `div` (-1)) `myCatch` print + +myCatch :: IO a -> (ArithException -> IO a) -> IO a +myCatch = catch + diff --git a/tests/numrun014.hs b/tests/numrun014.hs new file mode 100644 --- /dev/null +++ b/tests/numrun014.hs @@ -0,0 +1,211 @@ + +-- Test that we don't have rules (or othre optimisations) doing the +-- wrong thing for constant folding with Doubles. + +module Main (main) where + +zero :: Double +zero = 0 + +one :: Double +one = 1 + +nan :: Double +nan = 0 / 0 + +inf :: Double +inf = 1 / 0 + +neginf :: Double +neginf = -1 / 0 + +fzero :: Float +fzero = 0 + +fone :: Float +fone = 1 + +fnan :: Float +fnan = 0 / 0 + +finf :: Float +finf = 1 / 0 + +fneginf :: Float +fneginf = -1 / 0 + +main :: IO () +main = do putStrLn "=== Subtraction ===" + print (zero - zero) + print (zero - nan) + print (zero - inf) + print (zero - neginf) + print (nan - zero) + print (nan - nan) + print (nan - inf) + print (nan - neginf) + print (inf - zero) + print (inf - nan) + print (inf - inf) + print (inf - neginf) + print (neginf - zero) + print (neginf - nan) + print (neginf - inf) + print (neginf - neginf) + putStrLn "=== Addition ===" + print (zero + zero) + print (zero + nan) + print (zero + inf) + print (zero + neginf) + print (nan + zero) + print (nan + nan) + print (nan + inf) + print (nan + neginf) + print (inf + zero) + print (inf + nan) + print (inf + inf) + print (inf + neginf) + print (neginf + zero) + print (neginf + nan) + print (neginf + inf) + print (neginf + neginf) + putStrLn "=== Mutiplication ===" + print (zero * zero) + print (zero * one) + print (zero * nan) + print (zero * inf) + print (zero * neginf) + print (one * zero) + print (one * one) + print (one * nan) + print (one * inf) + print (one * neginf) + print (nan * zero) + print (nan * one) + print (nan * nan) + print (nan * inf) + print (nan * neginf) + print (inf * zero) + print (inf * one) + print (inf * nan) + print (inf * inf) + print (inf * neginf) + print (neginf * zero) + print (neginf * one) + print (neginf * nan) + print (neginf * inf) + print (neginf * neginf) + putStrLn "=== Division ===" + print (zero / zero) + print (zero / one) + print (zero / nan) + print (zero / inf) + print (zero / neginf) + print (one / zero) + print (one / one) + print (one / nan) + print (one / inf) + print (one / neginf) + print (nan / zero) + print (nan / one) + print (nan / nan) + print (nan / inf) + print (nan / neginf) + print (inf / zero) + print (inf / one) + print (inf / nan) + print (inf / inf) + print (inf / neginf) + print (neginf / zero) + print (neginf / one) + print (neginf / nan) + print (neginf / inf) + print (neginf / neginf) + + putStrLn "=== Subtraction ===" + print (fzero - fzero) + print (fzero - fnan) + print (fzero - finf) + print (fzero - fneginf) + print (fnan - fzero) + print (fnan - fnan) + print (fnan - finf) + print (fnan - fneginf) + print (finf - fzero) + print (finf - fnan) + print (finf - finf) + print (finf - fneginf) + print (fneginf - fzero) + print (fneginf - fnan) + print (fneginf - finf) + print (fneginf - fneginf) + putStrLn "=== Addition ===" + print (fzero + fzero) + print (fzero + fnan) + print (fzero + finf) + print (fzero + fneginf) + print (fnan + fzero) + print (fnan + fnan) + print (fnan + finf) + print (fnan + fneginf) + print (finf + fzero) + print (finf + fnan) + print (finf + finf) + print (finf + fneginf) + print (fneginf + fzero) + print (fneginf + fnan) + print (fneginf + finf) + print (fneginf + fneginf) + putStrLn "=== Mutiplication ===" + print (fzero * fzero) + print (fzero * fone) + print (fzero * fnan) + print (fzero * finf) + print (fzero * fneginf) + print (fone * fzero) + print (fone * fone) + print (fone * fnan) + print (fone * finf) + print (fone * fneginf) + print (fnan * fzero) + print (fnan * fone) + print (fnan * fnan) + print (fnan * finf) + print (fnan * fneginf) + print (finf * fzero) + print (finf * fone) + print (finf * fnan) + print (finf * finf) + print (finf * fneginf) + print (fneginf * fzero) + print (fneginf * fone) + print (fneginf * fnan) + print (fneginf * finf) + print (fneginf * fneginf) + putStrLn "=== Division ===" + print (fzero / fzero) + print (fzero / fone) + print (fzero / fnan) + print (fzero / finf) + print (fzero / fneginf) + print (fone / fzero) + print (fone / fone) + print (fone / fnan) + print (fone / finf) + print (fone / fneginf) + print (fnan / fzero) + print (fnan / fone) + print (fnan / fnan) + print (fnan / finf) + print (fnan / fneginf) + print (finf / fzero) + print (finf / fone) + print (finf / fnan) + print (finf / finf) + print (finf / fneginf) + print (fneginf / fzero) + print (fneginf / fone) + print (fneginf / fnan) + print (fneginf / finf) + print (fneginf / fneginf) +