Re: [Haskell-cafe] Another point-free question (=, join, ap)

2009-02-14 Thread Edsko de Vries
On Fri, Feb 13, 2009 at 05:21:50PM +0100, Thomas Davie wrote:
 
 Hey,
 
 Thanks for all the suggestions. I was hoping that there was some  
 uniform
 pattern that would extend to n arguments (rather than having to use
 liftM2, litM3, etc. or have different 'application' operators in  
 between
 the different arguments); perhaps not. Oh well :)
 
 Sure you can!  What you want is Control.Applicative, not Control.Monad.
 
 (*) is the generic application you're looking for:
 
  pure (+) * [1,2,3] * [4,5,6]
 [5,6,7,6,7,8,7,8,9]
 
 Note that pure f * y can be shortened to fmap though, which  
 Control.Applicative defines a handy infix version of:
  (+) $ [1,2,3] * [4,5,6]
 [5,6,7,6,7,8,7,8,9]
 
 Hope that provides what you want

Hi Bob,

Thanks for the suggestion, but that solution does not work when the
function I want to apply (in your case, +) is monadic itself. Then I'd
still have to write

join $ f * [1,2,3] * [4,5,6]

:(

Edsko
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Another point-free question (=, join, ap)

2009-02-14 Thread Edsko de Vries
Hi Conor,

 Will this do?
 
   http://www.haskell.org/haskellwiki/Idiom_brackets
 
 You get to write
 
   iI f a1 a2 a3 Ji
 
 for
 
   do x1 - a1
  x2 - a2
  x3 - a3
  f a1 a2 a3
 
 amongst other things...

Cool :-) I had seen those idiom brackets before and put them on my
mental 'things I want to understand' list but never got round to them.
Very nice! Now if only ghc would allow me to write unicode so that I can
write *real* brackets.. (Something the Agda people do very well!)

Thanks!

Edsko
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] HaskellDB is alive?

2009-02-14 Thread Felipe Lessa
Hello!

There was a new HaskellDB release, but I didn't see any announcement
here. Is it back alive? What happened to 0.11?

Thanks =)

-- 
Felipe.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] HaskellDB is alive?

2009-02-14 Thread Artyom Shalkhakov
Hello,

2009/2/14 Felipe Lessa felipe.le...@gmail.com:
 There was a new HaskellDB release, but I didn't see any announcement
 here. Is it back alive? What happened to 0.11?

Well, HaskellDB HDBC backend got updated. HaskellDB itself lacks
manpower, you can see it for yourself by browsing it's mailing list archives.

I personally found that it lacks some features that I need for my application,
so I decided to go with raw HDBC. Combinators rule, however. :)

Cheers,
Artyom Shalkhakov.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Class Instances

2009-02-14 Thread Cetin Sert
Thank you Benedikt!

Thanks to your help I also figured out the way to do it using type families
yesterday:



class Pro p where
  type I p
  type O p
  re :: p → [I p → O p]

instance Pro (b → c) where
  type I (b → c) = b
  type O (b → c) = c
  re = repeat

instance Pro [b → c] where
  type I [b → c] = b
  type O [b → c] = c
  re = cycle


broadcast :: Pro p ⇒ p → [I p] → [O p]
...



Regards,
Cetin

2009/2/13 Benedikt Huber benj...@gmx.net

 Cetin Sert schrieb:
  Thank you for your answer!
 
  This comes close to solving the problem but in the last line of the
  above I want to be able to say:
 
  either
print $ broadcast id [1..10]
 
  or
print $ broadcast [ (x +) | x ← [1..10] ] [1..10]
 
  both need to be possible*.
 
  So is there a way to make the FunList disappear completely?
 Hi Cetin,
 yes, if you're willing to use multi-parameter typeclasses:
  class Processor p b c | p - b c where
   ready :: p - [b - c]
  instance Processor (b - c) b c where
   ready = repeat
  instance Processor [b - c] b c where
   ready = id
  broadcast :: Processor p b c = p - [b] - [c]

 Maybe there are other possibilities as well.
 --
 benedikt

 
  Regards,
  Cetin
 
  P.S.: * broadcast is a dummy function, I need this for tidying up the
  interface of a little experiment: http://corsis.blogspot.com/
 
  2009/2/13 Benedikt Huber benj...@gmx.net mailto:benj...@gmx.net
 
  Cetin Sert schrieb:
Hi,
   
class Processor a where
  ready :: (forall b c. a → [b → c])
   
instance Processor (b → c) where
  ready = repeat
...
---
Why can I not declare the above instances and always get:
  Hi Cetin,
  in your class declaration you state that a (Processor T) provides a
  function
ready :: T - [b - c]
  so
ready (t::T)
  has type (forall b c. [b - c]), a list of functions from arbitrary
  types b to c.
 
  The error messages tell you that e.g.
repeat (f :: t1 - t2)
  has type
(t1-t2) - [t1-t2]
  and not the required type
(t1-t2) - [a - b]
 
  With your declarations,
head (ready negate) hi
  has to typecheck, that's probably not what you want.
 
Is there a way around this?
 
  Maybe you meant
 
class Processor a where
  ready :: a b c - [b - c]
instance Processor (-) where
  ready = repeat
newtype FunList b c = FunList [b-c]
instance Processor FunList where
  ready (FunList fl) = fl
 
  I think the newtype FunList is neccessary here.
  benedikt
 
   
message.hs:229:10:
Couldn't match expected type `b' against inferred type `b1'
  `b' is a rigid type variable bound by
  the instance declaration at message.hs:228:20
  `b1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:19
  Expected type: b - c
  Inferred type: b1 - c1
In the expression: repeat
In the definition of `ready': ready = repeat
   
message.hs:229:10:
Couldn't match expected type `c' against inferred type `c1'
  `c' is a rigid type variable bound by
  the instance declaration at message.hs:228:24
  `c1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:21
  Expected type: b - c
  Inferred type: b1 - c1
In the expression: repeat
In the definition of `ready': ready = repeat
   
message.hs:232:10:
Couldn't match expected type `b1' against inferred type `b'
  `b1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:19
  `b' is a rigid type variable bound by
  the instance declaration at message.hs:231:20
  Expected type: [b1 - c]
  Inferred type: [b - c1]
In the expression: id
In the definition of `ready': ready = id
   
message.hs:232:10:
Couldn't match expected type `c1' against inferred type `c'
  `c1' is a rigid type variable bound by
   the type signature for `ready' at message.hs:226:21
  `c' is a rigid type variable bound by
  the instance declaration at message.hs:231:24
  Expected type: [b - c1]
  Inferred type: [b1 - c]
In the expression: id
In the definition of `ready': ready = id
   
Is there a way around this?
   
Regards,
CS
   
   
   
 
 
   
___
Haskell-Cafe mailing list

Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-14 Thread John A. De Goes


On Feb 13, 2009, at 6:31 PM, Krzysztof Skrzętnicki wrote:
On Fri, Feb 13, 2009 at 22:37, John A. De Goes j...@n-brain.net  
wrote:

On Feb 13, 2009, at 2:11 PM, Jonathan Cast wrote:


The compiler should fail when you tell it two mutually contradictory
things, and only when you tell it two mutually contradictory things.


By definition, it's not a contradiction when the symbol is  
unambiguously
typeable. Do you think math textbooks are filled with  
contradictions when

they give '+' a different meaning for vectors than matrices or real
numbers???


I can easily imagine a book which uses some operator in ambiguous way
yet relies on readers' intelligence in solving that issue. It is OK to
do that as long as it is easy. However: it can get arbitrarily worse.


Don't overlook the advantages of using familiar operators and names:  
you have some intuition about '+' and 'map', so if you see them, then  
you'll have some idea what they do (assuming the author is neither  
stupid nor malicious). However, if you see some operator like '$+' or  
some name like 'pp3', then you probably won't have any intuition about  
it.


Writing good software is about conveying intentions, and part of the  
way we can do that is relying on what other people already know. Which  
means using familiar names and operators when it is helpful to do so.



I would
consider any book which is hard
to read because of that badly written. Things are quite similar with  
the code.


I consider the current state of affairs quite poor: namely, abuse of  
type classes and alternate names and operators that aren't very  
suggestive, but were chosen purely to avoid conflicts.



Programming language should be easy to reason about for both computers
and humans. Compiler should therefore disallow programming style  
that is

inaccessible for potential readers. Want to overload something? Well,
use typeclasses to be explicit about it.



Type classes were not designed for name overloading. They're designed  
to factor out common patterns in programming. You shouldn't use a type  
class just because you want to use a name or operator.


And as I said before, if you want to disallow programming style that  
is inaccessible for potential readers, then you should disallow the  
current state of affairs.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-14 Thread John A. De Goes


Take, for example, this function:

f :: [Char] - Char

f [] = chr 0
f (c:cs) = chr (ord c + ord (f cs))

[] is typed as [Char], even though it could be typed in infinitely  
many other ways. Demonstrating yet again, that the compiler *does* use  
the additional information that it gathers to assist with typing.


Regards,

John A. De Goes
N-BRAIN, Inc.
The Evolution of Collaboration

http://www.n-brain.net|877-376-2724 x 101

On Feb 13, 2009, at 6:31 PM, Robert Greayer wrote:


-- John A. De Goes wrote:

Adding information cannot remove a contradiction from the  
information

set available to the compiler.


But it can and often does, for example, for [] or 4. What's the  
type of either expression without more information?


[] :: [a]

4 :: Num a = a

Do I win something?





___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] IO semantics and evaluation - summary

2009-02-14 Thread Stuart Cook
From Fixing Haskell IO:
 We can summarize the SDIOH (Standard Definition of IO in Haskell)
 as a value of type IO a is a value, that performs, then delivers
 a value of type a.

I think you've already made a critical mistake here. The quotes you
give all describe an IO value as something that when performed
results in input/output, whereas your summary describes it as
something that performs. The original quotations suggest that some
outside agent interprets the values and performs the actions they
denote, whereas it is your summary that has made the linguistic
shift to values that dance about on tables of their own accord.

In my mind, Haskell programs never actually do anything. Instead
they merely denote a value of type IO () that consists of tokens
representing input/output primitives, glued together by pure
functions. It is the job of the runtime to take that value and
actually modify the world in the manner described by the program.


Stuart
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Graph library, was: Haskell.org GSoC

2009-02-14 Thread Brent Yorgey
On Thu, Feb 12, 2009 at 04:10:21PM +0100, Wolfgang Jeltsch wrote:
 Am Donnerstag, 12. Februar 2009 15:34 schrieb Thomas DuBuisson:
  Daniel Kraft asked:
   That sounds interesting...  What do you mean by no canonical library? 
   Are there already ones but just no standard one?  But in this case, I
   don't think adding yet another one will help :D  Or isn't there a real
   general graph library?
 
  My impression is that there is now standard one, but then again I've
  only used Haskell + a graph library once.
 
   BTW, is there some sort of project hosting specifically for such
   Haskell projects?  Or should I go with sourceforge (for instance) for
   developing this, if I gave it a try?
 
  Get a community.haskell.org account once you are ready to start a
  repo, it can not only host your repo (ex:
  http://community.haskell.org/~tommd/pureMD5) but also allows you to
  upload packages to hackage.haskell.org.
 
 I already have a Hackage account. Can this be readily used as a 
 community.haskell.org account? If not, what if I get a community account. Do 
 I have two accounts for Hackage access then?

No, they are two separate things.  A Hackage account just lets you
upload things to Hackage.  A community.haskell.org account lets you
log into code.haskell.org (a completely different server than
Hackage), host projects there, and so on.

-Brent
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANNOUNCE: first Grapefruit release

2009-02-14 Thread Wolfgang Jeltsch
Dear friends of Haskell and Functional Reactive Programming,

its my pleasure to announce the first official release of Grapefruit, a 
library for Functional Reactive Programming (FRP) with a focus on user 
interfaces.

With Grapefruit, you can implement reactive and interactive systems in a 
declarative style. User interfaces are described as networks of communicating 
widgets and windows. Communication is done via different kinds of signals 
which describe temporal behavior.

Grapefruit consists of five packages with several interesting features:

grapefruit-frp: Functional Reactive Programming core

   * The FRP implementation uses a hybrid push/pull-based approach.

* Signals can be memoized by binding them to variables – like ordinary
data structures.

* Merging of event streams combines simultaneous events properly.

* Signals cannot behave differently by starting them at different times.
The type system is used to enforce proper aging of signals.

grapefruit-records: A record system for Functional Reactive Programming

* Input records can specify fields as being required or optional.

* Uninteresting output fields can be ignored. The set of interesting
fields is specified by pattern matching.

grapefruit-ui: Declarative user interface programming

* The interface for UI programming is platform-independent and can be
implemented on top of different UI toolkits.

* A concrete implementation can be selected at compile time or runtime.

grapefruit-ui-gtk: GTK+-based implementation of the general UI interface

* Gtk2Hs is used internally.

grapefruit-examples: examples demonstrating features of Grapefruit

* Circular communication and switching are demonstrated.

Support for the following is planned for the future:

* signals with incremental updates

* user interfaces with changing structure

* more kinds of UI components

* graphical animations

Further information about Grapefruit is available on its wiki page at 
http://haskell.org/haskellwiki/Grapefruit.

If you have questions, applause or criticism, please get in touch with me.

Wolfgang Jeltsch
Principal Grapefruit developer
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell-beginners] Re: permuting a list

2009-02-14 Thread Daniel Fischer
Am Samstag, 14. Februar 2009 16:37 schrieb Heinrich Apfelmus:

 That of course begs the question whether there is a faster but purely

No, it didn't beg any question. (Sorry for being a humourless pedant here)

 functional algorithm for generating random permutations without indexes
 and arrays?

 The answer is a resounding yes and the main idea is that shuffling a
 list is *essentially the same* as sorting a list; the minor difference
 being that the former chooses a permutation at random while the latter
 chooses a very particular permutation, namely the one that sorts the input.

 For the full exposition, see

http://apfelmus.nfshost.com/random-permutations.html

Excellent work, thanks.


 Regards,
 apfelmus

Cheers,
Daniel
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haddock Markup

2009-02-14 Thread Wolfgang Jeltsch
Am Freitag, 13. Februar 2009 01:30 schrieben Sie:
 On 12 Feb 2009, at 8:48 pm, Wolfgang Jeltsch wrote:
  I don’t understand this. The way which works is conversion from
  MathML to TeX.
  So your suggestion would be to use MathML as the source language.
  But this is
  obviously not what you suggest. I’m confused.

 It's explicit enough in the original message:
   Use a substantial chunk of MathML
   in a TeX-parseable syntax.

  If you want to use a subset of TeX in Haddock comments, how would
  you render them on a webpage?

 I didn't say a subset of TeX but a subset of MathML.

 [explaination follows]

So you mean a language which

* directly corresponds to a subset of MathML (and is therefore easily
convertible into sensible MathML)

* is at the same time valid TeX source which can be processed by TeX based
on a few macro definitions (like \mrow)

This sounds interesting, indeed.

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


Re: [Haskell-cafe] Graph library, was: Haskell.org GSoC

2009-02-14 Thread Wolfgang Jeltsch
Am Samstag, 14. Februar 2009 16:59 schrieb Brent Yorgey:
 On Thu, Feb 12, 2009 at 04:10:21PM +0100, Wolfgang Jeltsch wrote:
  Am Donnerstag, 12. Februar 2009 15:34 schrieb Thomas DuBuisson:
   Get a community.haskell.org account once you are ready to start a
   repo, it can not only host your repo (ex:
   http://community.haskell.org/~tommd/pureMD5) but also allows you to
   upload packages to hackage.haskell.org.
 
  I already have a Hackage account. Can this be readily used as a
  community.haskell.org account? If not, what if I get a community account.
  Do I have two accounts for Hackage access then?

 No, they are two separate things.  A Hackage account just lets you
 upload things to Hackage.  A community.haskell.org account lets you
 log into code.haskell.org (a completely different server than
 Hackage), host projects there, and so on.

But Thomas DuBuisson wrote that you can upload packages to HackageDB with your 
community.haskell.org account (see above). Is this wrong?

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


Re: [Haskell-cafe] IO semantics and evaluation - summary

2009-02-14 Thread Gregg Reynolds
On Sat, Feb 14, 2009 at 9:15 AM, Stuart Cook sco...@gmail.com wrote:

 From Fixing Haskell IO:
  We can summarize the SDIOH (Standard Definition of IO in Haskell)
  as a value of type IO a is a value, that performs, then delivers
  a value of type a.

 I think you've already made a critical mistake here. The quotes you
 give all describe an IO value as something that when performed
 results in input/output, whereas your summary describes it as
 something that performs. The original quotations suggest that some

outside agent interprets the values and performs the actions they
 denote, whereas it is your summary that has made the linguistic
 shift to values that dance about on tables of their own accord.


I see you point, and it perfectly illustrates the problem of ambiguity (
http://syntax.wikidot.com/blog:5).  Action and Performance are even more
ambiguous than computation and evaluation.  The natural analog to the
SDIOH is theatrical performance.  Where is the action, on the page or on the
boards?  Who performs the action, the character or the thespian?  Whose
action is it?  Even if we settle on these questions, we have to account for
delivers a value.  What does the performance of the action of Hamlet
deliver?  Dead Polonius?  Catharsis?

In the end it doesn't matter how one interprets action that is performed;
either way, there must be an agent.  No agent, no performance.  As you point
out, the SDIOH can be read as positing an outside agent; it can also be
read to posit the value itself as performer (which must interact with an
outside agent).  All of which leads to the very interesting philosophical
question of what a program process actually //is//: an agent acting on a
computer, or a script for the computer to enact (qua agent/thespian).
Either way the SDIOH effectively tries to incorporate action/agency into the
formal semantics.

My proposition is just that we avoid the whole mess by eliminating notions
like action,  performance, and delivery.  Split the semantics into internal
(standard denotational stuff) and external (interpretation, which can also
be represented mathematically), and you get a clearer, cleaner, simpler
picture with no philosophical complications.  I'm working on some diagrams
and simpler language; once I'm done I guess I'll find out.


 In my mind, Haskell programs never actually do anything. Instead
 they merely denote a value of type IO () that consists of tokens
 representing input/output primitives, glued together by pure
 functions. It is the job of the runtime to take that value and
 actually modify the world in the manner described by the program.


I wouldn't try to talk you out of whatever works for you.  Just scratching a
rather persistent itch about clear, simple, formal, complete representations
of the intersection of math and the world.

Thanks,

gregg
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Possible bug?

2009-02-14 Thread Wolfgang Jeltsch
Am Freitag, 13. Februar 2009 17:16 schrieb Peter Verswyvelen:
 Can all functional dependencies be completely replaced with associated
 types when using GHC 6.10.1?

It might be possible as long as you don’t use overlapping instances. With 
overlapping instances, it’s typically not possible since there are no 
overlapping type family instances.

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


Re: [Haskell-cafe] Re: space leak with 'concat' ?

2009-02-14 Thread Peter Verswyvelen
it was on MS.NET 3.5
now the problem was the following

the problematic object encapsulated a running timer. on each tick of the
timer, I added an occurrence to a stream

this stream was used in another thread, but the stream itself had no
backpointer to the object that generated it

so the object that encapsulated the running timer got collected since no
pointer existed to it... and no occurrences in the stream got generated
anymore.

If the GC would consider timers as roots, then this would not be a problem I
guess.

Do you think this is something to report as a bug to Microsoft?

But this is a bit off topic in Haskell Cafe :-)







On Thu, Feb 12, 2009 at 11:52 AM, Felipe Lessa felipe.le...@gmail.comwrote:

 2009/2/12 Peter Verswyvelen bugf...@gmail.com:
  It is funny that recently I had a strange problem in C# (I tried to write
  parts of Reactive in C#) where the garbage collector freed data that was
  actually needed by my program! I had to fix that by putting a local
 variable
  on the stack, passing the constructed data to a function did not work. I
  think .NET and Java the garbage collector traverses from data (the stack,
  globals, etc). If I understood Simon correctly, GHC traverse the code
 blocks
  instead, which feels correct as it would have fixed the bug I had in C#.
 So
  yet again an extreme difference between Haskell and .NET/Java even when
 it
  comes to garbage collection, Haskell wins :)

 I'm curious, a GC that removes live data is a buggy GC. What was
 holding the pointer to the data, if it was not the stack? Were you
 with MS .NET or with Mono?

 --
 Felipe.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] HaskellDB is alive?

2009-02-14 Thread Don Stewart
felipe.lessa:
 Hello!
 
 There was a new HaskellDB release, but I didn't see any announcement
 here. Is it back alive? What happened to 0.11?
 
 Thanks =)

http://hackage.haskell.org/cgi-bin/hackage-scripts/package/haskelldb-0.12
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-14 Thread Tillmann Rendel

John A. De Goes wrote:

Take, for example, this function:

f :: [Char] - Char

f [] = chr 0
f (c:cs) = chr (ord c + ord (f cs))

[] is typed as [Char], even though it could be typed in infinitely many 
other ways. Demonstrating yet again, that the compiler *does* use the 
additional information that it gathers to assist with typing.


I'm not sure about this example, since [] occurs in a pattern here, and 
I don't know how typing affects patterns. However, you seem to believe 
that in the expression


  'x' : []

the subexpression [] has type [Char]. That is not correct, though. This 
occurence and every occurence of [] has type (forall a . [a]). This 
becomes clearer if one uses a calculus wih explicit type abstraction and 
application, like ghc does in its Core language. In such a calculus, we 
have a uppercase lambda /\ type var - term which binds type 
parameters, and a type application term type similar to the 
lowercase lambda \ var - term and term application term term 
we already have in Haskell.


Now, the type of (:) is (forall a . a - [a] - [a]). Since this type 
contains one type variable, (:) has to applied to one type argument 
before it is used on term arguments. The same is true for [], which has 
type (forall a . [a]). That means that the expression above is equivalent to


  (:) Char 'x' ([] Char)

In this expression it is clear that [] has type (forall a . [a]), while 
([] Char) has type [Char]. The job of type inference is not to figure 
out the type of [], but to figure out that this occurence of [] in 
Haskell really means ([] Char) in a calculus with explicit type 
application.


  Tillmann
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Graph library, was: Haskell.org GSoC

2009-02-14 Thread Don Stewart
g9ks157k:
 Am Samstag, 14. Februar 2009 16:59 schrieb Brent Yorgey:
  On Thu, Feb 12, 2009 at 04:10:21PM +0100, Wolfgang Jeltsch wrote:
   Am Donnerstag, 12. Februar 2009 15:34 schrieb Thomas DuBuisson:
Get a community.haskell.org account once you are ready to start a
repo, it can not only host your repo (ex:
http://community.haskell.org/~tommd/pureMD5) but also allows you to
upload packages to hackage.haskell.org.
  
   I already have a Hackage account. Can this be readily used as a
   community.haskell.org account? If not, what if I get a community account.
   Do I have two accounts for Hackage access then?
 
  No, they are two separate things.  A Hackage account just lets you
  upload things to Hackage.  A community.haskell.org account lets you
  log into code.haskell.org (a completely different server than
  Hackage), host projects there, and so on.
 
 But Thomas DuBuisson wrote that you can upload packages to HackageDB with 
 your 
 community.haskell.org account (see above). Is this wrong?

Yes. Register for community accounts (shell, trac, darcs etc)

http://community.haskell.org/

(or you can use github if all you need is a repo).

To get hackage upload perms,

http://hackage.haskell.org/packages/accounts.html

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: space leak with 'concat' ?

2009-02-14 Thread Felipe Lessa
On Sat, Feb 14, 2009 at 3:18 PM, Peter Verswyvelen bugf...@gmail.com wrote:
 Do you think this is something to report as a bug to Microsoft?
 But this is a bit off topic in Haskell Cafe :-)

I don't know how MS treats bug reports, but if you can make a small
test case, then you should. It would also be nice to do so and see how
Mono likes it. However you're right, enough .NET on this thread =).

-- 
Felipe.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Race condition possible?

2009-02-14 Thread Paul Johnson

Peter Verswyvelen wrote:

Consider the following code

stamp v x = do
  t - getCurrentTime 
  putMVar v (x,t)


Is it possible - with GHC - that a thread switch happens after the t 
- getCurrentTime and the putMVar v (x,t)? 

If so, how would it be possible to make sure that the operation of 
reading the current time and writing the pair to the MVar is an 
atomic operation, in the sense that no thread switch can happen 
between the two? Would this require STM?


Thanks again for sharing your wisdom with me :)

Peter

I'm not entirely sure what you are trying to achieve here.  Presumably 
you want v to contain the (value, time) pair as soon as possible after 
time t.  Of course it won't be instantaneous.  So another thread could 
observe that at time (t+delta) the variable v does not yet contain 
(x,t).  Is this a problem?


Atomic transactions won't work because getCurrentTime is of type IO 
Time, whereas anything inside atomic has to be of type STM a.


In theory you could lock out context switches by messing around with the 
GHC runtime, but if you are running on a multicore machine then that 
won't work either.


Paul.

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Race condition possible?

2009-02-14 Thread Peter Verswyvelen
If you have two streams of time/value pairs - using MVars as write-once
sampling variables - and both streams are fed from another thread (e.g.
timers firing), and you want to merge these two streams into a single stream
with monotonic time stamps, then you want to be able to check if at time t
an occurrence exists in a stream. In the case an old time was read but not
yet written to an mvar, this could lead to the merged stream not being
monotonic. At least in my C# prototype that was the case, I used many very
high frequency timers to stress test the merger, and this bug popped up. I
found similar code in the Reactive library, but Reactive is much more clever
operationally (and semantically) than my little prototype so it might not be
a problem. But if it is, I guess it can be solved by introducing another
MVar to indicate I'm reading time, at least I solved it in the C#
prototype in that way.


On Sat, Feb 14, 2009 at 8:01 PM, Paul Johnson p...@cogito.org.uk wrote:

 I'm not entirely sure what you are trying to achieve here.  Presumably you
 want v to contain the (value, time) pair as soon as possible after time t.
  Of course it won't be instantaneous.  So another thread could observe that
 at time (t+delta) the variable v does not yet contain (x,t).  Is this a
 problem?

 Atomic transactions won't work because getCurrentTime is of type IO
 Time, whereas anything inside atomic has to be of type STM a.

 In theory you could lock out context switches by messing around with the
 GHC runtime, but if you are running on a multicore machine then that won't
 work either.

 Paul.


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Confused by SYB example with zipping

2009-02-14 Thread Henry Laxen
Dear Group,

When trying to run the example at:
http://www.cs.vu.nl/boilerplate/testsuite/gzip/Main.hs
ghc 6.10.1 says

A pattern type signature cannot bind scoped type variables `a'
  unless the pattern has a rigid type context
In the pattern: f :: a - a - a
In the definition of `mkTT':
mkTT (f :: a - a - a) x y
   = case (cast x, cast y) of {
   (Just (x' :: a), Just (y' :: a)) - cast (f x' y')
   _ - Nothing }
In the definition of `main':
main = print $ gzip (mkTT maxS) genCom1 genCom2
 where
 genCom1 = everywhere (mkT (double Joost)) genCom
 genCom2 = everywhere (mkT (double Marlow)) genCom
 double x (E (p@(P y _)) (S s)) | x == y = E p (S (2 * s))
 double _ e = e
 maxS (S x) (S y) = S (max x y)
 
Failed, modules loaded: CompanyDatatypes.

-
I must admit I don't really know what to make of this.  Any insights would
be appreciated.
Thanks.
Henry Laxen

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Infinite types should be optionally allowed

2009-02-14 Thread Job Vranish
I'm pretty sure that the problem is decidable, at least with haskell
98 types (other type extensions may complicate things a bit). It ends
up being a graph unification algorithm. I've tried some simple
algorithms and they seem to work.

What do you mean by the inference engine is only half of the story?
From what I understand, the inference engine infers types via
unification, if the types unify, then the unified types are the
inferred types, if the types don't unify, then type check fails. Am I
missing/misunderstanding  something?

I almost think that the problem might be solvable by just generating
the appropriate newtype whenever an infinite type shows up, and doing
the wrapping/unwrapping behind the scenes. This would be a hacked up
way to do it, but I think it would work.


On Fri, Feb 13, 2009 at 6:09 PM, Luke Palmer lrpal...@gmail.com wrote:
 On Fri, Feb 13, 2009 at 4:04 PM, Luke Palmer lrpal...@gmail.com wrote:

 On Fri, Feb 13, 2009 at 3:13 PM, Job Vranish jvran...@gmail.com wrote:

 There are good reasons against allowing infinite types by default
 (mostly, that a lot of things type check that are normally not what we
 want). An old haskell cafe conversation on the topic is here:

 http://www.nabble.com/There%27s-nothing-wrong-with-infinite-types!-td7713737.html

 However, I think infinite types should be allowed, but only with an
 explicit type signature. In other words, don't allow infinite types to
 be inferred, but if they are specified, let them pass. I think it
 would be very hard to shoot yourself in the foot this way.

 Oops!  I'm sorry, I completely misread the proposal.  Or read it correctly,
 saw an undecidability hiding in there, and got carried away.

 What you are proposing is called equi-recursive types, in contrast to the
 more popular iso-recursive types (which Haskell uses).  There are plentiful
 undecidable problems with equi-recursive types, but there are ways to pull
 it off.  The question is whether these ways play nicely with Haskell's type
 system.

 But because of the fundamental computational problems associated, there
 needs to be a great deal of certainty that this is even possible before
 considering its language design implications.


 That inference engine seems to be a pretty little proof-of-concept,
 doesn't it?  But it is sweeping some very important stuff under the carpet.

 The proposal is to infer the type of a term,  then check it against an
 annotation.  Thus every program is well-typed, but it's the compiler's job
 to check that it has the type the user intended.  I like the idea.

 But the inference engine is only half of the story.  It does no type
 checking.  Although checking is often viewed as the easier of the two
 problems, in this case it is not.  A term has no normal form if and only if
 its type is equal to (forall a. a).  You can see the problem here.

 Luke



 Newtype is the standard solution to situations where you really need
 an infinite type, but in some cases this can be a big annoyance. Using
 newtype sacrifices data type abstraction and very useful type classes
 like Functor. You can use multiparameter type classes and functional
 dependencies to recover some of the lost abstraction, but then type
 checking becomes harder to reason about and the code gets way more
 ugly (If you doubt, let me know, I have some examples). Allowing
 infinite types would fix this.

 I'm imagining a syntax something like this:
 someFunctionThatCreatesInfiniteType :: a - b | b = [(a, b)]

 Thoughts? Opinions? Am I missing anything obvious?

 - Job
 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-14 Thread Luke Palmer
On Sat, Feb 14, 2009 at 7:56 AM, John A. De Goes j...@n-brain.net wrote:

 Don't overlook the advantages of using familiar operators and names: you
 have some intuition about '+' and 'map', so if you see them, then you'll
 have some idea what they do (assuming the author is neither stupid nor
 malicious). However, if you see some operator like '$+' or some name like
 'pp3', then you probably won't have any intuition about it.

 Writing good software is about conveying intentions, and part of the way we
 can do that is relying on what other people already know. Which means using
 familiar names and operators when it is helpful to do so.


Keep in mind that such intuitions often have a formalization.  We have an
intuition about what map means.  When we dig deep and try to write down
what that intuition is, the following appears:

   map id = id
   map (f . g) = map f . map g

Now that we have an operation and laws, it is reasonable to use a typeclass.

To me, typeclasses are at their best when you have a real abstraction to
encode.  If you are having trouble using a typeclass and need C++-style
ad-hoc overloading, it's likely you are trying to encode a fake
abstraction -- one that has only linguistic, rather than mathematical
meaning.

Haskell is not an isolated linguist.  Her low tolerance for vagueness
strikes again.

Luke




  I would
 consider any book which is hard
 to read because of that badly written. Things are quite similar with the
 code.


 I consider the current state of affairs quite poor: namely, abuse of type
 classes and alternate names and operators that aren't very suggestive, but
 were chosen purely to avoid conflicts.

  Programming language should be easy to reason about for both computers
 and humans. Compiler should therefore disallow programming style that is
 inaccessible for potential readers. Want to overload something? Well,
 use typeclasses to be explicit about it.



 Type classes were not designed for name overloading. They're designed to
 factor out common patterns in programming. You shouldn't use a type class
 just because you want to use a name or operator.

 And as I said before, if you want to disallow programming style that is
 inaccessible for potential readers, then you should disallow the current
 state of affairs.

 Regards,

 John A. De Goes
 N-BRAIN, Inc.
 The Evolution of Collaboration

 http://www.n-brain.net|877-376-2724 x 101


 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANNOUNCE: first Grapefruit release

2009-02-14 Thread Roman Cheplyaka
* Wolfgang Jeltsch g9ks1...@acme.softbase.org [2009-02-14 17:19:09+0100]
 Dear friends of Haskell and Functional Reactive Programming,
 
 its my pleasure to announce the first official release of Grapefruit, a 
 library for Functional Reactive Programming (FRP) with a focus on user 
 interfaces.
 
 With Grapefruit, you can implement reactive and interactive systems in a 
 declarative style. User interfaces are described as networks of communicating 
 widgets and windows. Communication is done via different kinds of signals 
 which describe temporal behavior.

Greetings!

Does this version not support Codebreaker and CircuitingObjects examples
shown on the wiki page? Or there's another reason why they are not
included in the grapefruit-examples?

-- 
Roman I. Cheplyaka :: http://ro-che.info/
Don't let school get in the way of your education. - Mark Twain
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Possible bug?

2009-02-14 Thread Ryan Ingram
2009/2/13 Peter Verswyvelen bugf...@gmail.com:
 No the error I got was
 Could not deduce (Controller m v c)
 from the context (Controller m v c2)
   arising from a use of `MVC' at NM8\GUI\PanZoom.hs:126:32-65
 Possible fix:
   add (Controller m v c) to the context of the constructor `MVC'
 In the expression: MVC m v (PZC s z (unsafeCoerce c))
 In the definition of `panZoomedMVC'':
 panZoomedMVC' s z (MVC m v c) = MVC m v (PZC s z (unsafeCoerce c))
 I got this after adding the type signature of
 panZoomedMVC' :: (Controller m v c, PanZoomable z) =
  State - z - MVC m v - MVC m v

No function with the type signature of panZoomedMVC' can be called
(unless there is a functional dependency that uniquely determines c
from m and v).  It's ambiguous; there's no way to know which instance
to call.

GHC allows such a function to get an inferred type, but then when it
comes time to call it (and provide the Controller instance) or type
check it against a provided signature, it cannot resolve the ambiguity
and you get that error.

What is happening in this case is something along these lines:

1) Infer a type and constraints for panZoomedMVC':

Constraints:
   Controller t1 t2 t3
   PanZoomable t4

Type:
   State - t4 - MVC t1 t2 - MVC t1 t2

2) Unify the inferred type signature with your provided signature

Constraints:
   Controller m v t3
   PanZoomable z

Type:
   State - z - MVC m v - MVC m v

3) Verify that constraints are sufficient.  This fails, because the
use of Controller in the function (Controller m v t3) doesn't match
the use provided by your constraint (Controller m v c).

However, leaving out the type signature doesn't help you; it just
delays your problem.  Because of the ambiguity, panZoomedMVC' cannot
be called; you'll get the error at the callsite instead.

To solve this problem, either add a dummy argument that fixes c, or
add a functional dependency or associated type to Controller that
fixes c based on m and v.  For example:

 data Proxy a = Proxy
 panZoomedMVC' :: (Controller m v c, PanZoomable z) =
  Proxy c - State - z - MVC m v - MVC m v
 panZoomedMVC' _ s z mvc = ...

Then you can pass the proper Proxy when calling the function to make
the typechecker happy.

or

 class Controller m v c | m v - c where ...

or

 class Controller m v where
type Control m v
...

  -- ryan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] ANNOUNCE: haha-0.1 - Animated ascii lambda

2009-02-14 Thread Sebastiaan Visser
Always wanted to have an full-color rotating vector based ascii art  
lambda on your terminal? This is your chance, installing `haha' will  
do the trick!


This is very minimal vector based ascii art library written just for  
fun. There is a sample program called `rotating-lambda' which does  
exactly what is says.


Make sure your terminal window is at least 80x40 and supports the most  
basic ANSI escape sequences before trying the demo.


--
Sebastiaan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Possible bug?

2009-02-14 Thread Peter Verswyvelen
Thanks Ryan.
I'm always struggling with functional dependencies since to be honest - I
don't really understand how the type inferer figures out all the types and I
didn't take the time to study it yet. Your email will help me a bit further
with this.

My functional dependency was c - m v. It can't be m v - c since for the
same model and view type , you can have many controllers types.

On Sat, Feb 14, 2009 at 11:38 PM, Ryan Ingram ryani.s...@gmail.com wrote:

 2009/2/13 Peter Verswyvelen bugf...@gmail.com:
  No the error I got was
  Could not deduce (Controller m v c)
  from the context (Controller m v c2)
arising from a use of `MVC' at NM8\GUI\PanZoom.hs:126:32-65
  Possible fix:
add (Controller m v c) to the context of the constructor `MVC'
  In the expression: MVC m v (PZC s z (unsafeCoerce c))
  In the definition of `panZoomedMVC'':
  panZoomedMVC' s z (MVC m v c) = MVC m v (PZC s z (unsafeCoerce
 c))
  I got this after adding the type signature of
  panZoomedMVC' :: (Controller m v c, PanZoomable z) =
   State - z - MVC m v - MVC m v

 No function with the type signature of panZoomedMVC' can be called
 (unless there is a functional dependency that uniquely determines c
 from m and v).  It's ambiguous; there's no way to know which instance
 to call.

 GHC allows such a function to get an inferred type, but then when it
 comes time to call it (and provide the Controller instance) or type
 check it against a provided signature, it cannot resolve the ambiguity
 and you get that error.

 What is happening in this case is something along these lines:

 1) Infer a type and constraints for panZoomedMVC':

 Constraints:
   Controller t1 t2 t3
   PanZoomable t4

 Type:
   State - t4 - MVC t1 t2 - MVC t1 t2

 2) Unify the inferred type signature with your provided signature

 Constraints:
   Controller m v t3
   PanZoomable z

 Type:
State - z - MVC m v - MVC m v

 3) Verify that constraints are sufficient.  This fails, because the
 use of Controller in the function (Controller m v t3) doesn't match
 the use provided by your constraint (Controller m v c).

 However, leaving out the type signature doesn't help you; it just
 delays your problem.  Because of the ambiguity, panZoomedMVC' cannot
 be called; you'll get the error at the callsite instead.

 To solve this problem, either add a dummy argument that fixes c, or
 add a functional dependency or associated type to Controller that
 fixes c based on m and v.  For example:

  data Proxy a = Proxy
  panZoomedMVC' :: (Controller m v c, PanZoomable z) =
   Proxy c - State - z - MVC m v - MVC m v
  panZoomedMVC' _ s z mvc = ...

 Then you can pass the proper Proxy when calling the function to make
 the typechecker happy.

 or

  class Controller m v c | m v - c where ...

 or

  class Controller m v where
 type Control m v
 ...

  -- ryan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Amazing

2009-02-14 Thread Peter Verswyvelen
One of the things I liked a lot when working with C# was that as soon as my
code compiled, it usually worked after an iteration of two.At least if we
forget about the nasty imperative debugging that is needed after a while
because of unanticipated and unchecked runtime side effects.
After heaving read about Haskell and having written some small programs for
the last year or so, I'm now finally writing a bigger program with it. It is
not so easy yet since learning a language and trying to reach a deadline at
the same time is hard :)

However, it is just amazing that whenever my Haskell program compiles (which
to be fair can take a while for an average Haskeller like me ;-), it just...
works! I have heard rumors that this was the case, but I can really confirm
it.

A bit hurray for strong typing! (and if you don't like it, you can still use
Dynamic and Typeable ;-)
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: permuting a list

2009-02-14 Thread Henning Thielemann


On Sat, 14 Feb 2009, Daniel Fischer wrote:


Am Samstag, 14. Februar 2009 16:37 schrieb Heinrich Apfelmus:


For the full exposition, see

   http://apfelmus.nfshost.com/random-permutations.html


Excellent work, thanks.


Interesting read.
 Btw. a further development of the PFP library is also on Hackage:
  http://hackage.haskell.org/cgi-bin/hackage-scripts/package/probability
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread John Meacham
On Sun, Feb 15, 2009 at 12:51:38AM +0100, Peter Verswyvelen wrote:
 However, it is just amazing that whenever my Haskell program compiles (which
 to be fair can take a while for an average Haskeller like me ;-), it just...
 works! I have heard rumors that this was the case, but I can really confirm
 it.

Indeed. You have to be careful or you will start expecting your perl
scripts to just work if your editor is capable of saving the file to
disk. Which can lead to all sorts of trouble :)

John


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


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Rick R
I have been learning Haskell for the last two weeks and was relaying that
exact benefit to my friend in attempts to convert him. I spend 3 hours
getting a few functions to compile, but when they do, they just work. Every
time.

2009/2/14 Peter Verswyvelen bugf...@gmail.com

 One of the things I liked a lot when working with C# was that as soon as my
 code compiled, it usually worked after an iteration of two.At least if we
 forget about the nasty imperative debugging that is needed after a while
 because of unanticipated and unchecked runtime side effects.
 After heaving read about Haskell and having written some small programs for
 the last year or so, I'm now finally writing a bigger program with it. It is
 not so easy yet since learning a language and trying to reach a deadline at
 the same time is hard :)

 However, it is just amazing that whenever my Haskell program compiles
 (which to be fair can take a while for an average Haskeller like me ;-), it
 just... works! I have heard rumors that this was the case, but I can really
 confirm it.

 A bit hurray for strong typing! (and if you don't like it, you can still
 use Dynamic and Typeable ;-)


 ___
 Haskell-Cafe mailing list
 Haskell-Cafe@haskell.org
 http://www.haskell.org/mailman/listinfo/haskell-cafe




-- 
We can't solve problems by using the same kind of thinking we used when we
created them.
   - A. Einstein
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Iteratee-based IO and lightweight monadic regions in the wild

2009-02-14 Thread Ben Franksen
Artyom Shalkhakov wrote:
 Is anybody planning to use these shiny new ways for doing IO?

Interesting that you ask. I am currently using the 'lightweight monadic
region' approach to manage network resources (so called 'channels',
connections to a named variable; the context is Haskell support for a
certain network protocol used in some distributed control systems). These
channels should be freed in a timely fashion and must not be used after
freeing them, just like file handles. A complication arises due to channels
being subordinate to another type of resource, so called 'client contexts',
which must be handled in a similar fashion. Another complication is due to
the underlying C library's heavy use of callbacks to signal changes related
to a channel (such as value change or connection loss). Remembering a
message by Jules Bean some time ago on this list
(http://www.haskell.org/pipermail/haskell-cafe/2007-July/028501.html) I
tried to integrate his ideas of threading one monad through another with
monadic regions, which was a very interesting and enlightening experience.
Somewhere along the way I replaced his MPTC with associated type synonyms,
which greatly simplified the type signatures. Then I saw that RMonadIO is
indeed subsumed by InterleavableIO:

class Monad m = InterleavableIO m where
  type Internals m
  embed :: (Internals m - IO a) - m a
  callback :: m a - Internals m - IO a

instance InterleavableIO m = RMonadIO m where
  brace before after during =
  embed $ \x - bracket (before' x) (\a - after' a x) (\a - during' a
x)
where
  before' x = callback before x
  after' a x = callback (after a) x
  during' a x = callback (during a) x
  snag action handler = embed $ \x - catch (action' x) (\e - handler' e x)
where
  action' x = callback action x
  handler' e x = callback (handler e) x
  lIO = embed . const

which is indeed exactly the same implementation for the instances as in the
original regions paper (and source), only that in my case the exceptions
don't have to be 'cleansed' of handles (which could otherwise leak from a
region).

I am currently working on integrating concurrency into my monadic regions.
Specifically, I want to be able to re-assign certain resources, like
with 'shDup' but not to a parent region but to a completely new,
independent region that shares the same 'client context' but runs in
another thread. This is very much in flux, however, and I still have to
check it is actually safe.

Cheers
Ben

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Felipe Lessa
As this topic popped out, my secrets for programming in Haskell are
three words: assert, HUnit, QuickCheck.

- Create internal functions that verify the results of the exported
ones, or maybe an easier to verify implementation that is slower, and
put them on assert's. This has saved me a few times.

- Create HUnit tests before writing the function itself (but after
writing its type), and automate the execution (maybe with
test-framework-hunit). This way you can test your implementation after
type-checking, optimizations and/or fixed bugs.

- If you can write down properties and Arbitrary's easily, do so and
wire everything with the HUnit tests. I don't use QuickCheck as I use
HUnit because it is often impossible to write meaningful Arbitrary
instances (haven't tried SmallCheck yet, but most of the time the
problem is with some kind of data type with lots of invariants to be
maintained).

Creating tests before the implementation + Haskell = Very few bugs +
Almost no regressions

-- 
Felipe.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] ANNOUNCE: haha-0.1 - Animated ascii lambda

2009-02-14 Thread Don Stewart
sfvisser:
 Always wanted to have an full-color rotating vector based ascii art
 lambda on your terminal? This is your chance, installing `haha' will do
 the trick!

 This is very minimal vector based ascii art library written just for
 fun. There is a sample program called `rotating-lambda' which does
 exactly what is says.

 Make sure your terminal window is at least 80x40 and supports the most
 basic ANSI escape sequences before trying the demo.

Very smoothly done!

Here's a video of what he's talking about,

http://www.youtube.com/watch?v=MugQXHUZPK8 

Raw video,

http://galois.com/~dons/images/rotating-lambda.ogv

-- Don

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Race condition possible?

2009-02-14 Thread Bryan O'Sullivan
2009/2/14 Peter Verswyvelen bugf...@gmail.com

 If you have two streams of time/value pairs - using MVars as write-once
 sampling variables - and both streams are fed from another thread (e.g.
 timers firing), and you want to merge these two streams into a single stream
 with monotonic time stamps, then you want to be able to check if at time t
 an occurrence exists in a stream.


What you want to do isn't actually achievable on multi-processor machines
without some form of mutual exclusion. Time on different cores does not
progress monotonically, and you'll pay an enormous performance penalty to do
what you want to do (the nature of which is somewhat unclear).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Can this be done?

2009-02-14 Thread wren ng thornton

Chung-chieh Shan wrote:

wren ng thornton wrote:
 It's ugly, but one option is to just reify your continuations as an ADT, 
 where there are constructors for each function and fields for each 
 variable that needs closing over. Serializing that ADT should be simple 
 (unless some of those functions are higher-order in which case you run 
 into the same problem of how to serialize the function arguments). In 
 GHC's STG machine this representation shouldn't have much overhead, 
 though it does require the developer to do the compiler's job.


FWIW, this idea is called defunctionalization (due to Reynolds),
and it works for higher-order functions as well (because you can
defunctionalize those function arguments in the same way).


Oh certainly. Depending on how the HOFs are used, however, that can lead 
to a very large grammar. The basic ADT approach works best when there 
are a small selection of actions to take or pass around (aka few states 
in the state machine).


For a more general solution you'll want to use something like HOAS or 
Template Haskell's AST, with explicit representations for general 
function application, let binding, and case expressions. That way the 
building blocks are small enough to keep the evaluator simple to maintain.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Sebastian Sylvan
2009/2/14 Peter Verswyvelen bugf...@gmail.com

 One of the things I liked a lot when working with C# was that as soon as my
 code compiled, it usually worked after an iteration of two.At least if we
 forget about the nasty imperative debugging that is needed after a while
 because of unanticipated and unchecked runtime side effects.
 After heaving read about Haskell and having written some small programs for
 the last year or so, I'm now finally writing a bigger program with it. It is
 not so easy yet since learning a language and trying to reach a deadline at
 the same time is hard :)

 However, it is just amazing that whenever my Haskell program compiles
 (which to be fair can take a while for an average Haskeller like me ;-), it
 just... works! I have heard rumors that this was the case, but I can really
 confirm it.

 A bit hurray for strong typing! (and if you don't like it, you can still
 use Dynamic and Typeable ;-)


I've found the same thing. An interesting observation is that (for me) the
vast majority of the type errors are things that would've happened in *any*
statically typed language (like C#), but somehow Haskell manages to be a lot
better at catching errors at compile time.
So my conclusion is that it's not just static typing, it's functional
programming in conjunction with static strong type checking.

When all you're writing are expressions, then *everything* goes through some
level of sanity checking. When you're writing imperative code, a lot of
the meaning of your program comes from the ordering of statements - which
usually isn't checked at all (aside from scope).

So IMO static typing is good, but it's only with functional programming that
it really shines.

-- 
Sebastian Sylvan
+44(0)7857-300802
UIN: 44640862
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Jeremy Shaw
At Sun, 15 Feb 2009 05:37:12 +,
Sebastian Sylvan wrote:

 So my conclusion is that it's not just static typing, it's functional
 programming in conjunction with static strong type checking.

Indeed. For example, it's pretty hard to accidentally use an
'uninitialized variable' in Haskell, because variables can only be
introduced using the let statement or a lambda expression, which both
require that the name be bound to something.

And, in languages like C if you write:

--

if (foo)
statement1;
else
statement2;
statement3;

statement4;

--

You might be mislead into think that statement2 is part of the
conditional. In Haskell, if you write:

do if foo
then do statement1
else do statement2
statement3
   statement4

then the visual layout gives you the correct idea.

I think the lack of automatic type casting and C++ style name
overloading also helps. If you explicitly state what you want done,
you are more likely to get what you want than if you let the compiler
do it according to some rules that you may or may not remember.

I have had the unfortunate experience of adding 1 + 1 and getting 11
in some languages. But, not in Haskell.

By using folds and maps, we avoid many off-by-one errors.

So, I would agree that it is not just static type checking, but a
whole bunch of little things that all add up.

- jeremy

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Overloading functions based on arguments?

2009-02-14 Thread wren ng thornton

John A. De Goes wrote:

On Feb 13, 2009, at 2:11 PM, Jonathan Cast wrote:

The compiler should fail when you tell it two mutually contradictory
things, and only when you tell it two mutually contradictory things.


By definition, it's not a contradiction when the symbol is unambiguously 
typeable. Do you think math textbooks are filled with contradictions 
when they give '+' a different meaning for vectors than matrices or real 
numbers???


Yes. Yes, I do.

It is precisely this abuse of notation which makes, for instance, 
statistics textbooks impossible to read (without already knowing the 
material). Scalars, vectors, and matrices are fundamentally different 
here and the operations on them should be unambiguous, regardless of 
context. When reading a machine learning algorithm it should *never* be 
a question whether something is scalar or not. Ambiguity is a bug. 
Replacing one kind for another is almost always wrong.


For another example, consider matrices vs their transposes. Many folks 
can't be bothered to type a single character to clarify when things 
should be transposed before multiplying. No matter how quickly someone 
can test the equation to verify it, leaving that information off makes 
the equation simply wrong. And it's not as if square matrices aren't 
ubiquitous.


--
Live well,
~wren
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Michael D. Adams
2009/2/15 Sebastian Sylvan syl...@student.chalmers.se:
 2009/2/14 Peter Verswyvelen bugf...@gmail.com
 One of the things I liked a lot when working with C# was that as soon as
 my code compiled, it usually worked after an iteration of two.At least if we
 forget about the nasty imperative debugging that is needed after a while
 because of unanticipated and unchecked runtime side effects.
 After heaving read about Haskell and having written some small programs
 for the last year or so, I'm now finally writing a bigger program with it.
 It is not so easy yet since learning a language and trying to reach a
 deadline at the same time is hard :)
 However, it is just amazing that whenever my Haskell program compiles
 (which to be fair can take a while for an average Haskeller like me ;-), it
 just... works! I have heard rumors that this was the case, but I can really
 confirm it.

 A bit hurray for strong typing! (and if you don't like it, you can still
 use Dynamic and Typeable ;-)

 I've found the same thing. An interesting observation is that (for me) the
 vast majority of the type errors are things that would've happened in *any*
 statically typed language (like C#), but somehow Haskell manages to be a lot
 better at catching errors at compile time.
 So my conclusion is that it's not just static typing, it's functional
 programming in conjunction with static strong type checking.
 When all you're writing are expressions, then *everything* goes through some
 level of sanity checking. When you're writing imperative code, a lot of
 the meaning of your program comes from the ordering of statements - which
 usually isn't checked at all (aside from scope).
 So IMO static typing is good, but it's only with functional programming that
 it really shines.

Don't forget Algebraic Data Types.  Those seem to also avoid many of
the sorts of errors that you would see in OO or struct-based (i.e. C)
programming.

Has anyone seen any real studies of this phenomenon?  There is plenty
of anecdotal evidence that Haskell is doing something right to reduce
the bugs, but (1) some hard evidence would be nice and (2) its not
very clear which features of Haskell most contribute to this.  (On
that note, IIRC there was a study that correlated bug rates to lines
of code *independent* of language (i.e. writing your program in half a
many lines or a language that allowed you to express it in half as
many lines reduced the number of bugs by half).  This is one area that
Haskell does well in.)

Michael D. Adams
mdmko...@gmail.com
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Amazing

2009-02-14 Thread Artyom Shalkhakov
Hello,

2009/2/15 Michael D. Adams mdmko...@gmail.com:
 Has anyone seen any real studies of this phenomenon?  There is plenty
 of anecdotal evidence that Haskell is doing something right to reduce
 the bugs

Let's just call it a miracle of FP, write many books and articles on
the matter
(i.e., generate a lot of hype), strike gold, and get dirty rich. ;-)

Cheers,
Artyom Shalkhakov.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe