Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-09-07 Thread John Lato
At first I regarded this as simply a bug in the Iteratee.map definition, but
like Ben, it's started to bother me a lot.  I think this is precisely the
sort of issue a proper denotational semantics would fix.

Unfortunately the only general solution I see is to abandon chunking and
work strictly element-wise.  I say unfortunately because my current best
implementation is about 5 times slower than the main tree.  I'm open to
ideas.

John


 From: Ben midfi...@gmail.com

 Sorry to be late coming into this conversation.

 Something that has bothered me (which I have mentioned to John Lato
 privately) is that it is very easy to write non-compositional code due
 to the chunking.  For example, there is a standard function

 map :: (a - b) - Enumeratee a b c

 whose meaning I hope is clear : use the function to transform the type
 of a stream and pass it to an iteratee.  However last I checked the
 versions provided in both the iteratee and enumerator packages fail to
 satisfy the equation

 map f (it1  it2) == (map f it1)  (map f it 2)

 because of chunking, essentially.  You can check this with f == id and
 it1 and it2 are head:

 let r = runIdentity . runIteratee

 runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ map id $ r (head 
 head)
 -- Right (Just 2)

 runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ (map id $ r
 head)  (map id $ r head)
 -- Right (Just 11)

 It is possible to fix this behavior, but it complicates the obvious
 definitions a lot.

 B

 On Wed, Sep 1, 2010 at 5:10 AM, Heinrich Apfelmus
 apfel...@quantentunnel.de wrote:
  Tilo Wiklund wrote:
 
  Daniel Fischer wrote:
 
  [...]
  Well, I just gave an example where one would want chunking for reasons
  other than performance. That iteratees don't provide the desired
  functionality is a different matter.
  [...]
 
  In the case of hashing, wouldn't it be more reasonable to consider
  iterators over streams of fixed (or at least predictable) sized chunks
  (where a set of chunks can themselves be chunked), with the chunking
  behaviour being given by another iteratee over the original stream?
 
  It seems to me that one of the major points of iteratees is to provide
  an abstraction from the kind of chunking irrelevant to the parsing
  logic, otherwise I fail to see any difference (at least relevant to
  chunking) to plain strict IO.
 
  I thought so, too, but I was informed[1] that iteratees are just a small
  step up the abstraction ladder. The difference compared to an ordinary
 file
   Handle  is that you can now reuse one and the same iteratee for reading
  from a  String , for instance, without changing the source code of the
  iteratee.
 
  Furthermore, iteratees can be suspended, which facilities resource
  management like closing files handles after they've been read.
 
   [1]:
 
 http://www.reddit.com/r/haskell/comments/ar4wb/understanding_iteratees/c0j0f3r
 
 
 
  Regards,
  Heinrich Apfelmus
 
  --
  http://apfelmus.nfshost.com
 
  ___
  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: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-09-07 Thread John Millikin
On Mon, Sep 6, 2010 at 22:49, Ben midfi...@gmail.com wrote:
 Sorry to be late coming into this conversation.

 Something that has bothered me (which I have mentioned to John Lato
 privately) is that it is very easy to write non-compositional code due
 to the chunking.  For example, there is a standard function

 map :: (a - b) - Enumeratee a b c

 whose meaning I hope is clear : use the function to transform the type
 of a stream and pass it to an iteratee.  However last I checked the
 versions provided in both the iteratee and enumerator packages fail to
 satisfy the equation

 map f (it1  it2) == (map f it1)  (map f it 2)

 because of chunking, essentially.  You can check this with f == id and
 it1 and it2 are head:

 let r = runIdentity . runIteratee

 runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ map id $ r (head  
 head)
 -- Right (Just 2)

 runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ (map id $ r
 head)  (map id $ r head)
 -- Right (Just 11)

 It is possible to fix this behavior, but it complicates the obvious
 definitions a lot.

Chunking doesn't have anything to do with this, and an iteratee
encoding without input chunking would exhibit the same problem. You're
running into an (annoying? dangerous?) subtlety in enumeratees. In the
particular case of map/head, it's possible to construct an iteratee
with the expected behavior by altering the definition of 'map'.
However, if the composition is more complicated (like map/parse-json),
this alteration becomes impossible.

Remember than an enumeratee's return value contains two levels of
extra input. The outer layer is from the enumeratee (map), while the
inner is from the iteratee (head). The iteratee is allowed to consume
an arbitrary amount of input before yielding, and depending on its
purpose it might yield extra input from a previous stream.

Perhaps the problem is that 'map' is the wrong name? It might make
users expect that it composes horizontally rather than vertically.
Normally this incorrect interpretation would be caught by the type
checker, but using () allows the code to compile.

Anyway, the correct way to encode @(map f it1)  (map f it 2)@, using
above style is:

(map id (r head) = returnI)  (map id (r head) = returnI)

so the full expression becomes:

runIdentity $ run $ enumList 10 [1..100] $ r $ (map id (r head)
= returnI)  (map id (r head) = returnI)

which ought to return the correct value (untested; I have no Haskell
compiler on this computer).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-09-06 Thread Ben
Sorry to be late coming into this conversation.

Something that has bothered me (which I have mentioned to John Lato
privately) is that it is very easy to write non-compositional code due
to the chunking.  For example, there is a standard function

map :: (a - b) - Enumeratee a b c

whose meaning I hope is clear : use the function to transform the type
of a stream and pass it to an iteratee.  However last I checked the
versions provided in both the iteratee and enumerator packages fail to
satisfy the equation

map f (it1  it2) == (map f it1)  (map f it 2)

because of chunking, essentially.  You can check this with f == id and
it1 and it2 are head:

let r = runIdentity . runIteratee

runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ map id $ r (head  head)
-- Right (Just 2)

runIdentity $ run $ enumList 10 [1..100] $ r $ joinI $ (map id $ r
head)  (map id $ r head)
-- Right (Just 11)

It is possible to fix this behavior, but it complicates the obvious
definitions a lot.

B

On Wed, Sep 1, 2010 at 5:10 AM, Heinrich Apfelmus
apfel...@quantentunnel.de wrote:
 Tilo Wiklund wrote:

 Daniel Fischer wrote:

 [...]
 Well, I just gave an example where one would want chunking for reasons
 other than performance. That iteratees don't provide the desired
 functionality is a different matter.
 [...]

 In the case of hashing, wouldn't it be more reasonable to consider
 iterators over streams of fixed (or at least predictable) sized chunks
 (where a set of chunks can themselves be chunked), with the chunking
 behaviour being given by another iteratee over the original stream?

 It seems to me that one of the major points of iteratees is to provide
 an abstraction from the kind of chunking irrelevant to the parsing
 logic, otherwise I fail to see any difference (at least relevant to
 chunking) to plain strict IO.

 I thought so, too, but I was informed[1] that iteratees are just a small
 step up the abstraction ladder. The difference compared to an ordinary file
  Handle  is that you can now reuse one and the same iteratee for reading
 from a  String , for instance, without changing the source code of the
 iteratee.

 Furthermore, iteratees can be suspended, which facilities resource
 management like closing files handles after they've been read.

  [1]:
 http://www.reddit.com/r/haskell/comments/ar4wb/understanding_iteratees/c0j0f3r



 Regards,
 Heinrich Apfelmus

 --
 http://apfelmus.nfshost.com

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

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-09-01 Thread Heinrich Apfelmus

Tilo Wiklund wrote:

Daniel Fischer wrote:

[...]
Well, I just gave an example where one would want chunking for reasons
other than performance. That iteratees don't provide the desired
functionality is a different matter.
[...]


In the case of hashing, wouldn't it be more reasonable to consider
iterators over streams of fixed (or at least predictable) sized chunks
(where a set of chunks can themselves be chunked), with the chunking
behaviour being given by another iteratee over the original stream?

It seems to me that one of the major points of iteratees is to provide
an abstraction from the kind of chunking irrelevant to the parsing
logic, otherwise I fail to see any difference (at least relevant to
chunking) to plain strict IO.


I thought so, too, but I was informed[1] that iteratees are just a small 
step up the abstraction ladder. The difference compared to an ordinary 
file  Handle  is that you can now reuse one and the same iteratee for 
reading from a  String , for instance, without changing the source code 
of the iteratee.


Furthermore, iteratees can be suspended, which facilities resource 
management like closing files handles after they've been read.


  [1]: 
http://www.reddit.com/r/haskell/comments/ar4wb/understanding_iteratees/c0j0f3r




Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-28 Thread Tilo Wiklund
On 26/08/2010, Daniel Fischer daniel.is.fisc...@web.de wrote:
 [...]
 Well, I just gave an example where one would want chunking for reasons
 other than performance. That iteratees don't provide the desired
 functionality is a different matter.
 [...]


In the case of hashing, wouldn't it be more reasonable to consider
iterators over streams of fixed (or at least predictable) sized chunks
(where a set of chunks can themselves be chunked), with the chunking
behaviour being given by another iteratee over the original stream?

It seems to me that one of the major points of iteratees is to provide
an abstraction from the kind of chunking irrelevant to the parsing
logic, otherwise I fail to see any difference (at least relevant to
chunking) to plain strict IO.

I'm not particularly well read on anything here, so I could just
totally miss what is going on, in which case I apologise.

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-27 Thread Heinrich Apfelmus

Daniel Fischer wrote:

Heinrich Apfelmus wrote:

Daniel Fischer wrote:

For many hashing or de/encryption algorithms, chunking is more natural
than single-character access.


Even when the chunk lengths are unpredictable? After all, unlike with
fread  in C, you can't request the next chunk to have a certain length
with Iteratees.


Well, I just gave an example where one would want chunking for reasons 
other than performance. That iteratees don't provide the desired 
functionality is a different matter.


For performance reasons, one would still be likely to want the I/O to 
happen in larger chunks than the processing, so it's kind of moot.


Yes, I/O should happen in chunks, but I thought that the Enumerator 
implementations could buffer I/O while still presenting single 
characters to the Iteratees.



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-26 Thread Heinrich Apfelmus

Daniel Fischer wrote:

John Lato wrote:

Heinrich Apfelmus wrote:

Do you have an example where you want chunking instead of single
character access?


I am unable to think of any examples where you want chunking for any
reason other than efficiency.


For many hashing or de/encryption algorithms, chunking is more natural than 
single-character access.


Even when the chunk lengths are unpredictable? After all, unlike with 
fread  in C, you can't request the next chunk to have a certain length 
with Iteratees.



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-26 Thread Daniel Fischer
On Thursday 26 August 2010 09:33:30, Heinrich Apfelmus wrote:
 Daniel Fischer wrote:
  John Lato wrote:
  Heinrich Apfelmus wrote:
 
  Do you have an example where you want chunking instead of single
  character access?
 
  I am unable to think of any examples where you want chunking for any
  reason other than efficiency.
 
  For many hashing or de/encryption algorithms, chunking is more natural
  than single-character access.

 Even when the chunk lengths are unpredictable? After all, unlike with
 fread  in C, you can't request the next chunk to have a certain length
 with Iteratees.


Well, I just gave an example where one would want chunking for reasons 
other than performance. That iteratees don't provide the desired 
functionality is a different matter.
For performance reasons, one would still be likely to want the I/O to 
happen in larger chunks than the processing, so it's kind of moot.

Cheers,
Daniel

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-25 Thread Heinrich Apfelmus

Stephen Tetley wrote:

John Lato wrote:


This is how I think of them.  I particularly your description of them as a
foldl with a pause button.
Maybe it would be helpful to consider iteratees along with delimited
continuations?


Aren't they closer - in implementation and by supported operations -
to resumptions monads?

See many papers by William Harrison here:
http://www.cs.missouri.edu/~harrisonwl/abstracts.html


A general method to implement resumption monads, or, in fact, any monad, 
 is given in my Operational Monad Tutorial:


   http://apfelmus.nfshost.com/articles/operational-monad.html

Here a tiny toy implementation of Iteratees:

   data IterateeI a where
   Symbol :: IterateeI Char
   EOF:: IterateeI Bool
   type Iteratee = ProgramT IterateeI
   symbol = singleton . Symbol
   eof= singleton . EOF

   runString :: Monad m = Iteratee m a - String - m a
   runString m cs = go cs = viewT m
   where
   go _  (Return x)  = return x
   go [] (Symbol := k) = error Expecting input
   go (c:cs) (Symbol := k) = runString (k c) cs
   go cs (EOF:= k) = runString (k $ null cs) cs

   -- an iteratee that counts the number of elements in the input
   count :: Monad m = Iteratee m Int
   count = go 0
   where
   go n = eof = \b - case b of
   True  - return n
   False - symbol  go $! (n+1)


Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-25 Thread Heinrich Apfelmus

Jason Dagit wrote:

Heinrich Apfelmus wrote:


I'm curious, can you give an example where you want to be explicit about
chunking? I have a hard time imagining an example where chunking is
beneficial compared to getting each character in sequence. Chunking
seems to be common in C for reasons of performance, but how does that
apply to Haskell?


[...]
I think it basically comes down to this: We replace lazy io with explicit
chunking because lazy io is unsafe, but explicit chunking can be safe.


Ah, I mean to compare Iteratees with chunking to Iteratees with single 
character access, not to lazy IO.


In C, this would be a comparison between  read  and  getchar . If I 
remember correctly, the former is faster for copying a file simply 
because copying one character at a time with  getchar  is too granular 
(you have to make an expensive system call every time). Of course, this 
reasoning only applies to C and not necessarily to Haskell.


Do you have an example where you want chunking instead of single 
character access?



Supposing we use lazy io (Prelude.readFile):
  1) read the file, compute (a), close the file, read the file, compute (b),
and finally close the file. You can do so in constant space.
  2) read the file, use one pass to calculate both (a) and (b) at the same
time, then close the file. You can do so in constant space.
  3) read the file, use one pass to compute (a) followed by a pass to
compute (b), then close the file.  The space used will be O(filesize).

I consider option #3 to be letting the elements of the stream leak out.
 The computation in (b) references them and thus the garbage collector
doesn't free them between (a) and (b), and the optimizer cannot fuse (a) and
(b) in all cases.


Indeed, Iteratees make it difficult to express option #3, hence 
discouraging this particular space leak. Compared to lazy IO, they also 
make sure that the file handle is closed properly and does not leak.



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-25 Thread Heinrich Apfelmus

Nicolas Pouillard wrote:

Heinrich Apfelmus wrote:


There are also enumerators and enumeratees. I think that

 purpose of enumerator =
run an iteratee on multiple sources
 (i.e. first part of the input from a  Handle ,
   second part from a  String )


I would say more simply that an enumerator is a data-producer (or source).
Although it is a producer defined as a consumer (or sink) feeder.


Sure, but then why not define them as

   type Enumerator a b = Iteratee a b - IO b

? After all, I imagine a data producer to feed an Iteratee with tokens 
until it has run to completion.



The reason for the definition

   type Enumerator a b = Iteratee a b - IO (Iteratee a b)

is that you can now concatenate different input sources.


Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-25 Thread John Lato

 From: Heinrich Apfelmus apfel...@quantentunnel.de

 Jason Dagit wrote:
  Heinrich Apfelmus wrote:
 
  I'm curious, can you give an example where you want to be explicit about
  chunking? I have a hard time imagining an example where chunking is
  beneficial compared to getting each character in sequence. Chunking
  seems to be common in C for reasons of performance, but how does that
  apply to Haskell?
 
  [...]
  I think it basically comes down to this: We replace lazy io with explicit
  chunking because lazy io is unsafe, but explicit chunking can be safe.

 Ah, I mean to compare Iteratees with chunking to Iteratees with single
 character access, not to lazy IO.

 In C, this would be a comparison between  read  and  getchar . If I
 remember correctly, the former is faster for copying a file simply
 because copying one character at a time with  getchar  is too granular
 (you have to make an expensive system call every time). Of course, this
 reasoning only applies to C and not necessarily to Haskell.

 Do you have an example where you want chunking instead of single
 character access?


I am unable to think of any examples where you want chunking for any reason
other than efficiency.  Yesterday I spent some time on an element-wise
iteratee implementation, and unfortunately it's significantly slower than
any of the chunked implementations.  I'm certain there's room for
optimization, but I don't know if it's possible to make up the whole
difference.  I'd need to make some examination of the core to figure out
where it could be improved.

It's also possible that certain other implementations, such as your ProgramT
version or the simplified implementation John Millikin recently posted to
this list, would be more amenable to compiler magic for this purpose.

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-25 Thread Daniel Fischer
On Wednesday 25 August 2010 13:53:47, John Lato wrote:
  From: Heinrich Apfelmus apfel...@quantentunnel.de
 
  Do you have an example where you want chunking instead of single
  character access?

 I am unable to think of any examples where you want chunking for any
 reason other than efficiency.

For many hashing or de/encryption algorithms, chunking is more natural than 
single-character access.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread Conal Elliott
Here's a way I've been tinkering with to think about iteratees clearly.

For simplicity, I'll stick with pure, error-free iteratees for now, and take
chunks to be strings.  Define a function that runs the iteratee:

 runIter :: Iteratee a - [String] - (a, [String])

Note that chunking is explicit here.

Next, a relation that an iteratee implements a given specification, defined
by a state transformer:

 sat :: Iteratee a - State String a - Bool

Define sat in terms of concatenating chunks:

 sat it st =
   second concat . runIter it == runState st . second concat

where the RHS equality is between functions (pointwise/extensionally), and
runState uses the representation of State directly

 runState :: State s a - s - (a,s)

(I think this sat definition is what Conrad was alluding to.)

Now use sat to specify and verify operations on iteratees and to
*synthesize* those operations from their specifications.  Some iteratees
might not satisfy *any* (State-based) specification.  For instance, an
iteratee could look at the lengths or number of its chunks and produce
results accordingly.  I think of such iteratees as abstraction leaks.  Can
the iteratee vocabulary be honed to make only well-behaved (specifiable)
iteratees possible to express?  If so, can we preserve performance benefits?

If indeed the abstraction leaks can be fixed, I expect there will be a
simpler  more conventional semantics than sat above.

  - Conal


On Tue, Aug 24, 2010 at 2:55 PM, Conrad Parker con...@metadecks.org wrote:

 On 24 August 2010 14:47, Jason Dagit da...@codersbase.com wrote:
 
 
  On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker con...@metadecks.org
  wrote:
 
  On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
   I'm not a semanticist, so I apologize right now if I say something
   stupid or
   incorrect.
  
   On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net
 wrote:
  
   So perhaps this could be a reasonable semantics?
  
   Iteratee a = [Char] - Maybe (a, [Char])
  
   I've been tinkering with this model as well.
  
   However, it doesn't really correspond to the iteratee interfaces I've
   seen, since those interfaces allow an iteratee to notice size and
   number of
   chunks.  I suspect this ability is an accidental abstraction leak,
   which
   raises the question of how to patch the leak.
  
   From a purely practical viewpoint I feel that treating the chunking as
   an
   abstraction leak might be missing the point.  If you said, you wanted
   the
   semantics to acknowledge the chunking but be invariant under the size
 or
   number of the chunks then I would be happier.
 
  I think that's the point, ie. to specify what the invariants should
  be. For example (to paraphrase, very poorly, something Conal wrote on
  the whiteboard behind me):
 
  run [concat [chunk]] == run [chunk]
 
  ie. the (a, [Char]) you maybe get from running an iteratee over any
  partitioning of chunks should be the same, ie. the same as from
  running it over the concatenation of all chunks, which is the whole
  input [Char].
 
  I find this notation foreign.  I get [Char], that's the Haskell String
  type, but what is [chunk]?  I doubt you mean a list of one element.

 sorry, that was just my way of writing the list of chunks or perhaps
 the stream of chunks that represents the input.

 Conrad.

 
 
   I use iteratees when I need to be explicit about chunking and when I
   don't
   want the resources to leak outside of the stream processing.  If you
   took
   those properties away, I wouldn't want to use it anymore because then
 it
   would just be an inelegant way to do things.
 
  Then I suppose the model for Enumerators is different than that for
  Iteratees; part of the point of an Enumerator is to control the size
  of the chunks, so that needs to be part of the model. An Iteratee, on
  the other hand, should not have to know the size of its chunks. So you
  don't want to be able to know the length of a chunk (ie. a part of the
  stream), but you do want to be able to, say, fold over it, and to be
  able to stop the computation at any time (these being the main point
  of iteratees ...).
 
  I think I agree with that.
  Jason

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread Heinrich Apfelmus

Conal Elliott wrote:

Is there a simpler model of Enumerator? My intuition is that it's simply a
stream:


[[Enumerator a]] = String


Oddly, 'a' doesn't show up on the RHS.  Maybe the representation ought to be


type Enumerator = forall a. Iteratee a - Iteratee a


so


[[Enumerator]] = String


I concur, that seems to be all there is to it.


There is a small nuance in the Iteratee implementation, namely: if an 
Enumerator is something that provides a complete input stream to an 
Iteratee, why isn't it simply defined as


type Enumerator = forall a. Iteratee a - a

i.e. as a function that runs an Iteratee on an input stream and extracts 
the result? I think the purpose of the implementation


type Enumerator = forall a. Iteratee a - Iteratee a

is that it allows us to concatenate different input streams. In other words

fromString (xs ++ ys) = fromString ys . fromString xs

assuming a function

fromString :: String - Enumerator

To get an actual result from an Iteratee, we only need a way to run it 
on the empty stream.


runOnEmptyString :: Iteratee a - Maybe a



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread Heinrich Apfelmus

Jason Dagit wrote:

From a purely practical viewpoint I feel that treating the chunking
as an abstraction leak might be missing the point.  If you said, you
wanted the semantics to acknowledge the chunking but be invariant
under the size or number of the chunks then I would be happier.

I use iteratees when I need to be explicit about chunking and when I
don't want the resources to leak outside of the stream processing.
If you took those properties away, I wouldn't want to use it anymore
because then it would just be an inelegant way to do things.


I'm curious, can you give an example where you want to be explicit about
chunking? I have a hard time imagining an example where chunking is
beneficial compared to getting each character in sequence. Chunking
seems to be common in C for reasons of performance, but how does that
apply to Haskell?


On the matter of leaking resources outside the stream processing,
Iteratee does not give you any guarantees, it's only a stylistic aid
(which can be powerful, of course). For instance, the following Iteratee
returns the whole stream as a list:

getStream :: Iteratee e a m [a]
getStream = Iteratee . return . Continue $ go []
where
go xs EOF= Yield xs EOF
go xs (Chunk ys) = Continue $ go (xs++ys)

(using the API from  http://ianen.org/articles/understanding-iteratees/ )


Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread Jason Dagit
On Tue, Aug 24, 2010 at 12:49 AM, Heinrich Apfelmus 
apfel...@quantentunnel.de wrote:

 Jason Dagit wrote:

 From a purely practical viewpoint I feel that treating the chunking
 as an abstraction leak might be missing the point.  If you said, you
 wanted the semantics to acknowledge the chunking but be invariant
 under the size or number of the chunks then I would be happier.

 I use iteratees when I need to be explicit about chunking and when I
 don't want the resources to leak outside of the stream processing.
 If you took those properties away, I wouldn't want to use it anymore
 because then it would just be an inelegant way to do things.


 I'm curious, can you give an example where you want to be explicit about
 chunking? I have a hard time imagining an example where chunking is
 beneficial compared to getting each character in sequence. Chunking
 seems to be common in C for reasons of performance, but how does that
 apply to Haskell?


It applies to Haskell for the same reasons, as far as I can tell.  You want
it to manage performance characteristics.  See my example below.  If you
wrote it using chunking you wouldn't need lazy io (which is argued quite
well in other place to be bad and I assume you've read the arguments and
more or less agree).  Furthermore, wouldn't iteratees force you to implement
something equivalent to either option #1 or #2, but #3 wouldn't be possible?

I think it basically comes down to this: We replace lazy io with explicit
chunking because lazy io is unsafe, but explicit chunking can be safe.

So, if you had a lazy pure generator you wouldn't need chunking, although
perhaps the iteratee style would help avoid accidental space leaks that
happen from referencing the stream elements outside of the fold (like #3
below).




 On the matter of leaking resources outside the stream processing,
 Iteratee does not give you any guarantees, it's only a stylistic aid
 (which can be powerful, of course). For instance, the following Iteratee
 returns the whole stream as a list:


I think your example is fine.  I consider it a misbehaving iteratee, in the
same way that returning any large structure would be misbehaving in this
context.  I think, if the iteratee returns something large that's different
than letting things leak out.  It's like a difference of scope.  A
well-behaved iteratee will reduce the input to reasonable return value.
 What would be bad, is if other bits of code could reference parts of the
stream, while the iteratee is looking at it, and hold on to it.  That would
cause a space leak.  An example of this bad behavior, would be to use
readFile to read a file.  Then compute two things: a) sum of the bytes in
the file as Int32, b) length (in number of characters) of the file.

Supposing we use lazy io (Prelude.readFile):
  1) read the file, compute (a), close the file, read the file, compute (b),
and finally close the file. You can do so in constant space.
  2) read the file, use one pass to calculate both (a) and (b) at the same
time, then close the file. You can do so in constant space.
  3) read the file, use one pass to compute (a) followed by a pass to
compute (b), then close the file.  The space used will be O(filesize).

I consider option #3 to be letting the elements of the stream leak out.
 The computation in (b) references them and thus the garbage collector
doesn't free them between (a) and (b), and the optimizer cannot fuse (a) and
(b) in all cases.

There is a fourth option, and that is to use strict io but then each of the
above takes space O(filesize).

I hope that makes sense.  It's getting late here and I could be talking
non-sense, but I have tried the above 3 cases in the past and as best as I
can recall those were my findings.

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread John Lato
I think the big problem with chunking is that many useful iteratees need to
be able to inspect the length of the chunk.  The most obvious is drop, but
there are many others.  Or if not inspect the length, have a new function on
the stream dropReport :: Int - s - (s, Int) which reports how much was
dropped.  Either way, chunking adds a deal of implementation burden.

I suspect that the proper vocabulary for iteratees wouldn't include chunks
at all, only single elements.  This discussion has prompted me to consider
the implications of such an implementation, as it would be much simpler.  I
have one idea that I think will at least maintain performance for many
operations, although there will be performance hits too.  If the drawbacks
are in areas that aren't particularly useful, though, it may be acceptable.

John


 From: Conal Elliott co...@conal.net

 Here's a way I've been tinkering with to think about iteratees clearly.

 For simplicity, I'll stick with pure, error-free iteratees for now, and
 take
 chunks to be strings.  Define a function that runs the iteratee:

  runIter :: Iteratee a - [String] - (a, [String])

 Note that chunking is explicit here.

 Next, a relation that an iteratee implements a given specification, defined
 by a state transformer:

  sat :: Iteratee a - State String a - Bool

 Define sat in terms of concatenating chunks:

  sat it st =
second concat . runIter it == runState st . second concat

 where the RHS equality is between functions (pointwise/extensionally), and
 runState uses the representation of State directly

  runState :: State s a - s - (a,s)

 (I think this sat definition is what Conrad was alluding to.)

 Now use sat to specify and verify operations on iteratees and to
 *synthesize* those operations from their specifications.  Some iteratees
 might not satisfy *any* (State-based) specification.  For instance, an
 iteratee could look at the lengths or number of its chunks and produce
 results accordingly.  I think of such iteratees as abstraction leaks.  Can
 the iteratee vocabulary be honed to make only well-behaved (specifiable)
 iteratees possible to express?  If so, can we preserve performance
 benefits?

 If indeed the abstraction leaks can be fixed, I expect there will be a
 simpler  more conventional semantics than sat above.

  - Conal


 On Tue, Aug 24, 2010 at 2:55 PM, Conrad Parker con...@metadecks.org
 wrote:

  On 24 August 2010 14:47, Jason Dagit da...@codersbase.com wrote:
  
  
   On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker con...@metadecks.org
   wrote:
  
   On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
I'm not a semanticist, so I apologize right now if I say something
stupid or
incorrect.
   
On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net
  wrote:
   
So perhaps this could be a reasonable semantics?
   
Iteratee a = [Char] - Maybe (a, [Char])
   
I've been tinkering with this model as well.
   
However, it doesn't really correspond to the iteratee interfaces
 I've
seen, since those interfaces allow an iteratee to notice size and
number of
chunks.  I suspect this ability is an accidental abstraction leak,
which
raises the question of how to patch the leak.
   
From a purely practical viewpoint I feel that treating the chunking
 as
an
abstraction leak might be missing the point.  If you said, you
 wanted
the
semantics to acknowledge the chunking but be invariant under the
 size
  or
number of the chunks then I would be happier.
  
   I think that's the point, ie. to specify what the invariants should
   be. For example (to paraphrase, very poorly, something Conal wrote on
   the whiteboard behind me):
  
   run [concat [chunk]] == run [chunk]
  
   ie. the (a, [Char]) you maybe get from running an iteratee over any
   partitioning of chunks should be the same, ie. the same as from
   running it over the concatenation of all chunks, which is the whole
   input [Char].
  
   I find this notation foreign.  I get [Char], that's the Haskell String
   type, but what is [chunk]?  I doubt you mean a list of one element.
 
  sorry, that was just my way of writing the list of chunks or perhaps
  the stream of chunks that represents the input.
 
  Conrad.
 
  
  
I use iteratees when I need to be explicit about chunking and when I
don't
want the resources to leak outside of the stream processing.  If
 you
took
those properties away, I wouldn't want to use it anymore because
 then
  it
would just be an inelegant way to do things.
  
   Then I suppose the model for Enumerators is different than that for
   Iteratees; part of the point of an Enumerator is to control the size
   of the chunks, so that needs to be part of the model. An Iteratee, on
   the other hand, should not have to know the size of its chunks. So you
   don't want to be able to know the length of a chunk (ie. a part of the
   stream), but you do want to 

Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread Conal Elliott
Hi John,

Please note that I'm suggesting eliminating chunks from the semantics only
-- not from the implementation.

For precise  simple chunk-less semantics, it's only important that the
iteratees map equivalent input streams to equivalent output streams, where
equivalent means equal after concatenating all of the chunks.  In other
words, the chunk lists denote their concatenations, so semantically equal
inputs must lead to semantically equal outputs.  (Assuming I understand the
intention of chunking as being an implementation issue only, i.e., present
only for optimization.)  We could call this property semantic referential
transparency.  IIUC, 'drop' is semantically RT, since it's *specified* in
terms of elements (and only *implemented* in terms of chunks).

Do you know of any iteratees in use that map (semantically) equal inputs to
(semantically) unequal outputs, i.e.,that  violate semantic RT as I've
defined it?  In the current APIs, one can easily define such iteratees, but
I'm hoping that the programming interfaces can be repaired to eliminate that
problem (the abstraction leaks I've been mentioning).

   - Conal

On Tue, Aug 24, 2010 at 9:32 PM, John Lato jwl...@gmail.com wrote:

 I think the big problem with chunking is that many useful iteratees need to
 be able to inspect the length of the chunk.  The most obvious is drop, but
 there are many others.  Or if not inspect the length, have a new function on
 the stream dropReport :: Int - s - (s, Int) which reports how much was
 dropped.  Either way, chunking adds a deal of implementation burden.

 I suspect that the proper vocabulary for iteratees wouldn't include chunks
 at all, only single elements.  This discussion has prompted me to consider
 the implications of such an implementation, as it would be much simpler.  I
 have one idea that I think will at least maintain performance for many
 operations, although there will be performance hits too.  If the drawbacks
 are in areas that aren't particularly useful, though, it may be acceptable.

 John


 From: Conal Elliott co...@conal.net


 Here's a way I've been tinkering with to think about iteratees clearly.

 For simplicity, I'll stick with pure, error-free iteratees for now, and
 take
 chunks to be strings.  Define a function that runs the iteratee:

  runIter :: Iteratee a - [String] - (a, [String])

 Note that chunking is explicit here.

 Next, a relation that an iteratee implements a given specification,
 defined
 by a state transformer:

  sat :: Iteratee a - State String a - Bool

 Define sat in terms of concatenating chunks:

  sat it st =
second concat . runIter it == runState st . second concat

 where the RHS equality is between functions (pointwise/extensionally), and
 runState uses the representation of State directly

  runState :: State s a - s - (a,s)

 (I think this sat definition is what Conrad was alluding to.)

 Now use sat to specify and verify operations on iteratees and to
 *synthesize* those operations from their specifications.  Some iteratees
 might not satisfy *any* (State-based) specification.  For instance, an
 iteratee could look at the lengths or number of its chunks and produce
 results accordingly.  I think of such iteratees as abstraction leaks.  Can
 the iteratee vocabulary be honed to make only well-behaved (specifiable)
 iteratees possible to express?  If so, can we preserve performance
 benefits?

 If indeed the abstraction leaks can be fixed, I expect there will be a
 simpler  more conventional semantics than sat above.

  - Conal


 On Tue, Aug 24, 2010 at 2:55 PM, Conrad Parker con...@metadecks.org
 wrote:

  On 24 August 2010 14:47, Jason Dagit da...@codersbase.com wrote:
  
  
   On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker con...@metadecks.org
 
   wrote:
  
   On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
I'm not a semanticist, so I apologize right now if I say something
stupid or
incorrect.
   
On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net
  wrote:
   
So perhaps this could be a reasonable semantics?
   
Iteratee a = [Char] - Maybe (a, [Char])
   
I've been tinkering with this model as well.
   
However, it doesn't really correspond to the iteratee interfaces
 I've
seen, since those interfaces allow an iteratee to notice size and
number of
chunks.  I suspect this ability is an accidental abstraction leak,
which
raises the question of how to patch the leak.
   
From a purely practical viewpoint I feel that treating the chunking
 as
an
abstraction leak might be missing the point.  If you said, you
 wanted
the
semantics to acknowledge the chunking but be invariant under the
 size
  or
number of the chunks then I would be happier.
  
   I think that's the point, ie. to specify what the invariants should
   be. For example (to paraphrase, very poorly, something Conal wrote on
   the whiteboard behind me):
  
   run [concat [chunk]] == 

Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-24 Thread John Lato
Hi Conal,

I'm aware of one case that violates semantic referential transparency, but
it's a bug.  Which pretty much proves your point as I understand it.

John

On Tue, Aug 24, 2010 at 2:01 PM, Conal Elliott co...@conal.net wrote:

 Hi John,

 Please note that I'm suggesting eliminating chunks from the semantics only
 -- not from the implementation.

 For precise  simple chunk-less semantics, it's only important that the
 iteratees map equivalent input streams to equivalent output streams, where
 equivalent means equal after concatenating all of the chunks.  In other
 words, the chunk lists denote their concatenations, so semantically equal
 inputs must lead to semantically equal outputs.  (Assuming I understand the
 intention of chunking as being an implementation issue only, i.e., present
 only for optimization.)  We could call this property semantic referential
 transparency.  IIUC, 'drop' is semantically RT, since it's *specified* in
 terms of elements (and only *implemented* in terms of chunks).

 Do you know of any iteratees in use that map (semantically) equal inputs to
 (semantically) unequal outputs, i.e.,that  violate semantic RT as I've
 defined it?  In the current APIs, one can easily define such iteratees, but
 I'm hoping that the programming interfaces can be repaired to eliminate that
 problem (the abstraction leaks I've been mentioning).

- Conal


 On Tue, Aug 24, 2010 at 9:32 PM, John Lato jwl...@gmail.com wrote:

 I think the big problem with chunking is that many useful iteratees need
 to be able to inspect the length of the chunk.  The most obvious is drop,
 but there are many others.  Or if not inspect the length, have a new
 function on the stream dropReport :: Int - s - (s, Int) which reports
 how much was dropped.  Either way, chunking adds a deal of implementation
 burden.

 I suspect that the proper vocabulary for iteratees wouldn't include chunks
 at all, only single elements.  This discussion has prompted me to consider
 the implications of such an implementation, as it would be much simpler.  I
 have one idea that I think will at least maintain performance for many
 operations, although there will be performance hits too.  If the drawbacks
 are in areas that aren't particularly useful, though, it may be acceptable.

 John


 From: Conal Elliott co...@conal.net


 Here's a way I've been tinkering with to think about iteratees clearly.

 For simplicity, I'll stick with pure, error-free iteratees for now, and
 take
 chunks to be strings.  Define a function that runs the iteratee:

  runIter :: Iteratee a - [String] - (a, [String])

 Note that chunking is explicit here.

 Next, a relation that an iteratee implements a given specification,
 defined
 by a state transformer:

  sat :: Iteratee a - State String a - Bool

 Define sat in terms of concatenating chunks:

  sat it st =
second concat . runIter it == runState st . second concat

 where the RHS equality is between functions (pointwise/extensionally),
 and
 runState uses the representation of State directly

  runState :: State s a - s - (a,s)

 (I think this sat definition is what Conrad was alluding to.)

 Now use sat to specify and verify operations on iteratees and to
 *synthesize* those operations from their specifications.  Some iteratees
 might not satisfy *any* (State-based) specification.  For instance, an
 iteratee could look at the lengths or number of its chunks and produce
 results accordingly.  I think of such iteratees as abstraction leaks.
  Can
 the iteratee vocabulary be honed to make only well-behaved (specifiable)
 iteratees possible to express?  If so, can we preserve performance
 benefits?

 If indeed the abstraction leaks can be fixed, I expect there will be a
 simpler  more conventional semantics than sat above.

  - Conal


 On Tue, Aug 24, 2010 at 2:55 PM, Conrad Parker con...@metadecks.org
 wrote:

  On 24 August 2010 14:47, Jason Dagit da...@codersbase.com wrote:
  
  
   On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker 
 con...@metadecks.org
   wrote:
  
   On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
I'm not a semanticist, so I apologize right now if I say something
stupid or
incorrect.
   
On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net
  wrote:
   
So perhaps this could be a reasonable semantics?
   
Iteratee a = [Char] - Maybe (a, [Char])
   
I've been tinkering with this model as well.
   
However, it doesn't really correspond to the iteratee interfaces
 I've
seen, since those interfaces allow an iteratee to notice size and
number of
chunks.  I suspect this ability is an accidental abstraction
 leak,
which
raises the question of how to patch the leak.
   
From a purely practical viewpoint I feel that treating the
 chunking as
an
abstraction leak might be missing the point.  If you said, you
 wanted
the
semantics to acknowledge the chunking but be invariant under the
 size
  or
   

[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Heinrich Apfelmus

Conal Elliott wrote:

For anyone interested in iteratees (etc) and not yet on the iteratees
mailing list.

I'm asking about what iteratees *mean* (denote), independent of the various
implementations.  My original note (also at the end below):


In my world view, iteratees are just a monad M with a single operation

symbol :: M Char

that reads the next symbol from an input stream. In other words, they're 
a very simple parser monad. The emphasis is not on parsing, but on the 
fact that one and the same monadic value can be run on different streams


runHandle :: M a - Handle - IO a
runString :: M a - String - a
runByteString :: M a - ByteString - a

The monad M may also include convenience like exceptions and  liftIO .

I have omitted the chunking [Char] because I don't like it; invariance 
with respect to the chunk sizes is something that should be left to the 
iteratee abstraction.



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Luke Palmer
On Mon, Aug 23, 2010 at 1:06 AM, Heinrich Apfelmus
apfel...@quantentunnel.de wrote:
 Conal Elliott wrote:

 For anyone interested in iteratees (etc) and not yet on the iteratees
 mailing list.

 I'm asking about what iteratees *mean* (denote), independent of the
 various
 implementations.  My original note (also at the end below):

 In my world view, iteratees are just a monad M with a single operation

    symbol :: M Char

 that reads the next symbol from an input stream.

So perhaps this could be a reasonable semantics?

Iteratee a = [Char] - Maybe (a, [Char])
   = MaybeT (State [Char]) a

symbol [] = Nothing
symbol (c:cs) = Just (c, cs)

I'm not experienced with iteratees. Does this miss something?

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


[Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Heinrich Apfelmus

Luke Palmer wrote:

Heinrich Apfelmus wrote:

Conal Elliott wrote:

For anyone interested in iteratees (etc) and not yet on the iteratees
mailing list.

I'm asking about what iteratees *mean* (denote), independent of the
various implementations.


In my world view, iteratees are just a monad M with a single operation

   symbol :: M Char

that reads the next symbol from an input stream.


So perhaps this could be a reasonable semantics?

Iteratee a = [Char] - Maybe (a, [Char])
   = MaybeT (State [Char]) a

symbol [] = Nothing
symbol (c:cs) = Just (c, cs)

I'm not experienced with iteratees. Does this miss something?


From a purely denotational point of view, that's a reasonable semantics.

However, and that's the main point, with this particular semantics, it 
is impossible to implement


runHandle :: M a - Handle - IO a

without using  unsafeInterleaveIO . Typical implementations of iteratees 
do make that possible, by being able to suspend the iteratee after 
feeding it a character.



There are also enumerators and enumeratees. I think that

purpose of enumerator =
run an iteratee on multiple sources
(i.e. first part of the input from a  Handle ,
  second part from a  String )

purpose of enumeratee =
iteratee as a stream transformer, i.e. as a map [x] - [y]

I am not sure whether this elaborate reinvention of the standard lists 
functions is worth the trouble.



Regards,
Heinrich Apfelmus

--
http://apfelmus.nfshost.com

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Nicolas Pouillard
On Mon, 23 Aug 2010 14:38:29 +0200, Heinrich Apfelmus 
apfel...@quantentunnel.de wrote:
 Luke Palmer wrote:
  Heinrich Apfelmus wrote:
  Conal Elliott wrote:
  For anyone interested in iteratees (etc) and not yet on the iteratees
  mailing list.
 
  I'm asking about what iteratees *mean* (denote), independent of the
  various implementations.
 
  In my world view, iteratees are just a monad M with a single operation
 
 symbol :: M Char
 
  that reads the next symbol from an input stream.
  
  So perhaps this could be a reasonable semantics?
  
  Iteratee a = [Char] - Maybe (a, [Char])
 = MaybeT (State [Char]) a
  
  symbol [] = Nothing
  symbol (c:cs) = Just (c, cs)
  
  I'm not experienced with iteratees. Does this miss something?
 
  From a purely denotational point of view, that's a reasonable semantics.
 
 However, and that's the main point, with this particular semantics, it 
 is impossible to implement
 
  runHandle :: M a - Handle - IO a
 
 without using  unsafeInterleaveIO . Typical implementations of iteratees 
 do make that possible, by being able to suspend the iteratee after 
 feeding it a character.
 
 
 There are also enumerators and enumeratees. I think that
 
  purpose of enumerator =
   run an iteratee on multiple sources
  (i.e. first part of the input from a  Handle ,
second part from a  String )

I would say more simply that an enumerator is a data-producer (or source).
Although it is a producer defined as a consummer (or sink) feeder.

An iteratee is thus the consummer. It is defined as an action asking either
for more food or producing a value and a food left over

-- ignoring errors and over-simplifing Stream as Maybe
data Step a b = Continue (Maybe a - IO (Step a b))
  | Yield b (Maybe a)

type Iteratee a b = IO (Step a b)

-- the most important case is when getting Continue as input:
-- type Enumerator a b = (Maybe a - IO (Step a b)) - IO (Step a b)
type Enumerator a b = Step a b - IO (Step a b)

Note that I'm far from an expert on Iteratee but I start to get some intuitions
out of it.

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Conal Elliott

 I have omitted the chunking [Char] because I don't like it; invariance with
 respect to the chunk sizes is something that should be left to the iteratee
 abstraction.


I have this same reservation about iteratees.  And related one for
enumerators and enumeratees.  Assuming my sense of their intended meanings
is on track, they allow lots of well-typed but bogus values.

Defining and adhering to a precise denotational model would eliminate all of
these abstraction leaks, as Luke Palmer alludes to in
http://lukepalmer.wordpress.com/2008/07/18/semantic-design/ .

  - Conal

On Mon, Aug 23, 2010 at 4:06 PM, Heinrich Apfelmus 
apfel...@quantentunnel.de wrote:

 Conal Elliott wrote:

 For anyone interested in iteratees (etc) and not yet on the iteratees
 mailing list.

 I'm asking about what iteratees *mean* (denote), independent of the
 various
 implementations.  My original note (also at the end below):


 In my world view, iteratees are just a monad M with a single operation

symbol :: M Char

 that reads the next symbol from an input stream. In other words, they're a
 very simple parser monad. The emphasis is not on parsing, but on the fact
 that one and the same monadic value can be run on different streams

runHandle :: M a - Handle - IO a
runString :: M a - String - a
runByteString :: M a - ByteString - a

 The monad M may also include convenience like exceptions and  liftIO .

 I have omitted the chunking [Char] because I don't like it; invariance with
 respect to the chunk sizes is something that should be left to the iteratee
 abstraction.


 Regards,
 Heinrich Apfelmus

 --
 http://apfelmus.nfshost.com

 ___
 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: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Conal Elliott

 So perhaps this could be a reasonable semantics?

 Iteratee a = [Char] - Maybe (a, [Char])


I've been tinkering with this model as well.

However, it doesn't really correspond to the iteratee interfaces I've seen,
since those interfaces allow an iteratee to notice size and number of
chunks.  I suspect this ability is an accidental abstraction leak, which
raises the question of how to patch the leak.

What about enumerators? The definition given in Oleg's presentation (
http://okmij.org/ftp/Streams.html#iteratee, slide 21) is

 type Enumerator a = Iteratee a - Iteratee a

Since we have a semantics for Iteratee, we could take this Enumerator
definition as is, and we'd have a semantics, i.e.,

 [[Enumerator a]] = [[Iteratee a]] - [[Iteratee a]]

I don't trust this choice, however.  It could be that, like the Iteratee
representation, the Enumerator representation (as a function) is more an
*implementation* than a semantics.  That is, like Iteratee,

* there might be a simpler and more natural semantic model; and
* the representation may be junky, i.e., having many representations that we
wouldn't want to be denotable.

Is there a simpler model of Enumerator? My intuition is that it's simply a
stream:

 [[Enumerator a]] = String

Oddly, 'a' doesn't show up on the RHS.  Maybe the representation ought to be

 type Enumerator = forall a. Iteratee a - Iteratee a

so

 [[Enumerator]] = String

Are there any enumerator definitions that couldn't use this more restrictive
representation type?  Glancing through the slides, the only Enumerator types
I see are indeed polymorphic over a (the iteratee's result type.)

Again, there's a terrible abstraction leak here, i.e., many ways to write
down enumerators that type-check but are not meaningful within the model.
Can this leak be fixed?

Comments?

  - Conal

On Mon, Aug 23, 2010 at 8:13 PM, Luke Palmer lrpal...@gmail.com wrote:

 On Mon, Aug 23, 2010 at 1:06 AM, Heinrich Apfelmus
 apfel...@quantentunnel.de wrote:
  Conal Elliott wrote:
 
  For anyone interested in iteratees (etc) and not yet on the iteratees
  mailing list.
 
  I'm asking about what iteratees *mean* (denote), independent of the
  various
  implementations.  My original note (also at the end below):
 
  In my world view, iteratees are just a monad M with a single operation
 
 symbol :: M Char
 
  that reads the next symbol from an input stream.

 So perhaps this could be a reasonable semantics?

 Iteratee a = [Char] - Maybe (a, [Char])
   = MaybeT (State [Char]) a

 symbol [] = Nothing
 symbol (c:cs) = Just (c, cs)

 I'm not experienced with iteratees. Does this miss something?

 Luke
 ___
 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: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Jason Dagit
I'm not a semanticist, so I apologize right now if I say something stupid or
incorrect.

On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net wrote:

 So perhaps this could be a reasonable semantics?

 Iteratee a = [Char] - Maybe (a, [Char])


 I've been tinkering with this model as well.

 However, it doesn't really correspond to the iteratee interfaces I've seen,
 since those interfaces allow an iteratee to notice size and number of
 chunks.  I suspect this ability is an accidental abstraction leak, which
 raises the question of how to patch the leak.


From a purely practical viewpoint I feel that treating the chunking as an
abstraction leak might be missing the point.  If you said, you wanted the
semantics to acknowledge the chunking but be invariant under the size or
number of the chunks then I would be happier.

I use iteratees when I need to be explicit about chunking and when I don't
want the resources to leak outside of the stream processing.  If you took
those properties away, I wouldn't want to use it anymore because then it
would just be an inelegant way to do things.

I won't comment further in this email because I think I lack the formal
training to follow the rest of your discussion.  And that is unfortunate for
me.

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Conrad Parker
On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
 I'm not a semanticist, so I apologize right now if I say something stupid or
 incorrect.

 On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net wrote:

 So perhaps this could be a reasonable semantics?

 Iteratee a = [Char] - Maybe (a, [Char])

 I've been tinkering with this model as well.

 However, it doesn't really correspond to the iteratee interfaces I've
 seen, since those interfaces allow an iteratee to notice size and number of
 chunks.  I suspect this ability is an accidental abstraction leak, which
 raises the question of how to patch the leak.

 From a purely practical viewpoint I feel that treating the chunking as an
 abstraction leak might be missing the point.  If you said, you wanted the
 semantics to acknowledge the chunking but be invariant under the size or
 number of the chunks then I would be happier.

I think that's the point, ie. to specify what the invariants should
be. For example (to paraphrase, very poorly, something Conal wrote on
the whiteboard behind me):

run [concat [chunk]] == run [chunk]

ie. the (a, [Char]) you maybe get from running an iteratee over any
partitioning of chunks should be the same, ie. the same as from
running it over the concatenation of all chunks, which is the whole
input [Char].

 I use iteratees when I need to be explicit about chunking and when I don't
 want the resources to leak outside of the stream processing.  If you took
 those properties away, I wouldn't want to use it anymore because then it
 would just be an inelegant way to do things.

Then I suppose the model for Enumerators is different than that for
Iteratees; part of the point of an Enumerator is to control the size
of the chunks, so that needs to be part of the model. An Iteratee, on
the other hand, should not have to know the size of its chunks. So you
don't want to be able to know the length of a chunk (ie. a part of the
stream), but you do want to be able to, say, fold over it, and to be
able to stop the computation at any time (these being the main point
of iteratees ...).

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Jason Dagit
On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker con...@metadecks.orgwrote:

 On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
  I'm not a semanticist, so I apologize right now if I say something stupid
 or
  incorrect.
 
  On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net wrote:
 
  So perhaps this could be a reasonable semantics?
 
  Iteratee a = [Char] - Maybe (a, [Char])
 
  I've been tinkering with this model as well.
 
  However, it doesn't really correspond to the iteratee interfaces I've
  seen, since those interfaces allow an iteratee to notice size and number
 of
  chunks.  I suspect this ability is an accidental abstraction leak, which
  raises the question of how to patch the leak.
 
  From a purely practical viewpoint I feel that treating the chunking as an
  abstraction leak might be missing the point.  If you said, you wanted the
  semantics to acknowledge the chunking but be invariant under the size or
  number of the chunks then I would be happier.

 I think that's the point, ie. to specify what the invariants should
 be. For example (to paraphrase, very poorly, something Conal wrote on
 the whiteboard behind me):

 run [concat [chunk]] == run [chunk]

 ie. the (a, [Char]) you maybe get from running an iteratee over any
 partitioning of chunks should be the same, ie. the same as from
 running it over the concatenation of all chunks, which is the whole
 input [Char].


I find this notation foreign.  I get [Char], that's the Haskell String
type, but what is [chunk]?  I doubt you mean a list of one element.



  I use iteratees when I need to be explicit about chunking and when I
 don't
  want the resources to leak outside of the stream processing.  If you
 took
  those properties away, I wouldn't want to use it anymore because then it
  would just be an inelegant way to do things.

 Then I suppose the model for Enumerators is different than that for
 Iteratees; part of the point of an Enumerator is to control the size
 of the chunks, so that needs to be part of the model. An Iteratee, on
 the other hand, should not have to know the size of its chunks. So you
 don't want to be able to know the length of a chunk (ie. a part of the
 stream), but you do want to be able to, say, fold over it, and to be
 able to stop the computation at any time (these being the main point
 of iteratees ...).


I think I agree with that.

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


Re: [Haskell-cafe] Re: Fwd: Semantics of iteratees, enumerators, enumeratees?

2010-08-23 Thread Conrad Parker
On 24 August 2010 14:47, Jason Dagit da...@codersbase.com wrote:


 On Mon, Aug 23, 2010 at 10:37 PM, Conrad Parker con...@metadecks.org
 wrote:

 On 24 August 2010 14:14, Jason Dagit da...@codersbase.com wrote:
  I'm not a semanticist, so I apologize right now if I say something
  stupid or
  incorrect.
 
  On Mon, Aug 23, 2010 at 9:57 PM, Conal Elliott co...@conal.net wrote:
 
  So perhaps this could be a reasonable semantics?
 
  Iteratee a = [Char] - Maybe (a, [Char])
 
  I've been tinkering with this model as well.
 
  However, it doesn't really correspond to the iteratee interfaces I've
  seen, since those interfaces allow an iteratee to notice size and
  number of
  chunks.  I suspect this ability is an accidental abstraction leak,
  which
  raises the question of how to patch the leak.
 
  From a purely practical viewpoint I feel that treating the chunking as
  an
  abstraction leak might be missing the point.  If you said, you wanted
  the
  semantics to acknowledge the chunking but be invariant under the size or
  number of the chunks then I would be happier.

 I think that's the point, ie. to specify what the invariants should
 be. For example (to paraphrase, very poorly, something Conal wrote on
 the whiteboard behind me):

 run [concat [chunk]] == run [chunk]

 ie. the (a, [Char]) you maybe get from running an iteratee over any
 partitioning of chunks should be the same, ie. the same as from
 running it over the concatenation of all chunks, which is the whole
 input [Char].

 I find this notation foreign.  I get [Char], that's the Haskell String
 type, but what is [chunk]?  I doubt you mean a list of one element.

sorry, that was just my way of writing the list of chunks or perhaps
the stream of chunks that represents the input.

Conrad.



  I use iteratees when I need to be explicit about chunking and when I
  don't
  want the resources to leak outside of the stream processing.  If you
  took
  those properties away, I wouldn't want to use it anymore because then it
  would just be an inelegant way to do things.

 Then I suppose the model for Enumerators is different than that for
 Iteratees; part of the point of an Enumerator is to control the size
 of the chunks, so that needs to be part of the model. An Iteratee, on
 the other hand, should not have to know the size of its chunks. So you
 don't want to be able to know the length of a chunk (ie. a part of the
 stream), but you do want to be able to, say, fold over it, and to be
 able to stop the computation at any time (these being the main point
 of iteratees ...).

 I think I agree with that.
 Jason
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe