I think this is a consequence of the rule that we never abstract over types of 
kind #. But I believe this should work with my branch:

> type Tuple (a :: TYPE v1) (b :: TYPE v2) = (# a, b #)

The user would have to request that the synonym be used over both * and #, but 
the synonym should work. The need to request the special treatment might be 
lifted, but we'd have to think hard about where we want the generality by 
default and where we want simpler behavior by default.

Richard

On Dec 6, 2015, at 1:55 PM, Ömer Sinan Ağacan <omeraga...@gmail.com> wrote:

> In this program:
> 
>    {-# LANGUAGE MagicHash, UnboxedTuples #-}
> 
>    module Main where
> 
>    import GHC.Prim
>    import GHC.Types
> 
>    type Tuple a b = (# a, b #)
> 
>    main = do
>      let -- x :: Tuple Int# Float#
>          x :: (# Int#, Float# #)
>          x = (# 1#, 0.0# #)
> 
>      return ()
> 
> If I use the first type declaration for 'x' I'm getting this error message:
> 
>    Expecting a lifted type, but ‘Int#’ is unlifted
> 
> Indeed, if I look at the kinds of arguments of 'Tuple':
> 
>    λ:7> :k Tuple
>    Tuple :: * -> * -> #
> 
> It's star. I was wondering why is this not 'OpenKind'(or whatever the
> super-kind of star and hash). Is there a problem with this? Is this a bug?
> Or is this simply because type synonyms are implemented before OpenKinds?
> _______________________________________________
> ghc-devs mailing list
> ghc-devs@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
> 

_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

Reply via email to