如何强制GHC只评估一次静态表达式

Question

join对于有序列表,我有一个类似于SQL的简单例子:if outer参数是True它的联合; 否则它的交集:

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

当我描述它时,我看到isOuter每次append调用时都会评估条件:

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

但我想情况进行一次评估,因此append在go循环替换要么(k :)或id.我能以某种方式强迫它吗？它与记忆有关吗？

编辑:似乎我误解了探查器输出.我添加了跟踪append定义:

append k = if trace "outer" outer then (k :) else id

并且outer只打印一次.

EDIT2:如果我append用无点定义替换,那么if条件只被评估一次:

 append = if outer then (:) else flip const

Answer 1

我会尝试向内推lambdas:

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

原始代码本质\k -> if outer ...上是首先接受参数,然后测试后卫.上面的代码在采取参数之前测试了守卫.

替代方案:

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

可以进一步将这些lambda简化为更易读的形式.