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,252
    • Issues 4,252
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 398
    • Merge Requests 398
  • 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
  • #14860

Closed
Open
Opened Feb 27, 2018 by Ryan Scott@RyanGlScottMaintainer

QuantifiedConstraints: Can't quantify constraint involving type family

This program fails to typecheck using the wip/T2893 branch, to my surprise:

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Bug where

import Data.Proxy

type family   Apply (f :: * -> *) a
type instance Apply Proxy a = Proxy a

data ExTyFam f where
  MkExTyFam :: Apply f a -> ExTyFam f

instance (forall a. Show (Apply f a)) => Show (ExTyFam f) where
  show (MkExTyFam x) = show x
  showsPrec = undefined -- Not defining these leads to the oddities observed in
  showList = undefined  -- https://ghc.haskell.org/trac/ghc/ticket/5927#comment:32

test :: ExTyFam Proxy -> String
test = show

This fails with:

$ ghc-cq/inplace/bin/ghc-stage2 --interactive Bug.hs
GHCi, version 8.5.20180128: http://www.haskell.org/ghc/  :? for help
Loaded GHCi configuration from /home/rgscott/.ghci
[1 of 1] Compiling Bug              ( Bug.hs, interpreted )

Bug.hs:17:24: error:
    • Could not deduce (Show (Apply f a)) arising from a use of ‘show’
      from the context: forall a. Show (Apply f a)
        bound by the instance declaration at Bug.hs:16:10-57
    • In the expression: show x
      In an equation for ‘show’: show (MkExTyFam x) = show x
      In the instance declaration for ‘Show (ExTyFam f)’
   |
17 |   show (MkExTyFam x) = show x
   |                        ^^^^^^

I would have expected the (forall a. Show (Apply f a)) quantified constraint to kick in, but it didn't.

Trac metadata
Trac field Value
Version 8.5
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#14860