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,322
    • Issues 4,322
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 361
    • Merge Requests 361
  • 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
  • #3412

Closed
Open
Opened Aug 02, 2009 by Bertram Felgenhauer@int-eReporter

the 'impossible' happened (expectJust chooseExternalIds)

This module fails to compile with ghc head (with optimizations and using a 'perf' build):

module Bug where

import Ix

newtype U = U Int deriving (Eq, Ord)

instance Ix U where
  index (U from, U to) (U idx) = index (from, to) idx

The output is as follows - the underlined part is the identifier that it fails to find. (I added a ++ show id to the message.)

# ghc -c -fforce-recomp -O Bug.hs
ghc-stage2: panic! (the 'impossible' happened)
  (GHC version 6.11.20090801 for i386-unknown-linux):
        expectJust chooseExternalIds { GHC.Arr.$windex2 }
                                       ^^^^^^^^^^^^^^^^

Here's a stripped down version of Ix.hs that still exhibits the bug, to make the example more self-contained. It has to be compiled with -O as well:

module Ix2 where

class Ix a where
    index :: (a, a) -> a -> Int

instance Ix Int where
    index (m, n) i
        | m <= i && i <= n = m - i
        | otherwise        = indexError i

{-# NOINLINE indexError #-}
indexError :: a -> b
indexError _ = undefined
Trac metadata
Trac field Value
Version 6.11
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Assignee
Assign to
6.12.1
Milestone
6.12.1
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#3412