SPECIALIZE function for type defined elsewhere

Max Bolingbroke batterseapower at hotmail.com
Wed Jul 28 11:40:59 EDT 2010


On 28 July 2010 13:57, Sebastian Fischer <sebf at informatik.uni-kiel.de> wrote:
> In my case, I don't want to put everything in a single module because I
> cannot know what other B-like modules people will implement.Are they bound
> to use `f` unspecialized for their types?

Yes. GHC might inline "f" into the call site and achieve
specialisation that way, but AFAIK there is no way to force this.

> Why?

SPECIALISE pragmas are not supported in any but the defining module
because the Core for a function to specialise is not guaranteed to be
available in any other module. I don't think there is any other
barrier.

It is possible to imagine implementing a remedy for this by using
-fexpose-all-unfoldings and having GHC use the exposed Core to
generate a specialisation in any importing module. You would probably
also want some sort of mechanism to "common up" specialisations if
several modules independently specialise one function to the same type
(could do this in the linker or even earlier).

You would probably also have to be prepared to emit warnings about
stuff like this:

"""
module A where

import B

f :: Foo a => a -> a
f = ...
"""

"""
module B

import {-# SOURCE #-} A

newtype Bar = ...

instance Foo Bar where

{-# SPECIALISE f :: Bar -> Bar #-}
"""

Another nice-to-have along the same lines is something like this:

"""
map_unboxed :: [Int#] -> [Int#]
map_unboxed = map (+# 1)
"""

i.e. allow polymorphic functions to be instantiated at types of a kind
other than *. This would be a rather cool and useful feature :-).

As far as I know noone is working on either of these features.

Cheers,
Max


More information about the Glasgow-haskell-users mailing list