Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Johan Tibell
Hi John!

On Wed, Feb 20, 2008 at 3:39 PM, John Goerzen [EMAIL PROTECTED] wrote:
  3) Would it make sense to base as much code as possible in the Haskell
core areound ListLike definitions?  Here I think of functions such
as lines and words, which make sense both on [Char] as well as
ByteStrings.

I don't think the examples you gave (i.e. lines and words) make much
sense on ByteStrings. You would have to assume that the sequence of
bytes are in some particular Unicode encoding and thus words and lines
will break if they get passed a ByteString using a different encoding.
I don't think either of those two functions make sense on anything but
sequence of character types like String.

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Duncan Coutts

On Wed, 2008-02-20 at 19:01 -0600, John Goerzen wrote:
 On Wednesday 20 February 2008 5:13:34 pm Duncan Coutts wrote:
  On Wed, 2008-02-20 at 08:39 -0600, John Goerzen wrote:
   * The iconv library works only on lazy ByteStrings, and does not
  handle Strings or strict ByteStrings
 
  There is a very good reason for this. The right solution in this
  particular example is not to overload every internal string operation in
  the iconv lib (which would be far far too slow) but to convert to/from
 
 I guess the first question here is: in general, why?

If one is stitching together coarse grained operations then it doesn't
matter too much that we pass in a dictionary and indirect every
operating through that. When we're using very fine grained operations
the overhead per-operation is more significant. If we do not specialise
to the list type we get all the extra overhead and we loose out on all
the static optimisations. If we do specialise we get N copies of the
code.

Iconv is a weird example because it is calling out to a foreign lib that
requires blocks of elements. A more convincing example might be an xml
parser. I conjecture that it is faster and uses less code to make a
single implementation on the best string representation and convert at
the boundaries than to overload all the operations inside the parser by
the string type. My guess is that a well written xml parser over lazy
bytestring will be about the same speed as one written one over String
*even* if we have to initially convert from a String input and certainly
faster than an xml parser that takes a StringLike dictionary at
runtime. 

So I'm claiming that the single impl with boundary conversion gives us
the best of both worlds, no code bloat due to specialisation and working
with whichever string type you like, by converting it at the beginning
and end. Of course only an experiment can say either way.

 Let's say you were using something like ListLike (or StringLike, see below).  
 If a library used these operations exclusively, you could make it work on 
 most any type of list by simply changing your imports.  (Hide the regular 
 functions from Prelude, and import ListLike).  For types such as ByteStrings 
 or lists, that already have a very rich native implementation of these 
 functions, the native implementation is used.  You should be getting greater 
 compatibility essentially for free.  ListLike is an exhaustive mapping over 
 these native functions.  This would be great for anything from sort 
 algorithms to parsers, etc.  I even have a ListLikeIO typeclass[2] to 
 facilitate this. [2]
 
 Now in your iconv case, you have a special case because you are doing 
 manipulation specifically upon 8-bit binary data.  It may not make sense for 
 you to support a [Char] or even a Char8 ByteString because it does not lend 
 itself to those very well.  You could, perhaps, support a [Word8] as well as 
 a ByteString when using ListLike.  That is, you may have a function like 
 this:
 
 head :: ListLike full Word8 = full - Word8
 
 You could still use this with a ByteString at native speeds, and a [Word8] at 
 its native speed.

Only if we definitely eliminate the type class dictionary statically and
pay the code bloat cost of having several implementations around.

 But this doesn't buy us the ability to use this library interchangably with a 
 Word8-based ByteString and a [Char].  That is a scenario ListLike is not 
 designed to help with.  ListLike is designed to make the container 
 interchangable, but does not address making the contents interchangable.
 
 I think this is what you are pointing out?

Not really. The iconv example would work with any ListLike(withCString)
whose contents are Word8.

  your favourite representation on the edge. So in this case those
  conversions would be pack/unpack or the similar equivalents for strict
  - lazy bytestrings.
 
  If we want it to be generic then we want a class of string like things
  that provides conversions only, not operations.
 
  For example we could export iconv as:
 
  iconv :: StringLike string = Encoding - Encoding - string - string
  iconv to from = (convertStringRep :: Lazy.ByteString - string)
. theRealIconv
. (convertStringRep :: string - Lazy.ByteString)
 
  class StringLike string where
...
 
  convertStringRep :: (StringLike s1, StringLike s2) = s1 - s2
  -- analogous to fromIntegral
 
 ListLike has something along these lines, too: [1]
 
 class StringLike s where
   toString :: s - String
   fromString :: String - s
   lines :: ListLike full s = s - full
   words :: ListLike full s = s - full
   unlines :: ListLike full s = full - s
   unwords :: ListLike full s = full - s
 
 The last four functions are there as a way to provide a universal interface 
 to optimized native functions, where available.  The minimal complete 
 definition is just toString and fromString.
 
 Technically, you could make every function look like:
 
 iconv data = 

Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 10:06 +0100, Johan Tibell wrote:
 Hi John!
 
 On Wed, Feb 20, 2008 at 3:39 PM, John Goerzen [EMAIL PROTECTED] wrote:
   3) Would it make sense to base as much code as possible in the Haskell
 core areound ListLike definitions?  Here I think of functions such
 as lines and words, which make sense both on [Char] as well as
 ByteStrings.
 
 I don't think the examples you gave (i.e. lines and words) make much
 sense on ByteStrings. You would have to assume that the sequence of
 bytes are in some particular Unicode encoding and thus words and lines
 will break if they get passed a ByteString using a different encoding.
 I don't think either of those two functions make sense on anything but
 sequence of character types like String.

That's exactly what the Data.ByteString[.Lazy].Char8 modules provide, a
Char8 view of a Bytestring. Those modules provide functions like words,
lines etc that assume an ASCII compatible 8bit encoding.

One day we'll have a separate type that does Unicode with a similar fast
packed representation.

Duncan

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 05:07 +0100, Henning Thielemann wrote:

 As long as it is only about speeding up list processing, one might also
 consider this as optimization problem. This could be handled without
 adapting much List based code in applications to a generic sequence class.
 That is, if I convert the result of a composition of list functions to a
 lazy ByteString, I tell the compiler that I don't need full laziness and
 the compiler can optimize, say
ByteString.fromList . List.func1 . List.func2 . List.build
  to
ByteString.func1 . ByteString.func2 . ByteString.build
  or even better
ByteString.fusedFunc1Func2Build
  by some clever fusion framework. I think that a type class is easier to
 justify if it unifies data structures that are more different than just
 providing the same API with different efficiency.

This is orthogonal I think. This could be done with stream fusion
without any common class. It requires that the types use stream fusion,
then conversions between types (eg list/array) could be done with
streams too.

Duncan

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Duncan Coutts

On Wed, 2008-02-20 at 16:43 -0800, Conal Elliott wrote:
 There was a chat today on #haskell  (15:08 to 16:10) about evolving
 haddock.  I'd like to get comments.
 
 The goal is to get the full functionality of a general purpose,
 programmer-friendly markup language like markdown.  One example is
 image embedding.  Another is friendly links (no visible URL).  

To be honest I like the fact that haddock's markup is really simple and
perhaps somewhat restrictive. A great improvement though would be to
make it easy to extract the docs from haddock in a nice format so that
the could be re-used in other contexts rather than just generating html
api documentation. Haddock does have support for multiple backends,
someone just needs to define and write a generic backend that spits out
the info that haddock gathers in a machine readable format.

Then people could feed that into whatever other system they like.

 Since the old and new doc languages would be quite incompatible, we
 might want to specify in a .cabal file which language to use. 

That's the main thing that worries me. Currently we have the rather nice
situation that we have a single standardised markup format that everyone
understands.

So I very much support the idea of making the markup easier to extract
but I think we should be very careful about changing the markup format.
The haddock markup format has always been very lightweight and does not
assume much about the capabilities of the backend (paper, web,
whatever).

Duncan

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


Re: [Haskell-cafe] Can't seem to get `par` working appropriately with lists

2008-02-21 Thread Jules Bean

Luke Andrew wrote:

   import Control.Parallel

   fib1 n = if n == 0 then 0 else if n == 1 then 1 else fib1 (n-1) +
fib1 (n-2)
   fib2 n = if n == 0 then 0 else if n == 1 then 1 else fib2 (n-1) +
fib2 (n-2)

   main = do print $ (fib2 37 `par` fib1 37) + (fib2 37)



fib2 37 won't be shared.

You're telling ghc to calculate fib2 37 once, in parallel, throw it 
away, and then calculate it again.


Try:

let f1 = fib1 37
f2 = fib2 37
in print $ (f2 `par` f1) + f2

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


[Haskell-cafe] Can't seem to get `par` working appropriately with lists

2008-02-21 Thread Luke Andrew

Hopefully an easy one here; after reading Don Stewart's blog posts about
parallel Haskell and with a shiny new quad-core cpu begging for a
workout, i thought I'd give Haskell a try. I've also been meaning to
write a ray-tracer, so I started with that. I've got the initial
ray-tracer working, and am now looking to parallize it. I tried using
the `par` function to evaluate things in parallel, but I couldn't get it
to work with lists. I simplified my problem down into the following 2
test cases:

(there are two fibonacci functions to ensure haskell treats them as 2
independent computations to be spread across 2 cores)

test1.hs:

   import Control.Parallel

   fib1 n = if n == 0 then 0 else if n == 1 then 1 else fib1 (n-1) +
fib1 (n-2)
   fib2 n = if n == 0 then 0 else if n == 1 then 1 else fib2 (n-1) +
fib2 (n-2)

   main = do print $ (fib2 37 `par` fib1 37) + (fib2 37)

compilation  testing:

   [EMAIL PROTECTED]:~/mcls$ ghc -O2 -threaded --make test1
   [1 of 1] Compiling Main ( test1.hs, test1.o )
   Linking test1 ...

   [EMAIL PROTECTED]:~/mcls$ time ./test1 +RTS -N1
   48315634

   real0m5.856s
   user0m5.816s
   sys 0m0.004s

   [EMAIL PROTECTED]:~/mcls$ time ./test1 +RTS -N2
   48315634

   real0m3.450s
   user0m6.734s
   sys 0m0.024s

As expected, running it with 2 cores is substantially faster. Doing
almost the same thing, but with lists, doesn't seem to have any
significant speed difference:

test2.hs:

   import Control.Parallel

   fib1 n = if n == 0 then 0 else if n == 1 then 1 else fib1 (n-1) +
fib1 (n-2)
   fib2 n = if n == 0 then 0 else if n == 1 then 1 else fib2 (n-1) +
fib2 (n-2)
   fiblist1 n = [fib1 x| x - [1..n]]
   fiblist2 n = [fib2 x| x - [1..n]]

   main = do print $ zipWith (+) (fiblist2 37 `par` fiblist1 37)
(fiblist2 37)

compilation  testing:

   [EMAIL PROTECTED]:~/mcls$ ghc -O2 -threaded --make test2

   [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N1
   [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]

   real0m15.294s
   user0m15.196s
   sys 0m0.013s

   [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N2
   [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]

   real0m15.268s
   user0m15.169s
   sys 0m0.013s

I've tried using bang patterns in various places, but to no avail. Any
ideas?

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Henning Thielemann

On Thu, 21 Feb 2008, Duncan Coutts wrote:

 On Thu, 2008-02-21 at 05:07 +0100, Henning Thielemann wrote:

  As long as it is only about speeding up list processing, one might also
  consider this as optimization problem. This could be handled without
  adapting much List based code in applications to a generic sequence class.
  That is, if I convert the result of a composition of list functions to a
  lazy ByteString, I tell the compiler that I don't need full laziness and
  the compiler can optimize, say
 ByteString.fromList . List.func1 . List.func2 . List.build
   to
 ByteString.func1 . ByteString.func2 . ByteString.build
   or even better
 ByteString.fusedFunc1Func2Build
   by some clever fusion framework. I think that a type class is easier to
  justify if it unifies data structures that are more different than just
  providing the same API with different efficiency.

 This is orthogonal I think. This could be done with stream fusion
 without any common class. It requires that the types use stream fusion,
 then conversions between types (eg list/array) could be done with
 streams too.

I suppose we mean the same. My question is: Why do we use ByteString
instead of [Word8] ? Entirely because of efficiency, right? So if we could
stick to List code and only convert to ByteString at the end and the
compiler all rewrites it to ByteString code, then we would not need
libraries that are specialised to ByteString, but they can use [Word8]
instead.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re[2]: [Haskell-cafe] A little toy of Haskell Trivia

2008-02-21 Thread Bulat Ziganshin
Hello Wolfgang,

Thursday, February 21, 2008, 2:45:43 AM, you wrote:
 I proudly announce a little toy that lists the frequency of modules
 being imported by other modules. Do you know Control.Monad is the most
 frequently imported module? I did not!

 This doesn’t surprise me very much.  What surprises me more is that OpenGL
 stuff is that popular. :-) 

perhaps opengl library just contains too many modules that imports
each other :)))



-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Johan Tibell
On Thu, Feb 21, 2008 at 11:37 AM, Duncan Coutts
[EMAIL PROTECTED] wrote:


  On Thu, 2008-02-21 at 10:06 +0100, Johan Tibell wrote:
   Hi John!
  
   On Wed, Feb 20, 2008 at 3:39 PM, John Goerzen [EMAIL PROTECTED] wrote:
 3) Would it make sense to base as much code as possible in the Haskell
   core areound ListLike definitions?  Here I think of functions such
   as lines and words, which make sense both on [Char] as well as
   ByteStrings.
  
   I don't think the examples you gave (i.e. lines and words) make much
   sense on ByteStrings. You would have to assume that the sequence of
   bytes are in some particular Unicode encoding and thus words and lines
   will break if they get passed a ByteString using a different encoding.
   I don't think either of those two functions make sense on anything but
   sequence of character types like String.

  That's exactly what the Data.ByteString[.Lazy].Char8 modules provide, a
  Char8 view of a Bytestring. Those modules provide functions like words,
  lines etc that assume an ASCII compatible 8bit encoding.

I would be very happy if people didn't use the .Char8 versions of
ByteString except for being able to write byte literals using pack. (I
would be even happier if Haskell had byte literals.) If people start
using ByteString in their library interfaces instead of String I'll be
really miserable because I can't really use their libraries for
writing applications that need to be internationalized because their
libraries would be limited to ASCII.

Data.ByteString and Data.ByteString.Char8 uses the same ByteString
type so I can take some bytes in UTF-32 which I read from the network
and use Data.ByteString.Char8 functions on them which will fail. I
prefer that a type that represent characters is guarded by encode and
decode functions. If that's not the case it's easy to mix data in
different encodings by mistake when e.g. writing web applications
which involve data in several different encodings.

  One day we'll have a separate type that does Unicode with a similar fast
  packed representation.

That will be a good day. :)

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Alistair Bayley
On 21/02/2008, Duncan Coutts [EMAIL PROTECTED] wrote:

 To be honest I like the fact that haddock's markup is really simple and
  perhaps somewhat restrictive. A great improvement though would be to
  make it easy to extract the docs from haddock in a nice format so that
  the could be re-used in other contexts rather than just generating html
  api documentation. Haddock does have support for multiple backends,
  someone just needs to define and write a generic backend that spits out
  the info that haddock gathers in a machine readable format.

I have probably misunderstood both of you, but I think that Conal
proposed that Haddock *input* syntax is largely unchanged; Haddock
should be able to *output* markdown, for consumption by pandoc.

(Which I think is also what you're suggesting.)

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


Re: [Haskell-cafe] Doubting Haskell

2008-02-21 Thread Yitzchak Gale
Cale Gibbard wrote:
  I woke up rather early, and haven't much to do, so I'll turn this into
  a tutorial. :)

Cale, this is fantastic, as always. I often find myself
searching for material like this when introducing
people to Haskell.

Would you be willing to put this on the wiki?

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


Re: [Haskell-cafe] A little toy of Haskell Trivia

2008-02-21 Thread Ross Paterson
On Wed, Feb 20, 2008 at 09:22:58PM +, Steve Lihn wrote:
 I proudly announce a little toy that lists the frequency of modules
 being imported by other modules. Do you know Control.Monad is the most
 frequently imported module? I did not!
 
 Currently it only includes GHC 6.8 core library. If you have any idea
 how to parse through HackageDB code, please let me know.

There's a link on the HackageDB Introduction page that gets you the
latest versions of all packages (30MB).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Gobbler Benchmarks

2008-02-21 Thread Adrian Hey

Hello Folks,

There's been some discussions recently about the pros and cons of
various coding styles, particularly whether stack greedy or heap
greedy is best, and how (if) ghcs stack management in particular
should affect all this. In particular, the problem of implementing
an eager take function. Here's some real numbers measured with ghc
6.8.2 under windowsxp using AMD Athlon 64 1.8 GHz. The source code
can be found here..

http://homepages.nildram.co.uk/~ahey/Test1.zip

There are 4 possible implementations that have been tested:

-- Uses O(n) stack
stackGobbler :: Int - [x] - [x]
stackGobbler 0 _  = []
stackGobbler _ [] = []
stackGobbler n (x:xs) = let xs' = stackGobbler (n-1) xs
in  xs' `seq` (x:xs')

-- Uses O(n) heap instead, O(1) stack
heapGobbler :: Int - [x] - [x]
heapGobbler = heapGobbler' []
  where heapGobbler' rxs 0 _  = reverse rxs
heapGobbler' rxs _ [] = reverse rxs
heapGobbler' rxs n (x:xs) = heapGobbler' (x:rxs) (n-1) xs

-- Neils O(n) heap version, O(1) stack
neilGobbler :: Int - [x] - [x]
neilGobbler n xs = length res `seq` res
 where res = take n xs

-- Continuation passing O(n) heap version, O(1) stack
cpGobbler :: Int - [x] - [x]
cpGobbler = f id
 where f c 0 _  = c []
   f c _ [] = c []
   f c n (x:xs) = f (\xs' - c (x:xs')) (n-1) xs

There are 16 tests for each, parameterised by p=0..15. Each test
takes 63*(2^p) elements from a test list of the same length, and
is repeated 2^(25-p) times. So in total, 63*(2^25) elements are
processed in each case (independent of p).

Here are the results in myCpuTimePrecision = 1562500 units
(the figure exported by System.CPUTime is wrong for me). To convert
these to actual time per element figures you need to multiply each
by 7.4 pS (I think :-). All tests were run with fixed stack and
heap sizes of 16 and 256 MiB respectively.

 pstack heap  neil  cp

 0 -  1793  2684  4937  2593
 1 -  1860  2673  4897  2584
 2 -  1910  2673  4825  2578
 3 -  1927  2659  4819  2575
 4 -  1946  2657  4813  2574
 5 -  1950  2656  5048  2578
 6 -  1960  2711  5036  2627
 7 -  1976  2730  5126  2643
 8 -  2072  2900  5197  2813
 9 -  2439  3044  5153  2974
10 -  2685  3275  5371  3199
11 -  2760  3384  5466  3321
12 -  2930  3487  5525  3444
13 -  3181  3648  5813  3698
14 -  3698  3973  6417  4031
15 -  4727  4987  7964  5224

So pretty much as I expected. For smallish lists, stackGobbler is
easily the fastest, heapGobbler and cpGobbler are pretty similar,
and neilGobbler is the slowest (sorry Neil:-).

The performance of all is degraded as p increases. I guess this
is not too surprising, but stackGobbler seems to degrade faster
so that at p=15 there's not much difference between it and
heapGobbler/cpGobbler. I'm not sure what it is that causes stackGobbler
to be unfairly penalised this way, but I'm reminded of this post
from John Meacham..

http://haskell.org/pipermail/glasgow-haskell-users/2007-May/012470.html

The other big problem with stackgobbler in practice is the risk of
stack overflow. For p=15 it would not work at all for ghc default
stack limit.

Regards
--
Adrian Hey

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread David Waern
2008/2/21, Conal Elliott [EMAIL PROTECTED]:
 There was a chat today on #haskell  (15:08 to 16:10) about evolving haddock.
  I'd like to get comments.

 The goal is to get the full functionality of a general purpose,
 programmer-friendly markup language like markdown.  One example is image
 embedding.  Another is friendly links (no visible URL).

Haddock already supports image embedding since version 0.8. I don't
think it works properly in version 2 (because of merge errors), but it
probably will in the next version.

Use url for including images.

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


Re: Re[2]: [Haskell-cafe] A little toy of Haskell Trivia

2008-02-21 Thread Brandon S. Allbery KF8NH


On Feb 21, 2008, at 5:24 , Bulat Ziganshin wrote:


Hello Wolfgang,

Thursday, February 21, 2008, 2:45:43 AM, you wrote:

I proudly announce a little toy that lists the frequency of modules
being imported by other modules. Do you know Control.Monad is the  
most

frequently imported module? I did not!


This doesn’t surprise me very much.  What surprises me more is  
that OpenGL

stuff is that popular. :-)


perhaps opengl library just contains too many modules that imports
each other :)))


I have seen (demo) programs import the OpenGL modules just to get  
(:=).  Wonder if that goes on in the real world?


--
brandon s. allbery [solaris,freebsd,perl,pugs,haskell] [EMAIL PROTECTED]
system administrator [openafs,heimdal,too many hats] [EMAIL PROTECTED]
electrical and computer engineering, carnegie mellon universityKF8NH


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


Re: [Haskell-cafe] Repeated function application

2008-02-21 Thread jerzy . karczmarczuk
Ben Butler-Cole writes: 


times :: (a - a) - Int - (a - a)
times f 0 = id
times f n = f . (times f (n-1)) 


Am I missing something more general
...I can't help feeling that there must be a way to get rid of the 
 explicit recursion. 


How would you implement times?


Anything against (apart an auxiliary list, and x not curried away) 

times n f x = (iterate f x)!!n 

Jerzy Karczmarczuk 



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


[Haskell-cafe] Repeated function application

2008-02-21 Thread Ben Butler-Cole
Hello

I was surprised to be unable to find anything like this in the standard 
libraries:

times :: (a - a) - Int - (a - a)
times f 0 = id
times f n = f . (times f (n-1))

Am I missing something more general which would allow me to repeatedly apply a 
function to an input? Or is this not useful?

I thought this looked a bit like a fold, so I tried expressing it like this:

times f n x = foldl (flip ($)) x (replicate n f)

... which horrifies me, but I can't help feeling that there must be a way to 
get rid of the explicit recursion.

How would you implement times?

Ben


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


Re: [Haskell-cafe] Repeated function application

2008-02-21 Thread Wolfgang Jeltsch
Am Donnerstag, 21. Februar 2008 16:58 schrieb Ben Butler-Cole:
 Hello

 I was surprised to be unable to find anything like this in the standard
 libraries:

 times :: (a - a) - Int - (a - a)
 times f 0 = id
 times f n = f . (times f (n-1))

times f n = (!! n) . iterate f

 […]

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Thomas Schilling


On 21 feb 2008, at 15.26, Devin Mullins wrote:


On Thu, Feb 21, 2008 at 10:21:50AM +, Duncan Coutts wrote:
So I'm claiming that the single impl with boundary conversion  
gives us
the best of both worlds, no code bloat due to specialisation and  
working
with whichever string type you like, by converting it at the  
beginning

and end. Of course only an experiment can say either way.


I think his point is that if I'm using three libraries, each of which
uses a different String type, that's a lot of boundaries. Perhaps  
worse
yet, if I'm a library author and I want to be a good citizen, I  
have to
write three versions of my code (or create my own StringLike  
typeclass).

I know of an example off-hand:
  http://nominolo.blogspot.com/2007/05/networkhttp-bytestrings.html
(Of course, as I read that, I see that the lazy code is different from
the strict code, but I'll just ignore that for the sake of, uh,
argument.)


Yes it does use different implementations, but the lazy interface has  
it's problems (leakage of handles, unclosed connections, and more).   
But what we really want is, as Duncan and Roman suggested, *one*  
standard, optimizable representation and conversions from and to it.   
This would work perfectly well with sockets.


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


Re: [Haskell-cafe] Selecting Array type

2008-02-21 Thread Justin Bailey
2008/2/20 Jeff φ [EMAIL PROTECTED]:
 I'd love to find a good article that describes the ins and outs of multi
 parameter types, functional dependencies, and type assertions, in enough
 detail to resolve these surprises.  A step-by-step walk through showing how
 the compiler resolve a type and selects an instance would be awesome.

The research paper Strong Types for Relational Databases linked on
the page below has an excellent introductory section on type-level
programming:

  http://wiki.di.uminho.pt/twiki/bin/view/Research/PURe/CoddFish

A recent issue of The Monad Reader had a great article on type-level
programming to solve the Instant Insanity game. I did not track down
a link but I'm sure you can find it easily.

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


[Haskell-cafe] Haskell + Windows Mobile?

2008-02-21 Thread Bulat Ziganshin
Hello haskell-cafe,

is there any haskell implementation for Windows Mobile? does they are
support creation of GUI apps and internet networking features?

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

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


Re[2]: [Haskell-cafe] question about STM and IO

2008-02-21 Thread Bulat Ziganshin
Hello Ryan,

Thursday, February 21, 2008, 5:02:52 AM, you wrote:

 values, determine that x = y, and just return (), but it's too late,
 the missiles have already been launched.

it seems that asymmetrical answer of mr.Putin is just to hire a bit
more Haskell Hackers :)


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Johan Tibell
On Thu, Feb 21, 2008 at 5:51 PM, Thomas Schilling
[EMAIL PROTECTED] wrote:
   I know of an example off-hand:
 http://nominolo.blogspot.com/2007/05/networkhttp-bytestrings.html
   (Of course, as I read that, I see that the lazy code is different from
   the strict code, but I'll just ignore that for the sake of, uh,
   argument.)

  Yes it does use different implementations, but the lazy interface has
  it's problems (leakage of handles, unclosed connections, and more).
  But what we really want is, as Duncan and Roman suggested, *one*
  standard, optimizable representation and conversions from and to it.
  This would work perfectly well with sockets.

I switched from lazy bytestrings to a left fold in my networking code
after reading what Oleg wrote about streams vs folds. No problems with
handles, etc. anymore.

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Yitzchak Gale
Duncan Coutts wrote:
 To be honest I like the fact that haddock's markup is really simple and
  perhaps somewhat restrictive. A great improvement though would be...
  a generic backend that spits out
  the info that haddock gathers in a machine readable format.

Alistair Bayley wrote:
  I have probably misunderstood both of you, but I think that Conal
  proposed that Haddock *input* syntax is largely unchanged; Haddock
  should be able to *output* markdown, for consumption by pandoc.

Perhaps, but I don't think markdown, or any other
presentation format, is right for that.

I'm sure that there are many presentation formats needed
by many different people. I think Duncan's point is that
haddock only really needs to produce one *generic* output.
It should faithfully preserve all of the information that
haddock knows how to produce, in a format that is
easy to parse.

That could then be transformed by other existing tools
into whatever you want, including the current HTML/CSS,
markdown, or anything else.

XML is what people usually use nowadays for that sort
of thing, but it doesn't have to be XML.

The haddock web site mentions that some work has
already been done on DocBook XML; that could work.
DITA would perhaps be a better fit. Or we could use
our own set of tags.

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Thomas Schilling


On 21 feb 2008, at 18.35, Johan Tibell wrote:


I switched from lazy bytestrings to a left fold in my networking code
after reading what Oleg wrote about streams vs folds. No problems with
handles, etc. anymore.



Do you fold over chunks?  Can you continue to use Parsek or other  
utilities that need a stream-abstraction, and if so, how do you  
handle the end of a chunk.  This is the kind of callback interface  
where lazy evaluation really abstracts things nicely.

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


Re: [Haskell-cafe] stream/bytestring questions

2008-02-21 Thread Chad Scherrer
On Wed, Feb 20, 2008 at 5:53 PM, Roman Leshchinskiy [EMAIL PROTECTED] wrote:
  In general, I don't see why programming directly with streams is
  something that should be avoided. You do have to be quite careful,
  though, if you want to get good performance (but GHC's simplifier is
  becoming increasingly robust in this respect).

Hmm. I was taking the approach of getting something working, given
what is currently exported from Data.Stream. How would you deal with
this? Should there be a Data.Stream.Internal or something that exports
streams and unlifted types?

If I'm understanding this correctly, these things were not exported in
the first place because this fusion framework provides an
approximation, but not an isomorphism, so partial bottoms don't always
behave nicely. I was hoping to get around this by programming instead
to Step and then hoping rules could be constructed to translate to
Streams. Do you think there's a better way around it?

   extract ns xs == [xs !! n | n - ns]

  Note that in contrast to your function, this doesn't assume that ns is
  sorted and hence, there is no way to implement this without producing an
  intermediate list.

Oh yes, good point. It's so easy to forget about assumptions like that.

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


[Haskell-cafe] Re: The Proliferation of List-Like Types

2008-02-21 Thread Chad Scherrer
On Wed, Feb 20, 2008 at 7:57 PM, Henning Thielemann
[EMAIL PROTECTED] wrote:
  I think there can also be problems simply because the element type is no
  longer fixed to Word8 but also not entirely free, but restricted to
  Storable. E.g. you cannot simply replace
 SV.fromList . List.map f by  SV.map f . SV.fromList
   because in the second form not only the result type of 'f' must be
  Storable, but the input type of 'f' must be Storable, too.

Hmm, interesting. But would we really need this? If we have [a]
rewritten as a stream and SV rewritten as a stream, couldn't they
still fuse?

Loosely speaking,
SV.fromList . List.map f
- (SV.unstream . List.stream) . (List.unstream . mapS f . List.stream)
- SV.unstream .  mapS f . List.stream

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


Re: [Haskell-cafe] Problem with Python AST

2008-02-21 Thread Roel van Dijk
Your solutions allows a bit more but fails with the equivalent of

def foo():
  for i in range(10):
if i == 6:
  return None

The loop context 'overwrites' the function context which makes the
return statement illegal. I think I need a type level list.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Repeated function application

2008-02-21 Thread Dan Weston

Ben Butler-Cole wrote:

Hello

I was surprised to be unable to find anything like this in the standard 
libraries:

times :: (a - a) - Int - (a - a)
times f 0 = id
times f n = f . (times f (n-1))

Am I missing something more general which would allow me to repeatedly apply a 
function to an input? Or is this not useful?


Invariably, this seems to invite a stack overflow when I try this (and 
is usually much slower anyway). Unless f is conditionally lazy, f^n and 
f will have the same strictness, so there is no point in keeping nested 
thunks.


If you apply f immediately to x, there is no stack explosion and faster 
runtime:


times :: (a - a) - Int - (a - a)
times f !n !x | n  0 = times f (n-1) (f x)
  | otherwise = x

Dan

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread David Menendez
On Thu, Feb 21, 2008 at 12:54 PM, Yitzchak Gale [EMAIL PROTECTED] wrote:
 Duncan Coutts wrote:
   To be honest I like the fact that haddock's markup is really simple and
perhaps somewhat restrictive. A great improvement though would be...

   a generic backend that spits out
the info that haddock gathers in a machine readable format.


 Alistair Bayley wrote:
I have probably misunderstood both of you, but I think that Conal
proposed that Haddock *input* syntax is largely unchanged; Haddock
should be able to *output* markdown, for consumption by pandoc.

  Perhaps, but I don't think markdown, or any other
  presentation format, is right for that.

Markdown is not really a presentation format. It's an authoring format
which allows you to write using an easy-to-read, easy-to-write plain
text format, then convert it to structurally valid XHTML (or HTML).
(from http://daringfireball.net/projects/markdown/)

Pandoc apparently generalizes this, allowing you to use the Markdown
syntax to produce other forms of output. I'm not sure what it does
with embedded XHTML, which Markdown allows (and which is necessary if
you want to do things like tables).

Markdown is more powerful than Haddock, and (for me, at least) easier
to read. I'd love to see it used for Haskell code documentation, but I
don't see it happening.

-- 
Dave Menendez [EMAIL PROTECTED]
http://www.eyrie.org/~zednenem/
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Yitzchak Gale
David Menendez wrote:
  Markdown is not really a presentation format.
 It's an authoring format

Its primary design goal is to be easy to read, not easy to
parse. That's why I consider it a presentation format,

Anyway, it's not suitable for use as API markup.
The whole point is that you want to add
metadata indicating how various pieces of your
content relate to various pieces of Haskell syntax.
You would have to add special markup, in
which case you would get, well, Haddock.

Or you could extend markdown's embedded HTML
facility to accept other tags for that purpose -
but then your content would be less readable than
Haddock, not more readable. (Though that
is the direction taken by C#.)

I'm happy with Haddock's input syntax. It's
quite readable, and simple enough. And
it's similar to many other API markup systems
for other languages, so many people feel
comfortable with it right from the start.

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


Re: [Haskell-cafe] Selecting Array type

2008-02-21 Thread Ryan Ingram
On 2/20/08, Jeff φ [EMAIL PROTECTED] wrote:
 -- SURPRISE 1: If function, arrTypeCast, is removed, (from both
 -- the class and instance) GHC assumes the kind of a and b are *,
 -- instead of * - * - * and produce . . .
 --
 -- report3.hs:37:24:
 -- `UArray' is not applied to enough type arguments
 -- Expected kind `*', but `UArray' has kind `* - * - *'
 -- In the type `(ArrTypeCast a UArray, IArray a Bool) =
 --  SmartArraySelector a Bool'
 -- In the instance declaration for `SmartArraySelector a Bool'
 --
 -- It appears that functions defined in a class can constrain the
 -- type variables of the class.  To me, this seems a bit magical
 -- and unexpected.

That's correct; GHC is doing kind inference but defaults to * if it
can't decide otherwise.  Try this instead:
 class ArrTypeCast (a :: * - * - *) (b :: * - * - *) | a - b, b-a
 instance ArrTypeCast x x

You can do the same for SmartArraySelector but then you need the
IArray constraint elsewhere; otherwise, smartArray can't call array.

 I'd love to find a good article that describes the ins and outs of multi
 parameter types, functional dependencies, and type assertions, in enough
 detail to resolve these surprises.  A step-by-step walk through showing how
 the compiler resolve a type and selects an instance would be awesome.

Me too.  I don't really know how this code works either :)

It seems like the functional dependency is still broken by ALL of the
declarations; remember that the instance head determines what
instances it defines, and we are specifying that ANY type a can be
specified as SmartArraySelector a Bool, as long as we introduce the
additional constraint of ArrTypeCast a UArray.  This is in contrast to
the functional dependency which states that the element type (Bool)
uniquely determines the array type (some type a?).

Here's an even smaller version of this file, using GHC 6.8.2 and type
equality constraints:

{-# LANGUAGE
UndecidableInstances, OverlappingInstances,
MultiParamTypeClasses, FunctionalDependencies,
FlexibleInstances, TypeFamilies #-}
module SmartArray where
import Data.Array.Unboxed

class IArray a e = SmartArraySelector a e | e - a
instance a ~ UArray = SmartArraySelector a Bool
instance a ~ UArray = SmartArraySelector a Char
instance a ~ UArray = SmartArraySelector a Double
instance a ~ UArray = SmartArraySelector a Float
instance a ~ UArray = SmartArraySelector a Int
instance a ~ Array  = SmartArraySelector a b

test :: SmartArraySelector a e = e - a Int e
test e = array (0,10) [ (i,e) | i - [0..10]]

I wouldn't be surprised if using these features together somehow makes
the type checker inconsistent!

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 13:37 +0100, Johan Tibell wrote:

 I would be very happy if people didn't use the .Char8 versions of
 ByteString except for being able to write byte literals using pack. (I
 would be even happier if Haskell had byte literals.) If people start
 using ByteString in their library interfaces instead of String I'll be
 really miserable because I can't really use their libraries for
 writing applications that need to be internationalized because their
 libraries would be limited to ASCII.
 
 Data.ByteString and Data.ByteString.Char8 uses the same ByteString
 type so I can take some bytes in UTF-32 which I read from the network
 and use Data.ByteString.Char8 functions on them which will fail. I
 prefer that a type that represent characters is guarded by encode and
 decode functions. If that's not the case it's easy to mix data in
 different encodings by mistake when e.g. writing web applications
 which involve data in several different encodings.

The intention of allowing both views on one data type was to support the
myriad of mixed ascii / binary protocols with a minimum of fuss (there
are loads of network protocols like this). The intention was never to
support Unicode like String does. That's why we called it Char8, not
Char.

I do accept that because the Unicode version has not appeared yet people
have been tempted to use ByteString for text, which is not appropriate.

Duncan

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Johan Tibell
On Thu, Feb 21, 2008 at 6:58 PM, Thomas Schilling
[EMAIL PROTECTED] wrote:

  On 21 feb 2008, at 18.35, Johan Tibell wrote:
  
   I switched from lazy bytestrings to a left fold in my networking code
   after reading what Oleg wrote about streams vs folds. No problems with
   handles, etc. anymore.
  

  Do you fold over chunks?

Yes.

  Can you continue to use Parsek or other
  utilities that need a stream-abstraction, and if so, how do you
  handle the end of a chunk.

I don't think so. I'm writing an incremental bytestring parser.

  This is the kind of callback interface
  where lazy evaluation really abstracts things nicely.

Streams are a nice abstraction however they don't work well in a server.

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


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 13:34 +0100, Henning Thielemann wrote:

 I suppose we mean the same. My question is: Why do we use ByteString
 instead of [Word8] ? Entirely because of efficiency, right? So if we could
 stick to List code and only convert to ByteString at the end and the
 compiler all rewrites it to ByteString code, then we would not need
 libraries that are specialised to ByteString, but they can use [Word8]
 instead.

Yeah if we could do that it'd be great. I've suggested similar things as
extensions of our work on streams. If we know the list is being used
fully strictly then we could have replaced it with a stricter data
structure.

Even if we could do that I'm not sure we'll ever get to the situation
where it's fully automatic because some operations on array like things
are slower than lists, like consing, so even if we discover that we're
using our lists strictly it does not follow that we could get any
benefit from converting to arrays.

I think we'll be stuck with separate list and stricter array types for
some time to come.

Duncan

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 13:12 +, Alistair Bayley wrote:
 On 21/02/2008, Duncan Coutts [EMAIL PROTECTED] wrote:
 
  To be honest I like the fact that haddock's markup is really simple and
   perhaps somewhat restrictive. A great improvement though would be to
   make it easy to extract the docs from haddock in a nice format so that
   the could be re-used in other contexts rather than just generating html
   api documentation. Haddock does have support for multiple backends,
   someone just needs to define and write a generic backend that spits out
   the info that haddock gathers in a machine readable format.
 
 I have probably misunderstood both of you, but I think that Conal
 proposed that Haddock *input* syntax is largely unchanged; Haddock
 should be able to *output* markdown, for consumption by pandoc.
 
 (Which I think is also what you're suggesting.)

Yes, I misunderstood, I though Conal was suggesting we extend the
haddock input format to allow all the markdown notations. I'd rather not
see different packages using different documentation dialects as it
makes it much easier for people to contribute if we're all using the
same language. I know there is a tension between richer markup for nicer
presentation and keeping simple markup for ease of understanding and to
present on limited medium like ghci or IDE tooltips. So IMHO we should
consider syntactic extensions rather carefully.

Though on that topic, we have no consensus as a community about what to
use for tutorials or user guides. Consequently there is no support in
Cabal etc for those kinds of documentation. GHC, Cabal and c2hs amongst
others use docbook but it's a horrible format to write and the tools to
process it are very finicky (we apparently have to hard code paths to
specific versions of xslt stylesheets).

Duncan

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


[Haskell-cafe] Re: Can't seem to get `par` working appropriately with lists

2008-02-21 Thread Ben Franksen
Luke Andrew wrote:
 main = do print $ zipWith (+) (fiblist2 37 `par` fiblist1 37)
 (fiblist2 37)
 
 compilation  testing:
 
 [EMAIL PROTECTED]:~/mcls$ ghc -O2 -threaded --make test2
 
 [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N1
 [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]
 
 real0m15.294s
 user0m15.196s
 sys 0m0.013s
 
 [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N2
 [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]
 
 real0m15.268s
 user0m15.169s
 sys 0m0.013s

This is due to lazyness: 'fiblist2 37' does not evaluate the whole resulting
list, so the thread spawned by 'par' will almost immediately return.

Take a look at Control.Parallel.Strategies, the 'parList' combinator is
probably what you need here. To get a feel what this 'strategies' stuff is
all about, it is a good idea to read (or at least skim over) the
accompanying paper, just google for Algorithm + Strategy = Parallelism.

Cheers
Ben

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


Re: [Haskell-cafe] Re: Can't seem to get `par` working appropriately with lists

2008-02-21 Thread Don Stewart
ben.franksen:
 Luke Andrew wrote:
  main = do print $ zipWith (+) (fiblist2 37 `par` fiblist1 37)
  (fiblist2 37)
  
  compilation  testing:
  
  [EMAIL PROTECTED]:~/mcls$ ghc -O2 -threaded --make test2
  
  [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N1
  [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]
  
  real0m15.294s
  user0m15.196s
  sys 0m0.013s
  
  [EMAIL PROTECTED]:~/mcls$ time ./test2 +RTS -N2
  [2,2,4,6,10,16,26,42......405774,18454930,29860704,48315634]
  
  real0m15.268s
  user0m15.169s
  sys 0m0.013s
 
 This is due to lazyness: 'fiblist2 37' does not evaluate the whole resulting
 list, so the thread spawned by 'par' will almost immediately return.
 
 Take a look at Control.Parallel.Strategies, the 'parList' combinator is
 probably what you need here. To get a feel what this 'strategies' stuff is
 all about, it is a good idea to read (or at least skim over) the
 accompanying paper, just google for Algorithm + Strategy = Parallelism.

or 'rnf' on the result.

rnf x `par` y

is the basic fully strict strategy.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Conal Elliott
I guess there was some confusion about the haddock-as-preprocessor idea.
Here's another try:

Pare the Haddock markup language down to very few markup directives, say
just 'foo' and Foo.Bar.  (Of course, Haddock continues to read and process
type signatures and module import  export specs.)  Compose this slimmed
down Haddock with a more mainstream and powerful markup language/processor
like markdown/pandoc.  How to compose?  By having Haddock translate its
markdown extensions into markdown and pass through all the rest.

The goal redesigning for composability is that we get more for less.
Haddock can focus on its speciality, namely hyperlinked Haskell code
documentation, and pandoc on its, namely human-writable and -readable prose
with modern features (images, friendly hyperlinks, smart quotes  dashes,
footnotes, super- and subscripts, pretty math, bibliography-style link
specs, etc).  Haddock development can focus its resources on
Haskell-specific functionality, and we library writers can still use a
full-featured mark-up language.

I love Haddock's Haskell-smarts, and I love (extended) markdown's features
and usability.  Currently, I have to choose between them, and I'd rather get
both at once.

We can take this composability idea further and plug in other nifty tools
like hscolour and lhs2TeX.  And a new tool that hyperlinks and annotates
source code in a variety of ways.  For instance, hover over an identifier to
see its type and doc string in a pop-up, or click to jump to the source code
(also annotated with type, doc, and source links).  And other tools we
haven't yet thought of.

Cheers,  - Conal


On Thu, Feb 21, 2008 at 5:12 AM, Alistair Bayley [EMAIL PROTECTED]
wrote:

 On 21/02/2008, Duncan Coutts [EMAIL PROTECTED] wrote:
 
  To be honest I like the fact that haddock's markup is really simple and
   perhaps somewhat restrictive. A great improvement though would be to
   make it easy to extract the docs from haddock in a nice format so that
   the could be re-used in other contexts rather than just generating html
   api documentation. Haddock does have support for multiple backends,
   someone just needs to define and write a generic backend that spits out
   the info that haddock gathers in a machine readable format.

 I have probably misunderstood both of you, but I think that Conal
 proposed that Haddock *input* syntax is largely unchanged; Haddock
 should be able to *output* markdown, for consumption by pandoc.

 (Which I think is also what you're suggesting.)

 Alistair

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Duncan Coutts

On Thu, 2008-02-21 at 16:54 -0800, Conal Elliott wrote:
 I guess there was some confusion about the haddock-as-preprocessor
 idea.  Here's another try:
 
 Pare the Haddock markup language down to very few markup directives,
 say just 'foo' and Foo.Bar.  (Of course, Haddock continues to read
 and process type signatures and module import  export specs.)
 Compose this slimmed down Haddock with a more mainstream and powerful
 markup language/processor like markdown/pandoc.  How to compose?  By
 having Haddock translate its markdown extensions into markdown and
 pass through all the rest.

So the advantage of passing the rest through uninterpreted is that
markdown then interprets it and we get lots of cool markup for free, the
disadvantage is that we get lots more markup that I don't
understand! :-)

There really is something to be said for being able to download a random
package, read the code at the documentation markup and be able to
understand it and modify it. If it's a simple common language like we
have at the moment we can do that. I worry about loosing that property.

So yes we could make haddock not care so much and pass everything
through and then people could do whatever they liked with new markup
formats but I wonder if we cannot find a common language that we can all
agree on. Are there any particularly cool things in markdown that lots
of haskell developers want to use in their api documentation?

Duncan

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


Re: [Haskell-cafe] haddock as a markdown preprocessor

2008-02-21 Thread Conal Elliott
On Thu, Feb 21, 2008 at 5:37 PM, Duncan Coutts [EMAIL PROTECTED]
wrote:

 So the advantage of passing the rest through uninterpreted is that
 markdown then interprets it and we get lots of cool markup for free, the
 disadvantage is that we get lots more markup that I don't
 understand! :-)

Thanks for this summary, Duncan.

 There really is something to be said for being able to download a random
 package, read the code at the documentation markup and be able to
 understand it and modify it. If it's a simple common language like we
 have at the moment we can do that. I worry about loosing that property.

Have you looked at markdown?  It's a popular and well-documented format and
based on common conventions.  I bet you'd have no trouble learning it, and I
bet many other Haskell programmers *already* know it.  (BTW, I just noticed
that this mail message is in written in markdown.)

 So yes we could make haddock not care so much and pass everything
 through and then people could do whatever they liked with new markup
 formats but I wonder if we cannot find a common language that we can all
 agree on. Are there any particularly cool things in markdown that lots
 of haskell developers want to use in their api documentation?

My previous note listed some (pandoc-extended) markdown features I use
regularly (while blogging) that are missing in Haddock.  If I could, I'd use
them in my code documentation.

I'd like to hear from others about what markup features you'd like to have
in your code documentation but aren't supported by Haddock.

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


Re: [Haskell-cafe] Selecting Array type

2008-02-21 Thread Ryan Ingram
On 2/21/08, Jeff φ [EMAIL PROTECTED] wrote:
 Thanks again.  I'm not familiar with type equality constraints.  I could not
 find information on this in the GHC users guide.  Is it documented
 somewhere?

Section 7.3 here talks about equality constraints.
http://www.haskell.org/haskellwiki/GHC/Indexed_types

There's an extremely good paper talking about the low-level mechanisms
for equality constraints in GHC Core here:
http://research.microsoft.com/%7Esimonpj/papers/ext%2Df/

GHC Core -is- System Fc as described in that paper; the type equality
constraints amount to a coercion function that is passed around the
core language to convert between the types and which is statically
guaranteed to be the identity function.

 It is interesting that you were able to drop the IArray
 constraint from the instances of SmartArraySelector.

During compilation from Haskell to Core, the compiler implicitly adds
calls to any available conversion functions it knows about as required
to convert between types.  This is why the IArray declaration can be
dropped; the compiler looks at the coercions currently available,
finds (a ~ UArray), and inserts a call that converts the existing
IArray UArray Bool declaration into an IArray a Bool declaration.
Determining that such a path exists is a search problem and much of
the work with associated types and type equality constraints involves
proving that the search is decidable.

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


[Haskell-cafe] Re: [Haskell] Re: Re: RE: Extensible records: Static duck typing

2008-02-21 Thread Mark P Jones

[Redirecting to haskell-cafe]

Ben Franksen wrote:

TREX seems to be generally agreed to be too complicated to implement and
explain.


What evidence do you have for this?  Speaking as somebody who
implemented Trex for Hugs (and who also witnessed Ben Gaster
build an independent implementation), I'd have to disagree
about the first part of this.  As I recall, the implementation
was reasonably straightforward, and wasn't any more complicated
than other common type system extensions that I've worked on.
I'm also not sure why you think it is complicated to explain,
but I suppose that's even more subjective.

One of the most difficult things about the Trex implementation
was finding a syntax that meshed nicely with the rest of the
Haskell syntax.  This is likely to be a problem for any record
system extension of Haskell---unless you're prepared to accept
a more unconventional syntax---because many of the symbols that
you might want to use ({, }, ., |, \, for example) have already
been adopted for other purposes.  Ah, syntax!

All the best,
Mark
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The Proliferation of List-Like Types

2008-02-21 Thread Jules Bean

Thomas Schilling wrote:


On 21 feb 2008, at 18.35, Johan Tibell wrote:


I switched from lazy bytestrings to a left fold in my networking code
after reading what Oleg wrote about streams vs folds. No problems with
handles, etc. anymore.



Do you fold over chunks?  Can you continue to use Parsek or other 
utilities that need a stream-abstraction, and if so, how do you handle 
the end of a chunk.  This is the kind of callback interface where lazy 
evaluation really abstracts things nicely.


You can't call a stream-abstraction utility using a left-fold-enumerator 
without cheating (unsafeInterleave), because the stream-abstraction is 
incompatible (and leaky! even though it is convenient).


You can convert in the other direction fine.

Chunk are no problem, and convertible: you can build an element fold 
from a chunk fold, and a chunk fold from an element fold (as long as 
there is an 'end-of-input' marker).


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