Re: [Haskell-cafe] Network parsing and parsec

2005-09-15 Thread Andrew Pimlott
On Thu, Sep 15, 2005 at 06:11:58PM -0700, Andrew Pimlott wrote:
> I don't see why this would be more error-prone than any other approach.

Hmm... I take that back.  I don't know anything about the IMAP protocol,
but after imagining for a few moments what it might be like, I can see
how it could be more difficult than my example.

The user state of the parser might help you...

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


Re: [Haskell-cafe] Network parsing and parsec

2005-09-15 Thread Andrew Pimlott
On Thu, Sep 15, 2005 at 11:09:25AM -0500, John Goerzen wrote:
> The recent thread on binary parsing got me to thinking about more
> general network protocol parsing with parsec.  A lot of network
> protocols these days are text-oriented, so seem a good fit for parsec.
> 
> However, the difficulty I come up time and again is: parsec normally
> expects to parse as much as possible at once.
> 
> With networking, you must be careful not to attempt to read more data
> than the server hands back, or else you'll block.
> 
> I've had some success with hGetContents on a socket and feeding it into
> extremely carefully-crafted parsers, but that is error-prone and ugly.

I don't see why this would be more error-prone than any other approach.
As for ugly, it might be somewhat more pleasant if Parsec could take
input from a monadic action, but hGetContents works, and if you want
more control (eg, reading from a socket fd directly), you can use
unsafeInterleaveIO yourself.

I wrote a parser for s-expressions that must not read beyond the final
')', and while I agree it is tricky, it's all necessary trickiness.
Note I use lexeme parsers as in the Parsec documentation, and use an "L"
suffix in their names.

-- do not eat trailing whitespace, because we want to process a request from
-- a lazy stream (eg socket) as soon as we see the closing paren.
sexpr :: Parser a -> Parser (Sexpr a)
sexpr p = liftM Atom p
  <|> cons p
cons :: Parser a -> Parser (Sexpr a)
cons p  = parens tailL where
  tailL = do  dotL
  sexprL p 
  <|> liftM2 Cons (sexprL p) tailL
  <|> return Nil
sexprL :: Parser a -> Parser (Sexpr a)
sexprL p  = lexeme (sexpr p)
consL :: Parser a -> Parser (Sexpr a)
consL p   = lexeme (cons p)

top p   = between whiteSpace eof p
lexeme p= do  r <- p
  whiteSpace
  return r
whiteSpace  = many space
dotL= lexeme (string ".")
-- NB: eats whitespace after opening paren, but not closing
parens p= between (lexeme (string "(")) (string ")") p

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


Re: [Haskell-cafe] Functional vs Imperative

2005-09-15 Thread John Meacham
On Fri, Sep 16, 2005 at 12:44:02AM +0200, Sebastian Sylvan wrote:
> On 9/16/05, John Meacham <[EMAIL PROTECTED]> wrote:
> > On Thu, Sep 15, 2005 at 09:38:35PM +0400, Bulat Ziganshin wrote:
> > > Hello Dhaemon,
> > >
> > > Tuesday, September 13, 2005, 5:45:52 PM, you wrote:
> > >
> > > D> everywhere... Why use a function language if you use it as an 
> > > imperative
> > > D> one?(i.e. most of the apps in http://haskell.org/practice.html)
> > >
> > > because most complex parts of code are really functional and Haskell
> > > give ability to express them shortly and reliably
> > 
> > Also, in many ways haskell is a 'better impertive language than
> > imperative ones'. the ability to treat IO actions as values and build up
> > computations functionally means your imperative code can end up being
> > much more concise, not to mention typesafe.
> > John
> > 
> 
> What was that slogan? "Haskell - the finest imperative language in the world"?

yeah, something like that. it was in a paper, 'tackling the akward
squad' maybe?

I have wondered whether a book explicitly teaching haskell as an
advanced imperative language from the beginning, introducing advanced FP
and type system concepts slowly, would do well. somewhere in chapter 8 or
so it would say "ha! little do you know, but you have been actually
learning advanced functional programming for 3 chapters now!"

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


Re: [Haskell-cafe] Functional vs Imperative

2005-09-15 Thread Sebastian Sylvan
On 9/16/05, John Meacham <[EMAIL PROTECTED]> wrote:
> On Thu, Sep 15, 2005 at 09:38:35PM +0400, Bulat Ziganshin wrote:
> > Hello Dhaemon,
> >
> > Tuesday, September 13, 2005, 5:45:52 PM, you wrote:
> >
> > D> everywhere... Why use a function language if you use it as an imperative
> > D> one?(i.e. most of the apps in http://haskell.org/practice.html)
> >
> > because most complex parts of code are really functional and Haskell
> > give ability to express them shortly and reliably
> 
> Also, in many ways haskell is a 'better impertive language than
> imperative ones'. the ability to treat IO actions as values and build up
> computations functionally means your imperative code can end up being
> much more concise, not to mention typesafe.
> John
> 

What was that slogan? "Haskell - the finest imperative language in the world"?

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


Re: [Haskell-cafe] Functional vs Imperative

2005-09-15 Thread John Meacham
On Thu, Sep 15, 2005 at 09:38:35PM +0400, Bulat Ziganshin wrote:
> Hello Dhaemon,
> 
> Tuesday, September 13, 2005, 5:45:52 PM, you wrote:
> 
> D> everywhere... Why use a function language if you use it as an imperative
> D> one?(i.e. most of the apps in http://haskell.org/practice.html)
> 
> because most complex parts of code are really functional and Haskell
> give ability to express them shortly and reliably

Also, in many ways haskell is a 'better impertive language than
imperative ones'. the ability to treat IO actions as values and build up
computations functionally means your imperative code can end up being
much more concise, not to mention typesafe.
John

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


Re: [Haskell-cafe] wxHaskell: getting a checkbox state

2005-09-15 Thread Sebastian Sylvan
On 9/14/05, Mark Carter <[EMAIL PROTECTED]> wrote:
> Arthur Baars wrote:
> 
> > Hi,
> >
> > A "Checkbox" is instance of the class Checkable:
> > http://wxhaskell.sourceforge.net/doc/
> > Graphics.UI.WX.Classes.html#t%3ACheckable
> >
> > This means you can "get" and "set" the "checked" property for
> > checkboxes.
> > for example:
> >  c <- get cbEdit checked
> >  set cbEdit [checked := not c ]
> >
> > The following code makes the checkbox print its state every time it
> > is  checked or unchecked:
> >cbEdit <- checkBox f [text := "Edit Mode" ]
> >set cbEdit [ on command :=  do v <- get cbEdit checked
> >   print v
> >   ]
> 
> 
> AHA! Yes, very useful.
> 
> The problem I was having before was that I was trying to create a
> separate function onCbEdit, thus:
>cbEdit <- checkBox p1 [text := "Edit Mode", on command :=  onCbEdit
> textlog   ]
> This had the problem that onCbEdit basically needed to have its control
> passed in (i.e. cbEdit) as a parameter in order to inspect its state. So
> I wanted to do something like:
>cbEdit <- checkBox p1 [text := "Edit Mode", on command :=  onCbEdit
> textlog   cbEdit ]
> Except you can't do that, because  cbEdit isn't yet defined. But your
> suggestion gets 'round that. In the main loop, I now do:
>   cbEdit <- checkBox p1 [text := "Edit Mode" ]
>   set cbEdit [ on command :=  onCbEdit textlog  cbEdit ]

Some extension (I think) to GHC allows mdo-notation (recursive do). So
you can do this:
mdo -- yadayada
   cbEdit <- checBox p1 [text := "Edit Mode", on comand :=
onCbEdit textlog cbEdit]
   -- yadayada...

/S

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


Re: [Haskell-cafe] Binary parser combinators and pretty printing

2005-09-15 Thread Einar Karttunen
On 15.09 21:53, Bulat Ziganshin wrote:
> EK> data Packet = Packet Word32 Word32 Word32 [FastString]
> 
> well. you can see my own BinaryStream package at http://freearc.narod.ru
> 
> class BinaryData a where
>   read :: ...
>   write :: ...

I don't think this is a very good solution. Keeping the on-wire datatypes 
explicit makes sense to me. Also things like endianess will need to be 
taken into account. If the encoding is derived automatically then 
changing the Haskell datatype will change the on-wire representation.
This is not wanted when interfacing with external protocols.

For typeclasses I would rather have:
getWord32BE :: Num a => MyMonad a
than
get :: MyClass a => MyMonad a

Note the difference between the Haskell type determining the on-wire 
type and it being explicit. I already have working TH code for the 
case where I want to derive automatic binary serialization for 
Haskell datatypes (SerTH).

> EK> Maybe even the tuple could be eliminated by using a little of TH.
> 
> it may be eliminated even without TH! :+: and :*: should work,
> although i don't tried this

I don't know how generics work in newer versions of GHC, but 
it may be worth investigating.

- Einar Karttunen

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


Re: [Haskell-cafe] Binary parser combinators and pretty printing

2005-09-15 Thread Bulat Ziganshin
Hello Einar,

Tuesday, September 13, 2005, 7:03:00 PM, you wrote:

EK> data Packet = Packet Word32 Word32 Word32 [FastString]

well. you can see my own BinaryStream package at http://freearc.narod.ru

class BinaryData a where
  read :: ...
  write :: ...

instance BinaryData Word32 where
  read = ...
  write = ...

instance BinaryData FastString where
  read = ...
  write = ...

instance (BinaryData a, BinaryData b, BinaryData c, BinaryData d) => BinaryData 
(a,b,c,d) where
  read = ...
  write = ...

instance (BinaryData a) => BinaryData [a] where
  read = ...
  write = ...

EK> 1) Simple monadic interface

EK> getPacket = do mid <- getWord32BE
EK>sid <- getWord32BE
EK>rid <- getWord32BE
EK>nmsg<- getWord32BE
EK>vars<- replicateM (fromIntegral nmsg) (getWord32BE >>= 
getBytes)
EK>return $ Packet mid sid rid nmsg vars

turns into:

  (a,b,c,d) <- read
  return $ Packet a b c d

EK> Maybe even the tuple could be eliminated by using a little of TH.

it may be eliminated even without TH! :+: and :*: should work,
although i don't tried this




-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



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


Re: [Haskell-cafe] Functional vs Imperative

2005-09-15 Thread Bulat Ziganshin
Hello Dhaemon,

Tuesday, September 13, 2005, 5:45:52 PM, you wrote:

D> everywhere... Why use a function language if you use it as an imperative
D> one?(i.e. most of the apps in http://haskell.org/practice.html)

because most complex parts of code are really functional and Haskell
give ability to express them shortly and reliably


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



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


Re: [Haskell-cafe] RE: [Haskell] ANNOUNCE: ghc-src version 0.2.0

2005-09-15 Thread Bulat Ziganshin
Hello Simon,

Tuesday, September 13, 2005, 5:00:17 PM, you wrote:

>> But I did finish the combinator based parser for GHC. I tested it by
>> having GHC( with combinator parser) compile itself and all the
>> libraries. This took about 10% longer than with the original GHC, so
>> in practice its speed is acceptable.

SM> With all due respect, a 10% increase in compile time isn't acceptable at
SM> all!

ability to extend/change Haskell syntax will be very interesting. i
will be glad to see it in some Haskell compiler, at least as
alternative front-end. for example, this give us ability to implement
automatic lifting with `borrow` keyword, dicussed now in Haskell ML


-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



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


Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-15 Thread Adam Turoff
On 9/15/05, John Goerzen <[EMAIL PROTECTED]> wrote:
> Not only that, but IMAP has a way where you can embed, say {305} instead
> of a string.  That means, "after you finish reading this line, read
> exactly 305 bytes, and consider that to be used here."  But if you see
> "{305}" (the double quotes indicating a string), this is just a string
> containing the text {305}.
> 
> So, to make that approach work, I would really need to do a lot of work
> outside of Parsec -- the stuff that I really want to use Parsec for, I
> think.

Well, you do have a state monad to work with.  Why not just stuff
the number 305 into your state, keep reading until you've read 305 bytes 
(decrementing the count as you read), and return the 305-byte string 
as your result for this parser?  When you resume,  you should 
be ready to parse the next very token after the 305-byte string.

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


[Haskell-cafe] Re: Network parsing and parsec

2005-09-15 Thread John Goerzen
On 2005-09-15, Peter Simons <[EMAIL PROTECTED]> wrote:
> The approach I recommend is to run a scanner (tokenizer)
> before the actual parser.
>
> IMAP, like most other RFC protocols, is line-based; so you
> can use a very simple scanner to read a CRLF-terminated line
> efficiently (using non-blocking I/O, for example), which you
> can then feed into the parser just fine because you know
> that it has to contain a complete request (response) that
> you can handle.

I thought of that, but that isn't really true for IMAP.  IMAP responses
can span many, many lines (for instance, it can return a list of all
matching messages in a folder, or multiple bits of status results).

Or they can use only one line.

Not only that, but IMAP has a way where you can embed, say {305} instead
of a string.  That means, "after you finish reading this line, read
exactly 305 bytes, and consider that to be used here."  But if you see
"{305}" (the double quotes indicating a string), this is just a string
containing the text {305}.

So, to make that approach work, I would really need to do a lot of work
outside of Parsec -- the stuff that I really want to use Parsec for, I
think.

-- John


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


Re: [Haskell-cafe] Doing Windows Programming

2005-09-15 Thread Brian McQueen
Thanks for this!  That is helpful and eye-opening.  I do want to use
ghc, though I don't really have a good reason for that choice.  It
seems that if I were to go with hugs, it would be easier going.

On 9/15/05, Juan Carlos Arevalo Baeza <[EMAIL PROTECTED]> wrote:
> GHC 6.4's support for Win32 is definitely broken. However, I've been
> experimenting with implementing a wrapper using FFI, and that has proven to
> be reasonably easy. The only gotchas:
>  
>  1- You have to run ghc --make with the extra -lGdi32, -lUser32, etc...
> switches.
>  2- You can't use something like ghc -e:Main.main Main.hs to run Win32
> programs. As soon as you are passing function pointers around (WindowProcs
> and the like) it just won't work because of the stub.c files.
>  3- Safely managing function pointers can be tricky, because FuncPtr has to
> be explicitly deallocated or else it will leak.
>  4- If you don't want to have the console window, you have to add the
> -optl-mwindows switch to the command line (hopefully, it'll be documented at
> some point) and refrain from ever writing anything out to stdout or stderr.
> If you want to be able to write stuff out (so that you can see it by
> ommitting the switch) then do something like this: 
>  
>  ---8<---
>  initGUI = catch (putStr " \b" >> hFlush stdout) $ \_ -> do
>  fd <- open "nul" 2 0
>  dup2 fd 0
>  dup2 fd 1
>  dup2 fd 2
>  return ()
>  
>  open fname oflag pmode = withCString fname $ \c_fname -> c_open c_fname
> oflag pmode
>  
>  foreign import ccall unsafe "HsBase.h __hscore_open" c_open :: CString ->
> CInt -> CInt -> IO CInt
>  foreign import ccall unsafe "HsBase.h dup2" dup2:: CInt -> CInt
> -> IO CInt
>  ---8<---
>  
> and then call initGUI from your main.
>  
> All very platform/compiler dependent, of course, so use with good
> judgement.
>  
>  JCAB
> 
>  
>  Neil Mitchell wrote: 
>  Hi,
> 
> The CVS version of Hugs for Windows has a module
> System.Win32.Registry, along with quite a few other windows modules.
> 
> I'm not sure if the last stable releases have these features in or not.
> 
> Thanks
> 
> Neil
> 
> On 9/11/05, Brian McQueen <[EMAIL PROTECTED]> wrote:
>  
>  
>  How can I use Haskell to do general Windows programming, like you
> would be able to do if you were using one of those Windows IDEs:
> 
> *moving data between windows apps
> *gaining access to windows registry
> *in general, access to the available Windows APIs
> 
> I'm sure folks must be writing Windows apps in Haskell somewhere. How
> do I get started?
> 
> Brian McQueen
> ___
> 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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Doing Windows Programming

2005-09-15 Thread Juan Carlos Arevalo Baeza




   GHC 6.4's support for Win32 is definitely broken. However, I've been
experimenting with implementing a wrapper using FFI, and that has
proven to be reasonably easy. The only gotchas:

1- You have to run ghc --make with the extra -lGdi32, -lUser32, etc...
switches.
2- You can't use something like ghc -e:Main.main Main.hs to run Win32
programs. As soon as you are passing function pointers around
(WindowProcs and the like) it just won't work because of the stub.c
files.
3- Safely managing function pointers can be tricky, because FuncPtr has
to be explicitly deallocated or else it will leak.
4- If you don't want to have the console window, you have to add the
-optl-mwindows switch to the command line (hopefully, it'll be
documented at some point) and refrain from ever writing anything out to
stdout or stderr. If you want to be able to write stuff out (so that
you can see it by ommitting the switch) then do something like this: 

---8<---
initGUI = catch (putStr " \b" >> hFlush stdout) $ \_ -> do
    fd <- open "nul" 2 0
    dup2 fd 0
    dup2 fd 1
    dup2 fd 2
    return ()

open fname oflag pmode = withCString fname $ \c_fname -> c_open
c_fname oflag pmode

foreign import ccall unsafe "HsBase.h __hscore_open" c_open :: CString
-> CInt -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h dup2" dup2    :: CInt
-> CInt -> IO CInt
---8<---

   and then call initGUI from your main.

   All very platform/compiler dependent, of course, so use with good
judgement.

JCAB

Neil Mitchell wrote:

  Hi,

The CVS version of Hugs for Windows has a module
System.Win32.Registry, along with quite a few other windows modules.

I'm not sure if the last stable releases have these features in or not.

Thanks

Neil

On 9/11/05, Brian McQueen <[EMAIL PROTECTED]> wrote:
  
  
How can I use Haskell to do general Windows programming, like you
would be able to do if you were using one of those Windows IDEs:

*moving data between windows apps
*gaining access to windows registry
*in general, access to the available Windows APIs

I'm sure folks must be writing Windows apps in Haskell somewhere.  How
do I get started?

Brian McQueen
___
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 mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: Network parsing and parsec

2005-09-15 Thread Peter Simons
John Goerzen writes:

 > With networking, you must be careful not to attempt to
 > read more data than the server hands back, or else you'll
 > block. [...] With a protocol such as IMAP, there is no
 > way to know until a server response is being parsed, how
 > many lines (or bytes) of data to read.

The approach I recommend is to run a scanner (tokenizer)
before the actual parser.

IMAP, like most other RFC protocols, is line-based; so you
can use a very simple scanner to read a CRLF-terminated line
efficiently (using non-blocking I/O, for example), which you
can then feed into the parser just fine because you know
that it has to contain a complete request (response) that
you can handle.

Peter

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


[Haskell-cafe] Network parsing and parsec

2005-09-15 Thread John Goerzen
Hello,

The recent thread on binary parsing got me to thinking about more
general network protocol parsing with parsec.  A lot of network
protocols these days are text-oriented, so seem a good fit for parsec.

However, the difficulty I come up time and again is: parsec normally
expects to parse as much as possible at once.

With networking, you must be careful not to attempt to read more data
than the server hands back, or else you'll block.

I've had some success with hGetContents on a socket and feeding it into
extremely carefully-crafted parsers, but that is error-prone and ugly.

Here's the problem.  With a protocol such as IMAP, there is no way to
know until a server response is being parsed, how many lines (or bytes)
of data to read.  Ideally, I would be able to slrup in more data as I
go, but that doesn't seem to be very practical in Parsec either.

Suggestions?

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


RE: Re[2]: [Haskell-cafe] Weak hashtable memoization code?

2005-09-15 Thread Simon Marlow
On 15 September 2005 13:44, Bulat Ziganshin wrote:

> Hello Simon,
> 
> Tuesday, September 13, 2005, 7:42:52 PM, you wrote:
> 
>> There's the memo table implementation in the util package:
>> hslibs/util/Memo.lhs.  Note that this is scheduled for demolition in
>> GHC 
>> 6.6.
> 
> why?

It doesn't perform very well, there's a general lack of interest, and
nobody interested in supporting it.  The right thing to do is make it
available as a Cabal package.

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


Re: [Haskell-cafe] Autrijus Tang interviewed by Perl.com

2005-09-15 Thread Philippa Cowderoy

On Thu, 15 Sep 2005, Joel Reymont wrote:


What is the meaning of xxs@(x:xs) in the code below?

I understand that x:xs is a list /head:tail/ but a tuple of (x:xs) does not 
make sense.




It's not a tuple, it's just the usual meaning for parens.

--
[EMAIL PROTECTED]

The task of the academic is not to scale great 
intellectual mountains, but to flatten them.

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


Re: [Haskell-cafe] Autrijus Tang interviewed by Perl.com

2005-09-15 Thread Joel Reymont

What is the meaning of xxs@(x:xs) in the code below?

I understand that x:xs is a list /head:tail/ but a tuple of (x:xs)  
does not make sense.


main = print (take 1000 hamming)
hamming = 1 : map (2*) hamming ~~ map (3*) hamming ~~ map (5*)  
hamming

where
xxs@(x:xs) ~~ yys@(y:ys)-- To merge two streams:
| x==y = (x : xs~~ys)   --  if the heads are common,  
take that

| xy  = (y : xxs~~ys)  --and proceed to merge the rest

Thanks, Joel

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


Re[2]: [Haskell-cafe] Weak hashtable memoization code?

2005-09-15 Thread Bulat Ziganshin
Hello Simon,

Tuesday, September 13, 2005, 7:42:52 PM, you wrote:

SM> There's the memo table implementation in the util package:
SM> hslibs/util/Memo.lhs.  Note that this is scheduled for demolition in GHC
SM> 6.6.

why?

-- 
Best regards,
 Bulatmailto:[EMAIL PROTECTED]



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


[Haskell-cafe] Autrijus Tang interviewed by Perl.com

2005-09-15 Thread John Goerzen
metaperl posted about this on the Haskell Sequence this morning and I
thought all of you list readers might be interested as well.

Autrijus Tang is well-known for developing the first working Perl 6
interpreter, Pugs. Pugs is written in Haskell. Perl.com has an
interview with Autrijus, and page 2 of that interview gets
particularly interesting.

  URL: http://www.perl.com/pub/a/2005/09/08/autrijus-tang.html?page=2

Favorite quote:

  "Haskell . . . is faster than C++, more concise than Perl, more
  regular than Python, more flexible than Ruby, more typeful than C#,
  more robust than Java, and has absolutely nothing in common with
  PHP."

-- John

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


Re: [Haskell-cafe] How to call ICS from Haskell

2005-09-15 Thread Malcolm Wallace
Huong Nguyen <[EMAIL PROTECTED]> writes:

>  Do you know how to call ICS (Integrated Canonizer and Solver: 
> www.icansolve.com ) or PVS (Prototype Verification
> System) from Haskell ?

Normally, it is easy to call external libraries via Haskell's FFI
(Foreign Function Interface), which is most suited to libraries
written in C.
http://www.cse.unsw.edu.au/~chak/haskell/ffi/

I see that ICS is written in O'Caml and PVS in Common Lisp.  ICS at
least has a C-level API, so there should be no problem in writing a
binding with the FFI.  But I don't know enough about Common Lisp to
be able to say whether the FFI can handle PVS or not.

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