Skip to content

GitLab

  • Menu
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 4,863
    • Issues 4,863
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 458
    • Merge requests 458
  • 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 Compiler
  • GHCGHC
  • Issues
  • #15966
Closed
Open
Created Nov 28, 2018 by Matthew Pickering@mpickeringDeveloper

panic when using RebindableSyntax

https://gist.github.com/mpickering/216ecdd9d8766dce2ff1080a17f77a0e

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RebindableSyntax #-}

{-# OPTIONS_GHC -Wall -Wno-missing-signatures -Wno-unticked-promoted-constructors
               -Wno-name-shadowing -fwarn-partial-type-signatures -Wno-partial-type-signatures #-}
module Repro(main) where

import Prelude hiding (Monad(..))
import Control.Applicative

data E (a :: * -> *) (n :: *) where
  VarE :: a n -> E a n

instance IMonad E where
  return :: a n -> E a n
  return = VarE

  (>>=) :: E a n -> (forall n . a n -> E b n) -> E b n
  VarE x >>= f = f x

class IMonad (m :: (* -> *) -> (* -> *)) where
  return :: forall a n . a n -> m a n
  (>>=) :: m a n -> (forall n . a n -> m b n) -> m b n

one :: Const Int n
one = (Const 1)

example_4 :: E (Const Int) n
example_4 = do
  x <- (return one)
  return x

main = example_4 `seq` ()

Compiling this file with GHC leads to a StgCmmEnv panic.

ghc: panic! (the 'impossible' happened)
  (GHC version 8.6.2 for x86_64-unknown-linux):
	StgCmmEnv: variable not found
  $dIMonad_a1lY
  local binds for:
  return
  >>=
  $tc'VarE
  $tcE
  $tcIMonad
  $trModule
  $tc'VarE1_r1oI
  $tc'VarE2_r1ps
  $krep_r1pt
  $krep1_r1pu
  $krep2_r1pv
  $krep3_r1pw
  $krep4_r1px
  $tcE1_r1py
  $tcE2_r1pz
  $tcIMonad1_r1pA
  $tcIMonad2_r1pB
  $krep5_r1pC
  $krep6_r1pD
  $krep7_r1pE
  $trModule1_r1pF
  $trModule2_r1pG
  $trModule3_r1pH
  $trModule4_r1pI
  $krep8_r1pJ
  $krep9_r1pK
  sat_s1rG
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable
        pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv

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

Loading the file into GHCi succeeds but then when the main function is invoked, a nameModule panic occurs.

*Repro> main
ghc: panic! (the 'impossible' happened)
  (GHC version 8.6.2 for x86_64-unknown-linux):
	nameModule
  system $dIMonad_a1LV
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable
        pprPanic, called at compiler/basicTypes/Name.hs:240:3 in ghc:Name

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

Reproduced on 8.6.{2,1} 8.4.4 8.2.2

Trac metadata
Trac field Value
Version 8.6.2
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