Lambda-lifting fails in simple Text example
Consider the example (which uses Text
; I'm working on finding a more minimal example),
{-# LANGUAGE BangPatterns #-}
module T11284 where
import Data.Char (isSpace)
import Data.List (foldl')
import GHC.Exts (build)
import qualified Data.Text as T
import qualified Data.Text.Array as A
longestWord :: T.Text -> Int
longestWord t = foldl' max 0 $ map T.length $ fusedWords t
fusedWords :: T.Text -> [T.Text]
fusedWords t0 = build $ \cons nil ->
let go !t
| T.null t = nil
| otherwise = let (w, rest) = T.span (not . isSpace) t
in cons w (go $ T.dropWhile isSpace rest)
in go t0
-- For reference
data Text = Text
{-# UNPACK #-} !A.Array -- payload (Word16 elements)
{-# UNPACK #-} !Int -- offset (units of Word16, not Char)
{-# UNPACK #-} !Int -- length (units of Word16, not Char)
longestWord
here produces the simplified Core,
Ticket.$wgo :: GHC.Prim.ByteArray# -> GHC.Prim.Int# -> GHC.Prim.Int# -> [T.Text]
Ticket.$wgo = ...
-- > $wgo1 xs n = foldl' (\a b -> max a $ T.length b) n xs
Ticket.$wgo1 :: [T.Text] -> GHC.Prim.Int# -> GHC.Prim.Int#
Ticket.$wgo1 =
\ (w_s4GJ :: [T.Text]) (ww_s4GN :: GHC.Prim.Int#) ->
case w_s4GJ of _ {
[] -> ww_s4GN;
: y_a4vC ys_a4vD ->
case y_a4vC
of _ { Data.Text.Internal.Text dt_a4jP dt1_a4jQ dt2_a4jR ->
let {
a_a4jO :: GHC.Prim.Int#
a_a4jO = GHC.Prim.+# dt1_a4jQ dt2_a4jR } in
letrec {
-- For the love of all that is good, why must you allocate?
--
-- This loop is essentially `T.length`, the first argument being
-- the length accumulator and the second being an index into the
-- ByteArray#
$wloop_length_s4GI :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
$wloop_length_s4GI =
\ (ww1_s4Gz :: GHC.Prim.Int#) (ww2_s4GD :: GHC.Prim.Int#) ->
-- Have we reached the end of the Text?
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.>=# ww2_s4GD a_a4jO)
of _ {
False -> {
...
-- in this body there are few cases analyses which
-- classify the code-points we encounter. The branches
-- are recursive calls of the form
$wloop_length_s4GI (GHC.Prim.+# ww1_s4Gz 1) (GHC.Prim.+# ww2_s4GD 1)
...
True -> ww1_s4Gz
}; } in
case $wloop_length_s4GI 0 dt1_a4jQ of ww1_s4GH { __DEFAULT ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# ww_s4GN ww1_s4GH)
of _ {
False -> Ticket.$wgo1 ys_a4vD ww_s4GN;
True -> Ticket.$wgo1 ys_a4vD ww1_s4GH
}
}
}
}
longestWord :: T.Text -> Int
longestWord =
\ (w_s4GT :: T.Text) ->
case w_s4GT
of _ { Data.Text.Internal.Text ww1_s4GW ww2_s4GX ww3_s4GY ->
case Ticket.$wgo1 (Ticket.$wgo ww1_s4GW ww2_s4GX ww3_s4GY) 0
of ww4_s4H2 { __DEFAULT ->
GHC.Types.I# ww4_s4H2
}
}
Notice $wloop_length_s4GI
: It should be a nice tight loop counting Unicode characters in the array dt_a4jP
until it arrives at its end. However, GHC fails to lambda-lift this closure, thereby turning it into an allocating operation! Oh no!