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,273
    • Issues 4,273
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 413
    • Merge Requests 413
  • 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
  • #12503

Closed
Open
Opened Aug 20, 2016 by Ryan Scott@RyanGlScottMaintainer

Template Haskell regression: GHC erroneously thinks a type variable is also a kind

The following program compiles without issue on GHC 7.6.3 through GHC 7.10.3, but fails to compile on GHC 8.0.1 and GHC HEAD. (I added a CPP guard simply because the DataD constructor changed between 7.10 and 8.0.)

{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module Regression where

import Language.Haskell.TH

data T k
class C a

$(do TyConI (DataD [] tName [ KindedTV kName kKind]
#if __GLASGOW_HASKELL__ >= 800
                   _
#endif
                   _ _) <- reify ''T
     d <- instanceD (cxt []) (conT ''C `appT` (conT tName `appT` sigT (varT kName) kKind)) []
     return [d])
$ /opt/ghc/8.0.1/bin/ghc Regression.hs 
[1 of 1] Compiling Regression       ( Regression.hs, Regression.o )
Regression.hs:(13,3)-(19,15): Splicing declarations
    do { TyConI (DataD []
                       tName_a2RT
                       [KindedTV kName_a2RU kKind_a2RV]
                       _
                       _
                       _) <- reify ''T;
         d_a31Y <- instanceD
                     (cxt [])
                     (conT ''C
                      `appT` (conT tName_a2RT `appT` sigT (varT kName_a2RU) kKind_a2RV))
                     [];
         return [d_a31Y] }
  ======>
    instance C (T (k_avB :: k_avC))

Regression.hs:13:3: error:
    Variable ‘k_avB’ used as both a kind and a type
    Did you intend to use TypeInType?

Somewhat confusingly, you can use instance C (T (k_avB :: k_avC)) on its own, and it will compile without issue. Also, quoting it doesn't seem to trip up this bug, as this also compiles without issue:

{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices #-}
module WorksSomehow where

import Language.Haskell.TH

data T k
class C a

$([d| instance C (T k) |])

The original program has several workarounds:

  1. Turn off PolyKinds (OK, this isn't a very good workaround...)
  2. Add an explicit kind signature to T, e.g., data T (k :: k1)
  3. Change the type variable of T to some other letter, e.g., data T p or data T k1

Given that (3) is a successful workaround, I strongly suspect that GHC is confusing the type variable k (which gets ddump-spliced as k_avB) with the kind variable k (which gets ddump-spliced as k_avC) due to their common prefix k.

Trac metadata
Trac field Value
Version 8.0.1
Type Bug
TypeOfFailure OtherFailure
Priority high
Resolution Unresolved
Component Template Haskell
Test case
Differential revisions
BlockedBy
Related
Blocking
CC goldfire
Operating system
Architecture
Assignee
Assign to
8.2.1
Milestone
8.2.1 (Past due)
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#12503