[GHC] #8538: confusing specialization CORE warning, also can't mark type class instances INLINEABLE unless class defn is marked INLINEABLE

[GHC]

#8538: confusing specialization CORE warning, also  can't mark type class
instances INLINEABLE unless class defn is marked INLINEABLE
------------------------------------+-------------------------------------
       Reporter:  carter            |             Owner:
           Type:  bug               |            Status:  new
       Priority:  normal            |         Milestone:
      Component:  Compiler          |           Version:  7.6.3
       Keywords:                    |  Operating System:  Unknown/Multiple
   Architecture:  Unknown/Multiple  |   Type of failure:  None/Unknown
     Difficulty:  Unknown           |         Test Case:
     Blocked By:                    |          Blocking:
Related Tickets:                    |
------------------------------------+-------------------------------------
 As part of writing an array library for numerical purposes, I have a
 static sized strict list type for representing the Indexing tuple. One
 implementation strategy makes it a tad generic, and then I'm writing a
 bunch of manipulation utilities using Functor, Applicative and Foldable.

 I wrote it with all the functions marked INLINABLE so i could ensure that
 I could have the index arith calculations SPECIALIZE in the common cases.

 Unfortunately, it seems like type class instances can only marked
 INLINABLE  if the type class definition is itself marked INLINE or
 INLINABLE. Considering i'm writing a numerical array library, I want to
 make sure that address arithmetic.

 This could could be argued to be by design (and thus a wont fix).

 That aside, I also get the following Warning for my "map2" function, which
 i found surprising. (and it perhaps is worth some investigation / cleanup
 )

 {{{

 src/Numerical/Types/Shape.hs:165:1: Warning:
     RULE left-hand side too complicated to desugar
       let {
         $dFunctor :: Functor (Shape ('S N0))
         [LclId]
         $dFunctor =
           Numerical.Types.Shape.$fFunctorShape @ 'Z $dFunctor } in
       map2
         @ a
         @ b
         @ c
         @ N2
         (Numerical.Types.Shape.$fApplicativeShape
            @ ('S N0)
            (Numerical.Types.Shape.$fFunctorShape @ ('S N0) $dFunctor)
            (Numerical.Types.Shape.$fApplicativeShape
               @ 'Z $dFunctor Numerical.Types.Shape.$fApplicativeShape0))
 }}}


 {{{
 {-# LANGUAGE PolyKinds   #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE NoImplicitPrelude #-}

 module Numerical.Types.Shape where

 import GHC.Magic
 import Data.Monoid
 import Data.Functor
 import Data.Foldable
 import Control.Applicative

 -- import Numerical.Types.Nat

 import Prelude (seq, ($!),($),Show(..),Eq(),Int)

 data Nat = S !Nat  | Z

 type N0 = Z

 type N1= S N0

 type N2 = S N1

 type N3 = S N2

 type N4 = S N3

 {-
 not doing the  HLIST style shape because I don't want to have
 any pattern matchings going on.

 Also would play hell with locality quality in the address translation
 hackery,
 because there'd be an extra load to get those ints!
 -}
 infixr 3 :*

  {-
 the concern basically boils down to "will it specialize / inline well"

  -}
 data Shape (rank :: Nat) a where
     Nil  :: Shape Z a
     (:*) ::  !(a) -> !(Shape r a ) -> Shape  (S r) a

 --deriving instance (Show (Shape rank a))

     -- deriving instance Eq (Shape rank a)


     -- #if defined( __GLASGOW_HASKELL__ ) &&  ( __GLASGOW_HASKELL__  >=
 707)
     --deriving instance Typeable (Shape rank a)
     -- #endif



 instance Functor (Shape Z) where

     fmap  = \ f Nil -> Nil
     {-# INLINABLE fmap #-}

 {-# SPECIALIZE fmap :: (a ->b  )-> (Shape Z a)-> (Shape Z b) #-}

 instance  (Functor (Shape r)) => Functor (Shape (S r)) where

     fmap  = \ f (a :* rest) -> f a :* fmap f rest
     {-# INLINABLE fmap  #-}

 {-# SPECIALIZE fmap :: (a ->b )-> (Shape N1 a)-> (Shape N1 b) #-}
 {-# SPECIALIZE fmap :: (a ->b )-> (Shape N2 a)-> (Shape N2 b) #-}

 instance  Applicative (Shape Z) where
     pure = \ _ -> Nil
     {-# INLINE pure #-}

     (<*>) = \ _  _ -> Nil
     {-# INLINE (<*>) #-}

 {-# SPECIALIZE pure  :: a -> Shape Z a #-}
 {-# SPECIALIZE (<*>) ::  Shape Z (a -> b) -> Shape Z a -> Shape Z b #-}

 instance  Applicative (Shape r)=> Applicative (Shape (S r)) where
     pure = \ a -> a :* (pure a)
     {-# INLINE pure  #-}

     (<*>) = \ (f:* fs) (a :* as) ->  f a :* (inline (<*>)) fs as
     {-# INLINE (<*>) #-}

 {-# SPECIALIZE pure :: a -> (Shape Z  a) #-}
 {-# SPECIALIZE pure :: a -> (Shape N1 a) #-}
 {-# SPECIALIZE pure :: a -> (Shape N2 a )#-}

 instance Foldable (Shape Z) where
     foldMap = \ _ _ -> mempty
     {-# INLINE foldMap #-}

     foldl = \ _ init  _ -> init
     {-# INLINE foldl #-}

     foldr = \ _ init _ -> init
     {-# INLINE foldr #-}

     foldr' = \_ !init _ -> init
     {-# INLINE foldr' #-}

     foldl' = \_ !init _ -> init
     {-# INLINE foldl' #-}

 --    {-# SPECIALIZE foldMap :: Monoid m => (a -> m)-> Shape Z a -> m  #-}
 --    {-# SPECIALIZE foldl :: (a ->b -> a) -> a -> Shape Z b -> a  #-}
 --    {-# SPECIALIZE foldr :: (b ->a -> a) -> a -> Shape Z b -> a  #-}
 --    {-# SPECIALIZE foldl' :: (a ->b -> a) -> a -> Shape Z b -> a  #-}
 --    {-# SPECIALIZE foldr' :: (b ->a -> a) -> a -> Shape Z b -> a  #-}


 instance (Foldable (Shape r))  => Foldable (Shape (S r)) where
     foldMap = \f  (a:* as) -> f a <> foldMap f as
     {-# INLINE foldMap #-}

     foldl' = \f !init (a :* as) -> let   next = f  init a   in     next
 `seq` (inline foldl) f next as
     {-# INLINE foldl' #-}

     foldr' = \f !init (a :* as ) -> f a $! (inline foldr) f init as
     {-# INLINABLE foldr' #-}

     foldl = \f init (a :* as) -> let   next = f  init a  in   (inline
 foldl) f next as
     {-# INLINE foldl #-}

     foldr = \f init (a :* as ) -> f a $ (inline foldr) f init as
     {-# INLINE foldr  #-}

 {-# SPECIALIZE foldMap::Monoid m => (a -> m)-> Shape N1 a -> m  #-}
 {-# SPECIALIZE foldl :: (a ->b -> a) ->a -> Shape N1 b -> a  #-}
 {-# SPECIALIZE foldr :: (b ->a -> a) -> a -> Shape N1 b  -> a  #-}
 {-# SPECIALIZE foldl' :: (a ->b -> a) -> a -> Shape N1 b -> a  #-}
 {-# SPECIALIZE foldr' :: (b ->a -> a) -> a -> Shape N1 b -> a  #-}

 {-# SPECIALIZE foldMap :: Monoid m => (a -> m)-> Shape N2 a -> m  #-}
 {-# SPECIALIZE foldl :: (a ->b-> a) ->a -> Shape N2 b -> a  #-}
 {-# SPECIALIZE foldr :: (b ->a -> a) -> a -> Shape N2 b -> a  #-}
 {-# SPECIALIZE foldl' :: (a ->b -> a) -> a -> Shape N2 b -> a  #-}
 {-# SPECIALIZE foldr' :: (b ->a -> a) -> a -> Shape N2 b -> a  #-}

 --
 map2 :: (Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b)
 -> (Shape r c )
 map2 = \f l r -> pure f <*>  l  <*> r

 {-# INLINABLE map2 #-}

 {-# SPECIALIZE map2 :: (a -> b -> c ) -> (Shape  Z a) -> (Shape  Z b) ->
 (Shape Z c )#-}
 {-# SPECIALIZE map2 :: (a -> b -> c ) -> (Shape  N1 a) -> (Shape  N1 b) ->
 (Shape  N1 c )#-}
 {-# SPECIALIZE map2 :: (a -> b -> c ) -> (Shape N2 a) -> (Shape  N2 b) ->
 (Shape  N2  c )#-}


 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/8538>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler