[Haskell-cafe] Higher order functions and strictness
Joachim Breitner
mail at joachim-breitner.de
Fri Dec 6 17:51:03 UTC 2013
Hi,
we currently have a pattern where a higher order function (like foldl,
or Map.unionWith), which naively build thunks without the passed
function having a chance to prevent that. Therefore, there are variants
like foldl', which seq the result of the function.
Can one have one function that allows for both? I take
mapMaybe :: (a -> b) -> Maybe a -> Maybe b
as an (simple, and not very relevant) example. With that signature,
there is not much "mapMaybe f x" can do. It either applies f lazily to
x, or strictly.
One could have
data Box a = Box a
mapMaybe :: (a -> Box b) -> Maybe a -> Maybe b
and have mapMaybe pattern-match on Box. Then it will evaluate
_something_ of the return value of f, and f can have control over
whether the thing inside the box is evaluated or not. So this is nice,
but unfortunately we now allocate and destruct a box that we do not care
about.
But since I had been looking at some unboxed tuples recently, I noticed
that the singleton unboxed tuple allows for exactly that: Call a
function in a way that it has control (i.e. can force stuff), but do not
necessarily evaluate its result, and all that without extra allocations.
Here is some example code:
{-# LANGUAGE UnboxedTuples #-}
import GHC.HeapView
mapMaybe :: (a -> (# b #) ) -> Maybe a -> Maybe b
mapMaybe _ Nothing = Nothing
mapMaybe f (Just x) = case f x of (# y #) -> Just y
f_plain :: Int -> Int
f_plain x = x + 1
f_lazy :: Int -> (# Int #)
f_lazy x = (# x + 1 #)
f_strict :: Int -> (# Int #)
f_strict x = let y = x + 1 in y `seq` (# y #)
main = do
let x = Just 1
Just y1 <- return $ fmap f_plain x
Just y2 <- return $ mapMaybe f_lazy x
Just y3 <- return $ mapMaybe f_strict x
let results = (y1,y2,y3)
buildHeapTree 10 (asBox results) >>= putStrLn . ppHeapTree
and here the result:
(_thunk _fun{0} (I# 1),_thunk (I# 1),I# 2)
as expected and desired, fmap and mapMaybe with the lazy f left a thunk
in the Just constructor, while the strict f had a chance to evaluate its
result.
Of course (#..#) has it downsides, e.g. you cannot make a newtype for it
(newtype Box a = (# x #)) does not work... but it might be an
interesting design pattern if you need it – imagine a "mapTuple10",
which takes 10 function arguments – you can’t have '-variants for every
2^10 possible strictness combinations.
Greetings,
Joachim
--
Joachim “nomeata” Breitner
mail at joachim-breitner.de • http://www.joachim-breitner.de/
Jabber: nomeata at joachim-breitner.de • GPG-Key: 0x4743206C
Debian Developer: nomeata at debian.org
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 198 bytes
Desc: This is a digitally signed message part
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20131206/01d8f9ff/attachment.sig>
More information about the Haskell-Cafe
mailing list