Re: [Haskell-cafe] Can Your Programming Language Do This?

2006-08-02 Thread Bernard Pope
On Wed, 2006-08-02 at 10:10 +0200, Stephane Bortzmeyer wrote:
> >From the excellent programming blog "Joel on software", a very good
> text if you need to convince Java or C programmers that functional
> programming is a A Good Thing.
> 
> Probably all the readers of this list will find it brings nothing new
> (that's perfectly right) but it is oriented towards ordinary
> programmers :-)
> 
> http://www.joelonsoftware.com/items/2006/08/01.html

Curiously, I did something similar in my first year Haskell tute this
week, which is the first week of semester (though I forgot to include
the Swedish chef). My class studied C in the previous semester, so to
motivate Haskell I got them to implement a polymorphic zipWith in C.

I've put the tutorial on my web page in case anyone is curious:
   http://www.cs.mu.oz.au/~bjpop/

Under the heading: "433-152 (Zipping Lists)"

Cheers,
Bernie.

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


Re: [Haskell-cafe] compiling lazy functional languages

2006-01-18 Thread Bernard Pope
On Wed, 2006-01-18 at 13:38 -0500, Sam Goldman wrote:
> Sorry if this is too off-topic for this list.
> 
> I'm a hobbyist programmer and I've recently become interested in lazy 
> functional languages, particularly the optimization strategies available 
> to them during compilation. I've been playing around with Haskell for 
> about a year and it has been an excellent resource for me.
> 
> I guess my main question is this: what are the x most compelling 
> directions in optimized compilation for (pure) lazy functional languages 
> in recent research (where x::Nat is an unevaluated thunk in your head)

Things that pop into my head immediately are:

   - Strictness analysis: there are far too many papers on this topic to
list here. Google will give you a good idea.

   - Inlining (which facilitates other optimisations). See for instance:
"Secrets of the Glasgow Haskell Compiler inliner".

   - Unboxing (passing arguments in evaluated form in registers rather
than as pointers to heap objects). 

Simon Peyton Jones has a stack of papers about all sorts of compiler
technologies (some of which fall under the title of optimisation). See:
   http://research.microsoft.com/~simonpj/Papers/papers.html#compiler

That should give you enough to start with.

Bernie.

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


Re: [Haskell-cafe] Learning about haskell compilers

2005-12-20 Thread Bernard Pope
On Tue, 2005-12-20 at 16:58 -0800, John Meacham wrote:
> On Tue, Dec 20, 2005 at 10:36:36AM -0600, Creighton Hogg wrote:
> > I was wondering where I should get started in learing about 
> > how to implement a haskell compiler?

Warning: a whole Haskell compiler is a LOT of work.

Nonetheless there are examples of mostly-single-person compilers and
interpreters out there, so it is possible to do one on your own. Though
I don't think reading their source code is necessarily the best way to
get started. 

I agree with what John said, especially this:

> there are various other abstract machines out there, the Lazy Virtual
> Machine used by Helium described in Daan Leijen's Phd thesis is quite
> interesting, and might make a better first target than G-machine code.

If you want to write a compiler,
targeting LVM is (I believe) the easiest way to get something working.
You could get the source code for hatchet from him to give you a front
end.

Another approach is to write a simple interpreter for a small functional
language and add features in bit-by-bit, as your enthusiasm dictates.
That way, you get the satisfaction of having something work early on. If
you write a compiler it might take weeks or months before it does
anything interesting. Then you can custom build your language with
whatever features take your fancy. For instance you can add a better
record system, or play with meta-programming facilities. I started a
little project like this a while ago, called baskell, which you can get
from here:

   http://www.cs.mu.oz.au/~bjpop/code.html

It has a rudimentary type checker, and a little REPL interface. Feel
free to hack it to pieces.

Cheers,
Bernie.

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


Re: [Haskell-cafe] Re: Tutorial uploaded

2005-12-20 Thread Bernard Pope
On Tue, 2005-12-20 at 20:58 +0100, Peter Simons wrote:

> Curiously enough, if you check out the reference
> documentation at:
> 
>   
> http://haskell.org/ghc/docs/latest/html/libraries/base/Control-Monad-ST.html#t%3ARealWorld
> 
> ..., you'll find that a "World" type actually exists.

While that is true in GHC it is not required by Haskell. The concrete
implementation of IO is compiler specific.

Also worth noting is that there are (two that I know of) languages that
employ an explicit world parameter to do IO: Clean and Mercury. 

Cheers,
Bernie.

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


Re: [Haskell-cafe] \Parsec\Token.hs

2005-11-08 Thread Bernard Pope
On Mon, 2005-11-07 at 21:32 -0500, Sara Kenedy wrote:
> Dear all,
> 
> I run file Token.hs in
> hugs98\libraries\Text\ParserCombinator\Parsec\Token.hs, but it
> displays this error
> 
> ERROR : 64 - Syntax error in data type definition (unexpected '.')
> 
> Anyone know how to fix this? Thanks.

The problem is that module uses extended features which are not part of
Haskell 98. In particular, on line 64 (and many others), it uses an
explicit "forall a." in the type of a record constructor.

You can get hugs to load it with the flag "-98", that is:

   hugs -98 

This tells hugs to allow extended features which are not Haskell 98,
such as the one mentioned above.

If you later decide to use ghc or ghci then you will need to give it the
"-f glasgow-exts" flag.

Cheers,
Bernie.

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


Re: [Haskell-cafe] a new Monad

2005-09-20 Thread Bernard Pope
On Fri, 2005-09-16 at 20:32 +0100, Malcolm Wallace wrote:
> Microsoft has announced the following:
> 
> Developers can also expect a new scripting language for management
> applications, called Monad.  Monad is an object-oriented language
> based on .NET, and provides command-line based management while
> enabling management services to be passed between different
> commands.
> 
> http://www.theregister.co.uk/2005/09/16/microsoft_longhorn_server/
> 
> What a strange choice of name for a language...!  :-)

Quick, someone call the lawyers. :)   

Bernie.

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


Re: [Haskell-cafe] case of (was: [Haskell] Mixing monadic and non-monadic functions)

2005-09-20 Thread Bernard Pope
On Tue, 2005-09-20 at 10:14 +0200, Sven Moritz Hallberg wrote:
> Donn Cave schrieb:
> 
> > The ordinary lambda comes close - in ghc anyway, it supports
> > pattern matching.  But I can't work out the syntax for multiple
> > cases, which would obviously be needed to make it practically
> > useful.
> > 
> > e.g., this seems to be OK:
> > getArgs >>= \ (a:_) -> putStrLn (show a)
> > 
> > but how do you write
> > getArgs >>= \   [] -> putStrLn "(no arguments)"
> > (a:_) -> putStrLn (show a)
> > 
> > (pardon me if I missed where you were going in "case of ...")
> 
> Sorry, I'm just jumping into this discussion, but why shouldn't the
> above work? I.e. extend lambda to accept a group of patterns:
> 
>   \{Pat1 -> exp1; Pat2 -> exp2; Pat3 -> exp3}

What about good old let?

main
   = getArgs >>=  let f []= putStrLn "(no arguments)"
  f (a:_) = putStrLn (show a)
  in f

Bernie.

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


Re: [Haskell-cafe] Dread __DISCARD__

2005-09-19 Thread Bernard Pope
On Sat, 2005-09-17 at 04:55 -0400, Steven Elkins wrote:
> On 9/17/05, Kenneth Hoste <[EMAIL PROTECTED]> wrote:
> 
> > Can you tell us where you got bjpop-ray ? I wrote my own raytracer in
> > Haskell, and would like to check this one out too...
> 
> http://www.cs.mu.oz.au/~bjpop/code.html


Don't expect anything fancy, I wrote this program for a lecture, so it
is fairly simple. 

There are other ray tracers / renderers listed on the Haskell Wiki:

   http://haskell.org/hawiki/H3D

Cheers,
Bernie.

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


Re: [Haskell-cafe] How to debug GHC

2005-09-05 Thread Bernard Pope
On Mon, 2005-09-05 at 11:12 +0100, Malcolm Wallace wrote:

> > Why is this a Cabal issue?  Are you interested in adding Buddah
> > support to Cabal?
> 
> I think what Bernie is referring to is that ghc-pkg-6.4 uses an input
> file format very similar to Cabal's file format, for registering a
> new package.  I would guess that Buddha needs to register a "buddha"
> package with ghc, but for now doesn't have the right syntax.  The file
> formats of Cabal and ghc-pkg are so similar that many people think
> they are the same thing, hence he can be forgiven for referring to
> it as a Cabal issue, rather than a ghc-pkg issue.

Malcolm is right. I have a ghc-pkg problem, not a cabal one. I was
looking in the wrong place (cabal docs), when I should have been looking
in the ghc docs.

Thanks Malcolm. 

Cheers,
Bernie. 

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


Re: [Haskell-cafe] How to debug GHC

2005-09-01 Thread Bernard Pope
On Thu, 2005-09-01 at 14:48 -0700, Frederik Eaton wrote:

> Is it that backtraces are difficult, or just require a lot of
> overhead? It doesn't seem very hard to me, at least in principle. Add
> a "stack trace" argument to every function. Every time a function is
> called, the source location of the call is prepended to the "stack
> trace". I'm not familiar with the implementation of functional
> programming languages, though.

Adding an extra argument to record the application context is one part
of the transformation employed by buddha. 

> Are the following correct?
> 
> 1. Hat requires users to restrict themselves to a certain small subset
> of the standard libraries, and to use hmake

Depends what you mean by standard libraries. As far as I know it
supports all the libraries which are specified in the Haskell 98 Report.
I believe it also supports some libraries in the new hierarchy that come
with the compilers. Also, many libraries can be used by Hat, if you
include them in your own source tree. Supporting all libraries that come
packed with GHC would be nice, but there are numerous hurdles that need
to be jumped over to get to that point. For instance, some libraries do
not use portable Haskell code. Also the issue of how libraries are
distributed in Haskell is a little bit in flux at the moment, since
Cabal is still being polished.

> 2. Buddha doesn't work with GHC 6.4

True. This is a cabal issue, that I haven't had time to resolve. buddha
is limited to even fewer libraries than Hat. So if your program doesn't
work with Hat it will probably not work with buddha. I realise this is a
big problem. I'll be the first to admit that buddha is still an
experimental system. It works fine for some small programs, and might be
useful to beginner programmers. I'm trying to finish my thesis at the
moment, so development has stopped, but I have plenty of ideas to try
out later on.

> 3. I can't find Freya

You can get a binary for Sparc off Henrik Nilsson's homepage:

   http://www.cs.nott.ac.uk/~nhn/

Note that Freya supports a subset of Haskell. From memory, no IO
functions, and no classes. Probably none of the extensions of GHC.

> 4. I can't find HsDebug. Maybe it's part of the fptools cvs
> repository? But solander.dcs.gla.ac.uk seems to be down :(

I don't know about the status of HsDebug. I believe it is not being
maintained. It relies on optimistic evaluation, which is in an
experimental branch of GHC. 

> But getting a stack backtrace when there is an error should be a
> pretty basic feature. It's very hard to debug a large program when you
> can randomly get messages like "*** Exception: Prelude.head: empty
> list" and have no idea where they came from. So GHC's many features
> become much less useful when there is no debugger which supports a
> program that has been written with them.

I agree with you. Note that debugging lazy functional languages is a
notoriously difficult problem. Work is being done, but the Haskell
community is small, and there is a definite shortage of labour.

Cheers,
Bernie.


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


Re: [Haskell-cafe] static typing and interactivity

2005-08-18 Thread Bernard Pope
On Thu, 2005-08-18 at 15:17 +0200, Ketil Malde wrote:
> Hi,
> 
> One slight annoyance using Haskell is the inability to load modules
> with type problems in the interactive environment (i.e. GHCi).  When I
> have a type error, it would be nice to have an interactive way to
> explore what the compiler thinks about the types involved -- as it is,
> I have to resort to adding type signatures more or less at random to
> narrow down the problem.
> 
> I'm not sure if it is technically feasible to (partially) load a
> module with definitions that fail type checking, but if it were, I
> thing it would make developing Haskell programs even nicer :-)

You might be interested in Chameleon:

   http://www.comp.nus.edu.sg/~sulzmann/chameleon/

especially the type debugger.

Bernie.

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


[Haskell-cafe] Re: [Haskell] pros and cons of static typing and side effects ?

2005-08-11 Thread Bernard Pope
[Moved to the Haskell cafe]

It's Friday afternoon here so I thought I'd join in the fun.

On Thu, 2005-08-11 at 23:01 -0400, [EMAIL PROTECTED] wrote:

> While you can't be certain that once your code typechecks, it's bug-free
> (though that does often happen), you can be almost guaranteed that if
> your code typechecks after a refactoring, the refactoring didn't
> introduce any bugs.  

(I tend to agree with ajb's sentiment, but I'll play the devil's
advocate anyway). Perhaps we can reach a fixed point of violent
agreement?

I'm a bit concerned with "can't be certain" on the one hand, and
"_almost_ guaranteed", on the other. 

I guess there are nuances to be explored here, and it is all about
degree of confidence.

Sometimes I have high confidence in my refactoring, like introducing a
state monad. Other times I have much less confidence, like swapping the
order of arguments in numerical calculations.

However, if it weren't for static type checking then I would be much
less game to even _try_ introducing a state monad in my code in the
first place. (Maybe that's just me). Another colleague of mine gave the
opinion that one of the reasons higher-order code is less common in
Prolog than Haskell is that in Prolog does not have static type checking
(it's just one factor out of many). It seems to me like static type
checking has the capacity to make some refactorings much less heroic
than they would be in the non-static setting.

That's my "log on the fire" for today.

Bernie.

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


RE: [Haskell-cafe] Updating the Haskell Standard

2005-07-21 Thread Bernard Pope
On Thu, 2005-07-21 at 09:39 +0100, Simon Peyton-Jones wrote:

> In fact there's a well established way to express the results of such an
> exercise: an Addendum to the Report.   Two of the things you mention
> here already are Addenda
>   http://haskell.org/definition/
> namely FFI and hierarchical namespaces.  [Actually, for the latter, the
> Addendum seems to be stuck at 0.0, and doesn't have any names attached
> to it.  So it's in a kind of limbo, but there's a draft at least.]
> 
> These Addenda are useful for exactly the reasons you describe: to
> solidify and nail down the details of particular language extensions.  

I have a small point, which has been raised in the past.

Extensions are one thing to work on. Clarifications, improvements,
deletions are another, which I think deserve equal attention (sometimes
I find myself wishing for less features rather than more...)

Is it better to have addenda which overrule parts of the report, or is
it better to modify it in place? 

Perhaps there is also room for "proposals to modify" which if widely
agreed upon get turned into actual changes.

Bernie.

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


Re: [Haskell-cafe] Best way to build strings?

2005-07-21 Thread Bernard Pope
On Thu, 2005-07-21 at 09:24 +0200, Tomasz Zielonka wrote:
> On Thu, Jul 21, 2005 at 04:55:15PM +1000, Bernard Pope wrote:
> > On Wed, 2005-07-20 at 17:06 +0100, Andy Gimblett wrote:
> > > show (Prefix l p) = "(" ++ l ++ "->" ++ show p ++ ")"
> > > show (External p q) = "(" ++ show p ++ " [] " ++ show q ++ ")"
> > > 
> > > but to me the extensive use of ++ is not particularly readable.
> > 
> > It is also inefficient because append has complexity proportional to the
> > length of its left argument. That's why the Prelude defines:
> > 
> >type ShowS = String -> String
> > 
> > and functions like showsPrec, shows, showChar
> 
> It's not that bad in this case, because ++ is right-associative.

You are right, in this case it is not too bad.

I meant that there are potential efficiency problems with this style of
generating strings, which ShowS and the pretty printers address.

Cheers,
Bernie.

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


Re: [Haskell-cafe] Best way to build strings?

2005-07-20 Thread Bernard Pope
On Wed, 2005-07-20 at 17:06 +0100, Andy Gimblett wrote:
> A small stylistic question: what's the "best" way to build strings
> containing other values?  For example, I have:
> 
> data Process = Stop |
>Prefix String Process |
>External Process Process
> 
> instance Show Process where
> show Stop = "Stop"
> show (Prefix l p) = "(" ++ l ++ "->" ++ show p ++ ")"
> show (External p q) = "(" ++ show p ++ " [] " ++ show q ++ ")"
> 
> but to me the extensive use of ++ is not particularly readable.

It is also inefficient because append has complexity proportional to the
length of its left argument. That's why the Prelude defines:

   type ShowS = String -> String

and functions like showsPrec, shows, showChar

> Is there a facility like this in Haskell?  Or something else I should
> be using, other than lots of ++ ?

It looks to me like you are doing some kind of pretty printing - that is
you are not printing the term using Haskell syntax. 

My preference is to only use Show where it is derived from the data
declaration, and use a hand-written pretty printer for other tasks,
for example Text.PrettyPrint

Cheers,
Bernie.

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


Re: [Haskell-cafe] Word32 to Int converions

2005-07-20 Thread Bernard Pope
On Wed, 2005-07-20 at 11:43 +0200, yin wrote:
> hello,
> 
> how do I convert an Word32 (or WordXYZ) to Int, or Integer, or Float,
> ...? The Int conversion is the priority.
> 
> Thanks.
> 
> Matej 'Yin' Gagyi

fromIntegral to convert to an instance of Integral, such as Int, Integer
etc

Cheers,
Bernie.

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


Re: [Haskell-cafe] file line operation perhaps need loop

2005-07-20 Thread Bernard Pope

On Wed, 2005-07-20 at 14:27 +0800, Sun Yi Ming wrote:

[snip]

> i first write this snippet of code:
> ---
> import System.IO
> 
> mix :: [a] -> [a] -> [a]
> mix [] ys = ys
> mix xs [] = xs
> mix (x:xs) (y:ys) = [x,y] ++ mix xs ys
> 
> f1 = do contents1 <- readFile "url1.txt"
> contents2 <- readFile "url2.txt"
> let urls1 = lines contents1
> urls2 = lines contents2
> urls = mix urls1 urls2
> writeFile "aha.txt" (unlines urls)
> --
> this works fine, but i think if the two file are very big, and the readFile 
> will consume too many mem.so i need to read the file line by line but stunned 
> by the loop in IO Monad:

Did you try it on a big file to see what happens?

There should not be any problem because readFile is lazy. That is it
reads the contents of the file on demand, not all at once. The only
thing you have to be careful about is that you do not require all the
contents of the file before any output can be produced. 

Bernie.


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


Re: [Haskell-cafe] IO Monad

2005-07-19 Thread Bernard Pope
On Wed, 2005-07-20 at 00:21 +0200, yin wrote:
> Dinh Tien Tuan Anh wrote:
> 
> >
> > Hi,
> > Could anyone explain for me why its not possible to return a primitive
> > type (such as Integer, String) while doing some IO actions ?
> >
> > e.g: foo :: IO() -> String
> >
> > What does it have to do with "lazy evalution" paradigm ?
> >
> In short, to not break functional aproach. Non-IO functions can't call
> IO functions, because IO functions are evaluated every time you call them.

I prefer to say it another way.

I think you asking for a function like this:

   f :: IO a -> a

If so, with this you could write:

   someChar :: Handle -> Char
   someChar handle
  = f (hGetChar handle)

where hGetChar :: Handle -> IO Char
and Handle represents the interface to a file.

This is a big problem for a purely functional language, because it means
someChar is not a function! Given the same Handle argument, successive
calls to someChar might return different results. Functions, by
definition, are not allowed to have this kind of behaviour.

Therefore f is not allowed. 

Cheers,
Bernie.

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


RE: [Haskell-cafe] Strict and non-strict vs eager and lazy, was C onfused about Cyclic struture

2005-07-19 Thread Bernard Pope
On Tue, 2005-07-19 at 09:03 +0100, Bayley, Alistair wrote:
> > From: Bernard Pope [mailto:[EMAIL PROTECTED] 
> > 
> > I should have mentioned this paper:
> > 
> > @article{Tremblay01,
> >   author=   {G. Tremblay},
> >   title={Lenient evaluation is neither strict nor lazy},
> >   journal=  {Computer Languages},
> >   volume=   {26},
> >   number=   {1},
> >   pages={43--66},
> >   year= {2001},
> > }
> > 
> > (however I think he says that Haskell is lazy!)

> Thanks. Do you have a link to a free (beer) version? I don't have an ACM
> subscription.

No. I only have a paper copy lying around somewhere.

> I found this related paper, which was useful:
> How Much Non-strictness do Lenient Programs Require?
> http://www.cs.ucsb.edu/~schauser/papers/95-fpca.ps

I haven't read that. Thanks for the pointer. 

There was a discussion related to this topic on the types list a while
back.

Here is a link to the conclusion:

http://lists.seas.upenn.edu/pipermail/types-list/2004/000352.html

Bernie.

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


Re: [Haskell-cafe] Proposal: deriving ShallowEq?

2005-07-19 Thread Bernard Pope
On Tue, 2005-07-19 at 17:01 +1000, Ben Lippmeier wrote:
> Hello,
> 
> I often find it useful to determine whether two objects are using the 
> same constructor, without worrying about the constructors' arguments.

[snip]

> Having some sort of generic shallowEq operator reduces the need for a 
> host of predicates such as: (this one from Data.Maybe)
> 
>  > isJust x
>  >  = case x of
>  >Just {} -> True
>  >_   -> False
> 
> .. which is an approach that is obviously going to be tedious when the 
> size of the data type becomes large.
> 
> --
> There is way to hack together a partial implementation of the ShallowEq 
> class within GHC, but it leaves much to be desired:
> 
>  > instance Show a => ShallowEq a where
>  >  ([EMAIL PROTECTED]) a b
>  >= (head $ words $ show a) == (head $ words $ show b)

Ouch!

> Questions:
>   1) Does anyone know a better/existing way to implement ShallowEq that 
> doesn't involve enumerating all the constructors in the data type?
> 
>   2) If not, can anyone think of reasons why it wouldn't be a good idea 
> for GHC to derive ShallowEq (by expanding said enumeration)?

DriFT comes to mind:

   http://repetae.net/john/computer/haskell/DrIFT/

it already supplies some query operators that might make shallowEq
redundant. 

Cheers,
Bernie.

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


Re: Re[2]: [Haskell-cafe] How to variables

2005-07-18 Thread Bernard Pope
On Tue, 2005-07-19 at 09:48 +0400, Bulat Ziganshin wrote:
> Hello robert,
> 
> Monday, July 18, 2005, 10:14:43 PM, you wrote:
> 
> 
> rd> main = loop 0 0 0 -- initial values
> rd>   where loop loop_num xpos ypos =
> rd>  do e <- pollEvent
> rd> let xpos' = 
> rd> ypos' = 
> rd> someActionInvolvingPosition xpos' ypos'
> rd> when breakCondition (return ())
> rd> loop (loop_num+1) xpos' ypos'
> 
> the last two lines should be
> 
> if breakCondition
>   then return ()
>   else loop (loop_num+1) xpos' ypos'

Or even better:

   unless breakCondition $ loop (loop_num+1) xpos' ypos'

Bernie.

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


RE: [Haskell-cafe] Strict and non-strict vs eager and lazy, was C onfused about Cyclic struture

2005-07-18 Thread Bernard Pope
On Mon, 2005-07-18 at 15:19 +0100, Bayley, Alistair wrote:
> > From: Jerzy Karczmarczuk [mailto:[EMAIL PROTECTED] 
> > 
> > Bernard Pope wrote:
> > 
> > >I'll be a little bit pedantic here. Haskell, the language definition,
> > >does not prescribe lazy evaluation. It says that the language is
> > >non-strict. Lazy evaluation is an implementation technique which
> > >satisfies non-strict semantics, but it is not the only 
> > technique which
> > >does this.
> > >  
> > >
> > This pedantry is renewed periodically.
> > 
> > It is a pity that nobody ever writes anything about that other
> > methods of implementation of non-strictness, nor about the
> > languages which use those methods.
> > 
> > I believe it might do some good to people who learn functional
> > programming in general, and Haskell in particular.
> > Any takers?
> 
> 
> Not a taker (yet - where can I find information about non-lazy
> implementation of non-strict languages? From Google so far: speculative
> evaluation (Eager Haskell), call-by-name vs call-by-need.)
> 
> Wikipedia frustratingly hints that "other evaluation strategies are
> possible", but that's all it says:
> http://en.wikipedia.org/wiki/Non-strict_programming_language

I should have mentioned this paper:

@article{Tremblay01,
  author=   {G. Tremblay},
  title={Lenient evaluation is neither strict nor lazy},
  journal=  {Computer Languages},
  volume=   {26},
  number=   {1},
  pages={43--66},
  year= {2001},
}

(however I think he says that Haskell is lazy!)

Cheers,
Bernie.

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


Re: Re[2]: [Haskell-cafe] Confused about Cyclic struture

2005-07-11 Thread Bernard Pope
On Sat, 2005-07-09 at 13:12 +0400, Bulat Ziganshin wrote:
> Hello Dinh,
> 
> Friday, July 08, 2005, 9:12:22 PM, you wrote:
> 
> DTTA>   Another question, it's said in the book that using cyclic structure 
> (like 
> DTTA> ones = 1:ones) , the list would be represented by a fixed amount of 
> memory.
> 
> DTTA>   Does it mean [1,1,1..] only occupy one cell of memory ?
> DTTA>   How about  in " take 100 [1,1,...] " ?
> 
> in order to understand how Haskell datastructures uses memory, you
> must remember that Haskell does LAZY evaluation. 

Hi,

I'll be a little bit pedantic here. Haskell, the language definition,
does not prescribe lazy evaluation. It says that the language is
non-strict. Lazy evaluation is an implementation technique which
satisfies non-strict semantics, but it is not the only technique which
does this.

As it happens, GHC, Hugs and nhc98 all employ lazy evaluation. Note that
they may still vary in subtle ways as to the precise details of
evaluation order, due to program transformations that may be applied to
the program during compilation.

As I said in my previous mail, the degree of sharing you get within
Haskell data structures is not defined in the language, it is defined
(perhaps loosely) by the implementation technique. 

Cheers,
Bernie.

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


Re: [Haskell-cafe] Confused about Cyclic struture

2005-07-07 Thread Bernard Pope
On Thu, 2005-07-07 at 18:43 +, Dinh Tien Tuan Anh wrote:
> Hi,
> Im a newbie to Haskell and the concept of "cyclic strutures" has confused me 
> a lot

I think it can be confusing for most people, so I wouldn't be too
concerned.

I may not answer your question completely, but I hope to give you an
idea of where to start.

To understand cyclic structures it is useful to think of "graph
reduction", because these graphs allow us to conveniently represent
sharing between objects. Cycles are simply "self-sharing".

> For example (taken from Richard Bird's book):
> 
> ones = 1:ones
> Its clear that it involves a cyclic structure

Here's a graph representation of that list (needs a fixed width font to
view correctly):

   @<---
  / \  |
 /   \_|
@
   / \
  /   \
 (:)   1

The @ sign represents function application. Note that the top
application has a cyclic right argument.

A good question is how did this cycle come about? One way of answering
this question is to consider how recursion can be implemented in graph
reduction.

The textbook approach is to say: okay let's introduce a dedicated
recursion operator, we'll call it fix (for fixpoint or maybe fixed
point).

The idea is that all recursive equations in the program can be
re-written into non-recursive equations by way of the new fix operator.

The intuition is that we want to get rid of the recursive call inside
ones. Here's a first step:

   ones' = \z -> 1 : z

I've called it ones' to avoid confusion with the original ones.
Now the parameter z takes the place of ones in the right-hand-side.
We can try to get back to the original version by applying ones' to
itself:

   ones' ones'

Of course this doesn't work because ones is now a function, and the
rightmost ones' must also be applied to itself:

   ones' (ones' ones')

Still it doesn't work for the same reason. What we want is a way to
apply ones' to itself "forever". That's where fix comes in. It should
satisfy this equation:

   fix f = f (fix f)

Thus:

   fix ones' = ones' (ones' (ones' (ones' ... ) ) )
= 1 : (ones' (ones' (ones' ... ) ) )
= 1 : 1 : (ones' (ones' ...) )
...

So we can tidy things up a bit:

   ones = fix (\z -> 1 : z)

This is the infinite list of ones, but not recursive (though fix is
recursive!).

So how is fix represented as a graph?

Here's one option:

fix> \f
  |
  |
  @
 / \
/   \
f@
/ \
   /   \
  fix   f

No cycles!

Here's another "clever" option:

fix>\f
 |
 |
 @<
/ \   |
   /   \__|
   f

Now a cycle. Note how the cycle captures the notion of a function
applied to itself forever.

Consider the difference between the two graph implementations of fix in
the definition of ones, such that we have:

 ones>@
 / \
/   \
   fix\z (looks a bit funny because of the lambda)
   |
   |
   @
  / \
 /   \
@ z
   / \
  /   \
 (:)   1

Hopefully you can see that the first version of fix will not produce a
cycle, but the second one will.

> 
> But:
> 
> ones = repeat 1
> repeat x = x:repeat x

> repeat x = xs where xs = x:xs
> create a cyclic stucture ?
> 

Consider the difference between:

   repeat = fix (\z x -> x : z x)

and:

   repeat x = fix (\z -> x : z)

Draw both graphs that result from using the cyclic version of fix. You
should note that only the second graph ends up with a cycle in the tail
of the list.

I've intentionally skipped over some details, like how to handle where
clauses. Grab a textbook to fill in the details.

Note that Haskell does not make any requirements as to how recursion
should be implemented. Therefore there is no guarantee how much sharing
you will get - it depends on the details of the compiler. However, all
the popular compilers seem to implement something akin to the cyclic
version of fix.

Cheers,
Bernie.

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


RE: [Haskell-cafe] Re: [Haskell] ANNOUNCE: GHC survey results

2005-06-30 Thread Bernard Pope
On Thu, 2005-06-30 at 10:36 +0100, Simon Peyton-Jones wrote:
>  | If anything I would like to see the Haskell community produce a
> Haskell
> | front end which was compiler neutral. That would facilitate many
> | interesting projects, and that might even help with the need to
> support
> | new extensions as they come along. There are already some candidates
> | floating around, but it seems they are not widely adopted.
> 
> Well, "ghc -c -fext-core Foo.hs" is a Haskell front end that produces
> System F code ("External Core"), in a file Foo.hcr.  I'm not sure
> whether that was what you meant.

That is one option, but it wasn't really what I meant. I was thinking of
plain old Haskell library code that implements Lexer, Parser, Desugar,
Type Inference etc. All the bits that happen at the front of a Haskell
compiler. This is what hatchet was supposed to be, and may one day
become.

I've tried in the past to pull the front end off ghc and nhc98 without
much luck. Though it looks like ghc-as-a-library might be just what the
doctor ordered. 

There is also the Programmatica project which seems to do a lot of what
I'm thinking of already. 

> However, External Core doesn't seem to have really caught on.

One problem is that different tools will want different views of the
code. External Core is probably too far away from the original source
for something like hat. 

> Only 5% said it was essential, with another 16% saying "nice to have".  

I would hazard a guess that fewer than 5% of GHC's users are writing
source transformation tools :)

> I'm sure there's room to improve the ExtCore route.

You are right, and to be honest I haven't really given much thought to
that route until now. 

Thanks for the pointer.

Cheers,
Bernie.

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


[Haskell-cafe] Re: [Haskell] ANNOUNCE: GHC survey results

2005-06-30 Thread Bernard Pope
[moved to haskell-cafe]

On Tue, 2005-06-28 at 14:46 -0700, John Meacham wrote:
> Unfortunatly hat suffers from the same problem that pretty much every
> non-trivial preprocessor does, as soon as you start using ghc's special
> or experimental features that have not been added to hat yet, they stop
> working. 

I agree this is a problem. 

[snip] 
> I am not sure what the general solution would be. perhaps
> hat being integrated with ghc? 

I think it is preferable to keep them separate. Already a big effort was
put into making hat independent of nhc98. 

There will always be more tools that Haskell could use, which must
transform the source code one way or another. I'd rather not see them
all be pushed inside ghc, or whatever other compiler was popular at the
time. It's probably better for ghc's maintainability to keep these tools
out of its source tree (pure speculation on my part though).

> or better yet would be a standard
> interface for ghc to call a preprocessor but at some intermediate level
> where most of the extensions have been sugared away but most of the
> original source structure still exists... the nice thing about a
> standard interface would be that jhc and other compilers could support
> it too. It wouldn't even need to be a plugin based thing, but rather an
> executable that ghc can run and pass commands to it on stdin and read
> results on stdout.

Sounds nicer. Perhaps GHC-as-a-library might be close to what is needed.
There is a danger that we won't be able to settle upon what is the right
core language to use, and some tools will be left out, thus reverting to
the solution employed by hat at the moment.

>  Being able to just work on any unmodified program the
> compiler supports is a huge feature. 

Yes. 

The problem is that Haskell is being torn in two directions. One
direction is a research vehicle. The other direction is a work-horse.
GHC sits somewhere in the middle, and does an amazing job too. The
trouble is that it has become a fast moving target.

Overall I think Hat's solution is a reasonable compromise between the
competing needs of the tool.

If anything I would like to see the Haskell community produce a Haskell
front end which was compiler neutral. That would facilitate many
interesting projects, and that might even help with the need to support
new extensions as they come along. There are already some candidates
floating around, but it seems they are not widely adopted.

Cheers,
Bernie.



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


Re: [Haskell-cafe] Re: Why I Love Haskell In One Simple Example

2005-06-27 Thread Bernard Pope
On Mon, 2005-06-27 at 22:12 +0200, Mads Lindstrøm wrote:

> > > I had newer seen anybody use "forall a." in function signatures before,
> > > and therefore was curious about its effect. This is probably do to my
> > > inexperience regarding Haskell. 

The "forall a." syntax is not Haskell 98. The universal quantification
of type variables is implicit in type signatures for polymorphic
functions, so there is no need to write it.

Haskell extensions have gone beyond the polymorphism allowed in Haskell
98, and thus have needed to disambiguate different types with explicit
quantifiers. Hence, glasgow-exts and hugs -98 allow an explicit forall.

> > If you omit it, the compiler will decide that test is some arbitrary
> > type (Double, Integer, whatever).  

I think John is talking about the monomorphism restriction and
defaulting. The use of the forall syntax is orthogonal to this.

> > Note that test in this example is not a function.
> OK, I assumed it was, as I thought all functions started with lower case
> and all modules, classes, and data/type constructors started with upper
> case. It does not take any variables as input, but that is still a
> function in my book (but I could be wrong there. I am no mathematician).

This kind of declaration:

   f = rhs

is called a "pattern binding" in Haskell. In contrast to this kind of
declaration:

   g pat1 pat2 ... patn = rhs

which is called a function binding.

g is always a function, but f might be bound to a constant expression,
or it might be bound to a function. Now, for convenience, people might
say f and g are functions, even when f is bound to a constant
expression.

Here's where it gets tricky: pattern bindings can be overloaded (so can
function bindings, but they are less tricky). When a pattern binding is
overloaded it is as if it has an implicit argument, which corresponds to
a type class dictionary (a structure that contains concrete
implementations of the classes overloaded functions). In that situation
you can imagine that the bound variable is a function whose (only)
argument is the dictionary - only you don't pass it in explicitly, the
compiler adds it for you. 

This brings us to the monomorphism restriction, which John was talking
about. This rule says that a pattern binding is not allowed to be
overloaded unless you supply an explicit type signature that says it is
overloaded. I won't go into the justification for this (it is a
contentious point, read the Haskell Report if you like).

Cheers,
Bernie.

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


Re: [Haskell-cafe] Noob error: Type b -> c b Does not match IO a

2005-06-22 Thread Bernard Pope
On Thu, 2005-06-23 at 00:17 -0400, [EMAIL PROTECTED] wrote:

> printFact [] = return
> printFact (x:xs) = do  -- triggers error message
>   putStrLn (x ++ " factorial is " ++ fact x)
>   printFact xs
>   return

> If anyone can explain to me how to fix this error I'd appreciate it.

You forgot to return a value. Typically when you have a function which
performs IO, but you don't want to return anything special as its result
you return the unit value, written as: ().

printFact [] = return ()
printFact (x:xs) = do  -- triggers error message
putStrLn (x ++ " factorial is " ++ fact x)
printFact xs
return ()

Another problem with this code is that you are trying to append numbers
with strings: x ++ " factorial is " ++ fact x

You will need to convert the numbers to strings explicitly with show:

   show x ++ " factorial is " ++ show (fact x)

> Also, what is the difference between <- and let?

The key difference is that, in the do notation, <- is used exclusively
with monads, whereas, let can be used with arbitrary types. The left
argument to <- is some kind of pattern (most often just a single
variable), and the right argument is a monadic expression. Eg:

   x <- getLine

means roughly: _run_ getLine, which returns an (IO String) type, and
bind the actual String to x, whatever the String happens to be in this
instance. Note carefully, that getLine has type (IO String) but x
has type String.

The let keyword is just an ordinary polymorphic binding, eg

   let x = 5 + y

says x is equal to the expression "5 + y" from now on, until the end of
the do block, or another binding of x is introduced. Note carefully that
if (5 + y) has type Int (for argument's sake), then x also has type Int.

Note that for let, unlike <-, the right argument is an arbitrary
expression, it does not have to be a monadic one. 

What might be confusing is that you can write:

   let z = getLine

which is not the same as:

   z <- getLine

The former just makes z equal to getLine, the latter _runs_ getLine,
unpacks the IO result, and binds it to z.

You might benefit from looking at how do notation is desugared into
ordinary expressions, this might help demystify some of it. Take a look
at the Haskell Report:

http://www.haskell.org/onlinereport/exps.html#sect3.14 

> Lastly, any comments on any other detail of the code, particularly
> coding, style are most welcome.

Once you become familiar with Haskell you will learn that some patterns
are idiomatic and can be simplified with the use of library functions.
For instance, many operations over lists can be achieved with a map, or
a fold. Also there are some useful versions of these for monads, such as
mapM and foldM. Reading other people's code sometimes helps.

Cheers,
Bernie.

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


Re: [Haskell-cafe] Buddha and GHC 6.4

2005-06-20 Thread Bernard Pope
On Mon, 2005-06-20 at 18:32 +0200, Ketil Malde wrote:
> More suggestions:
> 
> buggha -- after all, it's a debugger

Sounds like a word Australians use frequently, probably when they find a
bug in their program.

> Beelzebuddha -- by mixing in another deity, the hope is that the
> followers of each can argue with each other, rather than developers.

This one I like. I'm wondering what the mascot would look like...

Cheers,
Bernie.

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


Re: [Haskell-cafe] Buddha and GHC 6.4

2005-06-20 Thread Bernard Pope
On Mon, 2005-06-20 at 17:03 +0200, Gour wrote:
> Bernard Pope ([EMAIL PROTECTED]) wrote:
> > To stop the complaints I renamed every occurrence of buddha to
> > plargleflarp on the webpage. 
> 
> This term is not the best one :-)

No, but it made for some amusing emails.

> To make people happy, why not use the name 'buddha' instead of 'Buddha' ?
> 
> Then they cannot complain any longer ;)

I already did that.

I've also had some positive responses from other people who say they are
buddhist. I think the complainers are definitely in the minority.

To be honest I didn't think anyone would notice my little joke about
plargleflarp.

Anyway, now a new word is added to google's memory.

Cheers,
Bernie.

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


Re: [Haskell-cafe] Buddha and GHC 6.4

2005-06-19 Thread Bernard Pope
On Sun, 2005-06-19 at 12:16 -0400, Jim Apple wrote:
> Has anyone gotten Buddha (now called "plargleflarp" 
> http://www.cs.mu.oz.au/~bjpop/buddha/) do work with GHC 6.4? I'm getting
> 
> ghc-6.4: unknown package: buddha
> 
> Jim
> P.S. What happened to the old name?

Hi Jim,

Unfortunately I haven't had time to get buddha working with GHC 6.4. If
you really need it I can have a look into it later this week (let me
know how urgent it is). Otherwise it is best to stick with the previous
stable release of GHC for the moment.

Plargleflarp is a decoy. I started getting complaints about the name
when the program was noticed by someone on a linux mailing list. The
complaints have come from buddhists who don't like the use of the word.
To stop the complaints I renamed every occurrence of buddha to
plargleflarp on the webpage. 

So what will happen in the long term? As yet I don't know. I might
rename the program when version 2.0 comes out, I might not. If you have
any opinion then please let me know.

Cheers,
Bernie.

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


Re: [Haskell-cafe] foldl and space problems

2005-06-07 Thread Bernard Pope
On Tue, 2005-06-07 at 12:35 +0200, Gracjan Polak wrote:
> Bernard Pope wrote:
> > 
> > A more practical solution is to force the compiler to generate more
> > strict code. 
> 
> I tried to put strictness annotation in every place I could think of. 
> Without result :(

Did you try Data.List.foldl' ?

Perhaps you could post the definition of the state type? Or even better,
a small example of code that runs badly.

Cheers,
Bernie.

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


Re: [Haskell-cafe] foldl and space problems

2005-06-06 Thread Bernard Pope
On Mon, 2005-06-06 at 13:15 +0200, Gracjan Polak wrote:
> Hello,
> 
> My space problems continued...
> 
> I have foldl that produces list, some combining function and quite large 
> source list:
> 
> let xyz = foldl f state myBigList
> 
> This setting should lazyli consume myBigList when next elements of xyz 
> are demanded. Except that it seems that myBigList is held by state to 
> the end of computation :(
> 
> Question: is there any way to see what is holding my source list? I did 
> try to guess, but without results as of now:(

foldl suffers from a fairly notorious space leak when used under lazy
evaluation.

Here is foldl:

   foldl f acc [] = acc
   foldl f acc (x:xs)
  = foldl f (f acc x) xs

Here is a "symbolic" computation using it:

foo = foldl g init [a,b,c]
= foldl g (g init a) [b,c]
= foldl g (g (g init a) b) [c]
= foldl g (g (g (g init a) b) c) []
= (g (g (g init a) b) c)

Notice that the "accumulator" argument grows with size proportional to
the amount of list consumed.

I would guess that your program is suffering from this problem.

The solution?

One theoretical solution is to avoid lazy evaluation in the language
implementation. For instance an "optimistic" evaluator might avoid the
space leak. GHC has an experimental branch that supports this, but as
far as I know it has not seen an official release.

A more practical solution is to force the compiler to generate more
strict code. 

Data.List provides a function called foldl' which has the same type as
foldl, but has different strictness. In particular it forces the
accumulator argument to be "evaluated" before each recursive call to
foldl. 

Unfortunately foldl' is not always as strict as you want, because it
only forces the accumulator to be evaluated to what is called Weak Head
Normal Form. If your accumulated value (state) has a lazy data
constructor, such as the tuple constructor, you might find that the
space usage remains very high. Exercise for the reader: why is this so?

The solution in that case might be to add strictness flags to the
arguments of the state constructors, though this may have adverse
effects elsewhere in the program.

> How do I debug and/or reason about such situation?

Very good question. One solution is to practice your term re-writing
skills and try to reason about the size of the intermediate terms that
are generated.

You might also find GHood useful:

http://www.cs.kent.ac.uk/people/staff/cr3/toolbox/haskell/GHood/

Cheers,
Bernie.

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


Re: [Haskell-cafe] resolving missing class instances @ compile time

2005-05-04 Thread Bernard Pope
On Wed, 2005-05-04 at 17:18 -0700, Greg Buchholz wrote:
> Here's a little quirk I ran into recently.  While making a little
> vector data type in class Num (code below), I didn't implement an
> instance of "fromInteger" (thinking I didn't need it).  Well as you can
> probably guess, it turns out I did need it, and subsequently got a run
> time exception.  Which surprised me a little, since it seems like it
> could have been caught at compile time.  (Although I did ignore a
> warning).  This has probably been answered a thousand times, but could
> someone point me in the direction of documentation explaining why it
> compiled?
> 
> Thanks,
> 
> Greg Buchholz

Hi Greg,

Perhaps this section of the report might help:

>From Section "4.3.2 Instance Declarations" in the Haskell Report:

   http://www.haskell.org/onlinereport/decls.html#instance-decls

"If no binding is given for some class method then the corresponding
default class method in the class declaration is used (if present); if
such a default does not exist then the class method of this instance is
bound to undefined and no compile-time error results."

Cheers,
Bernie.

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


Re: [Haskell-cafe] Where do you use Haskell?

2005-05-03 Thread Bernard Pope
On Tue, 2005-05-03 at 00:38 -0400, Daniel Carrera wrote:

> So, I'm tempted to conclude that FP is only applicable to situations 
> where user interaction is a small part of the program. For example, for 
> simulations.

Others have suggested this is not always true. If you dig around you
will find some computer games written in purely functional languages. I
think these qualify as programs where user interaction is not a small
part of the program.

A very nice demonstration for the Clean programming language can be
found at this link:

http://www.cs.ru.nl/~clean/About_Clean/Platform_Games/platform_games.htm

I believe that the low-level game environment is written in C. However,
to make a new game you only need to write Clean code, the game
environment is just linked in at the end. The conclusion might be in
this case that C is better for the low-level bit twiddling needed for
every game, but Clean is better for constructing the logic of new games.
My personal experience tends to agree with this conclusion. 

Clean is not Haskell, but they are very closely related.

Cheers,
Bernie.

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


Re: [Haskell-cafe] How to debug GHC

2005-04-27 Thread Bernard Pope
On Wed, 2005-04-27 at 07:45 +0200, Ketil Malde wrote:
> > [I want to know] who called who all the way from "main" to "head",
> > because the key function is going to be one somewhere in the middle.
> 
> Perhaps.  I am told stack backtraces are difficult with non-strict
> semantics.

This is true, at least for _lazy_ implementations of non-strict
semantics.

The reason is that the (graph) context in which a function application
is constructed can be very different to the context in which it is
reduced. 

Partial application of functions introduces a similar problem.

This is not a problem in first-order eager languages because the
construction of a (saturated) function application is followed
immediately by its reduction. Thus the contexts of construction and
reduction are the same.

Debugging tools like Hat, Freya and Buddha, "remember" the
construction context of an application, so you can get call graphs that
reflect the dependencies between symbols in the source code. Thus you
can construct a meaningful backtrace etc. Actually, Hat remembers quite
a bit more context than Freya and Buddha, but that's another story.

Another way around the problem is to opt for a non-lazy, but still
non-strict, evaluation order, such as optimistic evaluation. Think:
mostly eager, with the occasional suspension. HsDebug is based on this
idea. (Though it doesn't solve the problem with partial applications.)

Cheers,
Bernie. 

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


Re: [Haskell-cafe] Thompson's Exercise 9.13

2005-04-10 Thread Bernard Pope
On Sun, 2005-04-10 at 15:44 +0900, Kaoru Hosokawa wrote:
> I've been working through Thompson's exercises and got to one I could 
> not solve. It's Exercise 9.13. This is where I need to define init 
> using foldr.
> 
>   init :: [a] -> [a]
>   init "Greggery Peccary" ~> "Greggary Peccar"

Hi,

Here's a tentative solution:

myinit xs
   = foldr (f (length xs)) [] xs
   where
   f len next []
  | len == 1 = []
  | otherwise = [next]
   f len next list@(x:xs)
  | length list + 1 == len = next : xs
  | otherwise = x : next : xs

What's the algorithm? 

We want to float the last item in the list to the front, and then drop
it off when the whole list is processed.

The trick is in knowing when we've processed the entire list. That is
done by keeping track of the length of the original input list, and
comparing that with the number of items processed. There is a special
case when the original list has only one element in it.

Not very efficient though! Also it behaves differently than init for the
empty list.

Perhaps you can come up with a more efficient solution!

Cheers,
Bernie.

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


Re: [Haskell-cafe] State Monad

2005-03-02 Thread Bernard Pope
On Thu, 2005-03-03 at 02:03 +0100, Sam G. wrote:
> I need a Monad to represent an internal stack. I mean I've got a lot of 
> functions which operates on lists and I would not like to pass the list as an 
> argument everytime. 
> 
> Could you help me writing this monad? To start, I just need a + function 
> which will return the sum of the 2 toppest elements of the stack.
> 
> Thanks in advance,
> Sam.

Here's a little program for you to ponder over.
Cheers,
Bernie.


import Control.Monad.State

type Stack a = [a]

push :: a -> Stack a -> Stack a
push x s = x:s

peek :: Stack a -> Maybe a
peek (x:_) = Just x
peek other = Nothing

multTopTwo :: Num a => Stack a -> Stack a
multTopTwo (x:y:rest)
   = x * y : rest
multTopTwo other = other

type StateStack a = State (Stack Int) a

pushList :: [Int] -> StateStack ()
pushList [] = return ()
pushList (x:xs)
   = (modify $ push x) >> pushList xs

prog :: [Int] -> StateStack (Maybe Int)
prog xs
   = do pushList xs
modify multTopTwo
gets peek

main = print $ evalState (prog [1..5]) []

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


Re: [Haskell-cafe] new Haskell hacker seeking peer review

2005-02-18 Thread Bernard Pope
On Fri, 2005-02-18 at 01:58 -0800, Sean Perry wrote:
> I am learning Haskell, so I decided to implement everyone's favorite,
> overused Unix command -- cat. Below is my simple implementation,
> comments about style, implementation, etc. are welcomed.
> 
> In particular, is my untilEOF idiomatically ok? Is there a better way to
> accomplish this? 

Haskell allows lazy IO. One example is hGetContents (and getContents
which is specialised for stdin):

   hGetContents :: Handle -> IO String

It looks like you get the whole file contents at once, but under the
hood it is read on demand.

This allows you to avoid the awkward tests for EOF.

Lazy IO is not without its problems, in particular it makes life hard
for the people who implement the compilers. You should look around the 
haskell list archives for the discussions about lazy that have happened
in the past.

Cheers,
Bernie.

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


RE: [Haskell-cafe] Point-free style (Was: Things to avoid)

2005-02-16 Thread Bernard Pope
On Mon, 2005-02-14 at 15:56 +, Simon Marlow wrote:
> 
> I don't think a general "things to avoid" section should be advocating
> not naming things... in fact I would advocate the reverse.  Name as many
> things as possible, at least until you have a good feel for how much
> point-freeness is going to result in code that you can read again in 6
> months time.

Another reason to name more things is that it can make debugging easier,
especially in something like buddha where it tells you:

   name args => result

Also, avoiding excessive higher-order code can make debugging easier
too.

Cheers,
Bernie.

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


Re: [Haskell-cafe] Equality of functions

2004-11-30 Thread Bernard Pope
On Tue, 2004-11-30 at 13:52 +, Jules Bean wrote:
> In the same sense, you could try
> 
> (map f [1..]) == (map g [1..])
> 
> and it will return False quickly if they are different, but it will run 
> forever if they are the same.

For some very generous definition of "quickly" :)

Bernie.

___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe