
Loosely related to Ticket #76 (Bang Patterns) is the question of whether we want the language to include strict tuples. It is related to bang patterns, because its sole motivation is to simplify enforcing strictness for some computations. Its about empowering the programmer to choose between laziness and strictness where they deem that necessary without forcing them to completely re-arrange sub-expressions (as seq does). So what are strict tupples? If a lazy pair is defined in pseudo code as data (a, b) = (a, b) a strict pair would be defined as data (!a, b!) = ( !a, !b ) Ie, a strict tuple is enclosed by bang parenthesis (! ... !). The use of the ! on the rhs are just the already standard strict data type fields. Why strict tuples, but not strict lists and strict Maybe and so on? Tuples are the Haskell choice of returning more than one result from a function. So, if I write add x y = x + y the caller gets an evaluated result. However, if I write addmul x y = (x + y, x * y) the caller gets a pair of two unevaluated results. Even with bang patterns, I still have to write addmul x y = let !s = x + y; !p = x * y in (s, p) to have both results evaluated. With strict tuples addmul x y = (!x + y, x * y!) suffices. Of course, the caller could invoke addmul using a bang patterns, as in let ( !s, !p ) = addmul x y in ... but that's quite different to statically knowing (from the type) that the two results of addmul will already be evaluated. The latter leaves room for more optimisations. Syntax issues ~~~~~~~~~~~~~ * In Haskell (,) is the pair constructor. What should be use for strict tuples? (!,!) ? * With strict tuples (! and !) would become some sort of reserved/special symbol. That interferes with bang patterns, as (!x, y!) would be tokenized as (! x , y !). We could use ( ... !) for strict tuples to avoid that conflict, or just requires that the user write ( !x, !y ) when they want a bang pattern. (Just like you cannot write `Just.x' to mean `Just . x' as the former will always be read as a qualified name and not the application of function composition. Bang patterns enable the programmer (among other things) to define functions with strict arguments. Strict tuples enable to define strict results. Manuel PS: IIRC Clean supports strict tuples.

Hello Manuel, Sunday, March 19, 2006, 5:35:12 AM, you wrote: MMTC> PS: IIRC Clean supports strict tuples. i've proposed to allow adding strict mark to any type constructors and type constructor parameters so that finally we can define any data structure that can be defined in strict languages. in particular: type StrictPair a b = !(,) a b type StrictElements a b = (,) !a !b type StrictBoth a b = !(,) !a !b type StrictFunction a b = !(->) !a !b strictMap :: StrictFunction a b -> ![!a] -> ![!b] where ![!a] is a strict list with strict elements -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

Am Sonntag, 19. März 2006 15:53 schrieb Bulat Ziganshin:
Hello Manuel,
Sunday, March 19, 2006, 5:35:12 AM, you wrote:
MMTC> PS: IIRC Clean supports strict tuples.
i've proposed to allow adding strict mark to any type constructors and type constructor parameters so that finally we can define any data structure that can be defined in strict languages. in particular:
type StrictPair a b = !(,) a b type StrictElements a b = (,) !a !b type StrictBoth a b = !(,) !a !b type StrictFunction a b = !(->) !a !b
strictMap :: StrictFunction a b -> ![!a] -> ![!b]
where ![!a] is a strict list with strict elements
Strictness has to refer to attributes (the things you apply a data constructor to). In you approach, strictness is connected to type arguments. This causes problems. For example, if you have data T a = C a a, what would T !a mean? Would both attributes be strict? But how would you force only one attribute to be strict then? These thinkings make me believe that assigning strictness flags to type arguments is just not sensible. Best wishes, Wolfgang

On 3/19/06, Manuel M T Chakravarty
Loosely related to Ticket #76 (Bang Patterns) is the question of whether we want the language to include strict tuples. It is related to bang patterns, because its sole motivation is to simplify enforcing strictness for some computations. Its about empowering the programmer to choose between laziness and strictness where they deem that necessary without forcing them to completely re-arrange sub-expressions (as seq does).
So what are strict tupples? If a lazy pair is defined in pseudo code as
data (a, b) = (a, b)
a strict pair would be defined as
data (!a, b!) = ( !a, !b )
Ie, a strict tuple is enclosed by bang parenthesis (! ... !). The use of the ! on the rhs are just the already standard strict data type fields.
Maybe I've missed something here. But is there really any reasonable usage cases for something like: f !(a,b) = a + b in the current bang patterns proposal? I mean, would anyone really ever want an explicitly strict (i.e. using extra syntax) tuple with lazy elements? Couldn't the syntax for strict tuples be just what I wrote above (instead of adding weird-looking exclamation parenthesis). I'm pretty sure that most programmers who would write "f !(a,b) = ..." would expect the tuple's elements to be forced (they wouldn't expect it to do nothing, at least).. In fact !(x:xs) should mean (intuitively to me, at least) "force x, and xs", meaning that the element x is forced, and the list xs is forced (but not the elements of the xs). Couldn't this be generalised? A pattern match on any constructor with a bang in front of it will force all the parts of the constructor (with seq)? So: f !xs = b -- gives f xs = xs `seq` b, like the current proposal f !(x:xs) = b -- gives f (x:xs) = x `seq` xs `seq` b, unlike the current proposal? The latter would then be equal to f (!x:xs) = b right? Just slightly more convenient in some cases... f (A !b (C !c !d) !e !f !g) = y would be equivalent to: f !(A b !(C c d) e f g) = y Instead of the latter meaning doing nothing... /S -- Sebastian Sylvan +46(0)736-818655 UIN: 44640862

On 3/20/06, Sebastian Sylvan
On 3/19/06, Manuel M T Chakravarty
wrote: Loosely related to Ticket #76 (Bang Patterns) is the question of whether we want the language to include strict tuples. It is related to bang patterns, because its sole motivation is to simplify enforcing strictness for some computations. Its about empowering the programmer to choose between laziness and strictness where they deem that necessary without forcing them to completely re-arrange sub-expressions (as seq does).
So what are strict tupples? If a lazy pair is defined in pseudo code as
data (a, b) = (a, b)
a strict pair would be defined as
data (!a, b!) = ( !a, !b )
Ie, a strict tuple is enclosed by bang parenthesis (! ... !). The use of the ! on the rhs are just the already standard strict data type fields.
Maybe I've missed something here. But is there really any reasonable usage cases for something like:
f !(a,b) = a + b
in the current bang patterns proposal?
I mean, would anyone really ever want an explicitly strict (i.e. using extra syntax) tuple with lazy elements?
Couldn't the syntax for strict tuples be just what I wrote above (instead of adding weird-looking exclamation parenthesis).
I'm pretty sure that most programmers who would write "f !(a,b) = ..." would expect the tuple's elements to be forced (they wouldn't expect it to do nothing, at least).. In fact !(x:xs) should mean (intuitively to me, at least) "force x, and xs", meaning that the element x is forced, and the list xs is forced (but not the elements of the xs).
Couldn't this be generalised? A pattern match on any constructor with a bang in front of it will force all the parts of the constructor (with seq)?
So: f !xs = b -- gives f xs = xs `seq` b, like the current proposal f !(x:xs) = b -- gives f (x:xs) = x `seq` xs `seq` b, unlike the current proposal?
The latter would then be equal to
f (!x:xs) = b
I mean f (!x:!xs) = b /S -- Sebastian Sylvan +46(0)736-818655 UIN: 44640862

Sebastian Sylvan:
On 3/19/06, Manuel M T Chakravarty
wrote: Loosely related to Ticket #76 (Bang Patterns) is the question of whether we want the language to include strict tuples. It is related to bang patterns, because its sole motivation is to simplify enforcing strictness for some computations. Its about empowering the programmer to choose between laziness and strictness where they deem that necessary without forcing them to completely re-arrange sub-expressions (as seq does).
So what are strict tupples? If a lazy pair is defined in pseudo code as
data (a, b) = (a, b)
a strict pair would be defined as
data (!a, b!) = ( !a, !b )
Ie, a strict tuple is enclosed by bang parenthesis (! ... !). The use of the ! on the rhs are just the already standard strict data type fields.
Maybe I've missed something here. But is there really any reasonable usage cases for something like:
f !(a,b) = a + b
in the current bang patterns proposal?
I mean, would anyone really ever want an explicitly strict (i.e. using extra syntax) tuple with lazy elements?
Couldn't the syntax for strict tuples be just what I wrote above (instead of adding weird-looking exclamation parenthesis).
I'm pretty sure that most programmers who would write "f !(a,b) = ..." would expect the tuple's elements to be forced (they wouldn't expect it to do nothing, at least).. In fact !(x:xs) should mean (intuitively to me, at least) "force x, and xs", meaning that the element x is forced, and the list xs is forced (but not the elements of the xs).
Couldn't this be generalised? A pattern match on any constructor with a bang in front of it will force all the parts of the constructor (with seq)?
The point about strict tuples is not that the components are forced on pattern matching (that's indeed what bang patterns are for). The point about strict tuples is that the components are forced *before* the tuple is *constructed*. It's really exactly the same as with strict fields in data type declarations today. So, yes, I can just define my own data MyStrictPair a b = MyStrictPair !a !b and use that. My point is simply that strict tuples are a particularly useful form of strict data types, so * they should be pre-defined in the Prelude and * they should inherit the special syntax of tuples. So, this is not so much a language feature as a library issue. Manuel

On 3/20/06, Manuel M T Chakravarty
Sebastian Sylvan:
On 3/19/06, Manuel M T Chakravarty
wrote: Loosely related to Ticket #76 (Bang Patterns) is the question of whether we want the language to include strict tuples. It is related to bang patterns, because its sole motivation is to simplify enforcing strictness for some computations. Its about empowering the programmer to choose between laziness and strictness where they deem that necessary without forcing them to completely re-arrange sub-expressions (as seq does).
So what are strict tupples? If a lazy pair is defined in pseudo code as
data (a, b) = (a, b)
a strict pair would be defined as
data (!a, b!) = ( !a, !b )
Ie, a strict tuple is enclosed by bang parenthesis (! ... !). The use of the ! on the rhs are just the already standard strict data type fields.
Maybe I've missed something here. But is there really any reasonable usage cases for something like:
f !(a,b) = a + b
in the current bang patterns proposal?
I mean, would anyone really ever want an explicitly strict (i.e. using extra syntax) tuple with lazy elements?
Couldn't the syntax for strict tuples be just what I wrote above (instead of adding weird-looking exclamation parenthesis).
I'm pretty sure that most programmers who would write "f !(a,b) = ..." would expect the tuple's elements to be forced (they wouldn't expect it to do nothing, at least).. In fact !(x:xs) should mean (intuitively to me, at least) "force x, and xs", meaning that the element x is forced, and the list xs is forced (but not the elements of the xs).
Couldn't this be generalised? A pattern match on any constructor with a bang in front of it will force all the parts of the constructor (with seq)?
The point about strict tuples is not that the components are forced on pattern matching (that's indeed what bang patterns are for). The point about strict tuples is that the components are forced *before* the tuple is *constructed*. It's really exactly the same as with strict fields in data type declarations today.
Ah yes, I get it now. What I wrote was more related to Bang patterns then (so it's a bit OT). The more I think about bang patterns, though, the more it seems reasonable that "f !(a,b)" shouldn't be equivalent to "f (a,b)". If one thinks about ! as removing one "layer" of laziness (e.g. !xs will force a list, but not its elements) then it should make sense that applying ! to a pattern where one (or more) "layer" of laziness has already been removed (via pattern matching) would result in forcing the next "layer" (e.g. ![a,b] would evaluate a and b, since the list itself has already been forced via pattern matching). It makes sense to me to at least. More sense than having ! do nothing in circumstances like the above, anyway. /S -- Sebastian Sylvan +46(0)736-818655 UIN: 44640862

On 3/18/06, Manuel M T Chakravarty
Of course, the caller could invoke addmul using a bang patterns, as in
let ( !s, !p ) = addmul x y in ...
but that's quite different to statically knowing (from the type) that the two results of addmul will already be evaluated. The latter leaves room for more optimisations.
I looked back at this, and I'm not sure that this statement (which
appears to be the core reason for considering this) is true at all. I
don't see that more optimization follows from the availability of
information regarding the strictness of a function result's
subcomponents.
--
Taral

Hello Taral,
Wednesday, March 22, 2006, 2:14:17 AM, you wrote:
T> On 3/18/06, Manuel M T Chakravarty
Of course, the caller could invoke addmul using a bang patterns, as in
let ( !s, !p ) = addmul x y in ...
but that's quite different to statically knowing (from the type) that the two results of addmul will already be evaluated. The latter leaves room for more optimisations.
T> I looked back at this, and I'm not sure that this statement (which T> appears to be the core reason for considering this) is true at all. I T> don't see that more optimization follows from the availability of T> information regarding the strictness of a function result's T> subcomponents. ghc uses unboxed tuples just for such sort of optimizations. instead of returning possibly-unevaluated pair with possibly-unevaluated elements it just return, say, two doubles in registers - a huge win -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

On 3/22/06, Bulat Ziganshin
ghc uses unboxed tuples just for such sort of optimizations. instead of returning possibly-unevaluated pair with possibly-unevaluated elements it just return, say, two doubles in registers - a huge win
I have no doubt of this. My comment refers to the idea that somehow
such strictness annotations are (a) required at the type level and (b)
required at all to enable such optimization. I believe the
optimization happens without any annotation from the user, and it
should stay that way.
--
Taral

Taral:
On 3/22/06, Bulat Ziganshin
wrote: ghc uses unboxed tuples just for such sort of optimizations. instead of returning possibly-unevaluated pair with possibly-unevaluated elements it just return, say, two doubles in registers - a huge win
I have no doubt of this. My comment refers to the idea that somehow such strictness annotations are (a) required at the type level and (b) required at all to enable such optimization. I believe the optimization happens without any annotation from the user, and it should stay that way.
It does happen...sometimes! The trouble is that for certain types of programs (eg, numeric intensive ones), you absolutely need that optimisation to happen. Without strict tuples, this means, you have to dump the intermediate code of the compiler and inspect it by hand to see whether the optimisation happens. If not, you have to tweak the source to nudge the compiler into recognising that it can optimise. Of course, all your efforts may be wasted when the next version of the compiler is released or when you have to change your code. Manuel

On 3/22/06, Manuel M T Chakravarty
It does happen...sometimes! The trouble is that for certain types of programs (eg, numeric intensive ones), you absolutely need that optimisation to happen. Without strict tuples, this means, you have to dump the intermediate code of the compiler and inspect it by hand to see whether the optimisation happens. If not, you have to tweak the source to nudge the compiler into recognising that it can optimise. Of course, all your efforts may be wasted when the next version of the compiler is released or when you have to change your code.
That kind of tweaking isn't required to simulate this. "a `seq` b
`seq` (a, b)" is perfectly sufficient, and is quite commonly seen in
such programs.
--
Taral

Bulat Ziganshin wrote:
Taral wrote: T> I don't see that more optimization follows from the availability T> of information regarding the strictness of a function result's T> subcomponents.
ghc uses unboxed tuples just for such sort of optimizations. instead of returning possibly-unevaluated pair with possibly-unevaluated elements it just return, say, two doubles in registers - a huge win
Mmm, not quite. Unboxed tuples are boxed tuples restricted such that they never have to be stored on the heap, but this has no effect on semantics at all. A function returning (# Double,Double #) may still return two thunks. -- Ben
participants (6)
-
Ben Rudiak-Gould
-
Bulat Ziganshin
-
Manuel M T Chakravarty
-
Sebastian Sylvan
-
Taral
-
Wolfgang Jeltsch