I have a trivial example of SQL-like join
for ordered lists: if outer
parameter is True
then it's union; otherwise it's intersection:
import System.Environment
main = do
[arg] <- getArgs
let outer = arg == "outer"
print $ length $ joinLists outer [1..1000] [1,3..1000]
joinLists :: (Ord a, Num a) => Bool -> [a] -> [a] -> [a]
joinLists outer xs ys = go xs ys
where
go [] _ = []
go _ [] = []
go xs@(x:xs') ys@(y:ys') = case compare x y of
LT -> append x $ go xs' ys
GT -> append y $ go xs ys'
EQ -> x : go xs' ys'
append k = if {-# SCC "isOuter" #-} outer then (k :) else id
When I profile it, I see that isOuter
condition is evaluated every time when append
is called:
stack ghc -- -O2 -prof example.hs && ./example outer +RTS -p && cat example.prof
individual inherited
COST CENTRE MODULE no. entries %time %alloc %time %alloc
MAIN MAIN 44 0 0.0 34.6 0.0 100.0
isOuter Main 88 499 0.0 0.0 0.0 0.0
But I'd like the condition to be evaluated only once, so append
in go
loop is replaced with either (k :)
or id
. Can I force it somehow? Is it related to memoization?
EDIT: Seems like I misinterpreted the profiler output. I added trace to append
definition:
append k = if trace "outer" outer then (k :) else id
And outer
is printed only once.
EDIT2: If I replace append
with point-free definition, then if
condition is evaluated only once:
append = if outer then (:) else flip const
{-# NOINLINE append #-}
, to no effect.if
statement, which is evaluated every time you callappend
, hence the hits to the cost centre. But the thunk that theouter
variable points to is only evaluated once. If you put your cost centre insidearg == "outer"
then you should see it only being hit once.if
condition to be evaluated multiple times, you could manually float it to the outside of the loop.joinLists outer = go (if outer then (:) else flip const)
and redefinego
to take an extra argument forappend
, rather than referring to its closure. I can't predict whether that'd be faster for your inputs.append = if outer then (:) else flip const
? (I would test it myself, but I don't have GHC here right now.)