
Dear GHC users I've just discovered something very peculiar with unboxed tuples in GHC. f2 x = (# True, False #) f1 x = (# True #) f0 x = (# #) What types do these functions have? f2 :: a -> (# Bool, Bool #) f1 :: a -> (# Bool #) BUT f0 :: a -> b -> (# b #) I think this is stupid. It should be f0 :: a -> (# #) But in fact even that type isn't what you expect (ie the analogue of f :: a -> () ) Here are the kinds of the type constructors: (,,) :: * -> * -> * -> * (,) :: * -> * -> * () :: * (# ,, #) :: * -> * -> * -> # (# , #) :: * -> * -> # BUT (# #) :: * -> # In both respects unboxed unit tuples are behaving differently to boxed ones. This seems bonkers. I propose to fix this, but I wanted to check if anyone is relying on the current odd behaviour. Simon

On Fri, Dec 23, 2011 at 12:46:38PM +0000, Simon Peyton-Jones wrote:
Dear GHC users
I've just discovered something very peculiar with unboxed tuples in GHC.
The problem is that there is no boxed singleton tuple, whereas there is an unboxed singleton tuple, so there is a conflict between the data constructor for singleton and unit, right?: Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 (# #) 0 () (# #) Thanks Ian

Your table isn't quite right. For data constructors the current situation is this: Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 (# #) 0 () Wierd! Indeed, in my proposal, here is no singleton data constructor for boxed tuples either! Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #) More uniform! If you the singleton-unboxed-tuple data constructor in source code, as a function, you'd write (\x -> (# x #)). In a pattern, or applied, you'd write (# x #). So then we have (for data constructors): Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #) Simple, uniform. Simon | -----Original Message----- | From: glasgow-haskell-users-bounces@haskell.org [mailto:glasgow-haskell- | users-bounces@haskell.org] On Behalf Of Ian Lynagh | Sent: 23 December 2011 13:17 | To: glasgow-haskell-users@haskell.org | Subject: Re: Unit unboxed tuples | | On Fri, Dec 23, 2011 at 12:46:38PM +0000, Simon Peyton-Jones wrote: | > Dear GHC users | > | > I've just discovered something very peculiar with unboxed tuples in GHC. | | The problem is that there is no boxed singleton tuple, whereas there is | an unboxed singleton tuple, so there is a conflict between the data | constructor for singleton and unit, right?: | | Arguments Boxed Unboxed | 3 ( , , ) (# , , #) | 2 ( , ) (# , #) | 1 (# #) | 0 () (# #) | | | Thanks | Ian | | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

On Fri, Dec 23, 2011 at 01:34:49PM +0000, Simon Peyton-Jones wrote:
Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #)
Simple, uniform.
Uniform horizontally, but strange vertically! Anyway, I don't have a better suggestion, and your proposal seems better than the status quo. Thanks Ian

On 23/12/2011 13:46, Ian Lynagh wrote:
On Fri, Dec 23, 2011 at 01:34:49PM +0000, Simon Peyton-Jones wrote:
Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #)
Simple, uniform.
Uniform horizontally, but strange vertically!
It's worth mentioning that if you want to write code that's generic over tuples in some way, the absence of a case for singletons is actually a bit annoying - you end up adding something like a One constructor to paper over the gap. But I can't think of any nice syntax for that case either. Cheers, Ganesh

Very hard to be generic over *unboxed* tuples! But yes the non-uniformity in boxed tuples is annoying. | -----Original Message----- | From: glasgow-haskell-users-bounces@haskell.org [mailto:glasgow-haskell- | users-bounces@haskell.org] On Behalf Of Ganesh Sittampalam | Sent: 23 December 2011 14:37 | To: glasgow-haskell-users@haskell.org | Subject: Re: Unit unboxed tuples | | On 23/12/2011 13:46, Ian Lynagh wrote: | > On Fri, Dec 23, 2011 at 01:34:49PM +0000, Simon Peyton-Jones wrote: | >> | >> Arguments Boxed Unboxed | >> 3 ( , , ) (# , , #) | >> 2 ( , ) (# , #) | >> 1 | >> 0 () (# #) | >> | >> Simple, uniform. | > | > Uniform horizontally, but strange vertically! | | It's worth mentioning that if you want to write code that's generic over | tuples in some way, the absence of a case for singletons is actually a | bit annoying - you end up adding something like a One constructor to | paper over the gap. But I can't think of any nice syntax for that case | either. | | Cheers, | | Ganesh | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users@haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

On December 23, 2011 09:37:04 Ganesh Sittampalam wrote:
On 23/12/2011 13:46, Ian Lynagh wrote:
On Fri, Dec 23, 2011 at 01:34:49PM +0000, Simon Peyton-Jones wrote:
Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #)
It's worth mentioning that if you want to write code that's generic over tuples in some way, the absence of a case for singletons is actually a bit annoying - you end up adding something like a One constructor to paper over the gap. But I can't think of any nice syntax for that case either.
I believe python uses (expr,) (i.e., nothing following the ,) to distinguish a singelton tupple from a braced term. Not great, but possibly not that bad. The other option you could do is introduce another unambiguous brace symbol for tupples. The new symbol would be optional except for the singelton. (- expr, expr, expr -) = (expr, expr, expr) (- expr, expr -) = (expr, expr) (- expr -) = <unable to express> (- -) = () Nothing has to be done for (# #) as it doesn't have the ambiguity. Cheers! -Tyson

On 12/23/11 12:57 PM, Tyson Whitehead wrote:
On December 23, 2011 09:37:04 Ganesh Sittampalam wrote:
On 23/12/2011 13:46, Ian Lynagh wrote:
On Fri, Dec 23, 2011 at 01:34:49PM +0000, Simon Peyton-Jones wrote:
Arguments Boxed Unboxed 3 ( , , ) (# , , #) 2 ( , ) (# , #) 1 0 () (# #)
It's worth mentioning that if you want to write code that's generic over tuples in some way, the absence of a case for singletons is actually a bit annoying - you end up adding something like a One constructor to paper over the gap. But I can't think of any nice syntax for that case either.
I believe python uses (expr,) (i.e., nothing following the ,) to distinguish a singelton tupple from a braced term. Not great, but possibly not that bad.
The other option you could do is introduce another unambiguous brace symbol for tupples. The new symbol would be optional except for the singelton.
(- expr, expr, expr -) = (expr, expr, expr) (- expr, expr -) = (expr, expr) (- expr -) =<unable to express> (- -) = ()
An alternative is to distinguish, say, (# x #) and its spaceful constructor (# #) from the spaceless (##); and analogously for the boxed tuples, though that introduces confusion about parentheses for boxing vs parentheses for grouping. FWIW, I'd always thought that () disallowed intervening spaces, though ghci tells me that ain't so. -- Live well, ~wren

On January 8, 2012 23:49:47 wren ng thornton wrote:
An alternative is to distinguish, say, (# x #) and its spaceful constructor (# #) from the spaceless (##); and analogously for the boxed tuples, though that introduces confusion about parentheses for boxing vs parentheses for grouping.
I think that sounds pretty good. Here is another that occured to me today (#), (# a #), (# a, b #), (# a, b, c #) ... If you replace the internal ',' with '#' (#), (# a #), (# a # b #), (# a # b # c #), ... you have number of elements = number of '#' - 1. Cheers! -Tyson

On 1/10/12 10:31 AM, Tyson Whitehead wrote:
On January 8, 2012 23:49:47 wren ng thornton wrote:
An alternative is to distinguish, say, (# x #) and its spaceful constructor (# #) from the spaceless (##); and analogously for the boxed tuples, though that introduces confusion about parentheses for boxing vs parentheses for grouping.
I think that sounds pretty good. Here is another that occured to me today
(#), (# a #), (# a, b #), (# a, b, c #) ...
If you replace the internal ',' with '#'
(#), (# a #), (# a # b #), (# a # b # c #), ...
you have number of elements = number of '#' - 1.
Yeah, I thought of suggesting (#) in lieu of (##). That might work better for parsing et alia since it removes the whitespace sensitivity of (##) vs (# #). -- Live well, ~wren

On 12/23/11 8:34 AM, Simon Peyton-Jones wrote:
More uniform! If you the singleton-unboxed-tuple data constructor in source code, as a function, you'd write (\x -> (# x #)). In a pattern, or applied, you'd write (# x #).
Shouldn't (# T #) be identical to T? I know that a putative (T) would be different from T because it would introduce an additional bottom, but I don't think that would apply to the unboxed case. Or is there something in the semantics of unboxed tuples that I'm missing? -- Live well, ~wren

On 09/01/2012 04:46, wren ng thornton wrote:
On 12/23/11 8:34 AM, Simon Peyton-Jones wrote:
More uniform! If you the singleton-unboxed-tuple data constructor in source code, as a function, you'd write (\x -> (# x #)). In a pattern, or applied, you'd write (# x #).
Shouldn't (# T #) be identical to T?
No, because (# T #) is unlifted, whereas T is lifted. In operational terms, a function that returns (# T #) does not evaluate the T before returning it, but a function returning T does. This is used in GHC for example to fetch a value from an array without evaluating it, for example: indexArray :: Array# e -> Int# -> (# e #) Cheers, Simon
I know that a putative (T) would be different from T because it would introduce an additional bottom, but I don't think that would apply to the unboxed case. Or is there something in the semantics of unboxed tuples that I'm missing?

Here are the kinds of the type constructors:
(,,) :: * -> * -> * -> * (,) :: * -> * -> * () :: *
(# ,, #) :: * -> * -> * -> # (# , #) :: * -> * -> # BUT (# #) :: * -> #
Just of out curiosity, what would be a compelling use case for singleton and unit unboxed tuples? Cheers, Stefan

On 23 December 2011 20:09, Stefan Holdermans
Here are the kinds of the type constructors:
(,,) :: * -> * -> * -> * (,) :: * -> * -> * () :: *
(# ,, #) :: * -> * -> * -> # (# , #) :: * -> * -> # BUT (# #) :: * -> #
Just of out curiosity, what would be a compelling use case for singleton and unit unboxed tuples?
For singleton unboxed tuples, any situation where you want to return a single value but not force its evaluation. This occurs for example with some low level functions in the implementation of ordinary lazy arrays. Duncan

On Sat, Dec 24, 2011 at 7:15 AM, Duncan Coutts
On 23 December 2011 20:09, Stefan Holdermans
wrote: Here are the kinds of the type constructors:
(,,) :: * -> * -> * -> * (,) :: * -> * -> * () :: *
(# ,, #) :: * -> * -> * -> # (# , #) :: * -> * -> # BUT (# #) :: * -> #
Just of out curiosity, what would be a compelling use case for singleton and unit unboxed tuples?
For singleton unboxed tuples, any situation where you want to return a single value but not force its evaluation. This occurs for example with some low level functions in the implementation of ordinary lazy arrays.
How is that different from returning a normal value?
--
Dave Menendez

Duncan,
Just of out curiosity, what would be a compelling use case for singleton and unit unboxed tuples?
For singleton unboxed tuples, any situation where you want to return a single value but not force its evaluation. This occurs for example with some low level functions in the implementation of ordinary lazy arrays.
That makes sense. Thanks. Leaves me wondering about nullary unboxed tuples... These give rise to a bottomless type, don't they? Cheers, Stefan

| > Just of out curiosity, what would be a compelling use case for singleton | and unit unboxed tuples? | | For singleton unboxed tuples, any situation where you want to return a | single value but not force its evaluation. This occurs for example | with some low level functions in the implementation of ordinary lazy | arrays. True; but you don't need the singleton constructor as a function to do that; just write f x = (# x+1 #) for example. Singleton unboxed tuples are a perfectly valid data type; it's just that we don't (now) have a name for their constructor. Simon

Quoting Simon Peyton-Jones
for example. Singleton unboxed tuples are a perfectly valid data type; it's just that we don't (now) have a name for their constructor.
Well, Haskell *does* have a mechanism for giving two different implementations to a particular name... class UnboxedUnit a where (# #) :: a instance UnboxedUnit (##) instance UnboxedUnit (a -> (# a #)) That only leaves solving the equivalent problem for the type-level name (# #). ~d
participants (10)
-
David Menendez
-
Duncan Coutts
-
Ganesh Sittampalam
-
Ian Lynagh
-
Simon Marlow
-
Simon Peyton-Jones
-
Stefan Holdermans
-
Tyson Whitehead
-
wagnerdm@seas.upenn.edu
-
wren ng thornton