Re: Homework

2003-08-26 Thread oleg

 Here's one: figure out what the following does :-)

 puzzle = (!!) $ map (1:) $ iterate (s (lzw (+)) (1:)) [] where
 s f g x = f x (g x)
 lzw op xs [] = xs
 lzw op [] ys = ys
 lzw op (x:xs) (y:ys) = op x y : lzw op xs ys


Can be written simpler

puzzle = (!!) $ iterate (s (lzw (+)) (0:)) [1] where
s f g x = f x (g x)
lzw op [] ys = ys
lzw op (x:xs) (y:ys) = op x y : lzw op xs ys

Incidentally, a small change gives a different series:

puzzle1 = (!!) $ iterate (s ((lzw (+)).(0:)) (1:)) [] where
s f g x = f x (g x)
lzw op [] ys = ys
lzw op (x:xs) (y:ys) = op x y : lzw op xs ys


can you tell which? Without loading into GHCi? 

Finally, how can we possibly live without the following:

puzzle2 = (!!) $ iterate (s ((lzw (+)).(1:).(0:)) (0:)) [1,1] where
s f g x = f x (g x)
lzw op xs [] = []
lzw op (x:xs) (y:ys) = op x y : lzw op xs ys
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


AW: Haskell indentation

2003-08-26 Thread Markus . Schnell
If your code goes out to far right, it's a good idea to
make a function out of it.

 main = do
   args - getArgs
   case args of
 (fname:_) - normalOp
  _- helpScreen

 normalOp = do
   ...

 helpScreen = putStrLn helpStr

Code should be formatted in a way easy to scan and overview.
You have to SEE the structure of the code.
That depends very much on what your program does.
No rules of thumb. Experience and experiments will do.

(That was taken *directly* out of my convoluted brain and
may be totally dumb.)

Markus


--
Markus Schnell
Infineon Technologies AG, CPR ET
Tel +49 (89) 234-20875


 -Ursprüngliche Nachricht-
 Von: Per Larsson [mailto:[EMAIL PROTECTED] 
 Gesendet: Dienstag, 26. August 2003 14:01
 An: [EMAIL PROTECTED]
 Betreff: Haskell indentation
 
 
 Hi,
 
 I have problems finding a pleasing indentation style for haskell code.
 Especially nested do-blocks have a tendency to run away to 
 the right margin.
 When looking on source code from experienced haskell 
 programmers, there 
 seems not to be any consensus at all, everyone uses their own 
 convention 
 and in many cases one changes style in the same module.
 
 Also, the automatic tools are problematic: the emacs mode I'm using
 bails out in certain contexts and there are few user 
 customizations available. 
 The haskell-src module in the GHC library offers a parser
 and pretty-printer for haskell code with nice options for customizing
 the indentation, but it can't handle comments which is a problem if
 you want to use it as a basis for implementing a indentation tool.
 
 Is there anyone who have given this some thought and have some
 suggestions for a consistent indentation style and/or desktop tools
 which I'm not aware of?
 
 Per
 
 
 ___
 Haskell-Cafe mailing list
 [EMAIL PROTECTED]
 http://www.haskell.org/mailman/listinfo/haskell-cafe
 
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: haskell reify, was sequencing data structures

2003-08-26 Thread Simon Marlow
 
- There needs to be some support from the 
 compilers/interpreters. Hugs 
  already has this. Ghc has some of it, but I abuse the 
 profiling system
  in order to get the names of constructors to be present 
 on the heap.
  I'm not happy with this. Under normal compilation GHC 
 doesn't keep
  constructor names around, as far as I know. However, the 
 new debugger
  in GHC must do something to get names of things, so perhaps the
  -prof hack is no longer needed?

I believe the debugger that Robert Ennals is working on tries to infer
constructor names from the symbol table of the binary.  Personally, I'd
like to see debugging info placed in a separate segment of the binary,
so it won't be loaded with the code but can be used by a debugger.

Cheers,
Simon

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


Debugging

2003-08-26 Thread Konrad Hinsen
My Haskell experiments have reached a size in which debugging tools would be 
more than welcome, so I looked around, and was very disappointed. I tried 
Hood, which is a pain to use (lots of editing of the code required), I looked 
at Buddha but didn't want to downgrade to GHC 5 for trying it (nor is my code 
Haskell 98, because of multi-parameter classes), and all that seems left to 
try is Hat, whose Web site I can't reach at the moment.

So what are you Haskell programmers using for debugging in real life?

Konrad.

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


Re: Puzzle

2003-08-26 Thread Matt Harden
On Friday 22 August 2003 04:29 pm, Ralf Hinze wrote:
 | Seeing as its thst time of year again and everyone is posting their
 | homework, has anyone got any good puzzles to do?
 | I wouldn't mind having a go at something a bit tricky.

 Here is another one: figure out what `unknown' is.

  unknown   =  mysterious unknown
 
  mysterious ks =  0 : weird ks
  weird (k : ks)=  (k + 1) : mysterious ks


Cool!  That leads me to this contraption:

 tricky= 0 : enigma tricky tricky
 enigma (k : ks)   = (k :) . labyrinth (enigma ks)
 labyrinth f (k : _ : ks)  = (k + 1) : f ks

Figure out what `tricky' is, and what its relationship is to `unknown'.

Enjoy!

Matt Harden

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


Re: Debugging

2003-08-26 Thread David Roundy
On Tue, Aug 26, 2003 at 05:27:11PM +0200, Konrad Hinsen wrote:
 My Haskell experiments have reached a size in which debugging tools would
 be more than welcome, so I looked around, and was very disappointed. I
 tried Hood, which is a pain to use (lots of editing of the code
 required), I looked at Buddha but didn't want to downgrade to GHC 5 for
 trying it (nor is my code Haskell 98, because of multi-parameter
 classes), and all that seems left to try is Hat, whose Web site I can't
 reach at the moment.
 
 So what are you Haskell programmers using for debugging in real life?

I mostly just use Debug.Trace, which is basically like the printf method of
debugging in C/C++ (which is what I usually use in those languages).  It's
not very elegant, but generally gets the job done.  The other debugging
tool (in a sense) I use is ghc's profiling, which I find helpful for
figuring out scaling problems.
-- 
David Roundy
http://civet.berkeley.edu/droundy/
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Yet Another Monad Tutorial

2003-08-26 Thread Wolfgang Jeltsch
On Thursday, 2003-08-14, 13:37, CEST, blaat blaat wrote:
 [...]

Hello,

I don't know exactly which of the following questions have already been 
answered but I decided to answer them all anyway.

 What is the difference between putStr a, (putStr a, putStr a), putStr
 (putStr a), putStr (show (putStr a))?

As I stated earlier, IO a denotes an I/O action which has a result of type a. 
So the above expressions have the following meaning:
putStr a:
an I/O action outputting the string a
(putStr a,putStr a):
a pair of two I/O actions, both outputting the string a (This pair
is not executable like an I/O actions is.)
putStr (putStr a):
illegal expression because the argument of putStr has to be of type
String but putStr a has type IO ()
putStr (show (putStr a)):
For this to work, IO () has to be an instance of class Show which
roughly means it must be convertable into a string. putStr a is the
I/O action which outputs a (see above). With a appropriate Show
instance, show (putStr a) would yield a string representation of
this I/O action. putStr (show (putStr a)) would be an I/O action
which outputs this string representation.

 At the moment objects of type IO a _only_ get evaluted when they are the
 _sole_ result of a Haskell program.

I/O expressions get evaluated the same way every other expression does. But 
theit resulting I/O actions get *executed* only under a certain condition. 
And the condition is that the action in question has to be a part of the main 
I/O action.

Evaluating an expression of type IO a doesn't mean to execute it but to 
calculate the I/O action. Since Haskell is pure, expression evaluation 
never does any I/O. I/O actions are not executed by expression evaluation but 
because the meaning of a Haskell program is to execute main.

 What kind of strange dichotomy is that? Is not the _only_ interpretation of
 this dichotomy that objects of type IO describe impure programs (composed of
 actions which are only evaluated when...)?

Yes, they *describe* impure programs. But as I just said, evaluating the 
actions doesn't mean to execute them.

 [...]

 And, if so, is not the only relation between a monad and doing functional IO
 that there is a monadic manner to construct descriptions of impure programs?
 If so, are there also non-monadic ways which might be equally interesting?

Yes, there is nothing magical about monads. They are just an abstract concept 
which fits nicely in the context of building descriptions of actions. And 
there are other ways of constructing such descriptions (as someone already 
mentioned).

 [...]

  From: Derek Elkins [EMAIL PROTECTED]
  To: blaat blaat [EMAIL PROTECTED], [EMAIL PROTECTED]

  [...]

   I believe that central in the IO-issue is not the fact that we are using
   monads for IO - but that we can purely create impure programs which do
   the IO for us ;-), and that those do not have to be of the monadic kind.

Exactly.

 [...]

Wolfgang

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


Re: Haskell indentation

2003-08-26 Thread John Meacham
On Tue, Aug 26, 2003 at 02:00:32PM +0200, Per Larsson wrote:
 I have problems finding a pleasing indentation style for haskell code.
 Especially nested do-blocks have a tendency to run away to the right margin.
 When looking on source code from experienced haskell programmers, there 
 seems not to be any consensus at all, everyone uses their own convention 
 and in many cases one changes style in the same module.
 
 Also, the automatic tools are problematic: the emacs mode I'm using
 bails out in certain contexts and there are few user customizations available. 
 The haskell-src module in the GHC library offers a parser
 and pretty-printer for haskell code with nice options for customizing
 the indentation, but it can't handle comments which is a problem if
 you want to use it as a basis for implementing a indentation tool.
 
 Is there anyone who have given this some thought and have some
 suggestions for a consistent indentation style and/or desktop tools
 which I'm not aware of?

I highly recommend the always-enter model. which means when you are
using layout you always do a linebreak after any block forming construct
(do, let, while, ...) and indent one more softtab level than the
surrounding code. this has a number of advantages:
 * no need for special modes or editor support
 * indents are always an integral number of softtabs.
 * code doesn't run off the right side of the screen since your
   indentation level is relative to the start of the line, not the
   expression that started it.
 * cut-n-paste of code blocks is easier.

examples of what I mean can be seen here: http://repetae.net/john/computer/haskell/

I have known several people to get turned off of haskell when trying to
recreate the indent style usually found in publications by hand... 

John 

-- 
---
John Meacham - California Institute of Technology, Alum. - [EMAIL PROTECTED]
---
___
Haskell-Cafe mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: Puzzle

2003-08-26 Thread Ralf Hinze
Am Dienstag, 26. August 2003 05:54 schrieb Matt Harden:
 Cool!  That leads me to this contraption:
  tricky= 0 : enigma tricky tricky
  enigma (k : ks)   = (k :) . labyrinth (enigma ks)
  labyrinth f (k : _ : ks)  = (k + 1) : f ks

 Figure out what `tricky' is, and what its relationship is to `unknown'.

Well, `tricky' can be defined much simpler:

 tricky =  [0 ..] \/ tricky

where `\/' denotes ... (I leave this to the imagination of the reader).

Cheers, Ralf

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