Commit 88d94524 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Test Trac #8848

parent b800e52a
{-# LANGUAGE KindSignatures, GADTs, DataKinds, FlexibleInstances, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
module T8848 where
import qualified Control.Applicative as A
import qualified Data.Functor as Fun
data Nat = S Nat | Z
data Shape (rank :: Nat) a where
Nil :: Shape Z a
(:*) :: a -> Shape r a -> Shape (S r) a
instance A.Applicative (Shape Z) where
instance A.Applicative (Shape r)=> A.Applicative (Shape (S r)) where
instance Fun.Functor (Shape Z) where
instance (Fun.Functor (Shape r)) => Fun.Functor (Shape (S r)) where
map2 :: (A.Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b) -> (Shape r c )
map2 = \f l r -> A.pure f A.<*> l A.<*> r
{-# SPECIALIZE map2 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c #-}
map3 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c
map3 x y z = map2 x y z
\ No newline at end of file
Rule fired: Class op fmap
Rule fired: Class op fmap
Rule fired: Class op pure
Rule fired: Class op <*>
Rule fired: Class op <*>
Rule fired: SPEC T8848.map2
Rule fired: Class op $p1Applicative
Rule fired: Class op <*>
Rule fired: Class op $p1Applicative
Rule fired: Class op <*>
Rule fired: Class op $p1Applicative
Rule fired: Class op fmap
Rule fired: Class op <*>
Rule fired: Class op $p1Applicative
Rule fired: Class op fmap
Rule fired: Class op <*>
Rule fired: SPEC T8848.$fFunctorShape ['T8848.Z]
module T8848a where
f :: Ord a => b -> a -> a
f y x = x
{-# SPECIALISE f :: b -> [Int] -> [Int] #-}
{- Specialised badly:
"SPEC Spec.f" [ALWAYS]
forall (@ b_aX7).
Spec.f @ b_aX7
@ [GHC.Types.Int]
(GHC.Classes.$fOrd[]
@ GHC.Types.Int
(GHC.Classes.$fEq[] @ GHC.Types.Int GHC.Classes.$fEqInt)
GHC.Classes.$fOrdInt)
= Spec.f_$sf @ b_aX7
-}
\ No newline at end of file
==================== Tidy Core rules ====================
"SPEC T8848a.f" [ALWAYS]
forall (@ b) ($dOrd :: GHC.Classes.Ord [GHC.Types.Int]).
T8848a.f @ b @ [GHC.Types.Int] $dOrd
= T8848a.f_$sf @ b
......@@ -202,3 +202,5 @@ test('T8832',
extra_clean(['T8832.hi', 'T8832a.o']),
run_command,
['$MAKE -s --no-print-directory T8832'])
test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings'])
test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules'])
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