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,248
    • Issues 4,248
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 391
    • Merge Requests 391
  • 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
  • #17332

Closed
Open
Opened Oct 09, 2019 by Ryan Scott@RyanGlScottMaintainer

ImpredicativeTypes lets you pluck QuantifiedConstraints out of nowhere

This typechecks on GHC 8.6.5, 8.8.1, and HEAD:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
module Bug where

import GHC.Exts

data Dict c = c => Dict

aux :: Dict (forall a. a)
aux = Dict

This is, to put it mildly, a bit concerning. Here is the most destructive use case I can find for this:

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Main where

data Dict c = c => Dict

aux :: Dict (forall a. a)
aux = Dict

class (forall a. a) => Bottom where
  no :: a

sortOfUnsafeCoerce :: a -> b
sortOfUnsafeCoerce
  | Dict <- aux
  = no

main :: IO ()
main = print (sortOfUnsafeCoerce True :: Int)

I call this function sortOfUnsafeCoerce and not unsafeCoerce because I can't actually make it exhibit any sort of unsafety at runtime—it just panics in various ways:

$ /opt/ghc/8.8.1/bin/runghc Bug.hs                      
Bug.hs: Bug.hs: panic! (the 'impossible' happened)
  (GHC version 8.8.1 for x86_64-unknown-linux):
        nameModule
  system irred_a1uI
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/utils/Outputable.hs:1159:37 in ghc:Outputable
        pprPanic, called at compiler/basicTypes/Name.hs:249:3 in ghc:Name

Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

$ /opt/ghc/8.8.1/bin/ghc -O0 Bug.hs
[1 of 1] Compiling Main             ( Bug.hs, Bug.o )
ghc: panic! (the 'impossible' happened)
  (GHC version 8.8.1 for x86_64-unknown-linux):
        StgCmmEnv: variable not found
  irred_a1gL
  local binds for:
  no
  $tc'Dict
  $tcBottom
  $tcDict
  $trModule
  $p1Bottom
  $tcBottom1_r1HY
  $tcBottom2_r1Iz
  $tc'Dict1_r1IA
  $tc'Dict2_r1IB
  $tcDict1_r1IC
  $tcDict2_r1ID
  $krep_r1IE
  $krep1_r1IF
  $krep2_r1IG
  $krep3_r1IH
  $trModule1_r1II
  $trModule2_r1IJ
  $trModule3_r1IK
  $trModule4_r1IL
  $krep4_r1IM
  $krep5_r1IN
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/utils/Outputable.hs:1159:37 in ghc:Outputable
        pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv

Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

$ /opt/ghc/8.8.1/bin/ghc -O Bug.hs
[1 of 1] Compiling Main             ( Bug.hs, Bug.o )
ghc: panic! (the 'impossible' happened)
  (GHC version 8.8.1 for x86_64-unknown-linux):
        piResultTys1
  c_a1i0[tau:0]
  [Bottom]
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/utils/Outputable.hs:1159:37 in ghc:Outputable
        pprPanic, called at compiler/types/Type.hs:1061:5 in ghc:Type

Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug

I'm unclear if this is the same underlying issue as #17267 (closed), but I thought I would file a separate ticket just to be sure.

Assignee
Assign to
None
Milestone
None
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#17332