Skip to content

Function incorrectly specialized on implicit parameter inside a constraint tuple

Summary

Function gets incorrectly specialized on implicit parameter inside a constraint tuple.

Steps to reproduce

Compile the following module, courtesy of @leonschoorl:

{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}

module Test where
import Prelude

type Hidden a =
  ( ?enable :: a
  , Eq a  -- removing this "fixes" the issue
  )

{-# NOINLINE a #-}
a
  :: Hidden Bool
  -- => Int -- OK
  => Integer -- problem
  -> Bool
a _ = ?enable

system
  :: Hidden Bool
  => Bool

system = a 0

topEntity
  :: Bool
  -> Bool
topEntity ena =
  let ?enable = ena
   in system

someVar =
  let ?enable = True
   in system

Using -fno-full-laziness and at least -O1:

ghc-8.10.2 -ddump-simpl -dcore-lint -v -O1 -fno-full-laziness Test.hs

As the simplifier output shows, someVar ends up in the definition of topEntity, and the argument is considered unused:

...
-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
topEntity :: Bool -> Bool
[GblId,
 Arity=1,
 Str=<L,A>,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
         Tmpl= \ _ [Occ=Dead] -> someVar}]
topEntity = \ _ [Occ=Dead] -> someVar
...

Full output:

> ghc-8.10.2 -ddump-simpl -dcore-lint -v -O1 -fforce-recomp -fno-full-laziness Test.hs
Glasgow Haskell Compiler, Version 8.10.2, stage 2 booted by GHC version 8.8.3
*** initializing package database:
Using binary package database: ~/.ghcup/ghc/8.10.2/lib/ghc-8.10.2/package.conf.d/package.cache
package flags []
loading package database ~/.ghcup/ghc/8.10.2/lib/ghc-8.10.2/package.conf.d
wired-in package ghc-prim mapped to ghc-prim-0.6.1
wired-in package integer-wired-in mapped to integer-gmp-1.0.3.0
wired-in package base mapped to base-4.14.1.0
wired-in package rts mapped to rts
wired-in package template-haskell mapped to template-haskell-2.16.0.0
wired-in package ghc mapped to ghc-8.10.2
!!! initializing package database: finished in 12.49 milliseconds, allocated 8.210 megabytes
*** initializing package database:
package flags []
loading package database ~/.ghcup/ghc/8.10.2/lib/ghc-8.10.2/package.conf.d
wired-in package ghc-prim mapped to ghc-prim-0.6.1
wired-in package integer-wired-in mapped to integer-gmp-1.0.3.0
wired-in package base mapped to base-4.14.1.0
wired-in package rts mapped to rts-1.0
wired-in package template-haskell mapped to template-haskell-2.16.0.0
wired-in package ghc mapped to ghc-8.10.2
!!! initializing package database: finished in 10.82 milliseconds, allocated 3.269 megabytes
*** Chasing dependencies:
Chasing modules from: *Test.hs
!!! Chasing dependencies: finished in 1.07 milliseconds, allocated 1.443 megabytes
Stable obj: {}
Stable BCO: {}
Ready for upsweep
  [NONREC
      ModSummary {
         ms_hs_date = 2020-09-04 08:27:19.224857248 UTC
         ms_mod = Test,
         ms_textual_imps = [(Nothing, Prelude)]
         ms_srcimps = []
      }]
*** Deleting temp files:
Deleting: 
compile: input file Test.hs
*** Checking old interface for Test (use -ddump-hi-diffs for more details):
[1 of 1] Compiling Test             ( Test.hs, Test.o )
*** Parser [Test]:
!!! Parser [Test]: finished in 0.59 milliseconds, allocated 0.992 megabytes
*** Renamer/typechecker [Test]:
!!! Renamer/typechecker [Test]: finished in 48.69 milliseconds, allocated 26.258 megabytes
*** Desugar [Test]:
Result size of Desugar (before optimization)
  = {terms: 55, types: 75, coercions: 11, joins: 0/12}
*** Core Linted result of Desugar (before optimization):
Result size of Desugar (after optimization)
  = {terms: 35, types: 52, coercions: 11, joins: 0/2}
*** Core Linted result of Desugar (after optimization):
!!! Desugar [Test]: finished in 0.73 milliseconds, allocated 0.829 megabytes

Test.hs:50:6: warning: [-Wsimplifiable-class-constraints]
    • The constraint ‘Eq Bool’ matches
        instance Eq Bool -- Defined in ‘GHC.Classes’
      This makes type inference for inner bindings fragile;
        either use MonoLocalBinds, or simplify it using the instance
    • In the type signature: a :: Hidden Bool => Integer -> Bool
   |
50 |   :: Hidden Bool
   |      ^^^^^^^^^^^...

Test.hs:57:6: warning: [-Wsimplifiable-class-constraints]
    • The constraint ‘Eq Bool’ matches
        instance Eq Bool -- Defined in ‘GHC.Classes’
      This makes type inference for inner bindings fragile;
        either use MonoLocalBinds, or simplify it using the instance
    • In the type signature: system :: Hidden Bool => Bool
   |
57 |   :: Hidden Bool
   |      ^^^^^^^^^^^...
*** Simplifier [Test]:
Result size of Simplifier iteration=1
  = {terms: 45, types: 57, coercions: 13, joins: 0/1}
*** Core Linted result of Simplifier:
Result size of Simplifier iteration=2
  = {terms: 43, types: 59, coercions: 16, joins: 0/0}
*** Core Linted result of Simplifier:
Result size of Simplifier
  = {terms: 43, types: 59, coercions: 16, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 1.22 milliseconds, allocated 1.424 megabytes
*** Specialise [Test]:
Result size of Specialise
  = {terms: 51, types: 75, coercions: 16, joins: 0/0}
*** Core Linted result of Specialise:
!!! Specialise [Test]: finished in 0.28 milliseconds, allocated 0.389 megabytes
*** Simplifier [Test]:
Result size of Simplifier iteration=1
  = {terms: 45, types: 60, coercions: 16, joins: 0/0}
*** Core Linted result of Simplifier:
Result size of Simplifier iteration=2
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
Result size of Simplifier
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 0.96 milliseconds, allocated 1.389 megabytes
*** Simplifier [Test]:
Result size of Simplifier
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 0.29 milliseconds, allocated 0.434 megabytes
*** Simplifier [Test]:
Result size of Simplifier
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 0.28 milliseconds, allocated 0.434 megabytes
*** Float inwards [Test]:
Result size of Float inwards
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Float inwards:
!!! Float inwards [Test]: finished in 0.18 milliseconds, allocated 0.293 megabytes
*** Called arity analysis [Test]:
Result size of Called arity analysis
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Called arity analysis:
!!! Called arity analysis [Test]: finished in 0.20 milliseconds, allocated 0.309 megabytes
*** Simplifier [Test]:
Result size of Simplifier
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 0.34 milliseconds, allocated 0.434 megabytes
*** Demand analysis [Test]:
Result size of Demand analysis
  = {terms: 41, types: 53, coercions: 12, joins: 0/0}
*** Core Linted result of Demand analysis:
!!! Demand analysis [Test]: finished in 0.27 milliseconds, allocated 0.390 megabytes
*** Worker Wrapper binds [Test]:
Result size of Worker Wrapper binds
  = {terms: 57, types: 80, coercions: 12, joins: 0/3}
*** Core Linted result of Worker Wrapper binds:
!!! Worker Wrapper binds [Test]: finished in 0.32 milliseconds, allocated 0.479 megabytes
*** Simplifier [Test]:
Result size of Simplifier iteration=1
  = {terms: 53, types: 68, coercions: 12, joins: 0/2}
*** Core Linted result of Simplifier:
Result size of Simplifier iteration=2
  = {terms: 47, types: 59, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
Result size of Simplifier
  = {terms: 47, types: 59, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 1.72 milliseconds, allocated 1.881 megabytes
*** Exitification transformation [Test]:
Result size of Exitification transformation
  = {terms: 47, types: 59, coercions: 12, joins: 0/0}
*** Core Linted result of Exitification transformation:
!!! Exitification transformation [Test]: finished in 0.28 milliseconds, allocated 0.375 megabytes
*** Common sub-expression [Test]:
Result size of Common sub-expression
  = {terms: 47, types: 59, coercions: 12, joins: 0/0}
*** Core Linted result of Common sub-expression:
!!! Common sub-expression [Test]: finished in 0.28 milliseconds, allocated 0.425 megabytes
*** Float inwards [Test]:
Result size of Float inwards
  = {terms: 47, types: 59, coercions: 12, joins: 0/0}
*** Core Linted result of Float inwards:
!!! Float inwards [Test]: finished in 0.24 milliseconds, allocated 0.390 megabytes
*** Simplifier [Test]:
Result size of Simplifier
  = {terms: 45, types: 58, coercions: 12, joins: 0/0}
*** Core Linted result of Simplifier:
!!! Simplifier [Test]: finished in 0.42 milliseconds, allocated 0.592 megabytes
*** Demand analysis [Test]:
Result size of Demand analysis
  = {terms: 45, types: 58, coercions: 12, joins: 0/0}
*** Core Linted result of Demand analysis:
!!! Demand analysis [Test]: finished in 0.32 milliseconds, allocated 0.495 megabytes
*** CoreTidy [Test]:

==================== Tidy Core ====================
Result size of Tidy Core
  = {terms: 45, types: 58, coercions: 12, joins: 0/0}

-- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0}
a1_r1rQ :: Hidden Bool => Integer -> ?enable::Bool
[GblId,
 Arity=2,
 Caf=NoCafRefs,
 Str=<S(SL),1*U(1*U,A)><L,A>,
 Unf=OtherCon []]
a1_r1rQ
  = \ ($d(%,%)_a1qm :: Hidden Bool) _ [Occ=Dead] ->
      GHC.Classes.$p1(%,%) @ (?enable::Bool) @ (Eq Bool) $d(%,%)_a1qm

-- RHS size: {terms: 1, types: 0, coercions: 8, joins: 0/0}
a [InlPrag=NOINLINE] :: Hidden Bool => Integer -> Bool
[GblId,
 Arity=2,
 Caf=NoCafRefs,
 Str=<S(SL),1*U(1*U,A)><L,A>,
 Unf=OtherCon []]
a = a1_r1rQ
    `cast` (<Hidden Bool>_R
            ->_R <Integer>_R
            ->_R GHC.Classes.N:IP[0] <"enable">_N <Bool>_N
            :: (Hidden Bool -> Integer -> ?enable::Bool)
               ~R# (Hidden Bool -> Integer -> Bool))

-- RHS size: {terms: 5, types: 5, coercions: 4, joins: 0/0}
someVar :: Bool
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 140 0}]
someVar
  = a (GHC.Types.True
       `cast` (Sym (GHC.Classes.N:IP[0] <"enable">_N <Bool>_N)
               :: Bool ~R# (?enable::Bool)),
       GHC.Classes.$fEqBool)
      0

-- RHS size: {terms: 7, types: 10, coercions: 0, joins: 0/0}
Test.$wsystem [InlPrag=NOUSERINLINE[2]] :: (?enable::Bool) => Bool
[GblId,
 Arity=1,
 Str=<S,1*U>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 200 0}]
Test.$wsystem
  = \ (ww_s1rv :: ?enable::Bool) ->
      a (ww_s1rv,
         Control.Exception.Base.absentError @ (Eq Bool) "ww Eq Bool"#)
        0

-- RHS size: {terms: 6, types: 9, coercions: 0, joins: 0/0}
system [InlPrag=NOUSERINLINE[2]] :: Hidden Bool => Bool
[GblId,
 Arity=1,
 Str=<S(SL),1*U(1*U,A)>,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
         Tmpl= \ (w_s1rs [Occ=Once!] :: Hidden Bool) ->
                 case w_s1rs of { (ww1_s1rv [Occ=Once], _ [Occ=Dead]) ->
                 Test.$wsystem ww1_s1rv
                 }}]
system
  = \ (w_s1rs :: Hidden Bool) ->
      case w_s1rs of { (ww1_s1rv, ww2_s1rw) -> Test.$wsystem ww1_s1rv }

-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
topEntity :: Bool -> Bool
[GblId,
 Arity=1,
 Str=<L,A>,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)
         Tmpl= \ _ [Occ=Dead] -> someVar}]
topEntity = \ _ [Occ=Dead] -> someVar

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Test.$trModule4 :: GHC.Prim.Addr#
[GblId,
 Caf=NoCafRefs,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Test.$trModule4 = "main"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Test.$trModule3 :: GHC.Types.TrName
[GblId,
 Caf=NoCafRefs,
 Str=m1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Test.$trModule3 = GHC.Types.TrNameS Test.$trModule4

-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Test.$trModule2 :: GHC.Prim.Addr#
[GblId,
 Caf=NoCafRefs,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Test.$trModule2 = "Test"#

-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Test.$trModule1 :: GHC.Types.TrName
[GblId,
 Caf=NoCafRefs,
 Str=m1,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Test.$trModule1 = GHC.Types.TrNameS Test.$trModule2

-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
Test.$trModule :: GHC.Types.Module
[GblId,
 Caf=NoCafRefs,
 Str=m,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
Test.$trModule = GHC.Types.Module Test.$trModule3 Test.$trModule1


------ Local rules for imported ids --------
"SPEC system"
    forall ($d(%,%)_s1rq :: Hidden Bool). system $d(%,%)_s1rq = someVar


Result size of Tidy Core
  = {terms: 45, types: 58, coercions: 12, joins: 0/0}
*** Core Linted result of Tidy Core:
!!! CoreTidy [Test]: finished in 2.89 milliseconds, allocated 3.210 megabytes
Created temporary directory: /tmp/ghc1023336_0
*** CorePrep [Test]:
Result size of CorePrep
  = {terms: 61, types: 69, coercions: 12, joins: 0/3}
*** Core Linted result of CorePrep:
!!! CorePrep [Test]: finished in 0.35 milliseconds, allocated 0.467 megabytes
*** Stg2Stg:
*** CodeGen [Test]:
!!! CodeGen [Test]: finished in 2.25 milliseconds, allocated 2.748 megabytes
writeBinIface: 16 Names
writeBinIface: 43 dict entries
*** systool:as:
*** Assembler:
gcc -iquote. -no-pie -fno-PIC -x assembler -c /tmp/ghc1023336_0/ghc_2.s -o Test.o.tmp
!!! systool:as: finished in 0.26 milliseconds, allocated 0.102 megabytes
Upsweep completely successful.
*** Deleting temp files:
Deleting: /tmp/ghc1023336_0/ghc_1.s /tmp/ghc1023336_0/ghc_2.s /tmp/ghc1023336_0/ghc_3.c
Warning: deleting non-existent /tmp/ghc1023336_0/ghc_1.s
Warning: deleting non-existent /tmp/ghc1023336_0/ghc_3.c
link(batch): upsweep (partially) failed OR
   Main.main not exported; not linking.
*** Deleting temp files:
Deleting: 
*** Deleting temp dirs:
Deleting: /tmp/ghc1023336_0

Expected behavior

Whether or not someVar is defined should not at all affect topEntity.

Environment

  • GHC version used: 8.6.5, 8.10.2. The issue is reportedly also present in ghc-9.0.1-alpha1, but not in and in GHC head.

Downstream issue: https://github.com/clash-lang/clash-compiler/issues/1500

Thanks to @leonschoorl for finding the minimal example!

Edited by JvWesterveld
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information