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,334
    • Issues 4,334
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 369
    • Merge Requests 369
  • 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
  • #3734

Closed
Open
Opened Dec 07, 2009 by Tomáš Janoušek@liskin

overlapping orphan instances behave like incoherent without warning/error

Consider these three modules:

module A where

class (Show a) => A a

data A' = A' deriving (Show)
instance A A'

data A'' = A'' deriving (Show)
instance A A''

print_a :: (A a) => a -> IO ()
print_a a = print a
{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
module B where

import A

data B a = B a deriving (Show)
instance (A a) => A (B a)
{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
module Main where

import A
import B

instance Show (B A') where
    show _ = "kokodak"

instance Show (B A'') where
    show _ = "brekeke"

instance A (B A'')

main :: IO ()
main = do
    print   (B A')
    print_a (B A')
    putStrLn ""
    print   (B A'')
    print_a (B A'')

Without understanding a thing about dictionaries, I would expect that if this actually compiles (which I now understand it should not), I'd get "kokodak kokodak brekeke brekeke" as output, but I got "kokodak B A' brekeke brekeke" instead.

I figured that even though I redefined Show (B A'), the A (B a) instance was defined in module B and consisted of the original Show dictionary. If I move the Show (B A') instance to module B, ghc complains that the definition of A (B a) depends on the instatiation of a and refuses to compile it, unless I enable IncoherentInstances.

The problem here is that if the Show (B A') instance is orphan, I get the IncoherentInstances behaviour for free without any warning or error, giving me the false feeling that the code is actually OK. Is it possible that ghc gives an error in this case, and may the documentation mention that Overlapping + Orphan => Incoherent?

Trac metadata
Trac field Value
Version 6.10.4
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler (Type checker)
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#3734