Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,248
    • Issues 5,248
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 564
    • Merge requests 564
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • 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
  • #9750
Closed
Open
Issue created Oct 31, 2014 by dreixel@dreixel

Core lint failure with TypeLits Symbol

The following module:

{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE ScopedTypeVariables    #-}

module Bug where

import GHC.TypeLits ( Symbol, KnownSymbol )

--------------------------------------------------------------------------------

data Meta = MetaCons Symbol
data M1 (c :: Meta) = M1

class Generic a where
  type Rep a :: *
  from  :: a -> Rep a

--------------------------------------------------------------------------------

data A = A1

instance Generic A where
  type Rep A = M1 ('MetaCons "test")
  from A1 = M1

class GShow' f where
  gshowsPrec' :: f -> ShowS

instance (KnownSymbol c) => GShow' (M1 ('MetaCons c))
instance GShow' A where gshowsPrec' = gshowsPrec' . from

fails -dcore-lint in HEAD with:

*** Core Lint errors : in result of Desugar (after optimization) ***
<no location info>: Warning:
    [RHS of $dKnownSymbol_azn :: GHC.TypeLits.KnownSymbol "test"]
    From-type of Cast differs from type of enclosed expression
    From-type: GHC.TypeLits.KnownSymbol "test"
    Type of enclosed expr: [GHC.Types.Char]
    Actual enclosed expr: GHC.CString.unpackCString# "test"#
    Coercion used in cast: GHC.TypeLits.NTCo:KnownSymbol[0] <"test">_N
                           ; GHC.TypeLits.NTCo:SSymbol[0] <"test">_P
Trac metadata
Trac field Value
Version 7.9
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking