Commit 03e8e23d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Test Trac #2486

parent 11991469
{-# OPTIONS_GHC -O -ddump-rules #-}
-- Trac #2486
--
-- The thing to look for here is that specialisations for fib and tak
-- at both Int and Double are indeed generated; hence -ddump-rules
module Main where
import System
import Numeric
main = do
n <- getArgs >>= readIO . head
let m = n-1
a = 27 + fromIntegral n
putStr $
line "Ack" [3,n] (ack 3 n) show ++
line "Fib" [a] (fib a :: Double) (\n -> showFFloat (Just 1) n []) ++
line "Tak" [3*m,2*m,m] (tak (3*m) (2*m) m :: Int) show ++
line "Fib" [3] (fib 3 :: Int) show ++
line "Tak" [3,2,1] (tak 3 2 1 :: Double) show
where
line pre a r f = pre ++ "(" ++ csv f a "" ++ "): " ++ f r ++ "\n"
csv f [a] s = s ++ f a
csv f (a:b) s = s ++ f a ++ "," ++ csv f b s
ack :: Int -> Int -> Int
ack 0 n = n+1
ack m 0 = ack (m-1) 1
ack m n = ack (m-1) (ack m (n-1))
fib :: (Num a, Ord a) => a -> a
fib n = if n >= 2 then fib (n-1) + fib (n-2) else 1
tak :: (Num a, Ord a) => a -> a -> a -> a
tak x y z = if y < x then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y) else z
==================== Transformation rules ====================
Local rules
Imported rules
==================== Top-level specialisations ====================
"SPEC Main.fib" ALWAYS
forall {$dNum_sRV :: GHC.Num.Num GHC.Types.Double
$dOrd_sRX :: GHC.Classes.Ord GHC.Types.Double}
Main.fib @ GHC.Types.Double $dNum_sRV $dOrd_sRX
= $sfib_sSv
"SPEC Main.fib" ALWAYS
forall {$dNum_sSd :: GHC.Num.Num GHC.Types.Int
$dOrd_sSf :: GHC.Classes.Ord GHC.Types.Int}
Main.fib @ GHC.Types.Int $dNum_sSd $dOrd_sSf
= $sfib_sSu
"SPEC Main.tak" ALWAYS
forall {$dNum_sRh :: GHC.Num.Num GHC.Types.Double
$dOrd_sRj :: GHC.Classes.Ord GHC.Types.Double}
Main.tak @ GHC.Types.Double $dNum_sRh $dOrd_sRj
= $stak_sRF
"SPEC Main.tak" ALWAYS
forall {$dNum_sRt :: GHC.Num.Num GHC.Types.Int
$dOrd_sRv :: GHC.Classes.Ord GHC.Types.Int}
Main.tak @ GHC.Types.Int $dNum_sRt $dOrd_sRv
= $stak_sRE
......@@ -21,3 +21,8 @@ test('simplrun009', normal, compile_and_run, [''])
test('simplrun010', composes([extra_run_opts('24 16 8'),
exit_code(1)])
, compile_and_run, [''])
# Really we'd like to run T2486 too, to check that its
# runtime has not gone up, but here I just compile it so that
# the output of -ddump-rules can be compared
test('T2486', normal, compile, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment