[PureScript] if 式と when 関数の計算量の差

Brainf**k のインタプリタを作っていて少しつまずいたので軽く書きます．

早速問題のコードを示します

ifF :: forall a. Boolean -> a -> a -> a
ifF f x y = if f then x else y

test1 = if true then 1 else 2

test2 = ifF true 1 2

改めて考えるとそれはそうなのですが，この ifF 関数は if 式と動作結果は同じであれど計算量が変わってきます．テストのため debug ライブラリの spy 関数を使ってみます．

testX = if true then spy "X" 1 else spy "X" 2

testY = ifF true (spy "Y" 1) (spy "Y" 2)

結果

-- testX
X: 1
-- testY
Y: 1
Y: 2

(false でやっても同じような結果になります)

PureScript は正格評価なので， ifF 関数に値を渡す際に spy "Y" 1 と spy "Y" 2 のどちらも評価していますが，if 式を使うと条件式が先に評価されてから then と else の対応する側の値が評価されます．

PureScript は純粋なので計算結果に影響はありませんが，計算量の変化がかなり大きな影響を与えることがあります．

このような例として when 関数が挙げられます．
when 関数は次のように実装されています．

when :: forall m. Applicative m => Boolean -> m Unit -> m Unit
when true m = m
when false _ = pure unit

第一引数の条件が true のときのみ第二引数を実行するような関数になっています．

そこで次のプログラムを見てください．

loop :: Effect Unit
loop = do
  let
    go n = do
      when (n >= 100000) $ throw "Error"
      pure $ Loop (n + 1)
  tailRecM go 0

loop' :: Effect Unit
loop' = do
  let
    go n = do
      if n >= 100000 then throw "Error"
      else pure unit
      pure $ Loop (n + 1)
  tailRecM go 0

末尾再帰で 100000 回以上再帰するとエラーを起こすプログラムを when と if で実装しました．一見上の方がスッキリしていますが……？
計算時間を計測してみます．

main :: Effect Unit
main = do
  log "loop"
  loopS <- nowTime
  catchError loop logShow
  loopE <- nowTime
  log $ "loop: " <> show (loopE `diff` loopS :: Milliseconds)

  log "loop'"
  loopS' <- nowTime
  catchError loop' logShow
  loopE' <- nowTime
  log $ "loop': " <> show (loopE' `diff` loopS' :: Milliseconds)

結果

loop
index.js:12264 Error: Error
    at ...
index.js:12264 loop: (Milliseconds 1250.0)
index.js:12264 loop'
index.js:12264 Error: Error
    at ...
index.js:12264 loop': (Milliseconds 24.0)

全く違います．loopの方はthrow 関数が重くかなり時間がかかっています．一方 loop'ではthrowが呼ばれるのは最後のみなので，速いです．(実際には throw 関数というより throw 関数内部で呼ばれている error 関数が重い)

今後気を付けていきたいです