Re: [Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread ajb
G'day all.

I wrote:

> I think you could.  What you need to convince a strict programmer of is
> that laziness gives you modularity.  The Graham Hutton Sudoku solver is
> a nice example, but it'd be cool if we had a similar example that was
> less cheesy than Sudoku.

OK, it's not pretty, but this is diff(1) in 120 lines:

http://andrew.bromage.org/darcs/diff/

It illustrates:

- Lazy evaluation (dynamic programming, lazy I/O, infinite lists)
- Function pipelining with (.) and ($)
- Monads
- Immutable arrays
- List comprehensions
- Algebraic data types
- Type-safe type synonyms (newtype)
- Fancy newtype deriving (Num)
- Smart constructors
- Pattern matching with at-patterns
- Lambda expressions
- Operator sections
- More besides

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


[Haskell-cafe] Re: release plans

2007-04-17 Thread Simon Marlow

Chad Scherrer wrote:
What do you think of this plan?  Are there features/bug-fixes that you 
really

want to see in 6.8?

I'm most anxious for parallel GC - do you think it will be another
release or two before this is a reality?


The parallel GC code is currently sitting dormant waiting for me to go back to 
it and figure out why it isn't performing very well.  Basically I saw little or 
no speedup regardless of how many CPUs I threw at it, which suggests that the 
bottleneck might be the memory system.  I tried a few things - prefetching, for 
example - without much success.


We know this is important, and it remains near the top of the priority list.  At 
this stage, I'd say it's unlikely we'll have parallel GC in 6.8, though.


Cheers,
Simon

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


Re: [Haskell-cafe] Zero-arity tests in QuickCheck and displaying expected result

2007-04-17 Thread Ketil Malde
On Mon, 2007-04-16 at 22:17 +0100, Joel Reymont wrote:

> On Apr 16, 2007, at 10:11 PM, Lennart Augustsson wrote:

>> Why can't you just do 'f 1 2 3 == (4, 5, 6, 7)' to test f?

> That's what HUnit does but it's enticing to be able to standardize on  
> QuickCheck for all of your testing.

Prelude Test.QuickCheck> let prop0 = List.sort [3,2,1] == [1,2,3] in quickCheck 
prop0
OK, passed 100 tests.

-k

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


Re: [Haskell-cafe] Zero-arity tests in QuickCheck and displaying expected result

2007-04-17 Thread Joel Reymont


On Apr 17, 2007, at 9:31 AM, Ketil Malde wrote:

Prelude Test.QuickCheck> let prop0 = List.sort [3,2,1] == [1,2,3]  
in quickCheck prop0

OK, passed 100 tests.


My point is to be able to see that result generated was X and that it  
did not match expected Y, where both X and Y are printed out.


--
http://wagerlabs.com/





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


[Haskell-cafe] GHC 6.7 and Associated Types

2007-04-17 Thread Maxime Henrion
Hello guys,


I've been documenting myself on associated types, which look like a very
nice way to deal with the problems that arise with multi-parameter type
classes.  As an exercise, I am trying to rewrite the MonadState type
class from the mtl package without functional dependencies.

Here is my (probably very naive) approach :

class MonadState m where
  type StateType m :: *
  get  :: m StateType
  put  :: m StateType -> m ()

As for instances:

instance MonadState (State s) where
  type StateType = s -- this is line 22
  get= State $ \s -> (s, s)
  put s  = State $ \_ -> ((), s)

I think I'm probably doing some very stupid thing and missing important
points.  In any case, here's the error I get :

State.hs:22:19: Not in scope: type variable `s'
Failed, modules loaded: none.

I'd be happy to be explained why this doesn't make sense, and how I
should proceed to implement this correctly.  I have tried various other
approaches with no luck yet.

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


Re: [Haskell-cafe] Efficient use of ByteString and type classes in template system

2007-04-17 Thread Thomas Hartman

Created wiki page

http://haskell.org/haskellwiki/String_Interpolation

and referenced various topics mentioned in this thread, there.

2007/4/16, Donald Bruce Stewart <[EMAIL PROTECTED]>:

johan.tibell:
> Hi Haskell Caf?!
>
> I'm writing a perl/python like string templating system which I plan
> to release soon:
>
> darcs get http://darcs.johantibell.com/template
>
> The goal is to provide simple string templating; no inline code, etc..
> An alternative to printf and ++.

Ok. You might also want to briefly look at the other templating system I
know of in Haskell, this small module by Stefan Wehr,


http://www.cse.unsw.edu.au/~dons/code/icfp05/tests/unit-tests/VariableExpansion.hs

Just a quick thing he did for the ICFP contest, but does indicate one
way to do it (i.e. via pretty printing).

>
> Example usage:
>
> >import qualified Data.ByteString as B
> >import Text.Template
> >
> >helloTemplate = "Hello, $name! Would you like some ${fruit}s?"
> >helloContext = [("name", "Johan"), ("fruit", "banana")]
> >
> >test1 = B.putStrLn $ substitute (B.pack helloTemplate) helloContext
>
> I want to make it perform well, especially when creating a template
> once and then rendering it multiple times. "Compiling" the template is
> a separate step from rendering in this use case:
>
> >compiledTemplate = template $ B.pack helloTemplate
> >
> >test2 = B.putStrLn $ render compiledTemplate helloContext
>
> A template is represented by a list of template fragments, each
> fragment is either a ByteString literal or a variable which is looked
> up in the "context" when rendered.
>
> >data Frag = Lit ByteString | Var ByteString
> >newtype Template = Template [Frag]
>
> This leads me to my first question. Would a lazy ByteString be better
> or worse here? The templates are of limited length. I would say the
> length is usually between one paragraph and a whole HTML page. The
> Template data type already acts a bit like a lazy ByteString since it
> consists of several chunks (although the chunck size is not adjusted
> to the CPU cache size like with the lazy ByteString).

Probably lazy bytestrings are better here, since you get O(n/k) append
cost, rather than O(n).  If most strings are small, it mightn't be
noticeable.

> Currently the context in which a template is rendered is represented
> by a type class.
>
> >class Context c where
> >lookup :: ByteString -> c -> Maybe ByteString
> >
> >instance Context (Map String String) where
> >lookup k c = liftM B.pack (Map.lookup (B.unpack k) c)
> >
> >instance Context (Map ByteString ByteString) where
> >lookup = Map.lookup
> >
> >-- More instance, for [(String, String)], etc.
>
> I added this as a convenience for the user, mainly to work around the
> problem of not having ByteString literals. A typical usage would have
> the keys in the context being literals and the values some variables:

note sure if it is relevant, but:

pack "Foo"

will be converted via rewrite rules to a bytestring literal at compile
time. So there's no overhead for having String literals.

>
> >someContext = Map.fromList [("name", name), ("fruit", fruit)]
>
> I'm not sure if this was a good decision, With this I'm halfway to the
> (in)famous Stringable class and it seems like many smarter people than

Yes, seems a little worrying.

> me have avoided introducing such a class. How will this affect
> performace? Take for example the rendering function:
>
> >render :: Context c => Template -> c -> ByteString
> >render (Template frags) ctx = B.concat $ map (renderFrag ctx) frags
> >
> >renderFrag :: Context c => c -> Frag -> ByteString
> >renderFrag ctx (Lit s) = s
> >renderFrag ctx (Var x) = case Text.Template.lookup x ctx of
> >   Just v  -> v
> >   Nothing -> error $ "Key not found: " ++
> >   (B.unpack x)
>
> How will the type dictionary 'c' hurt performance here? Would
> specializing the function directly in render help?

Hmm. Hard to say: look at the Core code and we will know.

Really though, you'll need some stress test cases to be able to make
resonable conclusions about performance.

>
> >render (Template frags) ctx = B.concat $ map (renderFrag f) frags
> >where f = flip Text.Template.lookup ctx
> >
> >renderFrag f (Var x) = case f x of
>
> I can see the implementation taking one of the following routes:
> - Go full Stringable, including for the Template
> - Revert to Context = Map ByteString ByteString which was the original
> implementation.
> - Some middle road, without MPTC, for example:
> >class Context c where
> >lookup :: ByteString -> c ByteString ByteString -> Maybe ByteString
> This would allow the user to supply some more efficient data type for
> lookup but not change the string type. Having a type class would allow
> me to provide things like the possibility to create a Context from a
> record where each record accessor function would server as key.
> Something like:
>
> >data Person { personN

Re: [Haskell-cafe] unsafeInerleaveIO and randomIO

2007-04-17 Thread Bertram Felgenhauer
Marc Weber wrote:
> stefan has pointed me a nice version:
> 
> Anyway I'm curious why 
> 
> =  ===
> randomInts :: IO [Int]
> randomInts = unsafeInterleaveIO $ 
> sequence $ cycle [unsafeInterleaveIO randomIO]
> =  ===
> 
> doesn't return.

sequence isn't lazy (not in the IO monad at least); it will try to run
to completion, returning an infinite list of (as yet unevaluated, due
to unsafeInterleaveIO) thunks. The construction of that list will never
finish though.

I think you want something like (untested)

> unsafeInterleaveSequence :: [IO a] -> IO [a]
> unsafeInterleaveSequence [] = return []
> unsafeInterleaveSequence (x:xs) =
>  unsafeInterleaveIO $ liftM2 (:) x (unsafeInterleaveSequence xs)
> 
> randomInts = unsafeInterleaveSequence $ repeat randomIO

or maybe (unsafeInterleaveIO randomIO) instead of randomIO.

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


[Haskell-cafe] Re: Type classes and type equality

2007-04-17 Thread Neil Mitchell

Hi Oleg,


> I'm looking for a type class which checks whether two types are the
> same or not.

For the full discussion of various solutions, please see Section 9 and
Appendix D of the HList paper:
http://homepages.cwi.nl/~ralf/HList/paper.pdf


Thanks for pointing that out. As far as I can see, this requires a new
instance declaration for every type? In this sense, it would require
as many Typeable declarations, but have the downside that it isn't
build into any compiler.

I was really hoping for something that requires less work on behalf of the user.

Thanks

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


[Haskell-cafe] Re: Tutorial on Haskell

2007-04-17 Thread apfelmus
[EMAIL PROTECTED] wrote:
> OK, it's not pretty, but this is diff(1) in 120 lines:
> 
> http://andrew.bromage.org/darcs/diff/

(Btw, pairs (Int,Int) are members of the Ix class as well, so there is
no need to generate an array of arrays. You can just pretend that one
array is indexed by pair of Ints

  table =
 array ((0,0),(lxs-1,lys-1))
 [((i,j), cell i j x y) |
 (i,x) <- zip [0..] xs, (j,y) <- zip [0..] ys]

)

Regards,
apfelmus

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


[Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread apfelmus
Maxime Henrion wrote:
> class MonadState m where
>   type StateType m :: *
>   get  :: m StateType
>   put  :: m StateType -> m ()
> 
> As for instances:
> 
> instance MonadState (State s) where
>   type StateType = s -- this is line 22

When defining the type function StateType, you have to give it the
required argument m = State s:

type StateType (State s) = s

>   get= State $ \s -> (s, s)
>   put s  = State $ \_ -> ((), s)

Regards,
apfelmus

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


Re: [Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread Maxime Henrion
apfelmus wrote:
> Maxime Henrion wrote:
> > class MonadState m where
> >   type StateType m :: *
> >   get  :: m StateType
> >   put  :: m StateType -> m ()
> > 
> > As for instances:
> > 
> > instance MonadState (State s) where
> >   type StateType = s -- this is line 22
> 
> When defining the type function StateType, you have to give it the
> required argument m = State s:
> 
> type StateType (State s) = s
> 
> >   get= State $ \s -> (s, s)
> >   put s  = State $ \_ -> ((), s)

I tried that too already, it gives:

State.hs:19:39:
Kind mis-match
Expected kind `k -> *', but `()' has kind `*'
In the type `m ()'
In the type `m StateType -> m ()'
In the class declaration for `MonadState'

Line 19 being the definition of put in the class.

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


[Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread apfelmus
Maxime Henrion wrote:
> apfelmus wrote:
>> Maxime Henrion wrote:
>>> class MonadState m where
>>>   type StateType m :: *
>>>   get  :: m StateType
>>>   put  :: m StateType -> m ()
>>>
>>> As for instances:
>>>
>>> instance MonadState (State s) where
>>>   type StateType = s -- this is line 22
>> When defining the type function StateType, you have to give it the
>> required argument m = State s:
>>
>> type StateType (State s) = s
>>
>>>   get= State $ \s -> (s, s)
>>>   put s  = State $ \_ -> ((), s)
> 
> I tried that too already, it gives:
> 
> State.hs:19:39:
> Kind mis-match
> Expected kind `k -> *', but `()' has kind `*'
> In the type `m ()'
> In the type `m StateType -> m ()'
> In the class declaration for `MonadState'

Ah, oh, I didn't even check whether the types in the class are good. I'm
not sure, but don't you want

  class MonadState m where
 type StateType m :: *
 get  :: m (StateType m)
 put  :: StateType m -> m ()

? Then, the substitutions m = State s and StateType (State s) = s yields
the expected types for put and get:

  get :: (State s) s
  put :: s -> (State s) ()


Regards,
apfelmus

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


[Haskell-cafe] Re: Parallel executing of actions

2007-04-17 Thread Simon Marlow

Mitar wrote:

Hi!

On 4/16/07, Bertram Felgenhauer <[EMAIL PROTECTED]> wrote:

> Since all the threads block on a single MVar how do they run in
> parallel?

The idea is that before the threads block on the MVar, they run their
action x to completion.


The rendering crashes. I will have to precompute the values in threads
someway and then sequentially draw it? Any suggestion how to do that?


I'm guessing this is becuase of the thread-local state used by OpenGL, which is 
the reason we have forkOS.  All your OpenGL calls must be executed by the same 
Haskell thread, and it must be a bound thread (i.e. either the main thread, or a 
thread created with forkOS).


Cheers,
Simon


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


Re: [Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread Maxime Henrion
Simon Peyton-Jones wrote:
> Associated *data* types should work in the HEAD (=6.7).  But associated *type 
> synonyms* do not, I'm afraid. We are actively working on it, but it'll be a 
> couple of months at least I guess.
> 
> You can see the state of play, and description of where we are up to here
> http://hackage.haskell.org/trac/ghc/wiki/TypeFunctions

Ah, it's good to know that it wasn't just me being stupid :-).

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


Re: [Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread Maxime Henrion
apfelmus wrote:
> Maxime Henrion wrote:
> > apfelmus wrote:
> >> Maxime Henrion wrote:
> >>> class MonadState m where
> >>>   type StateType m :: *
> >>>   get  :: m StateType
> >>>   put  :: m StateType -> m ()
> >>>
> >>> As for instances:
> >>>
> >>> instance MonadState (State s) where
> >>>   type StateType = s -- this is line 22
> >> When defining the type function StateType, you have to give it the
> >> required argument m = State s:
> >>
> >> type StateType (State s) = s
> >>
> >>>   get= State $ \s -> (s, s)
> >>>   put s  = State $ \_ -> ((), s)
> > 
> > I tried that too already, it gives:
> > 
> > State.hs:19:39:
> > Kind mis-match
> > Expected kind `k -> *', but `()' has kind `*'
> > In the type `m ()'
> > In the type `m StateType -> m ()'
> > In the class declaration for `MonadState'
> 
> Ah, oh, I didn't even check whether the types in the class are good. I'm
> not sure, but don't you want
> 
>   class MonadState m where
>  type StateType m :: *
>  get  :: m (StateType m)
>  put  :: StateType m -> m ()
>
> ? Then, the substitutions m = State s and StateType (State s) = s yields
> the expected types for put and get:
> 
>   get :: (State s) s
>   put :: s -> (State s) ()

Ah, I tried something like that too, and then I get errors in the
definition of the instance :

State.hs:23:19:
Couldn't match expected type `StateType (State s)'
   against inferred type `s' (a rigid variable)
  `s' is bound by the instance declaration at State.hs:21:27
  Expected type: State s (StateType (State s))
  Inferred type: State s s
In the expression: State $ (\ s -> (s, s))
In the definition of `get': get = State $ (\ s -> (s, s))

State.hs:24:19:
Couldn't match expected type `s' (a rigid variable)
   against inferred type `StateType (State s)'
  `s' is bound by the instance declaration at State.hs:21:27
  Expected type: State s ()
  Inferred type: State (StateType (State s)) ()
In the expression: State $ (\ _ -> ((), s))
In the definition of `put': put s = State $ (\ _ -> ((), s))

I would expect GHC to see that 'State s (StateType (State s))' is the
same as 'State s s', per the definition of StateType.  I'm not sure how
to express get differently so that it matches, and similarly for put.

If I write:

  get= State $ \s -> (StateType (State s), s)

I get:

State.hs:23:34: Not in scope: data constructor `StateType'

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


[Haskell-cafe] Re: Partial parsers in Happy

2007-04-17 Thread Simon Marlow

Juan Carlos Arevalo Baeza wrote:
   More info: I managed to do a hack that works around it, but it is 
clearly not acceptable. Part of the Haskell code generated by Happy 
contains this:


---
-- Accepting the parse

-- If the current token is 0#, it means we've just accepted a partial
-- parse (a %partial parser).  We must ignore the saved token on the top of
-- the stack in this case.
happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
happyReturn1 ans
happyAccept j tk st sts (HappyStk ans _) =
(happyTcHack j (happyTcHack st)) (happyReturn1 ans)

   That looked suspect. There's a "tk" parameter that is summarily 
ignored! So I started mucking with it. ...


You're quite right, Happy does consume an extra token because it always has one 
token of lookahead.  The %partial feature was added mainly so that I could parse 
the header of a module in GHC without parsing the whole module, so I didn't need 
to recover and parse the rest of the module in this case.


By all means fix Happy in whatever way you think is useful, and send me the 
patch.

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


[Haskell-cafe] Re: multithreading speedup

2007-04-17 Thread Simon Marlow

Fawzi Mohamed wrote:


Il giorno Apr 14, 2007, alle ore 2:45 PM, Sebastian Sylvan ha scritto:

I think you should probably consider the extremely lightweight forkIO 
threads as your "work items" and the GHC runtime as your thread pool 
system (it will find out how many threads you want using the RTS 
options and distribute it for you). If you're worried about memory 
efficiency you can tweak the initial stack sizes for threads etc. 
using runtime options.


It's still true that you don't want to fork off trivial computations 
in a separate thread, BUT that's true for manual work item queues as 
well (you'd want each work item to be a substantial amount of 
computation because there is overhead per item). E.g. if you have a 
list you might not want one thread per element (and you wouldn't want 
one work item per element either) if the per element tasks are fairly 
trivial, so you'd first group the list into chunks, and then let each 
chunk be a work item ( i.e. spawn a forkIO thread to process it).


yes, but to build the optimal chunk size one would like to know the 
number of working threads.

So again, any way to know it at runtime? or it is  a bad practice to ask?


There's no way currently, but it would be a useful thing to have.

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


Re: [Haskell-cafe] Efficient use of ByteString and type classes in template system

2007-04-17 Thread Johan Tibell

Great!

I've written some QuickCheck tests now (not commited) so I can start
to swap out the implementation and benchmark it. After I get it to run
fast enough and some nice utility methods (like the possibility of
using records as context) I'll announce a version 1.0.

Johan

On 4/17/07, Thomas Hartman <[EMAIL PROTECTED]> wrote:

Created wiki page

http://haskell.org/haskellwiki/String_Interpolation

and referenced various topics mentioned in this thread, there.

2007/4/16, Donald Bruce Stewart <[EMAIL PROTECTED]>:
> johan.tibell:
> > Hi Haskell Caf?!
> >
> > I'm writing a perl/python like string templating system which I plan
> > to release soon:
> >
> > darcs get http://darcs.johantibell.com/template
> >
> > The goal is to provide simple string templating; no inline code, etc..
> > An alternative to printf and ++.
>
> Ok. You might also want to briefly look at the other templating system I
> know of in Haskell, this small module by Stefan Wehr,
>
> 
http://www.cse.unsw.edu.au/~dons/code/icfp05/tests/unit-tests/VariableExpansion.hs
>
> Just a quick thing he did for the ICFP contest, but does indicate one
> way to do it (i.e. via pretty printing).
>
> >
> > Example usage:
> >
> > >import qualified Data.ByteString as B
> > >import Text.Template
> > >
> > >helloTemplate = "Hello, $name! Would you like some ${fruit}s?"
> > >helloContext = [("name", "Johan"), ("fruit", "banana")]
> > >
> > >test1 = B.putStrLn $ substitute (B.pack helloTemplate) helloContext
> >
> > I want to make it perform well, especially when creating a template
> > once and then rendering it multiple times. "Compiling" the template is
> > a separate step from rendering in this use case:
> >
> > >compiledTemplate = template $ B.pack helloTemplate
> > >
> > >test2 = B.putStrLn $ render compiledTemplate helloContext
> >
> > A template is represented by a list of template fragments, each
> > fragment is either a ByteString literal or a variable which is looked
> > up in the "context" when rendered.
> >
> > >data Frag = Lit ByteString | Var ByteString
> > >newtype Template = Template [Frag]
> >
> > This leads me to my first question. Would a lazy ByteString be better
> > or worse here? The templates are of limited length. I would say the
> > length is usually between one paragraph and a whole HTML page. The
> > Template data type already acts a bit like a lazy ByteString since it
> > consists of several chunks (although the chunck size is not adjusted
> > to the CPU cache size like with the lazy ByteString).
>
> Probably lazy bytestrings are better here, since you get O(n/k) append
> cost, rather than O(n).  If most strings are small, it mightn't be
> noticeable.
>
> > Currently the context in which a template is rendered is represented
> > by a type class.
> >
> > >class Context c where
> > >lookup :: ByteString -> c -> Maybe ByteString
> > >
> > >instance Context (Map String String) where
> > >lookup k c = liftM B.pack (Map.lookup (B.unpack k) c)
> > >
> > >instance Context (Map ByteString ByteString) where
> > >lookup = Map.lookup
> > >
> > >-- More instance, for [(String, String)], etc.
> >
> > I added this as a convenience for the user, mainly to work around the
> > problem of not having ByteString literals. A typical usage would have
> > the keys in the context being literals and the values some variables:
>
> note sure if it is relevant, but:
>
> pack "Foo"
>
> will be converted via rewrite rules to a bytestring literal at compile
> time. So there's no overhead for having String literals.
>
> >
> > >someContext = Map.fromList [("name", name), ("fruit", fruit)]
> >
> > I'm not sure if this was a good decision, With this I'm halfway to the
> > (in)famous Stringable class and it seems like many smarter people than
>
> Yes, seems a little worrying.
>
> > me have avoided introducing such a class. How will this affect
> > performace? Take for example the rendering function:
> >
> > >render :: Context c => Template -> c -> ByteString
> > >render (Template frags) ctx = B.concat $ map (renderFrag ctx) frags
> > >
> > >renderFrag :: Context c => c -> Frag -> ByteString
> > >renderFrag ctx (Lit s) = s
> > >renderFrag ctx (Var x) = case Text.Template.lookup x ctx of
> > >   Just v  -> v
> > >   Nothing -> error $ "Key not found: " ++
> > >   (B.unpack x)
> >
> > How will the type dictionary 'c' hurt performance here? Would
> > specializing the function directly in render help?
>
> Hmm. Hard to say: look at the Core code and we will know.
>
> Really though, you'll need some stress test cases to be able to make
> resonable conclusions about performance.
>
> >
> > >render (Template frags) ctx = B.concat $ map (renderFrag f) frags
> > >where f = flip Text.Template.lookup ctx
> > >
> > >renderFrag f (Var x) = case f x of
> >
> > I can see the implementation taking one of the following routes:
> > - Go full Stringable, including for the Template
> > - Revert 

Re: [Haskell-cafe] >> and sequencing [newbie]

2007-04-17 Thread David Powers

Like point free notation, I worry about what somebody somewhere is doing to
it :)

The existence of a well understood community standard (add a type signature
to your functions and only use monad operators with the laws) helps a lot -
but both pieces are optional.  I suppose the shorter and more declarative
nature of Haskell functions makes it a less urgent point though.


On 4/16/07, Donald Bruce Stewart <[EMAIL PROTECTED]> wrote:


clifford.beshers:
>
>Donald Bruce Stewart wrote:
>
> david:
>
>
>Ah... so the secret is in the hidden variables.  On some
>level I am beginning to fear that Monads resurrect some of
>the scariest aspects of method overriding from my OO
>programming days.  Do you (all) ever find that the ever
>changing nature of >>= makes code hard to read?
>
>
> You always know which monad you're in though, since its in the type.
> And the scary monads aren't terribly common anyway.
>
>
>Also, the monad laws impose a level of sanity that most OO
>frameworks do not, right?

Ah yes, and we have the 3 laws of monads. If you break these , the monad
police will come and lock you up.

-- Don

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


Re: [Haskell-cafe] implementing try for RWST ?

2007-04-17 Thread Chris Kuklewicz
Brandon S. Allbery KF8NH wrote:
> 
> On Apr 17, 2007, at 0:03 , [EMAIL PROTECTED] wrote:
>> eventually run in the IO monad. One may wonder then why do we need
>> RWST transformer, given that the IO monad can implement both the state
> 
> For what it's worth, I got the impression that RWST was an example of a
> complex monad transformer --- not necessarily something useful.
> 

I actually used RWS (not RWST in this case).  The analysis and transformation of
the regular expression parse tree in regex-tdfa is done by execRWS with monad 
type:

> type PM = RWS (Maybe GroupIndex) [Either Tag GroupInfo] ([OP]->[OP],Tag)

And to make it more complicated, some of the operations are via GHC's recursive
'mdo' syntax.  The reader is tracking which capture group we are inside (if any)
and the writer collects two streams of included Tags and capture GroupInfo.  The
state is a difference list of all the OP's and the next available Tag.

I use all of 'tell' 'listens' 'ask' 'local' 'get' 'put'

-- 
Chris

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


Re: [Haskell-cafe] unsafeInerleaveIO and randomIO

2007-04-17 Thread Matthew Brecknell
Bertram Felgenhauer:
> > unsafeInterleaveSequence :: [IO a] -> IO [a]
> > unsafeInterleaveSequence [] = return []
> > unsafeInterleaveSequence (x:xs) =
> >  unsafeInterleaveIO $ liftM2 (:) x (unsafeInterleaveSequence xs)
> > 
> > randomInts = unsafeInterleaveSequence $ repeat randomIO

I took a peek at GHC's Random.hs to get an idea of how "unsafe" this
approach might be. I see that theStdGen is stored in an IORef, and that
newStdGen and getStdGen are implemented in terms of the unsynchronised
getStdGen and setStdGen. I guess this allows a race condition in which
randomIO and friends could return duplicate random numbers in different
threads?

Something like this might be better:

> getStdRandom f = atomicModifyIORef theStdGen (swap . f)
>   where swap (v,g) = (g,v)
> newStdGen = atomicModifyIORef theStdGen split

Now let's see if I can figure out how to submit my first patch...

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


[Haskell-cafe] Re: Export Haskell Libraries

2007-04-17 Thread Simon Marlow

Dan Weston wrote:

In the GHC docs:
http://www.haskell.org/ghc/docs/6.4.1/html/users_guide/sec-ffi-ghc.html#using-own-main 



"There can be multiple calls to hs_init(), but each one should be 
matched by one (and only one) call to hs_exit()[8]."


What exactly happens with nested calls? Is there only one runtime 
created, with a simple counter to know which hs_exit should shut it 
down?


Yes.  But the runtime doesn't currently support restarting (hs_exit() followed 
by hs_init()).


If so, is there a way of having multiple interpreters open safely 
at the same time?


I'm not sure exactly what you mean by "multiple interpreters".  The runtime is 
only designed to support a single instance of itself (it uses global static 
storage everywhere).


Or does each hs_init() create a new separate concurrent runtime (the 
preferable alternative)?


Nope, see above.  To do that you'd need a "runtime handle" returned by hs_init() 
and passed to every foreign exported function, somehow.



And what is the cost of creating and destructing the GHC runtime anyway?


Not much.

Can the Haskell interpreter be in a Linux shared-object library, so long 
as I make sure to call hs_init() after loading and hs_exit() before 
unloading it? My experiments so far show this working flawlessly, but I 
vaguely remember an e-mail thread saying GHC couldn't be linked in 
dynamically.


Perhaps, although the shared library won't really be shared - it'll be linked in 
place each time you use it, because we don't currently have support for PIC 
everywhere (well, we have partial support and there's a SoC project to finish it 
off).


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


RE: [Haskell-cafe] Re: GHC 6.7 and Associated Types

2007-04-17 Thread Simon Peyton-Jones
Associated *data* types should work in the HEAD (=6.7).  But associated *type 
synonyms* do not, I'm afraid. We are actively working on it, but it'll be a 
couple of months at least I guess.

You can see the state of play, and description of where we are up to here
http://hackage.haskell.org/trac/ghc/wiki/TypeFunctions

Simon

| -Original Message-
| From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Maxime
| Henrion
| Sent: 17 April 2007 13:27
| To: apfelmus
| Cc: haskell-cafe@haskell.org
| Subject: Re: [Haskell-cafe] Re: GHC 6.7 and Associated Types
|
| apfelmus wrote:
| > Maxime Henrion wrote:
| > > apfelmus wrote:
| > >> Maxime Henrion wrote:
| > >>> class MonadState m where
| > >>>   type StateType m :: *
| > >>>   get  :: m StateType
| > >>>   put  :: m StateType -> m ()
| > >>>
| > >>> As for instances:
| > >>>
| > >>> instance MonadState (State s) where
| > >>>   type StateType = s -- this is line 22
| > >> When defining the type function StateType, you have to give it the
| > >> required argument m = State s:
| > >>
| > >> type StateType (State s) = s
| > >>
| > >>>   get= State $ \s -> (s, s)
| > >>>   put s  = State $ \_ -> ((), s)
| > >
| > > I tried that too already, it gives:
| > >
| > > State.hs:19:39:
| > > Kind mis-match
| > > Expected kind `k -> *', but `()' has kind `*'
| > > In the type `m ()'
| > > In the type `m StateType -> m ()'
| > > In the class declaration for `MonadState'
| >
| > Ah, oh, I didn't even check whether the types in the class are good. I'm
| > not sure, but don't you want
| >
| >   class MonadState m where
| >  type StateType m :: *
| >  get  :: m (StateType m)
| >  put  :: StateType m -> m ()
| >
| > ? Then, the substitutions m = State s and StateType (State s) = s yields
| > the expected types for put and get:
| >
| >   get :: (State s) s
| >   put :: s -> (State s) ()
|
| Ah, I tried something like that too, and then I get errors in the
| definition of the instance :
|
| State.hs:23:19:
| Couldn't match expected type `StateType (State s)'
|against inferred type `s' (a rigid variable)
|   `s' is bound by the instance declaration at State.hs:21:27
|   Expected type: State s (StateType (State s))
|   Inferred type: State s s
| In the expression: State $ (\ s -> (s, s))
| In the definition of `get': get = State $ (\ s -> (s, s))
|
| State.hs:24:19:
| Couldn't match expected type `s' (a rigid variable)
|against inferred type `StateType (State s)'
|   `s' is bound by the instance declaration at State.hs:21:27
|   Expected type: State s ()
|   Inferred type: State (StateType (State s)) ()
| In the expression: State $ (\ _ -> ((), s))
| In the definition of `put': put s = State $ (\ _ -> ((), s))
|
| I would expect GHC to see that 'State s (StateType (State s))' is the
| same as 'State s s', per the definition of StateType.  I'm not sure how
| to express get differently so that it matches, and similarly for put.
|
| If I write:
|
|   get= State $ \s -> (StateType (State s), s)
|
| I get:
|
| State.hs:23:34: Not in scope: data constructor `StateType'
|
| Thanks,
| Maxime
| ___
| 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] question about Data.Binary and Double instance

2007-04-17 Thread David Roundy
Hi all,

I'm wondering what exactly inspired the decode/encodeFloat implementation
for Data.Binary? It seems to me like it'd be much better to use a standard
format like IEEE, which would also be much more efficient, since as far as
I know, on every implementation a Double and a CDouble are identical.

Are there any suggestions how I could use Data.Binary to actually read a
binary file full of Doubles? Should I just use the Array interface, and
forget laziness and hopes of handling different-endian machines? Or is
there some way to reasonably do this using Data.Binary?
-- 
David Roundy
Department of Physics
Oregon State University
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Parallel executing of actions

2007-04-17 Thread Sebastian Sylvan

On 4/16/07, Mitar <[EMAIL PROTECTED]> wrote:


Hi!

On 4/16/07, Bertram Felgenhauer <[EMAIL PROTECTED]>
wrote:
> > Since all the threads block on a single MVar how do they run in
> > parallel?
>
> The idea is that before the threads block on the MVar, they run their
> action x to completion.

The rendering crashes. I will have to precompute the values in threads
someway and then sequentially draw it? Any suggestion how to do that?



Rendering into the same rendering context from multiple threads at the same
time is a baaad idea.

I would suggest chunking up your work (assuming that calculating your colour
is indeed a significant amount of work) in tiles or something, then fork off
a thread for each of them, sticking the final colours in a Chan. Then you
have another thread just pick tiles off the Chan and copy the results to the
frame buffer.

--
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] question about Data.Binary and Double instance

2007-04-17 Thread Brian Alliet
On Tue, Apr 17, 2007 at 10:32:02AM -0700, David Roundy wrote:
> I'm wondering what exactly inspired the decode/encodeFloat implementation

I kind of wondered the same thing when I first saw it. Looks like it
was just the quickest way to get it going.

> Are there any suggestions how I could use Data.Binary to actually read a
> binary file full of Doubles? Should I just use the Array interface, and
> forget laziness and hopes of handling different-endian machines? Or is
> there some way to reasonably do this using Data.Binary?

I threw together a somewhat portable "longBitsToDouble" function a
while ago for another project.

http://darcs.brianweb.net/hsutils/src/Brianweb/Data/Float.lhs

It doesn't depend on any unsafe operations or external ffi functions
but it will only works on IEEE 754 machines (but that includes every
machine ghc run on). It might not be fast enough for you though as it
still goes via Integer in the conversion.

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


Re: [Haskell-cafe] question about Data.Binary and Double instance

2007-04-17 Thread David Roundy
On Tue, Apr 17, 2007 at 02:50:14PM -0400, Brian Alliet wrote:
> I threw together a somewhat portable "longBitsToDouble" function a
> while ago for another project.
> 
> http://darcs.brianweb.net/hsutils/src/Brianweb/Data/Float.lhs
> 
> It doesn't depend on any unsafe operations or external ffi functions
> but it will only works on IEEE 754 machines (but that includes every
> machine ghc run on). It might not be fast enough for you though as it
> still goes via Integer in the conversion.

It seems like this conversion shouldn't take any time at all, and we ought
to be able to just copy the memory right over, or just do a unsafeCoerce#
(which is admittedly unsafe, but in practice between a Word64 and a Double
should be fine)...
-- 
David Roundy
Department of Physics
Oregon State University
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] question about Data.Binary and Double instance

2007-04-17 Thread Brian Alliet
On Tue, Apr 17, 2007 at 12:18:29PM -0700, David Roundy wrote:
> > machine ghc run on). It might not be fast enough for you though as it
> > still goes via Integer in the conversion.
> 
> It seems like this conversion shouldn't take any time at all, and we ought
> to be able to just copy the memory right over, or just do a unsafeCoerce#
> (which is admittedly unsafe, but in practice between a Word64 and a Double
> should be fine)...

True. I only wrote it that way so I wouldn't have to muck with low
level details between haskell implementations.

The right thing to do for Data.Binary is probably to just peek the
Double off the ForeignPtr in the ByteString, no sense going through
Word64 at all.

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


[Haskell-cafe] Re: Type classes and type equality

2007-04-17 Thread oleg

> Thanks for pointing that out. As far as I can see, this requires a new
> instance declaration for every type?

I guess it depends on how many extensions one may wish to enable. At
the very least we need multi-parameter type classes with functional
dependencies (because that's what TypeEq is in any case).

- If we permit no other extension, we need N^2 instances to compare N
classes for equality (basically, for each type we should say how it
compares to the others). This is not practical except in very limited
circumstances.

- If we permit undecidable instances, one may assign numerals to
types. This gives us total order and hence comparison on types.
In this approach, we only need N instances to cover N types. This is
still better than Typeable because the equality is decided and can be
acted upon at compile time.

- If we permit overlapping instances extension, then a few lines of code
decide equality for all existing and future types:

class  TypeEq x y b | x y -> b
instance TypeEq x x HTrue
instance TypeCast HFalse b => TypeEq x y b

Please see 
http://www.haskell.org/pipermail/haskell-cafe/2006-November/019705.html
for some less conventional application, with the complete code.

> I was really hoping for something that requires less work on behalf of
> the user.

The latter approach may be suitable then. It requires no work on
behalf of the user at all: the type comparison is universal.

http://darcs.haskell.org/HList

There is also an issue of ground vs unground types. All the approaches
above can decide equality for sufficiently grounded types. That is,
two types can be decided equal only if they are ground. The
disequality may be decided for partially ground types. If the types
are non-ground, the TypeEq constraint flows up, to be resolved when
the types are sufficiently instantiated. It is possible to decide
equality of non-ground types and even naked type variables. That is a
separate discussion.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Parallel executing of actions

2007-04-17 Thread Mitar

Hi!

On 4/17/07, Sebastian Sylvan <[EMAIL PROTECTED]> wrote:

I would suggest chunking up your work (assuming that calculating your colour
is indeed a significant amount of work) in tiles or something, then fork off
a thread for each of them, sticking the final colours in a Chan. Then you
have another thread just pick tiles off the Chan and copy the results to the
frame buffer.


Is there some completely different and maybe better way of rendering
the image? Because I noticed that in fact I do not really have any use
for OpenGL (I draw pixels on a 2D plane). So maybe is there some other
portable way of rendering a 2D image, which would be easier to
parallelize? Maybe of precomputing the image in completely functional
way and then only draw the whole image at once to the screen buffer
(now I call OpenGL draw pixel function for every pixel I want to draw
- this is probably not the best way).


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


Re: [Haskell-cafe] ... - what about introducing LazyIO ?

2007-04-17 Thread Marc Weber
> sequence isn't lazy (not in the IO monad at least); it will try to run
> to completion, returning an infinite list of (as yet unevaluated, due

I should have learned that lesson already..

This is the second time I could have needed a lazy IO monad version..
Does something like this already exist?

= LazyIO test 
module Main where
import Control.Monad
import System.IO.Unsafe

import Random

data LazyIO a = LazyIO (IO a)

-- conversion 
unLazy :: LazyIO a -> IO a
unLazy (LazyIO a) = a

-- my lazy monad
instance Monad LazyIO where
  return a = LazyIO (return a)
  (LazyIO m) >>= k = LazyIO $ unsafeInterleaveIO $ m >>= unLazy . k

main = do
  print "LazyIO test"
  putStrLn "this should work : (LazyIO version)"
  randoms <-  unLazy . sequence . cycle $ [ LazyIO (randomIO :: IO Int) ]
  print $ take 5 randoms
  putStrLn "this should hang : (IO version)"
  randoms <-  sequence . cycle $ [ randomIO :: IO Int ]
  print $ take 5 randoms
= LazyIO test 

compare this (adding unLazy and LazyIO) to reimplementing 
sequence, mapM, ...
> > unsafeInterleaveSequence :: [IO a] -> IO [a]
> > unsafeInterleaveSequence [] = return []
> > unsafeInterleaveSequence (x:xs) =
> >  unsafeInterleaveIO $ liftM2 (:) x (unsafeInterleaveSequence xs)

I really start to love haskell :)
Marc
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread R Hayes


In my opinion, one of the things that makes Haskell difficult to  
learn is the value system.  I'm not referring to "pure" vs.  
"impure".  Instead, I am referring to the beliefs and principles held  
by the Haskell community that are not shared with most of the  
programming world.  Principles like "It is valuable to be able to  
reason about programs rigorously".  This is foreign to most  
developers.  When they get to the section of a Haskell book that  
starts talking about this, their eyes glaze over and they skip over  
to the "more practical stuff".  By the time they get to Monads  
they're ready to rip their eyes out because the book is "too  
theoretical" or "too academic".


One of the truly powerful things about Haskell is the short distance  
between theory and practicality.  The problem is how to demonstrate  
this convincingly.  The ability to prove a program's correctness is  
regularly trotted out for show in this arena (or at least the lighter- 
weight claim that programs that compile usually work).  I don't think  
that most developers (and certainly not the OSCON crowd) are ready to  
drink that kool-aid.  They *enjoy* debugging and are tired of the  
"static" vs. "dynamic" debate.  But the ability to reason about  
programs has borne fruit that I *do* think they will appreciate.   
Because many of them care about performance.


I don't need to tell the subscribers to this list that the shockingly  
good performance of code written using Data.ByteString.Lazy is a  
direct result of being able to reason about programs.  Obviously, the  
details of the fusion techniques are outside the scope of any  
introductory tutorial.  But I think it would be useful to quickly  
implement a "wc -l" equivalent and explain why it's faster than the  
simple C equivalent.  Nothing overly deep, just draw the line from  
"reasoning about programs" to "fusion" and on to "amazing  
performance"  (capping it off with the fact the the fusion  
optimization is in the *Library*, not baked in to the compiler).  At  
a minimum, it shows that being able to reason about programs  
rigorously can have a payoff in a currency that they value.


R Hayes
rfhayes<>@reillyhayes.com



On Apr 16, 2007, at 1:34 AM, Simon Peyton-Jones wrote:


Friends

I have agreed to give a 3-hr tutorial on Haskell at the Open Source  
Convention 2007

http://conferences.oreillynet.com/os2007/

I'm quite excited about this: it is a great opportunity to expose  
Haskell to a bunch of smart folk, many of whom won't know much  
about Haskell.  My guess is that they'll be Linux/Perl/Ruby types,  
and they'll be practitioners rather than pointy-headed academics.


One possibility is to do a tutorial along the lines of "here's how  
to reverse a list", "here's what a type is" etc; you know the kind  
of thing.  But instead, I'd prefer to show them programs that they  
might consider *useful* rather than cute, and introduce the  
language along the way, as it were.


So this message is to ask you for your advice.  Many of you are  
exactly the kind of folk that come to OSCON --- except that you  
know Haskell.   So help me out:


Suggest concrete examples of programs that are
* small
* useful
* demonstrate Haskell's power
* preferably something that might be a bit
tricky in another language

For example, a possible unifying theme would be this:
http://haskell.org/haskellwiki/Simple_unix_tools

Another might be Don's cpu-scaling example
http://cgi.cse.unsw.edu.au/~dons/blog/2007/03/10

But there must be lots of others.  For example, there are lots in  
the blog entries that Don collects for the Haskell Weekly  
Newsletter.  But I'd like to use you as a filter: tell me your  
favourites, the examples you find compelling.  (It doesn't have to  
be *your* program... a URL to a great blog entry is just fine.)  Of  
course I'll give credit to the author.


Remember, the goal is _not_ "explain monads".  It's "Haskell is a  
great way to Get The Job Done".


Thanks!

Simon
___
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: Tutorial on Haskell

2007-04-17 Thread ajb
G'day all.

Quoting apfelmus <[EMAIL PROTECTED]>:

> (Btw, pairs (Int,Int) are members of the Ix class as well, so there is
> no need to generate an array of arrays.

I know.  It originally used lists, which is why it looks like that.  I
only allowed myself half an hour to write & debug this, so what you see
is what you get.

BTW, the fact that it's possible to write a working diff from scratch
in half an hour and in only 100 or so lines is remarkable, I think.
And it's the combination of all of those Haskell features that I
mentioned which makes it possible.

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


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread David Brown
R Hayes wrote:

> They *enjoy* debugging ...

I have to say this is one of the best things I've found for catching
bad programmers during interviews, no matter what kind of system it is
for.  I learned this the hard way after watching someone who never
really understood her program, but just kept thwacking at it with a
debugger until it at least partially worked.

Dave

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


[Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread dfeustel
What would be really useful is a Haskell Cookbook that
shows how to do in Haskell things that are so easily
done in imperative languages. How to solve simultaneous
equations using Gaussian elimination comes to mind.

Lots of examples would be great.

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


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread R Hayes




On Apr 17, 2007, at 4:46 PM, David Brown wrote:


R Hayes wrote:


They *enjoy* debugging ...


I have to say this is one of the best things I've found for catching
bad programmers during interviews, no matter what kind of system it is
for.  I learned this the hard way after watching someone who never
really understood her program, but just kept thwacking at it with a
debugger until it at least partially worked.


I've seen this too, but I would not use the word debugging to  
describe it.  I don't think I agree that enjoying debugging is a  
sufficient symptom for diagnosing this condition.  There are many  
people that love the puzzle-box aspect of debugging.  Some of them  
are very talented developers.


R Hayes
rfhayes<>@reillyhayes.com






Dave



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


[Haskell-cafe] Re: Type classes and type equality

2007-04-17 Thread Neil Mitchell

Hi


I guess it depends on how many extensions one may wish to enable. At
the very least we need multi-parameter type classes with functional
dependencies (because that's what TypeEq is in any case).

- If we permit no other extension, we need N^2 instances to compare N
classes for equality (basically, for each type we should say how it
compares to the others). This is not practical except in very limited
circumstances.

- If we permit undecidable instances, one may assign numerals to
types. This gives us total order and hence comparison on types.
In this approach, we only need N instances to cover N types. This is
still better than Typeable because the equality is decided and can be
acted upon at compile time.


In my particular case whether I act at compile time or run time is
unimportant, but obviously this is an important advantage in general.
Unfortunately a cost of one instance per type is still higher than I'd
like to pay :-)


- If we permit overlapping instances extension, then a few lines of code
decide equality for all existing and future types:

class  TypeEq x y b | x y -> b
instance TypeEq x x HTrue
instance TypeCast HFalse b => TypeEq x y b


This is exactly what I was after, but it doesn't seem to work in Hugs
- even with overlapping instances and unsafe overlapping instances
turned on.

*** This instance: TypeEq a b c
*** Conflicts with   : TypeEq a a HTrue
*** For class: TypeEq a b c
*** Under dependency : a b -> c

Is there any way to modify this to allow it to work under Hugs as well?

Thanks very much for your help,

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


Re: [Haskell-cafe] Parallel executing of actions

2007-04-17 Thread Juan Carlos Arevalo Baeza
   I may be talking out of my other end here, but... if you want something  
like parMap to calculate all the pixels in parallel, then... can't you use  
parMap itself?


   Something like:

weirdParMap action = sequence_ . map action . parMap (id $!)

   This evaluates all the elements of the list using parMap (the expensive  
part, right?), and then sequentially applies the action on the current  
thread.


JCAB

On Sun, 15 Apr 2007 12:56:02 -0700, Mitar <[EMAIL PROTECTED]> wrote:


Hi!

On 4/15/07, Spencer Janssen <[EMAIL PROTECTED]> wrote:

This version will fork a new thread for each action:

\begin{code}
import Control.Concurrent
import Control.Monad

parSequence_ xs = do
m <- newEmptyMVar
mapM_ (\x -> forkIO x >> putMVar m ()) xs
replicateM_ (length xs) (takeMVar m)

parMapM_ f xs = parSequence_ $ map f xs
\end{code}


OpenGL bindings successfully crash. The functional calculations in f
should be done in parallel, but those few OpenGL actions should still
be done sequentially. I am attaching the code in question. It is a
simple voxel raycasting engine.

(Any suggestions on other memory/performance improvements are more
than welcome.)


Mitar



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


Re: [Haskell-cafe] Parallel executing of actions

2007-04-17 Thread Stefan O'Rear
On Tue, Apr 17, 2007 at 05:49:11PM -0700, Juan Carlos Arevalo Baeza wrote:
>I may be talking out of my other end here, but... if you want something  
> like parMap to calculate all the pixels in parallel, then... can't you use  
> parMap itself?
> 
>Something like:
> 
> weirdParMap action = sequence_ . map action . parMap (id $!)
> 
>This evaluates all the elements of the list using parMap (the expensive  
> part, right?), and then sequentially applies the action on the current  
> thread.

You are.  I'm devoting most of my brain cells to automatic deriving of
TTypeable atm, but note that id is already strict, so (id $!) is
equivalent to id. 

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


Re: [Haskell-cafe] Re: Type classes and type equality

2007-04-17 Thread Stefan O'Rear
On Wed, Apr 18, 2007 at 01:47:04AM +0100, Neil Mitchell wrote:
> >- If we permit undecidable instances, one may assign numerals to
> >types. This gives us total order and hence comparison on types.
> >In this approach, we only need N instances to cover N types. This is
> >still better than Typeable because the equality is decided and can be
> >acted upon at compile time.
> 
> In my particular case whether I act at compile time or run time is
> unimportant, but obviously this is an important advantage in general.
> Unfortunately a cost of one instance per type is still higher than I'd
> like to pay :-)

Now, it requires one line of code:

{-# OPTIONS_DERIVE --derive=TTypeable #-}

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


Re: [Haskell-cafe] question about Data.Binary and Double instance

2007-04-17 Thread Duncan Coutts
On Tue, 2007-04-17 at 10:32 -0700, David Roundy wrote:
> Hi all,
> 
> I'm wondering what exactly inspired the decode/encodeFloat implementation
> for Data.Binary? It seems to me like it'd be much better to use a standard
> format like IEEE, which would also be much more efficient, since as far as
> I know, on every implementation a Double and a CDouble are identical.
> 
> Are there any suggestions how I could use Data.Binary to actually read a
> binary file full of Doubles? Should I just use the Array interface, and
> forget laziness and hopes of handling different-endian machines? Or is
> there some way to reasonably do this using Data.Binary?

Hi David,

We'd like to use IEEE format as the default Data.Binary serialisation
format for Haskell's Float and Double type, the only thing that makes
this tricky is doing it portably and efficiently.

We can't actually guarantee that we have any IEEE format types
available. The isIEEE will tell you if a particular type is indeed IEEE
but what do we do if isIEEE CDouble = False ?

Perhaps we just don't care about ARM or other arches where GHC runs that
do not use IEEE formats, I don't know. If that were the case we'd say
something like:

instance Binary Double where
  put d = assert (isIEEE (undefined :: Double)) $ do
write (poke d)

If we do care about ARM and the like then we need some way to translate
from the native Double encoding to an IEEE double external format. I
don't know how to do that. I also worry we'll end up with lots of
#ifdefs.

The other problem with doing this efficiently is that we have to worry
about alignment for that poke d operation. If we don't know the
alignment we have to poke into an aligned side buffer and copy over.
Similar issues apply to reading.

I'm currently exploring more design ideas for Data.Binary including how
to deal with alignment. Eliminating unnecessary bounds checks and using
aligned memory operations also significantly improves performance. I can
get up to ~750Mb/s serialisation out of a peak memory bandwidth of
~1750Mb/s, though a Haskell word-writing loop can only get ~850Mb/s.

Duncan

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


Re: [Haskell-cafe] Parallel executing of actions

2007-04-17 Thread Juan Carlos Arevalo Baeza

   :-) Thank you for your kindness. I mean... your frankness.

   I had another issue in that code which clearly shows that I don't know  
how to use parMap or strategies in general. Maybe this is better:


weirdParMap action = sequence_ . map action . parMap rwhnf (\x -> x `seq`  
x)


   or maybe that's overkill and this is sufficient:

weirdParMap action = sequence_ . map action . parMap rwhnf id

   or this:

weirdParMap action list = sequence_ $ map action (list `using` rnf)

   (which I guess would require the appropriate NFData instanbe for the  
pixel type)


   or maybe I still don't know enough about this Parallel Haskell thingy.

   In any case... couldn't something like this be what was needed in the  
OP?


JCAB

On Tue, 17 Apr 2007 17:56:27 -0700, Stefan O'Rear <[EMAIL PROTECTED]> wrote:

On Tue, Apr 17, 2007 at 05:49:11PM -0700, Juan Carlos Arevalo Baeza  
wrote:
   I may be talking out of my other end here, but... if you want  
something
like parMap to calculate all the pixels in parallel, then... can't you  
use

parMap itself?

   Something like:

weirdParMap action = sequence_ . map action . parMap (id $!)

   This evaluates all the elements of the list using parMap (the  
expensive

part, right?), and then sequentially applies the action on the current
thread.


You are.  I'm devoting most of my brain cells to automatic deriving of
TTypeable atm, but note that id is already strict, so (id $!) is
equivalent to id.

Stefan
___
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] question about Data.Binary and Double instance

2007-04-17 Thread Brian Alliet
On Wed, Apr 18, 2007 at 12:34:58PM +1000, Duncan Coutts wrote:
> We'd like to use IEEE format as the default Data.Binary serialisation
> format for Haskell's Float and Double type, the only thing that makes
> this tricky is doing it portably and efficiently.

You should note that your current method of serializing Doubles
(encodeFloat/decodeFloat) isn't portable either as the results of these
functions depend on floatRadix. So using some method that depends on
IEEE representation isn't much worse (might actually be better as you'd
get an error at runtime rather than writing data that could potentially
be read back as garbage).

I think the only way to do this 100% portably is to encode it as a
Rational before serializing.

Also even if someone were to bother to write the code to convert from
an arbitrary floating point rep to IEEE for serialization you'd run the
risk losing information if the hosts floating point rep was more
accurate that IEEE FP.

It seems like it might come down to making a choice between 100%
portable but incompatable with the default serialization mechanisms in
other languages or non-portable (but ok for just about every popular
arch used today) and compatable with other languages.

> Perhaps we just don't care about ARM or other arches where GHC runs that

Are there really any architectures supported by GHC that don't use IEEE
floating point? If so GHC.Float is wrong as isIEEE is always true.

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


Re: [Haskell-cafe] Tutorial on Haskell

2007-04-17 Thread Michael Vanier

R Hayes wrote:





On Apr 17, 2007, at 4:46 PM, David Brown wrote:


R Hayes wrote:


They *enjoy* debugging ...



I have to say this is one of the best things I've found for catching
bad programmers during interviews, no matter what kind of system it is
for.  I learned this the hard way after watching someone who never
really understood her program, but just kept thwacking at it with a
debugger until it at least partially worked.



I've seen this too, but I would not use the word debugging to describe 
it.  I don't think I agree that enjoying debugging is a sufficient 
symptom for diagnosing this condition.  There are many people that 
love the puzzle-box aspect of debugging.  Some of them are very 
talented developers.


R Hayes
rfhayes<>@reillyhayes.com



Dave


I agree with the latter sentiment.  I call the "thwacking at it"
approach "random programming" or "shotgun programming", the latter
suggesting that it's like shooting at the problem randomly until it
dies.  I prefer not having to debug, but when I do have to I find it fun
(up to a point).

Mike



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


[Haskell-cafe] Re: Release plans

2007-04-17 Thread Brandon Michael Moore
On Tue, Apr 17, 2007 at 12:50:48PM +0200, Doaitse Swierstra wrote:
> Just to show what kind of problems we are currently facing. The  
> following type checks in our EHC compiler and in Hugs, but not in the  
> GHC:
> 
> module Test where
> 
> data T s = forall x. T (s -> (x -> s) -> (x, s, Int))
> 
> run :: (forall s . T s) -> Int
> run ts  = case ts of
> T g -> let (x,_, b) =  g x id
>in b

Consider this additional code which also typechecks in Hugs:

v :: forall s . T s
v = T f

f :: s -> ([s] -> s) -> ([s], s, Int)
f v g = let x = [v] in (x, g x, 0)

due to parametricity, run v can't depend on x or g x.
Apparently id has type [x] -> x. Are EHC and Hugs supposed
to support equirecursive types?

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