Remi Turk wrote:

On Sun, Dec 22, 2002 at 04:00:45AM -0800, Jyrinx wrote:

As an experiment for a bigger project, I cooked up a simple program: It asks for integers interactively, and after each input, it spits out the running total. The wrinkle is that the function for calculating the total should be a non-monadic stream function (that is, type [Integer] -> [Integer] so that runningTotals [1,2,3,4,5] == [1,3,6,10,15]). The task is then to write a function to return a stream of integers, grabbing them from IO-land lazily (a la getContents).

Hi,
what about

module Main where

main = getContents >>= mapM_ print . scanl1 (+) . map read . lines

Ooh, neat! :-) (I love these one-liners - Haskell is absurdly concise :-D ) Hrm ... wasn't aware of the scanl1 thingie; looks like I reinvented the wheel a little ... (Come to think of it, is there any sort of handy quick-reference card for all these combinators? Seems like I and other novices could stand to save some typing ...)

One sticking point, though (and this is relevant to the bigger project): I'd like to print a prompt somehow before each input, which I'm not sure is possible if I just slurp up everything from getContents ... I've thought of using interact somehow, but I'm not sure where I'd start with that one ...

(Out of curiosity: How is the compiler deciding on a type for the input? (That is, how does it know we want integers? Is it just a default?) Looks to me like all it can infer is that it's of classes Read, Show, and Num ... that doesn't much narrow things down ...)

BTW, I already found a major problem with the code I attached earlier, using unsafeInterleaveIO: Run in GHCi (as I had done), it works fine; but compiled by GHC and run as an executable, it waits for input and *then* displays the prompt after the user hits Enter ... not very helpful. I didn't think it would do that, since (putStr "? " >> readLn) seemed pretty explicit as to order of evaluation, but I guess that's what I get for breaking referential transparency ...

Luke Maurer
[EMAIL PROTECTED]

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


Reply via email to