Opened 5 months ago

#8538 new bug

confusing specialization CORE warning, also can't mark type class instances INLINEABLE unless class defn is marked INLINEABLE

Reported by: carter Owned by:
Priority: normal Milestone:
Component: Compiler Version: 7.6.3
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Difficulty: Unknown
Test Case: Blocked By:
Blocking: Related Tickets:

Description

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 )#-}


Change History (0)

Note: See TracTickets for help on using tickets.