rather than ask the role of $! I found
it helpful to first grasp the role of seq, since $! is defined in terms
of seq and seq is a "primitive" operation (no prelude definition,
like with IO, it's a "given").
What helped me grasp seq was its role
in a strict fold.
Basically, try to sum all the numbers
from 1 to a million. Prelude "sum" probably gives stack overflow
(if not, up it to a billion ;) ), and so will a naive fold, as is
explained at
http://www.haskell.org/haskellwiki/Stack_overflow
The code below basically restates what
was already on the wiki, but I found my definitions of foldl' (using seq,
bang patterns, and $!) easier to understand than the definition on the
wiki page, and the definition from Data.List. (Maybe I'll edit the wiki.)
t.
{-# LANGUAGE BangPatterns #-}
-- stack overflow
t1 = myfoldl (+) 0 [1..10^6]
-- works, as do myfoldl'' and myfoldl'''
t2 = myfoldl' (+) 0 [1..10^6]
-- (myfoldl f q ) is a curried function
that takes a list
-- If I understand currectly, in this
"lazy" fold, this curried function isn't applied immediately,
because
-- by default the value of q is still
a thunk
myfoldl f z [] = z
myfoldl f z (x:xs) = ( myfoldl f q
) xs
where q = z `f` x
-- here, because of the definition
of seq, the curried function (myfoldl' f q) is applied immediately
-- because the value of q is known
already, so (myfoldl' f q ) is WHNF
myfoldl' f z [] = z
myfoldl' f z (x:xs) = seq q ( myfoldl'
f q ) xs
where q = z `f` x
--same as myfoldl'
myfoldl'' f z [] = z
myfoldl'' f !z (x:xs) = ( myfoldl''
f q ) xs
where q = z `f` x
myfoldl''' f z [] = z
myfoldl''' f z (x:xs) = (myfoldl'''
f $! q) xs
where q = z `f` x
PR Stanley <prstanley@ntlworld.com> Sent by: haskell-cafe-bounces@haskell.org
11/14/2007 06:46 PM
To
haskell-cafe@haskell.org
cc
Subject
[Haskell-cafe] What is the role of $!?
Hi
What is the role of $! ?
As far as I can gather it's something to do with strict application.
Could someone explain what it is meant by the term strict application please?
Thanks,
Paul
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
---
This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.