Skip to content
GitLab
Projects Groups Topics Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Register
  • Sign in
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributor statistics
    • Graph
    • Compare revisions
    • Locked files
  • Issues 5.5k
    • Issues 5.5k
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 639
    • Merge requests 639
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Artifacts
    • Schedules
    • Test cases
  • Deployments
    • Deployments
    • Releases
  • Packages and registries
    • Packages and registries
    • Model experiments
  • Analytics
    • Analytics
    • 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
  • #9562

Type families + hs-boot files = unsafeCoerce

Consider the following bundle of modules:

A.hs:

{-# LANGUAGE TypeFamilies #-}

module A where

type family F a b

B.hs-boot:

module B where

import A

oops :: F a b -> a -> b

B.hs:

{-# LANGUAGE TypeFamilies #-}

module B where

import A
import C

type instance F a b = b

oops :: F a b -> a -> b
oops = const

C.hs:

module C (oops) where

import {-# SOURCE #-} B

D.hs:

{-# LANGUAGE TypeFamilies #-}

module D where

import A
import C

type instance F a b = a

unsafeCoerce :: a -> b
unsafeCoerce x = oops x x

Main.hs:

module Main where

import D ( unsafeCoerce )

main = print $ (unsafeCoerce True :: Int)

When loading these into GHCi, we quite reasonably get a type family instance overlap error. But, separate compilation leads to disaster:

rae:01:49:47 ~/temp/bug> ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.3
rae:01:49:49 ~/temp/bug> ghc -c A.hs
rae:01:49:53 ~/temp/bug> ghc -c B.hs-boot 
rae:01:49:58 ~/temp/bug> ghc -c C.hs
rae:01:50:09 ~/temp/bug> ghc -c B.hs
rae:01:50:13 ~/temp/bug> ghc -c D.hs
rae:01:50:17 ~/temp/bug> ghc Main.hs -o Unsafe
[6 of 6] Compiling Main             ( Main.hs, Main.o )
Linking Unsafe ...
rae:01:50:23 ~/temp/bug> ./Unsafe
2882303761534249061

Yikes!

Proposed (terrible) solution: hs-boot files must list all type instance declarations in the corresponding modules. It may also be a good idea to require all normal instance declarations in the hs-boot file as well, because this same trick can be used to introduce incoherence (I think -- haven't tested).

This bug persists even if Main declares that it is Safe.

I've attached a tarball of the files for ease of testing.

(Credit to Edward Yang and Geoff Mainland, whose discussion provoked the line of inquiry that led to this discovery.)

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