Skip to content
GitLab
Projects Groups Topics Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Register
  • Sign in
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributor statistics
    • Graph
    • Compare revisions
    • Locked files
  • Issues 5.5k
    • Issues 5.5k
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 632
    • Merge requests 632
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Artifacts
    • Schedules
    • Test cases
  • Deployments
    • Deployments
    • Releases
  • Packages and registries
    • Packages and registries
    • Model experiments
  • Analytics
    • Analytics
    • 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
  • #15863

Splicing a type class method selects the wrong instance

Consider these 4 modules as concocted by Csongor.

The wrong instance is selected when you splice in B.me into D.

https://gist.github.com/mpickering/959a95525647802414ab50e8e6ed490c

module A where

class C a where
  foo :: a -> String

instance C Int where
foo _ = "int"
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module B where

import A

import Language.Haskell.TH

instance C a => C [a] where
  foo _ = "list"

me :: Q (TExp ([Int] -> String))
me = [|| foo ||]
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module C where

import A

import Language.Haskell.TH

instance {-# OVERLAPPING #-} C [Int] where
foo _ = "list2"
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module D where

import A
import B
import C

main2 = $$(me) [1 :: Int]
>>> main2
"list2"

In B, B.me is created by quoting foo. B.me :: Q (TExp ([Int] -> String)) so in order to type check this quote we need to solve the instance C [Int] which we should do by using the instance defined in B (and A).

In module C we define a different overlapping instance (note that this could be in a completely different library not under our control).

When we then splice B.me into D, the instance from C is used and can be witnessed by printing main2 which shows "list2" rather than "list" as expected.

This is a symptom of the fact that the renamed rather than the typechecked AST is serialised I think.

Trac metadata
Trac field Value
Version 8.6.1
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Edited Mar 13, 2019 by Matthew Pickering
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking