Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,324
    • Issues 4,324
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 385
    • Merge Requests 385
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
  • Security & Compliance
    • Security & Compliance
    • Dependency List
    • License Compliance
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Collapse sidebar
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #8147

Closed
Open
Opened Aug 21, 2013 by jkoppel@trac-jkoppel

Exponential behavior in instance resolution on fixpoint-of-sum

Doing instance resolution on a fixpoint-of-sum type takes a very long time. This is possibly the same issue as issue #5642.

These are the numbers I see for various n:

10 : 0.329s
20 : 0.479s
40 : 0.935s
80 : 2.821s
160 : 11.694s
320 : 1m30.39s
640:  Ran for over 1 hour without terminating

This uses a couple of attached support files. Apologies for not being able to reduce further.

-- Test.hs
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeOperators, DeriveFunctor, TemplateHaskell #-}

module Test where

import Control.Monad

import Lib
import TH

{-
With n=3, produces

data X1 e = X1 e deriving (Functor)
data X2 e = X2 e deriving (Functor)
data X3 e = X3 e deriving (Functor)

type X = X1 :+: X2 :+: X3
-}
$(let n = 320 in
  liftM concat $ sequence [liftM concat $ mapM mkDec $ map (('X':).show) [1..n]
                          , makeSumType "X" (map (('X':).show) [1..n])])


data Y0 e = Y0 e deriving ( Functor )

type X' = Y0 :+: X

class Lift f g where
  lift' :: f (Fix g) -> Fix g

instance (Lift f g, Lift f' g) => Lift (f :+: f') g where
  lift' x = case x of 
              L e -> lift' e
              R e -> lift' e

instance (Functor f, f :<: g) => Lift f g where
  lift' = In . inj

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . out

lift :: Fix X -> Fix X'
lift = cata lift' 

Virtually all the time is spent in compiling lift. For example, with n=640, commenting out lift makes it compile in around 2 seconds.

Interestingly, when I add the following code, compilation times only increase by 10-20%. In the original code where I encountered this issue, doing so doubles compilation time.

instance Lift Y0 X where
  lift' = undefined

lower :: Fix X' -> Fix X
lower = cata lift'
Trac metadata
Trac field Value
Version 7.6.3
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Assignee
Assign to
None
Milestone
None
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#8147