Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,360
    • Issues 5,360
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 567
    • Merge requests 567
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #7436
Closed
Open
Issue created Nov 21, 2012 by shachaf@trac-shachaf

Derived Foldable and Traversable instances become extremely inefficient due to eta-expansion

The following program:

{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
import Prelude hiding (foldr)
import Data.Foldable

data List a = Nil | Cons a (List a)
    deriving (Functor, Foldable)

mkList :: Int -> List Int
mkList 0 = Nil
mkList n = Cons n (mkList (n-1))

main :: IO ()
main = print $ foldr (\x y -> y) "end" (mkList n)
  where n = 100000

Takes n^2 time to run with GHC 7.6.1 -O2.

The generated Foldable code looks something like this:

instance Foldable List where
    foldr f z Nil = z
    foldr f z (Cons x xs) = f x (foldr (\a b -> f a b) z xs)

Eta-reducing the function, i.e.

instance Foldable List where
    foldr f z Nil = z
    foldr f z (Cons x xs) = f x (foldr f z xs)

Makes the program linear in n (in this case, runtime goes from 8.160s to 0.004s).

The Traversable instance also has the same issue.

There seem to be three different issues:

  • Derived Foldable and Traversable instances are nearly unusable for large structures.
  • An eta-expanded definition like foldr becomes asymptotically worse for some reason. Maybe this is expected behavior for this function, since f gets eta-expanded at each iteration?
  • Foldable instances are generated with foldr instead of foldMap.

This isn't directly related, since the code would have the same problem either way, but since I'm already writing about it... foldMap can allow asymptotically better operations on a structure than foldr (for example, finding the rightmost leaf of a binary tree using Data.Monoid.Last), so it should probably be generated instead. A foldMap definition should look like a simpler version of traverse, which is already derivable. Maybe this should be a separate ticket.

Edited Mar 09, 2019 by Simon Peyton Jones
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking