Re: Ranges and the Enum class

2006-03-21 Thread Malcolm Wallace
Wolfgang Jeltsch [EMAIL PROTECTED] writes:

  Also, toEnum and fromEnum would make more sense mapping from and to
  Integer.
 
 Why do we need toEnum and fromEnum at all?  As far as I know, they are merely 
 there to help people implement things like enumFrom.

They are often useful for writing serialisation routines, and they see
occasional use for other kinds of safe type coercion as well
(toEnum .  fromEnum)

Regards,
Malcolm
___
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: the MPTC Dilemma (please solve)

2006-03-21 Thread Claus Reinke
you're right about interactions in general. but do you think constructor 
classes specifically would pose any interaction problems with FDs?

You have to be more careful with unification in a higher-kinded setting.
I am not sure how to do that with CHRs.


to quote from the ATS paper: just like Jones, we only need first-order
unification despite the presence of higher-kinded variables, as we require
all applications of associated type synonyms to be saturated.


variant A: I never understood why parameters of a class declaration
are limited to variables. the instance parameters just have
to match the class parameters, so let's assume we didn't
have that variables-only restriction.

class Graph (g e v) where
src :: e - g e v - v
tgt :: e - g e v - v

we associate edge and node types with a graph type by
making them parameters, and extract them by matching.


The dependency seems to be lost here.


what dependency?

the associated types have become parameters to the graph type,
so the dependency of association is represented by structural inclusion
(type constructors are really constructors, so even phantom types
would still be visible in the type construct). any instances of this class 
would have to be for types matching the form (g e v), fixing the type 
parameters.



variant B: I've often wanted type destructors as well as constructors.
would there be any problem with that?

type Edge (g e v) = e
type Vertex (g e v) = v

class Graph g where
src :: Edge g - g - Vertex g
tgt :: Edge g  - g - Vertex g


Also no dependency and you need higher-order matching, which in general
is undecidable.


the dependency is still represented by the type parameters, as in the
previous case. and is this any more higher-order than what we have 
with constructor classes anyway? here's an example implementation

of the two destructors, using type classes with constructor instances:

   {-# OPTIONS_GHC -fglasgow-exts #-}

   import Data.Typeable

   data Graph e v = Graph e v

   class Edge g e | g - e where edge :: g - String
   instance Typeable e = Edge (g e v) e where edge g = show (typeOf 
(undefined::e))

   class Vertex g v | g - v where vertex :: g - String
   instance Typeable v = Vertex (g e v) v where vertex g = show (typeOf 
(undefined::v))

[the Typeable is only there so that we can see at the value level that 
the type-level selection works]


   *Main edge (Graph (1,1) 1)
   (Integer,Integer)
   *Main vertex (Graph (1,1) 1)
   Integer


variant C: the point the paper makes is not so much about the number
of class parameters, but that the associations for concepts
should not need to be repeated for every combined concept.
and, indeed, they need not be

class Edge g e | g - e
instance Edge (g e v) e
class Vertex g v | g - v
instance Vertex (g e v) v

class (Edge g e,Vertex g v) = Graph g where
src :: e - g - v
tgt :: e - g - v

(this assumes scoped type variables; also, current GHC,
 contrary to its documentation, does not permit entirely 
 FD-determined variables in superclass contexts)


You still need to get at the parameter somehow from a graph (for which
you need an associated type).


oh, please! are you even reading what I write? as should be clear from 
running the parts of the code that GHC does accept (see above), FDs

are quite capable of associating an edge type parameter with its graph.

all three seem to offer possible solutions to the problem posed in 
that paper, don't they?


Not really.


...


II. The other one is that if you use FDs to define type-indexed
types, you cannot make these abstract (ie, the representations
leak into user code).  For details, please see the Lack of
abstraction. subsubsection in Section 5 of
http://www.cse.unsw.edu.au/~chak/papers/#assoc

do they have to? if variant C above would not run into limitations
of current implementations, it would seem to extend to cover ATS:

class C a where
type CT a

instance C t0 where
type CT t0 = t1

would translate to something like:

class CT a t | a - t
instance CT t0 t1

class CT a t = CT a
instance CT t0 t1 = C t0

as Martin pointed out when I first suggested this on haskell-cafe,
this might lead to parallel recursions for classes C and their type
associations CT, so perhaps one might only want to use this to
hide the extra parameter from user code (similar to calling auxiliary
functions with an initial value for an accumulator).


That doesn't address that problem at all.


come again? CT expresses the type 

important news: refocusing discussion

2006-03-21 Thread isaac jones
Greetings,

While discussion on this mailing list has been coming fast  furious,
actual tangible progress, even as measured on the wiki, has not been as
fast. 

To remedy this, we propose to focus immediately and intently on a few of
the most critical topics, and to focus all of our energies on them until
they are done.  We'd like to go so far as to ask folks to drop
discussion on other items until these are solved.

The goal of this approach is that we will spend the most time on the
critical (and hard) stuff, instead of leaving it for last.  We know that
we can spend a _lot_ of time and energy discussing relatively small
things, and so we want to make sure that these relatively small things
don't take up all of our time.  We will tackle them later.

The topics that John and I feel are critical, and rather unsolved,
are:
 * The class system (MPTC Dilemma, etc)
 * Concurrency
 * (One more, perhaps standard libraries)

The logic here is that Haskell' will be accepted by the community  if we
solved these problems, and if we go with some of the most robust and
uncontroversial extensions already out there.

We will probably partition the committee into subcommittees to focus on
each topic.

Our goal will be to bring these topics to beta quality by mid April.
That is, something that we could be happy with, but that perhaps needs
some polishing.  After that, we may try to pick the next most critical
topics with the goal of having everything at beta quality by the
face-to-face we're hoping to have at PLDI in June.

With an eye toward considering related proposals together, we've added a
topic field to the wiki, and a new query to the front page which
groups the proposals by topic:

http://hackage.haskell.org/trac/haskell-prime/query?status=newstatus=assignedstatus=reopenedgroup=topiccomponent=Proposalorder=priority

I'd like to ask folks to please bring currently open threads to a close
and to document the consensus in tickets.  Anyone can edit tickets, so
please don't be shy.


your chairs,

  Isaac Jones
  John Launchbury

-- 
isaac jones [EMAIL PROTECTED]

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


Re: Ranges and the Enum class

2006-03-21 Thread Wolfgang Jeltsch
Am Dienstag, 21. März 2006 02:47 schrieb Aaron Denney:
 [...]

  No, I use them.  In my opinion, it makes much more sense to write succ n
  than n + 1.

 Agreed, for non-arithmetical types.

I think, it's perfectly sensible for arithmetical types like Integer.  If you 
mean “the next integer” then succ n is the most logical thing to write.  If 
you write n + 1 instead, you invoke a more complex operation (addition) with 
a special constant as one of its parameters, and this obfuscates what you 
actually mean, in my opinion.

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


Re: Ranges and the Enum class

2006-03-21 Thread Wolfgang Jeltsch
Am Dienstag, 21. März 2006 10:08 schrieb Malcolm Wallace:
 Wolfgang Jeltsch [EMAIL PROTECTED] writes:
 [...]

  Why do we need toEnum and fromEnum at all?  As far as I know, they are
  merely there to help people implement things like enumFrom.

 They are often useful for writing serialisation routines, and they see
 occasional use for other kinds of safe type coercion as well
 (toEnum .  fromEnum)

 Regards,
 Malcolm

Maybe they should be in a separate class.  Enum should be about enumerating, 
not “indexing”.

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 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: Time Library

2006-03-21 Thread Taral
On 3/20/06, Ashley Yakeley [EMAIL PROTECTED] wrote:
 Never as far as I can imagine. The 'a' parameter will be taken by a
 phantom type.
 http://haskell.org/haskellwiki/Phantom_type

Now I don't recall, but is it allowed to do:

data HasResolution a = Fixed a = ...?

--
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: important news: refocusing discussion

2006-03-21 Thread Taral
On 3/21/06, isaac jones [EMAIL PROTECTED] wrote:
 I'd like to ask folks to please bring currently open threads to a close
 and to document the consensus in tickets.  Anyone can edit tickets, so
 please don't be shy.

Claus, can you document some of your FD work in the
FunctionalDependencies ticket? I think that the new confluence results
lends a lot towards the adoption of FDs in Haskell'.

--
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 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: Time Library

2006-03-21 Thread Ashley Yakeley

Taral wrote:


Now I don't recall, but is it allowed to do:

data HasResolution a = Fixed a = ...?


Not usefully.

 data T a = MkT a
 data C a = T a = MkT a

It's allowed, but it doesn't do what you probably want. All it does is 
change the type of the constructor MkT.


If the parameter a to Fixed is free, we don't particularly want to 
hide away the HasResolution constraint on it somehow. Of course, once 
it's specialised as a particular type (e.g. Fixed E12), then it's not 
needed anymore.


--
Ashley Yakeley, Seattle WA
WWED? http://www.cs.utexas.edu/users/EWD/

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


Re: important news: refocusing discussion

2006-03-21 Thread isaac jones
On Tue, 2006-03-21 at 15:27 -0800, Ashley Yakeley wrote:
 isaac jones wrote:
 
  The topics that John and I feel are critical, and rather unsolved,
  are:
   * The class system (MPTC Dilemma, etc)
   * Concurrency
   * (One more, perhaps standard libraries)
 
 Could you summarise the current state of these?

AFAIK, the class system is summarized on this page:
http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/MultiParamTypeClassesDilemma

Although there are some proposals here that are not really covered by
that topic, they should probably be considered together:
http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/query?status=newstatus=assignedstatus=reopenedgroup=topiccomponent=Proposalorder=priority


Concurrency is summarized here:
http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/Concurrency

and libraries have not really been discussed much at all.

peace,

  isaac

-- 
isaac jones [EMAIL PROTECTED]

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


Collections interface

2006-03-21 Thread Jim Apple
I have created a ticket to make a standard collection interface. It is here:

http://hackage.haskell.org/trac/haskell-prime/ticket/97

Obviously, it will be tough to figure out what the library can look
like without knowing what MPTC's will look like.

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


Re: Restricted Data Types Now

2006-03-21 Thread Jim Apple
On 2/8/06, [EMAIL PROTECTED] [EMAIL PROTECTED] wrote:

 It seems we can emulate the restricted data types in existing
 Haskell.

I have proposed this for Haskell' libraries. See
http://hackage.haskell.org/trac/haskell-prime/ticket/98

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


MonadPlus Reform

2006-03-21 Thread Ashley Yakeley
Does this come under the standard libraries topic? I would like to see 
the MonadPlus class disambiguated:


class Monad m = MonadZero m where
   mzero :: m a
class MonadZero m = MonadPlus m where
   mplus :: m a - m a - m a
class MonadZero m = MonadOr m where
   morelse :: m a - m a - m a

http://haskell.org/haskellwiki/MonadPlus_reform_proposal

--
Ashley Yakeley, Seattle WA
WWED? http://www.cs.utexas.edu/users/EWD/

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


Re: Time Library

2006-03-21 Thread Taral
On 3/21/06, Ashley Yakeley [EMAIL PROTECTED] wrote:
 Not usefully.

   data T a = MkT a
   data C a = T a = MkT a

 It's allowed, but it doesn't do what you probably want. All it does is
 change the type of the constructor MkT.

I think it also allows the inference of HasResolution a from Fixed a,
thus removing the HasResolution condition on your instances.

--
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