
Hello,
I'm quite new to Haskell, but this is my understanding... Please correct me
if I am wrong, as there is a good chance I am. ;)
### Begin Code ###
module Main where
main =
putStrLn (show( (take 4 . map (> 0)) (f s t) ))
where
s = 2 : t
t = 3 : s
f = zipWith (-)
{-
- Output:
- *Main> main
- [False,True,False,True]
-}
{-
- (take 4 . map (> 0)) (f s t)
- Evaluates the list for take until 4 elements have been reached.
- Below I replaced (f s t) with the values to make the evaluation
- explicit.
-
- Evaluation:
-
- map (> 0) (zipWith (-) [2 ..] [3 ..])
- False -- 1st element for take.
-
- map (> 0) (zipWith (-) [3 ..] [2 ..])
- True -- 2nd element for take.
-
- map (> 0) (zipWith (-) [2 ..] [3 ..])
- False -- 3rd element for take.
-
- map (> 0) (zipWith (-) [3 ..] [2 ..])
- True -- 4th element for take.
-}
-- EOF.
### End Code ###
Hope that helps.
__
Donnie Jones
On Fri, May 9, 2008 at 1:52 PM, PR Stanley
Hi (take 4 . map (>0)) (f s t) where s = 2 : t t = 3 : s f = zipWith (-) What would be the order of evaluation for the above code? How would I illustrate the evaluation step-by-step? I'm guessing that the code necessitates lazy evaluation and as such it starts with take then it applies f which in turn applies s and t and zipWith until the first element satisfies the predicate in map and This is repeated 4 times What does the list think? Many thanks, Paul P.S. I'm not done with induction. I'm just letting it rst for a bit.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe