blob: 32797adea2fb9fcf27696971688ad7325c026f0e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE KindSignatures, GADTs, DataKinds, FlexibleInstances, FlexibleContexts #-}
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]
-- Artificially made recursive so that it won't inline,
-- so we can see if the specialisation happens
map2 = \f l r -> (A.pure f A.<*> l A.<*> r) : map2 f l 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
|
