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,351
    • Issues 5,351
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 574
    • Merge requests 574
  • 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
  • #16104
Closed
Open
Issue created Dec 28, 2018 by Levent Erkök@LeventErkokReporter

Plugin name lookup behavior change from GHC 8.4 series

I'm trying to port a core plugin to GHC 8.6.3, which was last working fine with GHC 8.4 series. Unfortunately, I'm running into issues. Wondering if pluging programming requirements have changed, or is this a regression in GHC itself. I boiled it down to the following example and would like some guidance on how to make this work:

I have the following in file TestPlugin.hs:

{-# LANGUAGE TemplateHaskell #-}

module TestPlugin (plugin) where

import GhcPlugins
import Data.Bits

plugin :: Plugin
plugin = defaultPlugin {installCoreToDos = install}
  where install _ todos = return (test : todos)

        test = CoreDoPluginPass "Test" check

        check :: ModGuts -> CoreM ModGuts
        check m = do mbN <- thNameToGhcName 'complement
                     case mbN of
                       Just _  -> liftIO $ putStrLn "Found complement!"
                       Nothing -> error "Failed to locate complement"

                     return m

And I have a very simple Test.hs file:

{-# OPTIONS_GHC -fplugin TestPlugin #-}

main :: IO ()
main = return ()

With GHC-8.4.2, I have:

$ ghc-8.4.2 --make -package ghc -c TestPlugin.hs
[1 of 1] Compiling TestPlugin       ( TestPlugin.hs, TestPlugin.o )

$ ghc-8.4.2 -package ghc -c Test.hs
Found complement!

But with GHC 8.6.3, I get:

$ ghc-8.6.3 --make -package ghc -c TestPlugin.hs
[1 of 1] Compiling TestPlugin       ( TestPlugin.hs, TestPlugin.o )

$ ghc-8.6.3 -package ghc -c Test.hs
ghc: panic! (the 'impossible' happened)
  (GHC version 8.6.3 for x86_64-apple-darwin):
	Failed to locate complement

The problem goes away if I change Test.hs to:

{-# OPTIONS_GHC -fplugin TestPlugin #-}

import Data.Bits  -- Should not be required in the client code!

main :: IO ()
main = return ()

That is, if I explicitly import Data.Bits. But this is quite undesirable, since Test.hs is client code and the users of the plugin have no reason to import all bunch of modules the plugin might need for its own purposes. (In practice, this would require clients to import a whole bunch of irrelevant modules; quite unworkable and not maintainable.)

Should I be coding my plugin differently? Or is this a GHC regression?

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