[Haskell-cafe] Gtk2hs on GHC6.8.2?

2008-03-24 Thread Ryan Ingram
The WinXP binary release of Gtk2hs won't install for me; it seems to
expect GHC6.8.1 and refuses to install on 6.8.2.  Is there any
significant difference in the compilers that would cause it not to
work on 6.8.2?  Is there a way I can trick it into installing?

I really don't want to have to build from source.  I've had nothing
but trouble trying to get large projects to build within
cygwin/mingw/msys.

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


[Haskell-cafe] Re: Libraries need a new owner

2008-03-24 Thread Don Stewart
ahey:
> Hello Folks,
> 
> As some of you will be aware, I have been working on various Map
> implementations that currently live here..
> 
> http://code.haskell.org/collections/collections-ghc6.8
> 
> The libs in question being Data.Tree.AVL, Data.Trie.General and a few
> other bits like Data.COrdering and the AVL based Data.Map/Set clones.
> 
> Well, I have decided to stop work on these. So they need a new owner if
> they're going to go anywhere. If anyone is interested in the job then I
> suggest they contact myself or Jean-Philippe Bernardy.
> 
> Of course I will be happy to provide any help or advise anyone who takes
> over these libs may feel they need from me. I might even contribute a
> few patches from time to time myself :-)
> 
> Thanks

How about we propose this work be done for Summer of Code.

I've created a ticket here:

http://hackage.haskell.org/trac/summer-of-code/ticket/1549

Add comments, or if you can mentor, add that information too!

Let's get a new faster Data.Map and other containers ready to go by the
end of the northern summer?

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


Re: [Haskell-cafe] Terminating GLUT/GLFW programs

2008-03-24 Thread Peter Verswyvelen

Hi,

I had a similar (unsolved) problem with GLUT but on my system (Windows 
XP + GHC 6.8.2)  GLFW works fine, exiting is no problem at all.


But when building GLFW, make sure that the GHC gcc-lib directory comes 
*before* the MinGW/Cygwin directory in your PATH environment variable, 
since when linking, the LD.EXE bundled with GHC *must* be used.


Cheers,
Peter

[EMAIL PROTECTED] wrote:


L.S.,

I am trying GLUT and GLFW (on Windows XP, with GHC 6.8.2); the sample 
programs do not terminate when I close the window by clicking on the 
cross in the upper right corner of the window.


The sample program for GLUT is at
  
http://blog.mikael.johanssons.org/archive/2006/09/opengl-programming-in-haskell-a-tutorial-part-1/ 


the GLFW program:
  http://haskell.org/haskellwiki/GLFW

I tried in the GLUT program:
  close = exitWith ExitSuccess

  closeCallback $= Just close -- => User error (unknown GLUT call 
getCloseFunc, check for freeglut)


this needs freeglut (not documented); I downloaded freeglut.dll and 
placed it in the windows\system32 directory. The error message remained.


What is needed to let these programs terminate properly?



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


Re: [Haskell-cafe] Re: HFuse: ls fails in HelloFS

2008-03-24 Thread Jason Dusek
  What about System.FUSE then?

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


Re: [Haskell-cafe] Re: Libraries need a new owner

2008-03-24 Thread Matthew Pocock
On Monday 24 March 2008, Don Stewart wrote:
> Let's get a new faster Data.Map and other containers ready to go by the
> end of the northern summer?

And while we are visiting this, can I put in a vote for a seperation between 
the default Data.* container concrete implementations and associated classes? 
E.g. between the cannonical Map implementation and a Map class that could (if 
I felt mad) be backed by a list, or (if I was more sane) the cannonical Map 
datatype? This would go /at least/ for Map, Set, List.

Matthew

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


[Haskell-cafe] RE: How to implement Read instance for user defined type

2008-03-24 Thread Verma Anurag-VNF673
 
That works, but is probably not what you want. You can use the lex 
function to parse identifiers not enclosed in quotes:
 
 > instance Read Mark where
 >   readsPrec _ str = [(Mark x, t') | ("mark",t) <- lex str,
 > (x,t') <- reads t
 

I played a bit around with lex function and it seems that under certain
circumstances it doesn't read the string of token properly 

 

For e.g. 

 

 

-- IP address 

 

*Mark> lex "192.168.0.1"

[("192.168",".0.1")]

 

-- digit + char 

 

Also lex "8021p"   output is 

 

*Mark> lex "8021p"

[("8021","p")]

 

Is there any other lex variant available?  Or should I switch to using
Parsec library, in that case, will I still be able to use it with Read
instances? If so, how?

 

Anurag

 

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


Re: [Haskell-cafe] Equality constraints in type families

2008-03-24 Thread Claus Reinke

type family F a :: * -> *

F x y ~ F u v <=> F x ~ F u /\ y ~ v


words, in a type term like (F Int Bool), the two parameters Int and  
Bool are treated differently.  Int is treated like a parameter to a  
function (which is what you where expecting), whereas Bool is treated  
like a parameter to a vanilla data constructor (the part you did not  
expect).  To highlight this distinction, we call only Int a type  
index.  Generally, if a type family F has arity n, it's first n  
parameters are type indicies, the rest are treated like the parameters  
of any other type constructor.  


i'm not sure haskell offers the kind of distinction that we
need to talk about this: 'data constructor' is value-level,
'type constructor' doesn't distinguish between type- vs
data-defined type constructors. i think i know what you
mean, but it confuses me that you use 'data constructor'
(should be data/newtype-defined type constructor?)
and 'type constructor' (don't you want to exclude
type-defined type constructors here).

   data ConstD x y = ConstD x
   type ConstT x y = x

'ConstD x' and 'ConstT x' have the same kind, that
of type constructors: * -> *. but:

   ConstD x y1 ~ ConstD x y2 => y1 ~ y2

whereas

   forall y1, y2: ConstT x y1 ~ ConstT x y2

and i thought 'type family' was meant to suggest type
synonym families, in contrast to 'data family'?

you did notice that i gave an example of how ghc does
not seem to follow that decomposition rule, didn't you?
ghc seems to behave almost as i would expect, not as
the decomposition rule seems to suggest.

still confused,
claus


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


Re: [Haskell-cafe] Equality constraints in type families

2008-03-24 Thread Claus Reinke

type family F a :: * -> *

F x y ~ F u v <=> F x ~ F u /\ y ~ v


why would F x and F u have to be the same functions?
shouldn't it be sufficient for them to have the same result,
when applied to y and v, respectively?


Oh, yes, that is sufficient and exactly what is meant by F x ~ F u.   
It means, the two can be unified modulo any type instances and local  
given equalities.


sorry, i don't understand how that could be meant by 'F x ~ F u';
that equality doesn't even refer to any specific point on which these
two need to be equal, so it can only be a point-free higher-order
equality, can't it?

the right-to-left implication is obvious, but the left-to-right
implication seems to say that, for 'F x' and 'F u' to be equal on 
any concrete pair of types 'y' and 'u', they have to be equal on 
all possible types and 'y' and 'u' themselves have to be equal.


again, i gave a concrete example of how ghc behaves as i 
would expect, not as that decomposition rule would suggest.


i'll try to re-read the other paper you suggested, but it would 
help me if you could discuss the two concrete examples i

gave in this thread.

thanks,
claus


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


Re: [Haskell-cafe] Gtk2hs on GHC6.8.2?

2008-03-24 Thread Duncan Coutts
In message <[EMAIL PROTECTED]> "Ryan
Ingram" <[EMAIL PROTECTED]> writes:
> The WinXP binary release of Gtk2hs won't install for me; it seems to
> expect GHC6.8.1 and refuses to install on 6.8.2. 

Right. It does that on purpose and with good reason.

Do you think the error message could be improved? The message should already say
that it detected ghc 6.8.2 but that it requires ghc 6.8.1 (or 6.6.1).

> Is there any significant difference in the compilers that would cause it not
> to work on 6.8.2? 

Yes. The .hi files are versioned and ghc will reject .hi files created by a
different version of ghc.

> Is there a way I can trick it into installing?

You could probably trick the installer but it would not help you at all, as all
you'll get is ghc reporting that the .hi files were written by ghc-6.8.1 rather
than ghc-6.8.2.

You are in luck however, I did a build with ghc-6.8.2 just the other day but
hadn't announced it yet:
http://haskell.org/~duncan/gtk2hs/gtk2hs-0.9.12.1.exe

Let me know how you get on, though in general bugs are best reported to the
gtk2hs-devel mailing list or in our bug tracker.

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


Re: [Haskell-cafe] more on FFI build error

2008-03-24 Thread Claude Heiland-Allen

Galchin Vasili wrote:


line #102 ...

   allocaBytes (#const sizeof(struct mq_attr)) $ \ p_attrs -> do
 
definition of struct mq_attr on Linux ...


  struct mq_attr
{
  long int mq_flags;/* Message queue flags.  */
  long int mq_maxmsg;   /* Maximum number of messages.  */
  long int mq_msgsize;  /* Maximum message size.  */
  long int mq_curmsgs;  /* Number of messages currently queued.  */
  long int __pad[4];
};



Did you #include the header file that defines this struct?


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


[Haskell-cafe] Re: deconstruction of the list/backtracking applicative functor?

2008-03-24 Thread apfelmus

(Sorry for the late reply)

Conal Elliott wrote:

Is there a known deconstruction of the list/backtracking applicative functor
(AF)?  If I decompose the list type into pieces (Maybe, product,
composition), I think I can see where the ZipList AF comes from, but not the
list/backtracking AF.


So, you mean that the strange thing about the list monad is that the 
"natural" applicative structure for [a] is derived from the "composition"


  [a]  ~  Maybe (a, Maybe (a, ...))  ~  Maybe `O` (a,) `O` Maybe `O` 
(a,) `O` ...


? Well, this is not quite true since the applicativity you're seeking is 
in the extra argument  a , not in the argument of the composition. In 
fact, this infinite composition doesn't have an argument (that's the 
whole point of taking the fixed point). In other words, every chain like


  Maybe `O` (a,) `O` Maybe `O` (a,)
  Maybe `O` (a,) `O` Maybe `O` (a,) `O` Maybe `O` (a,)

etc. is an applicative functor in its argument, but not necessarily in 
a  . So, there is more to the "natural" ZipList AF than  Maybe, product 
and composition.



Is there some construction simpler than lists
(non-recursive) that introduces cross products?


What do you mean with "cross products" here? Something with

  sequence :: Applicative f => [f a] -> f [a]

being the cartesian product for the list monad? Or simpler

  pure (,) :: Applicative f => (f a, f b) -> f (a,b)

somehow "crossing" the "elements" of  f a  and  f b ?


Regards,
apfelmus

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


Re: [Haskell-cafe] HXT and types in Control.Arrow.ArrowTree

2008-03-24 Thread Robert Vollmert

Hello,

On Mar 23, 2008, at 18:53, Albert Y. C. Lai wrote:


You are right, there is no harm generalizing deep, since a related  
combinator, multi, has the more general type.


thanks for the reply! Perhaps I'll suggest the generalization to the  
HXT authors. Meanwhile, I've discovered examples of just the kind of  
thing I'm trying to do at http://www.haskell.org/haskellwiki/HXT/Practical/ 
 .



 Meanwhile, I don't think


deep (hasName "a") >>> getLink


looks too bad. :)


That's true, it was a bad example. It's just that if getLink already  
includes the hasName test, the above seems redundant.


Cheers
Robert

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


[Haskell-cafe] Random Monad

2008-03-24 Thread Matthew Pocock
Hi,

Who currently maintains the Random monad code? I have some patches to 
contribute.

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


[Haskell-cafe] Haddock Help Required

2008-03-24 Thread Dominic Steinitz
What should I be using for the file name for the read-interface option
in haddock? Trying to use the file on www.haskell.org gives this:

[EMAIL PROTECTED]:~/asn15/asn1> haddock -html -o hdoc Pretty.hs -B
/usr/lib/ghc-6.8.2 --optghc="-fglasgow-exts"
--read-interface=http://www.haskell.org/ghc/docs/latest/html/libraries/base,http://www.haskell.org/ghc/docs/latest/html/libraries/base/base.haddock
haddock: internal Haddock or GHC error:
http://www.haskell.org/ghc/docs/latest/html/libraries/base/base.haddock:
openBinaryFile: does not exist (No such file or directory)


But if I download the file and try and use it locally, I get this

[EMAIL PROTECTED]:~/asn15/asn1> haddock -v -html -o hdoc Pretty.hs -B
/usr/lib/ghc-6.8.2 --optghc="-fglasgow-exts"
--read-interface=http://www.haskell.org/ghc/docs/latest/html/libraries/base,base.haddock
Warning: Cannot read base.haddock:
   "Magic number mismatch: couldn't load interface file: base.haddock"
Skipping this interface.
Warning: main:Language.ASN1: could not find link destinations for:
GHC.Enum.Enum GHC.Base.Eq GHC.Base.Ord GHC.Show.Show GHC.Num.Integer
Language.ASN1.ComponentIndex Language.ASN1.Tagged GHC.Base.String
Data.Maybe.Maybe Language.ASN1.Octet Data.Map.Map
Warning: main:Pretty: could not find link destinations for:
Text.PrettyPrint.HughesPJ.Doc Pretty.Pretty Pretty.PrettyVal
Warning: main:ConstrainedType: could not find link destinations for:
Data.Maybe.Maybe GHC.Base.Bool GHC.Num.Integer Pretty.Pretty
Pretty.PrettyVal GHC.Base.String GHC.Base.Eq GHC.Show.Show GHC.Base.Int
GHC.Word.Word8 GHC.Base.Ord Data.Monoid.Monoid
Data.Binary.Strict.BitPut.BitPut GHC.Real.Integral
Control.Monad.State.Class.MonadState Data.ByteString.Internal.ByteString
Control.Monad.Error.Class.MonadError GHC.Base.Char
Data.Binary.Strict.BitGet.BitGet

Any help would be appreciated.

Dominic.

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


[Haskell-cafe] ghc warn-unused-imports

2008-03-24 Thread Evan Laforge
So it appears that GHC will warn about "unused" imports when you
import qualified if you could have gotten the symbol from somewhere
else.  For instance, if you write:

import qualified Control.Monad.Trans as Trans
import qualified Control.Monad.Writer as Writer

and use "Trans.lift", it will complain because you could have used
"Writer.lift".  Then if you go import State, it will want you to use
State.liftIO instead of Trans.liftIO (Writer doesn't have liftIO).
Now, one question is why these modules are exporting random stuff from
Trans, but in general the practice of warning when you use qualified
imports seems not only misleading (since if you comment out the import
your code breaks, and it's not obvious where it wanted you to get the
symbol), but brittle since a messy export list on some module you
import can suddenly trigger a flood of warnings.

So I'd suggest that if you say "import qualified M" and then use
"M.something", then "M is unused" msgs shouldn't appear.
warn-unused-imports is genuinely useful most of the time, so I don't
like to put on -fno-warn-unused-imports.

Is there a better way to suppress the "false positives" here?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: deconstruction of the list/backtracking applicative functor?

2008-03-24 Thread Conal Elliott
Thanks for the reply.  Here's the decomposition I had in mind.  Start with

type List a = Maybe (a, List a)

Rewrite a bit

type List a = Maybe (Id a, List a)

Then make the type *constructor* pairing explicit

type List a = Maybe ((Id :*: List) a)

where

newtype (f :*: g) a = Prod { unProd :: (f a, g a) }

Then make the type-constructor composition explicit

type List = Maybe :. (Id :*: List)

(which isn't legal Haskell, due to the type synonym cycle).  From there use
the Functor and Applicative instances for composition and pairing of type
constructors and for Id.  I think the result is equivalent to ZipList.

To clarify my "cross products" question, I mean fs <*> xs = [f x | f <- fs,
x <- xs], as with lists.

Cheers,  - Conal


On Mon, Mar 24, 2008 at 8:36 AM, apfelmus <[EMAIL PROTECTED]> wrote:

> (Sorry for the late reply)
>
> Conal Elliott wrote:
> > Is there a known deconstruction of the list/backtracking applicative
> functor
> > (AF)?  If I decompose the list type into pieces (Maybe, product,
> > composition), I think I can see where the ZipList AF comes from, but not
> the
> > list/backtracking AF.
>
> So, you mean that the strange thing about the list monad is that the
> "natural" applicative structure for [a] is derived from the "composition"
>
>   [a]  ~  Maybe (a, Maybe (a, ...))  ~  Maybe `O` (a,) `O` Maybe `O`
> (a,) `O` ...
>
> ? Well, this is not quite true since the applicativity you're seeking is
> in the extra argument  a , not in the argument of the composition. In
> fact, this infinite composition doesn't have an argument (that's the
> whole point of taking the fixed point). In other words, every chain like
>
>   Maybe `O` (a,) `O` Maybe `O` (a,)
>   Maybe `O` (a,) `O` Maybe `O` (a,) `O` Maybe `O` (a,)
>
> etc. is an applicative functor in its argument, but not necessarily in
> a  . So, there is more to the "natural" ZipList AF than  Maybe, product
> and composition.
>
> > Is there some construction simpler than lists
> > (non-recursive) that introduces cross products?
>
> What do you mean with "cross products" here? Something with
>
>   sequence :: Applicative f => [f a] -> f [a]
>
> being the cartesian product for the list monad? Or simpler
>
>   pure (,) :: Applicative f => (f a, f b) -> f (a,b)
>
> somehow "crossing" the "elements" of  f a  and  f b ?
>
>
> Regards,
> apfelmus
>
> ___
> 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


[Haskell-cafe] Monad instance for Data.Set, again

2008-03-24 Thread Henning Thielemann


The blog article
 http://www.randomhacks.net/articles/2007/03/15/data-set-monad-haskell-macros
  describes a variant of the Monad class which allows to restrict the type 
of the monadic result, in order to be able to make Data.Set an instance of 
Monad (requiring Ord constraint for the monadic result). The same problem 
arises for container data structures with restricted element types, where 
the element type restriction depends on the implementation of the 
container structure (such as UArray). It would be cumbersome to have 
several class parts, even more, type constraints in type signatures may 
reveal implementation details. E.g. constraint (Container c x y z) might 
be needed for a 'zipWith' function, whereas (Container c y x z) is needed 
if you use 'zipWith' with swapped arguments.



Here is another approach that looks tempting, but unfortunately does not 
work, and I wonder whether this can be made working.




module RestrictedMonad where

import Data.Set(Set)
import qualified Data.Set as Set


class AssociatedMonad m a where

class RestrictedMonad m where
   return :: AssociatedMonad m a => a -> m a
   (>>=)  :: (AssociatedMonad m a, AssociatedMonad m b) => m a -> (a -> m b) -> 
m b



instance (Ord a) => AssociatedMonad Set a where

instance RestrictedMonad Set where
   return = Set.singleton
   x >>= f = Set.unions (map f (Set.toList x))



GHC says:

RestrictedMonad.hs:21:13:
Could not deduce (Ord b)
  from the context (RestrictedMonad Set,
AssociatedMonad Set a,
AssociatedMonad Set b)
  arising from use of `Data.Set.unions' at RestrictedMonad.hs:21:13-22
Probable fix: add (Ord b) to the class or instance method 
`RestrictedMonad.>>='
In the definition of `>>=':
>>= x f = Data.Set.unions (map f (Data.Set.toList x))
In the definition for method `RestrictedMonad.>>='
In the instance declaration for `RestrictedMonad Set'

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


[Haskell-cafe] BUG: genObjectNames dies on Win32

2008-03-24 Thread Jefferson Heard
Could this get forwarded on to another more appropriate maling list?

Confirmed on GHC and GHCi 6.6 and 6.8,

Graphics.Rendering.OpenGL.GL.genObjectNames n is dying if I ask it to
return an IO :: [DisplayList]

For an example, just open GHCI and change context to
Graphics.Rendering.OpenGL.GL and do

genObjectNames 4 :: IO [DisplayList]

GHCi will merely die.  Compiled with GHC, I'm simply running out of
memory.  It eats RAM indefinitely.

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


Re: [Haskell-cafe] Random Monad

2008-03-24 Thread Henning Thielemann


On Mon, 24 Mar 2008, Matthew Pocock wrote:


Who currently maintains the Random monad code? I have some patches to
contribute.


Do you refer to the code on the wiki?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Haddock Help Required

2008-03-24 Thread David Waern
2008/3/24, Dominic Steinitz <[EMAIL PROTECTED]>:
> What should I be using for the file name for the read-interface option
>  in haddock?

You must use a file that is on your own hard drive and that is
generated with version 2.0 of Haddock, since that is what you're
using. The interface file format was changed in Haddock 2.0 due its
use of GHC data types, so you can't use 0.x interface files.

You need to generate base.haddock with Haddock 2.0. One way to do
that, is to make sure Haddock 2.0 is installed, then get the GHC 6.8.2
sources (with core libs) and build that with Haddock docs enabled.

Hope this helps,
David
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Random Monad

2008-03-24 Thread Matthew Pocock
On Monday 24 March 2008, Henning Thielemann wrote:
> On Mon, 24 Mar 2008, Matthew Pocock wrote:
> > Who currently maintains the Random monad code? I have some patches to
> > contribute.
>
> Do you refer to the code on the wiki?

No, to the code in darcs at http://code.haskell.org/monadrandom

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


Re: [Haskell-cafe] ghc warn-unused-imports

2008-03-24 Thread Henning Thielemann


On Mon, 24 Mar 2008, Evan Laforge wrote:


So it appears that GHC will warn about "unused" imports when you
import qualified if you could have gotten the symbol from somewhere
else.  For instance, if you write:

import qualified Control.Monad.Trans as Trans
import qualified Control.Monad.Writer as Writer

and use "Trans.lift", it will complain because you could have used
"Writer.lift".


I think, it's a known issue:
  http://hackage.haskell.org/trac/ghc/ticket/1148
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] SoC project: Python-Haskell bridge - request for feedback

2008-03-24 Thread Michał Janeczek
Hi,

I am a student interested in participating in this year's SoC.
At http://tsk.ch.uj.edu.pl/~janeczek/socapp.html (and also below
in this email) you can find a draft of my project proposal.

I'd like to ask you to comment on it, especially the deliverables
part. Are you interested in such a project, and if yes, what features
would be most important to you? Is anything missing, or should
something get more priority or attention?

Regards,
Michal


Python-Haskell bridge
=

Description
---

This project will seek to provide a comprehensive, high level (and thus
easy to use) binding between Haskell and Python programming languages.
This will allow using libraries of either side from each language.


Benefits for Python
---

* Robust, high assurance components

It might be beneficial to implement safety-critical components
in a strongly, statically typed language, using Python to keep
them together. Cryptography or authentication modules can be
an example.

* Performance improvements for speed-critical code

Haskell compiled to native code is typically an order of magnitude
faster than Python. Aside from that, advanced language features
(such as multicore parallel runtime, very lightweight threads
and software transactional memory) further serve in improving the
performance. Haskell could become a safe, high level alternative
to commonly used C extensions.

* Access to sophisticated libraries

While its set of libraries is not as comprehensive as that of
Python, Haskell can still offer some well tested, efficient
libraries. Examples might be rich parser combinator libraries
(like Parsec) and persistent, functional data structures.
QuickCheck testing library could also be used to drive analysis
of Python code.


Benefits for Haskell


The project would benefit Haskell by providing it with access to
an impressive suite of libraries. It also has a potential to help
Haskell adoption, by mitigating risk of using Haskell in a project.


Deliverables


* A low level library to access Python objects from Haskell

* A set of low level functions to convert built-in data types
  between Haskell and Python (strings, numbers, lists,
  dictionaries, functions, generators etc.)

* A higher level library allowing easy (transparent) access to
  Python functions from Haskell, and wrapping Haskell functions
  for Python to access

* A way to easily derive conversion functions for user-defined
  data types/objects. Functions derived in such a way should
  work well with both low level and high level access libraries

* Documentation and a set of examples for all of above


Optional goals
--

These are of lower priority, and might require a fair amount of work.
I would like to implement most of them, if technically feasible. If
they don't fit into Summer of Code timeframe, I am planning to finish
afterwards.

* A Python module for accessing functions from Haskell modules without
  manual wrapping (such wrapping should be already easy thanks to the
  high level library). It'd be accomplished through GHC api - if it
  allows it. The Haskell side of the high level library will already
  support such mode of operation

* Extend and refactor the code, to make it support other similar
  dynamic languages. This is a lot of work, and definitely out of
  the scope of Summer of Code project, but some design decisions
  may be influenced by this.


Related projects


They (and quite possibly some others) will be referenced for ideas.

* MissingPy

Provides a one way, low level binding to Python. Some of the code
can be possibly reused, especially data conversion functions. It
doesn't seem to export all features, in particular function
callbacks are not supported

* HaXR

XML-RPC binding for Haskell. It could provide inspiration for
reconciling Haskell and Python type systems, resulting in a
friendly interface

* rocaml

A binding between Ruby and OCaml
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] SoC project: Python-Haskell bridge - request for feedback

2008-03-24 Thread Bulat Ziganshin
Hello Michal,

Monday, March 24, 2008, 11:38:07 PM, you wrote:

> Python-Haskell bridge

seems interesting

> Benefits for Haskell

you forget about ability to use Python as scripting language inside
Haskell programs. look at HsLua library as example of this

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


[Haskell-cafe] Re: Type constraints for class instances

2008-03-24 Thread apfelmus

Krzysztof Skrzętnicki wrote:

class YOrd a where
ycmp :: a -> a -> (a,a)



Unfortunately, the performance of ysort is rather low. I believe that
it is impossible to create any sorting algorithm that uses ycmp
instead of compare, that is faster than O(n^2).


It is possible, the following implementation of  mergesort  is O(n log n) :)

  ysort :: (YOrd a) => [a] -> [a]
  ysort = head . mergeAll . map (:[])
where
mergeAll (x:y:zs) = mergeAll $ merge x y : mergeAll zs
mergeAll xs = xs

merge [] ys = ys
merge (x:xs) ys = merge3 x ys xs

merge3 x [] xs = x  : xs
merge3 x (y:ys) xs = x' : merge3 y' xs ys
where (x',y') = x `ycmp` y


Mergesort works like a tournament and the idea is to introduce

  merge3 :: YOrd a => a -> [a] -> [a] -> [a]

to make the intermediate candidates explicit. In a call

  merge3 x ys zs

, the candidate  x  is pitted against the  head  of  ys . The winner is 
moved to the front and the loser is the new candidate ( ycmp  is enough 
to do that). Furthermore, there is the invariant that  x  became 
candidate by winning over all  xs  (formally:  x <= minimum xs), there 
is no need to pit  x  against them for a second time.



The whole thing is O(n log n) for the usual reasons, the important part 
being that  merge3  is  O(1 + length xs + length ys). The problem with 
your solution was that  merge [gt] (merge xs ys)  could be  O(2 * length 
ys) or something. Both solutions are almost the same because


  merge3 x ys xs  ~  merge [x] (merge xs ys)

, but  merge3  incorporates the additional insight that we don't need to 
pit  x  against the  xs  anymore.



Regards,
apfelmus

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


Re: [Haskell-cafe] Random Monad

2008-03-24 Thread Bryan O'Sullivan
Matthew Pocock wrote:
> On Monday 24 March 2008, Henning Thielemann wrote:
>> On Mon, 24 Mar 2008, Matthew Pocock wrote:
>>> Who currently maintains the Random monad code? I have some patches to
>>> contribute.
>> Do you refer to the code on the wiki?
> 
> No, to the code in darcs at http://code.haskell.org/monadrandom

I believe it's Cale's baby.

http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: deconstruction of the list/backtracking applicative functor?

2008-03-24 Thread apfelmus

Conal Elliott wrote:

Thanks for the reply.  Here's the decomposition I had in mind.  Start with

type List a = Maybe (a, List a)

Rewrite a bit

type List a = Maybe (Id a, List a)

Then make the type *constructor* pairing explicit

type List a = Maybe ((Id :*: List) a)

where

newtype (f :*: g) a = Prod { unProd :: (f a, g a) }

Then make the type-constructor composition explicit

type List = Maybe :. (Id :*: List)

(which isn't legal Haskell, due to the type synonym cycle).  From there use
the Functor and Applicative instances for composition and pairing of type
constructors and for Id.  I think the result is equivalent to ZipList.


Ah, I didn't think of feeding  a  to both  f  and  g  in the product  f 
:* g  . Your argument cheats a bit because of its circularity: assuming 
 List  is an applicative functor, you deduce that  List  is an 
applicative functor. But in this case, the recursion is (co-)inductive, 
so things work out. Here's the formalization:


  -- higher-order functors  g :: (* -> *) -> (* -> *)
  -- (not sure how to do these classes directly in Haskell,
  --  but you know what I want to do here)
  class Functor2 g where
  forall f . Functor f => Functor (g f)
  class Applicative2 g where
  forall f . Applicative f => Applicative (g f)

  -- higher-order composition
  type (f :.. g) h = f :. (g :. h)

  -- fixed points for higher-order functors
  newtype Mu g a = In { out :: g (Mu g) a }

  type List a = Mu ((Maybe :.) :.. (Id :*)) a


  instance Applicative2 g => Applicative (Mu g) where
 pure x = In (pure x)
 (In f) <*> (In x) = In (f <*> g)

This last class instance looks ridiculous of course, but does nothing 
more than use the assertion  Applicative (Mu g)  in its own definition. 
But fortunately, this definition terminates.



Is there some construction simpler than lists
(non-recursive) that introduces cross products?


To clarify my "cross products" question, I mean fs <*> xs = [f x | f <- fs,
x <- xs], as with lists.


I'm not sure how to decouple the notion of cross products from lists. 
Maybe the other characterization of applicative functors sheds some 
light on it: applicative functors  f  can also be defined with the 
following two primitive operations


  pure  :: a -> f a
  cross :: (f a, f b) -> f (a,b)

  f <*> x = fmap eval (cross (f,x))
  where eval (f,x) = f x

Then, the choice

  pure x = repeat x
  [1,2] `cross` [3,4] = [(1,3), (2,4)]

yields zip lists whereas the choice

  pure x = [x]
  [1,2] `cross` [3,4] = [(1,3), (1,4), (2,3), (2,4)]

yields backtracking lists. I'm not sure whether other choices are 
possible too, they probably violate the laws mentioned in chapter 7 of 
the applicative functor paper.



Regards,
apfelmus

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


[Haskell-cafe] Re: Random Monad

2008-03-24 Thread apfelmus

Matthew Pocock wrote:

Who currently maintains the Random monad code?


/me whispers: have a look at 
http://code.haskell.org/monadrandom/MonadRandom.cabal



Regards,
apfelmus

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


[Haskell-cafe] Sorting with a weaker form of Ord (Re: Type constraints for class instances)

2008-03-24 Thread apfelmus

apfelmus wrote:

Krzysztof Skrzętnicki wrote:

class YOrd a where
ycmp :: a -> a -> (a,a)



Unfortunately, the performance of ysort is rather low. I believe that
it is impossible to create any sorting algorithm that uses ycmp
instead of compare, that is faster than O(n^2).


It is possible, the following implementation of  mergesort  is O(n log 
n) :)


merge3 x [] xs = x  : xs
merge3 x (y:ys) xs = x' : merge3 y' xs ys
where (x',y') = x `ycmp` y

invariant that  x  became  candidate by winning over all  xs


Oops,  merge3  clearly violates this invariant since  y'  could be  x . 
So, my previous post is all wrong  λ(>_<)λ .



Regards,
apfelmus

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


Re: [Haskell-cafe] SoC project: Python-Haskell bridge - request for feedback

2008-03-24 Thread Dan Weston

Bulat Ziganshin wrote:

Hello Michal,

Monday, March 24, 2008, 11:38:07 PM, you wrote:


Python-Haskell bridge


seems interesting


This is indeed interesting for those (like me) wanting to introduce 
Haskell stealthily into a Python-based facility: essentially, leave the 
IO monad in Python but invoke non-IO Haskell functions.



Benefits for Haskell


you forget about ability to use Python as scripting language inside
Haskell programs. look at HsLua library as example of this


This is much less interesting for those (like me) who, once in Haskell, 
don't feel the least inclined to go back to Python. Missing libraries in 
Haskell (for my applications) are usually also missing in Python and 
need FFI to some (usually numeric) library written in C/C++ anyway. Why 
do data marshalling twice?


Dan

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


Re[2]: [Haskell-cafe] SoC project: Python-Haskell bridge - request for feedback

2008-03-24 Thread Bulat Ziganshin
Hello Dan,

Tuesday, March 25, 2008, 1:29:51 AM, you wrote:

>> you forget about ability to use Python as scripting language inside
>> Haskell programs. look at HsLua library as example of this

> This is much less interesting for those (like me) who, once in Haskell,
> don't feel the least inclined to go back to Python. Missing libraries in
> Haskell (for my applications) are usually also missing in Python and 
> need FFI to some (usually numeric) library written in C/C++ anyway. Why
> do data marshalling twice?

Python, unlike Haskell, can be compiled on the fly



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] SoC project: Python-Haskell bridge - request for feedback

2008-03-24 Thread Don Stewart
westondan:
> Bulat Ziganshin wrote:
> >Hello Michal,
> >
> >Monday, March 24, 2008, 11:38:07 PM, you wrote:
> >
> >>Python-Haskell bridge
> >
> >seems interesting
> 
> This is indeed interesting for those (like me) wanting to introduce 
> Haskell stealthily into a Python-based facility: essentially, leave the 
> IO monad in Python but invoke non-IO Haskell functions.

Yes, exactly. The Haskell risk is mitigated, and you can use it exactly
as you wish, for strongly typed, purely functionaly, robust components
held together with Python glue.

And then its easier to sneak Haskell into an existing python toolchain.

> >>Benefits for Haskell
> >
> >you forget about ability to use Python as scripting language inside
> >Haskell programs. look at HsLua library as example of this
> 
> This is much less interesting for those (like me) who, once in Haskell, 
> don't feel the least inclined to go back to Python. Missing libraries in 
> Haskell (for my applications) are usually also missing in Python and 
> need FFI to some (usually numeric) library written in C/C++ anyway. Why 
> do data marshalling twice?

Agreed. There are some libraries we don't have (pygments is one).

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


Re: [Haskell-cafe] Terminating GLUT/GLFW programs

2008-03-24 Thread hjgtuyl


Thanks for the info, but it doesn't solve my problem; I adjusted the path,  
reinstalled GLFW and recompiled the program, but it still does not  
terminate.


Henk-Jan


On Mon, 24 Mar 2008 08:58:05 +0100, Peter Verswyvelen <[EMAIL PROTECTED]>  
wrote:



Hi,

I had a similar (unsolved) problem with GLUT but on my system (Windows  
XP + GHC 6.8.2)  GLFW works fine, exiting is no problem at all.


But when building GLFW, make sure that the GHC gcc-lib directory comes  
*before* the MinGW/Cygwin directory in your PATH environment variable,  
since when linking, the LD.EXE bundled with GHC *must* be used.


Cheers,
Peter

[EMAIL PROTECTED] wrote:


L.S.,

I am trying GLUT and GLFW (on Windows XP, with GHC 6.8.2); the sample  
programs do not terminate when I close the window by clicking on the  
cross in the upper right corner of the window.


The sample program for GLUT is at
   
http://blog.mikael.johanssons.org/archive/2006/09/opengl-programming-in-haskell-a-tutorial-part-1/  
the GLFW program:

  http://haskell.org/haskellwiki/GLFW

I tried in the GLUT program:
  close = exitWith ExitSuccess

  closeCallback $= Just close -- => User error (unknown GLUT call  
getCloseFunc, check for freeglut)


this needs freeglut (not documented); I downloaded freeglut.dll and  
placed it in the windows\system32 directory. The error message remained.


What is needed to let these programs terminate properly?




--
http://functor.bamikanarie.com
http://Van.Tuyl.eu/
--


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


[Haskell-cafe] [GSoC] Parallel Benchmarking and Profiling

2008-03-24 Thread Etienne Laurin
Hello,

I am putting together a student proposal to participate in Google's
Summer of Code with one of the following project ideas.

Parallel programming benchmarking and benchmark suite
- http://hackage.haskell.org/trac/summer-of-code/ticket/1544

Are there open source projects and real world applications that rely
on GHC's parrallel programming primitives and libraries? I have found
many references to LOLITA, but it seems to be old and not available
online. The idea page suggests porting existing benchmark suites such
as PARSEC, but PARSEC is 5G of C code. Most of it seems to come from
existing applications already written in C. It might also be
interesting to automate the discovery of optimal strategies through
empirical data, and to modify the thresholds dynamically.

Parallel profiling tools for GHC
- http://hackage.haskell.org/trac/summer-of-code/ticket/1559

Simon Marlow wrote on the idea page that Gransim was ported to a more
up-to-date GHC. The documentation available on the web seems to be for
GHC 0.29 but it describes many options for logging and visualising the
activity of threads and processors over time. Getting GHC to display
that information on the frontpanel would make a nice project.

Do you have any comments or suggestions?

Thank you,

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


Re: [Haskell-cafe] Equality constraints in type families

2008-03-24 Thread Manuel M T Chakravarty

Claus Reinke:

type family F a :: * -> *

F x y ~ F u v <=> F x ~ F u /\ y ~ v


words, in a type term like (F Int Bool), the two parameters Int  
and  Bool are treated differently.  Int is treated like a parameter  
to a  function (which is what you where expecting), whereas Bool is  
treated  like a parameter to a vanilla data constructor (the part  
you did not  expect).  To highlight this distinction, we call only  
Int a type  index.  Generally, if a type family F has arity n, it's  
first n  parameters are type indicies, the rest are treated like  
the parameters  of any other type constructor.


i'm not sure haskell offers the kind of distinction that we
need to talk about this: 'data constructor' is value-level,
'type constructor' doesn't distinguish between type- vs
data-defined type constructors. i think i know what you
mean, but it confuses me that you use 'data constructor'
(should be data/newtype-defined type constructor?)


Yes, I meant to write "data type constructor".


and 'type constructor' (don't you want to exclude
type-defined type constructors here).


It may have been clearer if I had written data type constructor, but  
then the Haskell 98 report doesn't bother with that either (so I tend  
to be slack about it, too).



  data ConstD x y = ConstD x
  type ConstT x y = x

'ConstD x' and 'ConstT x' have the same kind, that
of type constructors: * -> *. but:

  ConstD x y1 ~ ConstD x y2 => y1 ~ y2

whereas

  forall y1, y2: ConstT x y1 ~ ConstT x y2


But note that

  ConstT x ~ ConstT x

is malformed.


and i thought 'type family' was meant to suggest type
synonym families, in contrast to 'data family'?


My nomenclature is as follows.  The keywords 'type family' introduces  
a "type synonym family" and 'data family' introduces a "data type  
family" (or just "data family").  The term "type family" includes  
both.  This follows Haskell's common use of "type constructor", "type  
synonym constructor", and "data type constructor".



you did notice that i gave an example of how ghc does
not seem to follow that decomposition rule, didn't you?


Yes, but I didn't see why you think GHC does the wrong thing.

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


Re: [Haskell-cafe] Equality constraints in type families

2008-03-24 Thread Manuel M T Chakravarty

Claus Reinke:

type family F a :: * -> *

F x y ~ F u v <=> F x ~ F u /\ y ~ v


why would F x and F u have to be the same functions?
shouldn't it be sufficient for them to have the same result,
when applied to y and v, respectively?
Oh, yes, that is sufficient and exactly what is meant by F x ~ F  
u.   It means, the two can be unified modulo any type instances and  
local  given equalities.


sorry, i don't understand how that could be meant by 'F x ~ F u';
that equality doesn't even refer to any specific point on which these
two need to be equal, so it can only be a point-free higher-order
equality, can't it?

the right-to-left implication is obvious, but the left-to-right
implication seems to say that, for 'F x' and 'F u' to be equal on  
any concrete pair of types 'y' and 'u', they have to be equal on all  
possible types and 'y' and 'u' themselves have to be equal.


You write 'y' and 'u'.  Do you mean 'x' and 'u'?  If so, why do you  
think the implication indicates that x and u need to be the same?


again, i gave a concrete example of how ghc behaves as i would  
expect, not as that decomposition rule would suggest.


Maybe you can explain why you think so.  I didn't understand why you  
think the example is not following the decomposition rule.


Manuel

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


[Haskell-cafe] Monad instance for Data.Set

2008-03-24 Thread oleg

The following code solves exactly the problem of implementing
(restricted) MonadPlus in terms of Data.Set:

http://okmij.org/ftp/Haskell/DoRestrictedM.hs

The code is written to demonstrate the do-notation. We write the
monadic code as usual:

> test1s_do () = do
>   x <- return "a"
>   return $ "b" ++ x

and then instantiate it for Maybe String:

> test1sr_do :: Maybe String
> test1sr_do = unRM $ test1s_do ()
> -- Just "ba"

or for Data.Set:

> test2sr_do :: Set.Set String
> test2sr_do = unSM $ test1s_do ()
> -- fromList ["ba"]

It seems GHC 6.10 will support the do-notation even for the
generalized monads.

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


Re: [Haskell-cafe] Equality constraints in type families

2008-03-24 Thread Manuel M T Chakravarty

Manuel M T Chakravarty:
again, i gave a concrete example of how ghc behaves as i would  
expect, not as that decomposition rule would suggest.


Maybe you can explain why you think so.  I didn't understand why you  
think the example is not following the decomposition rule.


Actually, see

  http://hackage.haskell.org/trac/ghc/ticket/2157#comment:10

Manuel

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