Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to force GHC to evaluate static expression only once

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
like image 351
modular Avatar asked Nov 03 '16 18:11

modular


1 Answers

I would try pushing lambdas inwards:

append = if {-# SCC "isOuter" #-} outer then \k -> (k :) else \k -> id

The original code is essentially \k -> if outer ... which takes the argument first, and tests the guard later. The code above instead tests the guard before taking the argument.

Alternative:

append | outer     = \k -> (k :) 
       | otherwise = \k -> id

One can further simplify those lambdas to a more readable form.

like image 68
chi Avatar answered Dec 21 '22 12:12

chi