RE: important news: refocusing discussion

2006-03-22 Thread Simon Marlow
On 21 March 2006 23:51, isaac jones wrote:

 Concurrency is summarized here:

http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/Concurrenc
y

I have updated the concurrency page with a skeleton proposal.

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


Re: the MPTC Dilemma (please solve)

2006-03-22 Thread Roman Leshchinskiy

On Mon, 20 Mar 2006, Claus Reinke wrote:


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.


If I understand correctly, this requires all graphs to be polymorphic in 
the types of edges and vertices. Thus, you cannot (easily) define a graph 
which provides, say, only boolean edges. Moreover, doesn't this require 
higher-order matching?



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


This suffers from the same problems as the previous variant. It also looks 
a lot like a special form of associated types. Could the AT framework be 
extended to support a similar form of type synonyms (in effect, partial 
type functions outside of classes)? Would


  instance Graph Int
-- methods left undefined

be a type error here?


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)


What are the types of src and tgt here? Is it

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

This does not seem to be a real improvement to me and, in fact, seems 
quite counterintuitive.


Roman

___
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


Ticket #15: add a binary IO interface

2006-03-22 Thread Bulat Ziganshin
Hello ,

about this - i'm almost sure that current widely used libraries
(NewBinary) is not as good as my own one
(http://freearc.narod.ru/Streams.tar.gz) is not ever used and even
still not documented, so it is not easy to make right choice :)

-- 
Best regards,
 Bulat  mailto:[EMAIL PROTECTED]

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


Re: MonadPlus Reform

2006-03-22 Thread Cale Gibbard
I'd like to put a me too on that one. This part of the class
hierarchy is currently a bit inexpressive. I've been annoyed by the
fact that if I want to express in the type signature of a function
that a monad has a failure mechanism, I'm forced to go all the way up
to MonadPlus, which makes it look like something fully
nondeterministic is happening, when really I'm just possibly failing.

Also, mplus and morelse are quite different things, and it would be
nice to have both even in a monad supporting mplus. For instance, in
the list monad,
mplus = (++)
but
morelse [] ys = ys
morelse (x:xs) ys = (x:xs)

 - Cale

On 21/03/06, Ashley Yakeley [EMAIL PROTECTED] wrote:
 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

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

2006-03-22 Thread Claus Reinke

  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.


If I understand correctly, this requires all graphs to be polymorphic in 
the types of edges and vertices. Thus, you cannot (easily) define a graph 
which provides, say, only boolean edges. Moreover, doesn't this require 
higher-order matching?


I've already answered the last question. as for polymorphism, all this
requires is for a graph type parameterized by an edge and vertex
type (just as the SML solution, which got full marks in this category,
requires instantiations of the edge and vertex types in the graph structure). 
I already gave an example of a graph instantiated with (Int,Int) edges 
and Int vertices. see below for a translation of the ATC paper examples



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


This suffers from the same problems as the previous variant. It also looks 
a lot like a special form of associated types. Could the AT framework be 
extended to support a similar form of type synonyms (in effect, partial 
type functions outside of classes)? 


it suffers as little as the previous variant. and it was meant to be a special
form, showing that the full generality of ATs as a separate type class 
extension is not required to solve that paper's issue. and the translation 
from type functions to FDs or ATs is entirely syntactic, I think, so it 
would be nice to have in Haskell', as long as at least one of the two is 
included.



Would

  instance Graph Int
-- methods left undefined

be a type error here?


yes, of course. instances still have to be instances of classes. in variation
A, the type error would be in the instance head, in variation B, it would
be in the method types (although it could backpropagate to the head).


  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)


What are the types of src and tgt here? Is it

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


yes.

This does not seem to be a real improvement to me and, in fact, seems 
quite counterintuitive.


Roman


you're free to your own opinions, of course!-)

it is, however, probably as close as we can come within current Haskell,
and the shifting of Edge/Vertex to the right of the '=' is a purely syntactic
transformation, even if it is a nice one.

and as you can see from the implementation below (I had to move the 
class methods out of the class to circumvent GHC's current typing problem, 
so no method implementations, only the types), it is sufficient to address the 
problem in that survey paper, and accounting for graphs with specific types 
is no problem (direct translation from ATC paper examples):


   *Main :t \e-src e (undefined::NbmGraph)
   \e-src e (undefined::NbmGraph) :: GE2 - GV2
   *Main :t \e-src e (undefined::AdjGraph)
   \e-src e (undefined::AdjGraph) :: GE1 - GV1

cheers,
claus

{-# OPTIONS_GHC -fglasgow-exts #-}

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 Graph g
-- these should be class methods of Graph..
src, tgt :: (Edge g e,Vertex g v,Graph g) = e - g - v
src = undefined
tgt = undefined

-- adjacency matrix
data G1 e v = G1 [[v]]
data GV1 = GV1 Int
data GE1 = GE1 GV1 GV1
type AdjGraph = G1 GE1 GV1  -- type associations

instance Graph AdjGraph

-- neighbor map
data FiniteMap a b
data G2 e v = G2 (FiniteMap v v) 
data GV2 = GV2 Int

data GE2 = GE2 GV2 GV2
type NbmGraph = G2 GE2 GV2  -- type associations

instance Graph NbmGraph

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

2006-03-22 Thread Manuel M T Chakravarty
Simon Marlow:
 On 21 March 2006 23:51, isaac jones wrote:
 
  Concurrency is summarized here:
 
 http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/Concurrenc
 y
 
 I have updated the concurrency page with a skeleton proposal.

Yes, good plan.

Manuel


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