dons:
ndmitchell:
Hi
Does GHC specialize map? If it doesn't, then hand crafted version could be faster.
GHC doesn't specialize map, and a hand-crafted one could be faster - but you then wouldn't get foldr/build fusion. In general HLint tries to make the code prettier, but sometimes you will need to deviate from its suggestions when you've profiled etc. To stop HLint warning you just create Hints.hs and include the line "ignore = LennartsSuperFastModule.mySpecialisedMap" - full details in the manual.
I found so many 'map' re-implementations in Haskell libraries, even in those, where I thought their programmers must be more experienced than me. Hm, maybe even in libraries by Neil?
I can't really be blamed for making mistakes before HLint ;-)
But GHC tends to inline and specialise map, due to:
"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)
So that,
main = print (map toUpper "haskell")
Yields:
s :: Addr# s = "haskell"#
letrec unpack_snX :: Int# -> [Char] unpack_snX = \ (x :: Int#) -> case indexCharOffAddr# s x of i { _ -> ($wtoUpper i) (: @ Char) (unpack_snX (+# x 1) '\NUL' -> [] @ Char
Which looks inlined and specialised to my eyes.
Oh, I should note the inlining only happens here since the list constant is a 'build', and map is a bulid . foldr, so we get a build/foldr fusion, and an inlined map as a result. If we just use map in isolation, no inlining: A.foo = \ (xs_ala :: [Char]) -> map @ Char @ Char toUpper xs_ala Whereas a worker/wrapper version map :: (a -> b) -> [a] -> [b] map f xs = go xs where go [] = [] go (x:xs) = f x : go xs {-# INLINE map #-} We get an inlined version: go = \ (ds_dm7 :: [Char]) -> case ds_dm7 of wild_B1 { [] -> [] @ Char; : x_all xs_aln -> : @ Char (toUpper x_all) (A.go xs_aln) } -- Don