
#13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Just hit this with the following program missing `-XBangPatterns` from #11284: {{{ 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) }}} Complains with {{{ T11284.hs:18:6: error: Variable not in scope: go :: T.Text -> b | 18 | in go t0 }}} I'd say a warning when there's no space in a binary operator definition for `(!)` before its second parameter is the way to go. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13600#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler