Re: Strict tuples

2006-03-23 Thread Wolfgang Jeltsch
Am Mittwoch, 22. März 2006 14:19 schrieb Bulat Ziganshin:
 Hello Wolfgang,

 you said WHAT you think but not said WHY? my motivation is to be able
 to use myriads of already implemented algorithms on new datatypes

I think, I already tried to explain why I think the way I think in an earlier 
mail:

 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?

By the way, would it be okay for you to answer below the quotation, not above 
it?  And would it be possible to use just a  sign, followed by a space for 
marking quotations.  My MUA gets confused by things like “WJ ”. Thank you 
very much.

 [...]

Best wishes,
Wolfgang
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re[2]: Strict tuples

2006-03-22 Thread Bulat Ziganshin
Hello Wolfgang,

Wednesday, March 22, 2006, 1:29:24 AM, you wrote:

you said WHAT you think but not said WHY? my motivation is to be able
to use myriads of already implemented algorithms on new datatypes

 as i said, shebang patterns allow only to specify that IMPLEMENTATION
 of some function is strict. this helps only when this function are
 called directly. they can't help when function is passed as parameter
 or enclosed in data structure or a part of class. the same about
 datatypes - i can't declare what some algorithm works only with
 strict lists. i try to find extensions what will allow to specify
 strictness in every case where now we forced to use lazy computations

 the concrete syntax what i propose may be wrong

WJ Well, it's probably nice sometimes to have types which guarantee the 
WJ strictness of certain components.  For example, it might be good to have a
WJ list type where the strictness of the elements is guaranteed.  But I'm sure
WJ that it's wrong to try to achieve this by annotating type arguments like in
WJ [!a].  I think, this approach is wrong, not just the syntax.

WJ Best wishes,
WJ Wolfgang
WJ ___
WJ Haskell-prime mailing list
WJ Haskell-prime@haskell.org
WJ http://haskell.org/mailman/listinfo/haskell-prime



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Re[2]: Strict tuples

2006-03-22 Thread Taral
On 3/22/06, Bulat Ziganshin [EMAIL PROTECTED] 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.

--
Taral [EMAIL PROTECTED]
You can't prove anything.
-- Gödel's Incompetence Theorem
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-22 Thread Ben Rudiak-Gould

John Meacham wrote:

ghc's strictness analyzer is pretty darn good, If
something is subtle enough for the compiler not to catch it, then the
programmer probably won't right off the bat either.


Even the best strictness analyzer can't determine that a function is strict 
when it really isn't. The main point of strictness annotations, I think, is 
to actually change the denotational semantics of the program.



strictness does not belong in the type system in general. strictness
annotations are attached to the data components and not type components
in data declarations because they only affect the desugaring of the
constructor, but not the run-time representation or the types in
general. attaching strictness info to types is just the wrong thing to
do in general I think.


Your argument seems circular. Haskell 98 strictness annotations are just 
sugar, but they didn't *have* to be. You can say that f is strict if f _|_ = 
_|_, or you can say it's strict if its domain doesn't include _|_ at all. 
One feels more at home in the value language (seq, ! on constructor fields), 
the other feels more at home in the type language (! on the left of the 
function arrow, more generally ! on types to mean lack of _|_).


-- Ben

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-22 Thread Ben Rudiak-Gould

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

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Re[2]: Strict tuples

2006-03-22 Thread Manuel M T Chakravarty
Taral:
 On 3/22/06, Bulat Ziganshin [EMAIL PROTECTED] 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


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Re[2]: Strict tuples

2006-03-22 Thread Taral
On 3/22/06, Manuel M T Chakravarty [EMAIL PROTECTED] wrote:
 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 [EMAIL PROTECTED]
You can't prove anything.
-- Gödel's Incompetence Theorem
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


RE: Strict tuples

2006-03-21 Thread Simon Marlow
On 21 March 2006 03:10, John Meacham wrote:

 On Mon, Mar 20, 2006 at 09:39:41AM -0500, Manuel M T Chakravarty
 wrote: 
 Apart from the syntactic issues, does anybody else support the idea
 of strict tuples as proposed?  I just want to know whether I am
 alone on this before putting it on the wiki.
 
 I have a few issues though, not entirely easy to articulate.
 
 I worry about all the (! .. !) types that will appear in interfaces,
 making things like (map fst) not work.

After some thought, I find myself with a similar view to John.  Strict
tuples are starting to feel like real language bloat, one tiny addition
too much.  

Remember, every addition we make to the core syntax is multiplied by all
the parsers for Haskell and tools that have to grok Haskell, and make
the bar ever-so-slightly higher to producing such tools.  There's a
reason that syntax ends in tax :-)

By all means have strict tuples in a library somewhere.  They don't need
to have special syntax.

Cheers,
Simon
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-21 Thread Josef Svenningsson
On 3/21/06, Simon Marlow [EMAIL PROTECTED] wrote:
By all means have strict tuples in a library somewhere.They don't needto have special syntax.I have a module Data.Pair which provides pairs with different strictness properties. Perhaps it can be used as a startingpoint.
Cheers,/Josef
-
-- |
-- Module  :  Data.Pair
-- Copyright   :  (c) Josef Svenningsson 2005
-- License :  BSD-style
--
-- Maintainer  :  [EMAIL PROTECTED]
-- Stability   :  experimental
-- Portability :  portable
--
-- Several pair data types with different strictness properties
--
--
module Data.Pair ( Pair(..),
		   StrictLeft(..),
		   StrictRight(..),
		   StrictPair(..)
		  ) where

-- |A class for pairs. We need this to have a consistent interface for
--  several different pair types with different strictness properties.
--  Minimal complete instances are either @first@, @second@ and @pair@
--  or @casePair@ and @[EMAIL PROTECTED]
class Pair p where
  first:: p a b - a
  first p  = casePair (\a _ - a)
  second   :: p a b - b
  second p = casePair (\_ b - b)
  casePair :: (a - b - c) - p a b - c
  casePair c p = c (first p) (second p)
  pair :: a - b - p a b

propPair p = p == pair (first p) (second p)

data StrictLeft  a b = StrictLeft !a  b
data StrictRight a b = StrictRight a !b
data StrictPair  a b = StrictPair !a !b

instance Pair (,) where
  first  (f,_) = f
  second (_,s) = s
  pair f s = (f,s)

instance Pair StrictLeft where
  first  (StrictLeft f _) = f
  second (StrictLeft _ s) = s
  pair f s = StrictLeft f s

instance Pair StrictRight where
  first  (StrictRight f _) = f
  second (StrictRight _ s) = s
  pair f s = StrictRight f s

instance Pair StrictPair where
  first  (StrictPair f _) = f
  second (StrictPair _ s) = s
  pair f s = StrictPair f s
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-21 Thread Manuel M T Chakravarty
John Meacham:
 On Mon, Mar 20, 2006 at 09:39:41AM -0500, Manuel M T Chakravarty wrote:
  Apart from the syntactic issues, does anybody else support the idea of
  strict tuples as proposed?  I just want to know whether I am alone on
  this before putting it on the wiki.
 
 I have a few issues though, not entirely easy to articulate.
 
 I worry about all the (! .. !) types that will appear in interfaces,
 making things like (map fst) not work. It has been my experience that a
 lot of things that should be strict that are obvious to the user, are
 often obvious to the compiler as well. having the user place redundant
 strictness annotations in can ofsucate where the actual performance
 fixes are. As in, are lazy tuples actually a source of problems or are
 we just guessing? ghc's strictness analyzer is pretty darn good, If
 something is subtle enough for the compiler not to catch it, then the
 programmer probably won't right off the bat either. it usually takes
 profiling to determine where the human-fixable problems are.

I agree that strict tuples can be abused, but that's true for most
language features.

 strictness does not belong in the type system in general. strictness
 annotations are attached to the data components and not type components
 in data declarations because they only affect the desugaring of the
 constructor, but not the run-time representation or the types in
 general. attaching strictness info to types is just the wrong thing to
 do in general I think.

I am *not* proposing any addition or change to the type system.  In H98,
I can define

  data Pair a b = Pair a b
  data StrictPair a b = StrictPair !a !b

For some reason, we have Pair with special syntax pre-defined, but we
haven't got StrictPair pre-defined.  All I am proposing is to also
pre-define StrictPair.

 however, strict tuples I think would have use in function returns,
 no need to declare them as a separate type, just have
 
 (! a,b !) desugar exactly to a `seq` b `seq` (a,b)
 
 this avoids any type issues and the only time the strictness of a
 constructor comes into play is in the constructor desugaring anyway, it
 makes sense that strict tuples would be a simple desugaring to normal
 tuples as well.

The disadvantage of this scheme is that the consumer of a strict tuple,
then, has no knowledge of the fact that the components are already
evaluated - ie, this wastes a good opportunity for optimisations.

Manuel


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-21 Thread John Meacham
On Tue, Mar 21, 2006 at 02:27:37PM -0500, Manuel M T Chakravarty wrote:
  strictness does not belong in the type system in general. strictness
  annotations are attached to the data components and not type components
  in data declarations because they only affect the desugaring of the
  constructor, but not the run-time representation or the types in
  general. attaching strictness info to types is just the wrong thing to
  do in general I think.
 
 I am *not* proposing any addition or change to the type system.  In H98,
 I can define
 
   data Pair a b = Pair a b
   data StrictPair a b = StrictPair !a !b
 
 For some reason, we have Pair with special syntax pre-defined, but we
 haven't got StrictPair pre-defined.  All I am proposing is to also
 pre-define StrictPair.

yes, but 'StrictPair a b' being a separate type from '(,) a b' is the
problem I am refering to.



personally, I just really don't see much use for them and feel they will
give a false sense of efficiency while only creating headaches. Imagine
two uses.

f :: (! a,b!) - Int
f (!a, b!) = 3

well, this can better be expressed as
f :: (a,b) - Int
f (!a, !b) = 3

and now you can still do things like 'curry f'



now, imagine it in return position

f :: a - (! x,y!)
f a = (! x, y !) 

this can better be expressed as

f :: a - (x,y)
f a = x `seq` y `seq` (x,y)-- ^ some syntatic sugar 
for this could be nice


If you care enough about some data you are passing around to intimatly
know whether it might or might not have bottoms in it, then chances are
it is something you want a custom data type for anyway. strict tuples
would not really express intent any more and without some sort of
subtyping mechanism the hassle of dealing with them would greatly
outweigh the questionable benefit.

not that people shouldn't create their own 'data StrictPair' if they
want. but I would never want to see such a type in any public APIs. It
would just not be very friendly.



  however, strict tuples I think would have use in function returns,
  no need to declare them as a separate type, just have
  
  (! a,b !) desugar exactly to a `seq` b `seq` (a,b)
  
  this avoids any type issues and the only time the strictness of a
  constructor comes into play is in the constructor desugaring anyway, it
  makes sense that strict tuples would be a simple desugaring to normal
  tuples as well.
 
 The disadvantage of this scheme is that the consumer of a strict tuple,
 then, has no knowledge of the fact that the components are already
 evaluated - ie, this wastes a good opportunity for optimisations.

optimizations for who? knowing something is already evaluated without
any other knowledge about it affords no optimizations in the ghc model
(but actually does in the jhc one), knowing things will definitily be
evaluated certainly does. which strict tuples don't really help with any
more than the 'seq' translation would.


John


-- 
John Meacham - ⑆repetae.net⑆john⑈
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-21 Thread Wolfgang Jeltsch
Am Dienstag, 21. März 2006 11:28 schrieb Bulat Ziganshin:
 [...]

 as i said, shebang patterns allow only to specify that IMPLEMENTATION
 of some function is strict. this helps only when this function are
 called directly. they can't help when function is passed as parameter
 or enclosed in data structure or a part of class. the same about
 datatypes - i can't declare what some algorithm works only with
 strict lists. i try to find extensions what will allow to specify
 strictness in every case where now we forced to use lazy computations

 the concrete syntax what i propose may be wrong

Well, it's probably nice sometimes to have types which guarantee the 
strictness of certain components.  For example, it might be good to have a 
list type where the strictness of the elements is guaranteed.  But I'm sure 
that it's wrong to try to achieve this by annotating type arguments like in 
[!a].  I think, this approach is wrong, not just the syntax.

Best wishes,
Wolfgang
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-21 Thread Taral
On 3/18/06, Manuel M T Chakravarty [EMAIL PROTECTED] wrote:
 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 [EMAIL PROTECTED]
You can't prove anything.
-- Gödel's Incompetence Theorem
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


RE: Strict tuples

2006-03-20 Thread Simon Marlow
On 19 March 2006 02:35, 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.
 
 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.

Not to mention overlap with sections:  (!i).  Even with just bang
patterns, we have some interesting parsing problems due to the overlap
with infix '!'.  eg., now 

  arr ! x = indexArray arr x

will probably parse as

  arr (!x) = indexArray arr x

which means that in order to define (!) you have to use the prefix form:
(!) arr x = ...

GHC's implementation of bang pattern parsing has some ugliness to deal
with this.  In the report, we will have to be very careful to make sure
the syntax doesn't have any ambiguities in this area, which will
probably mean adding special cases to the grammar.

My suggestion is to avoid these problems by removing infix '!' from the
syntax:

http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/ArrayIndex
ing

I realise this is a code-breaking change, but I consider the special
cases introduced to the syntax by bang patterns to be rather warty.
Also, since I think many of us envisage Haskell moving towards having
more strictness annotations in the future, it makes sense to
consistently use the '!' operator to mean strict.

Cheers,
Simon
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re[2]: Strict tuples

2006-03-20 Thread Bulat Ziganshin
Hello Simon,

Monday, March 20, 2006, 1:47:52 PM, you wrote:

 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

SM Bulat, this doesn't constitute a proposal.  It leaves too many questions
SM unanswered.  If it is supposed to be just syntactic sugar, and I believe
SM that is your intention, then can you show me how the above definitions
SM translate into Haskell 98?  

i'm not sure that i can make complete proposal, but i can say what i
mean in more details:

one of the differences between Haskell and most other languages is what
even when we don't need laziness we are forced to buy it. so i want to
see the language where laziness is optional at any place.

shebang patterns allow to specify that concrete IMPLEMENTATION of some
function is strict in its using of parameters. but this can't help us
if we want to carry strict function in data structure, pass it as
function argument, has is as a class member. i was bitten by this
when i wrote Streams library - although Char encoding transformers are
simple strict computations that just read several bytes and then return
one Char, and byte reading operation by itself is very fast - they
cannot be combined to fast Char-reading function.

another problem is what while we can specify strictness of fields in
ADTs, we cannot redefine strictness of fields in existing ADT, such
as list.

my solutions to these problems:

1) make a strictness annotation part of function type declaration,
i.e. when function type can include strictness annotation on each of
its arguments and on result:

fac :: !Int - !Int - !Int

strictness annotation on argument means that function is strict in
this argument - if its value diverges then entire function diverges.
informally, strict argument can be evaluated before evaluation of
function body, as in the strict languages - what opens up possibility
to unbox such values and to omit checking of argument evaluation in
function body, moving this evaluation to the caller side

strictness annotation on result means that function DON'T DIVERGE if
all arguments are don't diverge. this allows to unbox result and to
skip checking that result was evaluated on callee side by moving real
computation inside the function. informally, this means that a
function is inexpensive enough and therefore can be computed non-lazily


2) to allow changing of strictness inside existing ADTs, i propose
to copy strictness annotations on type arguments to the type
declaration bodies:

data List a = Nil | Cons (List a) a
type StrictElements a = List !a

is equal to the:

data StrictElements a = Nil | Cons (List a) !a

i.e. it's the same list but each element is strict. using strictness
annotation on type constructor itself should mean strictifying of all
other (non-type-variable) fields:

type StrictList a = !List a
=
data StrictList a = !Nil | !Cons !(List a) a

of course, i don't mean introducing new incompatible types - that is a
compiler responsibility (sorry, Simon :) ) to convert between variants
of types with different strictness. That we should fix at the language
definition level is what on strict types te user don't expects lazy
evaluation of list/it's elements and compiler is free to use program
transformations what non-lazily computes these data. for example, if
putStr function accepts strict list, then it can be implemented
without evaluated? checks on each step and the callers would ensure
that all strings passed to this function are fully evaluated

these two changes together should make it possible to implement
strictly strict algorithms in Haskell

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


RE: Re[2]: Strict tuples

2006-03-20 Thread Simon Marlow
On 20 March 2006 12:26, Bulat Ziganshin wrote:

 2) to allow changing of strictness inside existing ADTs, i propose
 to copy strictness annotations on type arguments to the type
 declaration bodies:

 data List a = Nil | Cons (List a) a
 type StrictElements a = List !a
 
 is equal to the:
 
 data StrictElements a = Nil | Cons (List a) !a

So, in fact StrictElements is not compatible with the List type at all
(that is, you can't pass a value of type (StrictElements Int) to a
function expecting (List Int)).  I can envisage that this might be a
sound extension, and imlementable, but is it what you mean?  I don't
think so.

I imagine you want a lot of automatic conversion back and forth bewteen
strict and lazy types.  This is where it gets a *lot* trickier, starting
with the type system.

 i.e. it's the same list but each element is strict. using strictness
 annotation on type constructor itself should mean strictifying of all
 other (non-type-variable) fields:
 
 type StrictList a = !List a
 =
 data StrictList a = !Nil | !Cons !(List a) a

I don't know what !Nil or !Cons mean.

 of course, i don't mean introducing new incompatible types - that is a
 compiler responsibility (sorry, Simon :)

Well, you haven't told me what type system I need to implement, so it's
not just an implementation issue.  And it seems to me that you *are*
introducing incompatible types.

Cheers,
Simon
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-20 Thread Sebastian Sylvan
On 3/20/06, Sebastian Sylvan [EMAIL PROTECTED] wrote:
 On 3/19/06, Manuel M T Chakravarty [EMAIL PROTECTED] 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
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


RE: Strict tuples

2006-03-20 Thread Manuel M T Chakravarty
Simon Marlow:
 Not to mention overlap with sections:  (!i).  Even with just bang
 patterns, we have some interesting parsing problems due to the overlap
 with infix '!'.  eg., now 
 
   arr ! x = indexArray arr x
 
 will probably parse as
 
   arr (!x) = indexArray arr x
 
 which means that in order to define (!) you have to use the prefix form:
 (!) arr x = ...
 
 GHC's implementation of bang pattern parsing has some ugliness to deal
 with this.  In the report, we will have to be very careful to make sure
 the syntax doesn't have any ambiguities in this area, which will
 probably mean adding special cases to the grammar.
 
 My suggestion is to avoid these problems by removing infix '!' from the
 syntax:
 
 http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/ArrayIndex
 ing
 
 I realise this is a code-breaking change, but I consider the special
 cases introduced to the syntax by bang patterns to be rather warty.
 Also, since I think many of us envisage Haskell moving towards having
 more strictness annotations in the future, it makes sense to
 consistently use the '!' operator to mean strict.

I agree that the use of ! for indexing is a bad choice, actually a very
bad choice.  As arrays are not used that much and (!) isn't even
exported from the Prelude, I like the idea of changing the indexing
syntax.  I am less convinced that it is wise to change the syntax of
function composition, as this will break a huge set of programs.  I
actually also don't see that this affects the array proposal.  (.#)
would be a valid and free operator anyway, wouldn't it?  What about list
indexing? Use (.##)?  (Doesn't look very nice, but transfers the (!) for
arrays and (!!) for lists idea.)  A change to list indexing will
probably break more programs than a change to array indexing.

Apart from the syntactic issues, does anybody else support the idea of
strict tuples as proposed?  I just want to know whether I am alone on
this before putting it on the wiki.

Manuel

 On 19 March 2006 02:35, 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.
  
  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.
 

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-20 Thread Manuel M T Chakravarty
Sebastian Sylvan:
 On 3/19/06, Manuel M T Chakravarty [EMAIL PROTECTED] 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


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-20 Thread Sebastian Sylvan
On 3/20/06, Manuel M T Chakravarty [EMAIL PROTECTED] wrote:
 Sebastian Sylvan:
  On 3/19/06, Manuel M T Chakravarty [EMAIL PROTECTED] 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
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-20 Thread Wolfgang Jeltsch
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
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: Strict tuples

2006-03-20 Thread John Meacham
On Mon, Mar 20, 2006 at 09:39:41AM -0500, Manuel M T Chakravarty wrote:
 Apart from the syntactic issues, does anybody else support the idea of
 strict tuples as proposed?  I just want to know whether I am alone on
 this before putting it on the wiki.

I have a few issues though, not entirely easy to articulate.

I worry about all the (! .. !) types that will appear in interfaces,
making things like (map fst) not work. It has been my experience that a
lot of things that should be strict that are obvious to the user, are
often obvious to the compiler as well. having the user place redundant
strictness annotations in can ofsucate where the actual performance
fixes are. As in, are lazy tuples actually a source of problems or are
we just guessing? ghc's strictness analyzer is pretty darn good, If
something is subtle enough for the compiler not to catch it, then the
programmer probably won't right off the bat either. it usually takes
profiling to determine where the human-fixable problems are.

strictness does not belong in the type system in general. strictness
annotations are attached to the data components and not type components
in data declarations because they only affect the desugaring of the
constructor, but not the run-time representation or the types in
general. attaching strictness info to types is just the wrong thing to
do in general I think.

however, strict tuples I think would have use in function returns,
no need to declare them as a separate type, just have

(! a,b !) desugar exactly to a `seq` b `seq` (a,b)

this avoids any type issues and the only time the strictness of a
constructor comes into play is in the constructor desugaring anyway, it
makes sense that strict tuples would be a simple desugaring to normal
tuples as well.

hope this makes sense...

John


-- 
John Meacham - ⑆repetae.net⑆john⑈
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Strict tuples

2006-03-18 Thread 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.

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.


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime