Commit 59d7c9f4 authored by John Ericson's avatar John Ericson Committed by Marge Bot

Skip type family defaults with hs-boot and hsig files

Works around #17190, possible resolution for #17224. New design is is
according to accepted [GHC Propoal 320].

Instances in signatures currently unconditionally opt into associated
family defaults if no explicit instance is given. This is bad for two
reasons:

  1. It constrains possible instantiations to use the default, rather
  than possibly define the associated family differently.

  2. It breaks compilation as type families are unsupported in
  signatures.

This PR simply turns off the filling in of defaults in those cases.
Additionally, it squelches a missing definition warning for hs-boot too
that was only squelched for hsig before.

The downsides are:

  1. There is no way to opt into the default, other than copying its
  definition.

  2. If we fixed type classes in signatures, and wanted instances to
  have to explicitly *out of* rather than into the default, that would
  now be a breaking change.

The change that is most unambiguously goood is harmonizing the warning
squelching between hs-boot or hsig. Maybe they should have the warning
(opt out of default) maybe they shouldn't (opt in to default), but
surely it should be the same for both.

Add hs-boot version of a backpack test regarding class-specified
defaults in instances that appear in an hs-boot file.

The metrics increase is very slight and makes no sense --- at least no
one has figured anything out after this languishing for a while, so I'm
just going to accept it.

Metric Increase:
  T10421a

[GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320
parent b02a9ea7
Pipeline #26446 failed with stages
in 318 minutes and 36 seconds
......@@ -550,8 +550,10 @@ warnMissingAT name
= do { warn <- woptM Opt_WarnMissingMethods
; traceTc "warn" (ppr name <+> ppr warn)
; hsc_src <- fmap tcg_src getGblEnv
-- Warn only if -Wmissing-methods AND not a signature
; warnTc (Reason Opt_WarnMissingMethods) (warn && hsc_src /= HsigFile)
-- hs-boot and signatures never need to provide complete "definitions"
-- of any sort, as they aren't really defining anything, but just
-- constraining items which are defined elsewhere.
; warnTc (Reason Opt_WarnMissingMethods) (warn && hsc_src == HsSrcFile)
(text "No explicit" <+> text "associated type"
<+> text "or default declaration for"
<+> quotes (ppr name)) }
......@@ -512,9 +512,18 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds
-- Check for missing associated types and build them
-- from their defaults (if available)
; is_boot <- tcIsHsBootOrSig
; let atItems = classATItems clas
; tf_insts2 <- mapM (tcATDefault loc mini_subst defined_ats)
(classATItems clas)
(if is_boot then [] else atItems)
-- Don't default type family instances, but rather omit, in hsig/hs-boot.
-- Since hsig/hs-boot files are essentially large binders we want omission
-- of the definition to result in no restriction, rather than for example
-- attempting to "pattern match" with the invisible defaults and generate
-- equalities. Without further handling, this would just result in a panic
-- anyway.
-- See https://github.com/ghc-proposals/ghc-proposals/pull/320 for
-- additional discussion.
; return (df_stuff, tf_insts1 ++ concat tf_insts2) }
......@@ -539,8 +548,8 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds
all_insts = tyfam_insts ++ datafam_insts
-- In hs-boot files there should be no bindings
; is_boot <- tcIsHsBootOrSig
; let no_binds = isEmptyLHsBinds binds && null uprags
; is_boot <- tcIsHsBootOrSig
; failIfTc (is_boot && not no_binds) badBootDeclErr
; return ( [inst_info], all_insts, deriv_infos ) }
......
......@@ -48,6 +48,10 @@ test('bkp53', normal, backpack_compile, [''])
test('bkp54', normal, backpack_compile, [''])
test('bkp55', normal, backpack_compile, [''])
test('bkp56', normal, backpack_compile, [''])
test('bkp57', normal, backpack_compile, [''])
test('bkp58', normal, backpack_compile, [''])
test('bkp59', normal, backpack_compile, [''])
test('bkp60', normal, backpack_compile, [''])
test('T13140', normal, backpack_compile, [''])
test('T13149', expect_broken(13149), backpack_compile, [''])
......
-- no default method, backpack
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
unit common where
module Class where
class Show (T x) => C x where
type T x
def :: T x
--type T x = ()
unit consumer-abs where
dependency common
signature Instance where
import Class
data I = I Int
instance C I where
--type T I = ()
module Downstream where
import Class
import Instance
asdf :: C I => String
asdf = show $ def @I
unit consumer-impl where
dependency common
module Impl where
import Class
data I = I Int
instance C I where
type T I = ()
def = ()
unit tie where
dependency consumer-impl
dependency consumer-abs[Instance=consumer-impl:Impl]
module Tie where
import Downstream
main = print asdf
[1 of 4] Processing common
Instantiating common
[1 of 1] Compiling Class ( common/Class.hs, bkp57.out/common/Class.o )
[2 of 4] Processing consumer-abs
[1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, nothing )
[2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, nothing )
[3 of 4] Processing consumer-impl
Instantiating consumer-impl
[1 of 1] Including common
[1 of 1] Compiling Impl ( consumer-impl/Impl.hs, bkp57.out/consumer-impl/Impl.o )
[4 of 4] Processing tie
Instantiating tie
[1 of 2] Including consumer-impl
[2 of 2] Including consumer-abs[Instance=consumer-impl:Impl]
Instantiating consumer-abs[Instance=consumer-impl:Impl]
[1 of 1] Including common
[1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o )
[2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o )
[1 of 1] Compiling Tie ( tie/Tie.hs, bkp57.out/tie/Tie.o )
-- no default method, hs-boot
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
unit common where
module Class where
class Show (T x) => C x where
type T x
--type T x = ()
def :: T x
unit consumer-impl where
dependency common
module {-# SOURCE #-} Impl where
import Class
data I = I Int
instance C I where
--type T I = ()
module Downstream where
import Class
import {-# SOURCE #-} Impl
asdf :: C I => String
asdf = show $ def @I
module Impl where
import Class
data I = I Int
instance C I where
type T I = ()
def = ()
unit tie where
dependency consumer-impl
module Tie where
import Downstream
import Impl
main = print asdf
[1 of 3] Processing common
Instantiating common
[1 of 1] Compiling Class ( common/Class.hs, bkp58.out/common/Class.o )
[2 of 3] Processing consumer-impl
Instantiating consumer-impl
[1 of 1] Including common
[1 of 3] Compiling Impl[boot] ( consumer-impl/Impl.hs-boot, bkp58.out/consumer-impl/Impl.o-boot )
[2 of 3] Compiling Downstream ( consumer-impl/Downstream.hs, bkp58.out/consumer-impl/Downstream.o )
[3 of 3] Compiling Impl ( consumer-impl/Impl.hs, bkp58.out/consumer-impl/Impl.o )
[3 of 3] Processing tie
Instantiating tie
[1 of 1] Including consumer-impl
[1 of 1] Compiling Tie ( tie/Tie.hs, bkp58.out/tie/Tie.o )
-- default method, backpack
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
unit common where
module Class where
class Show (T x) => C x where
type T x
type T x = ()
def :: T x
class D x where
unit consumer-abs where
dependency common
signature Instance where
import Class
data I = I Int
instance C I where
--type T I = ()
module Downstream where
import Class
import Instance
asdf :: C I => String
asdf = show $ def @I
unit consumer-impl where
dependency common
module Impl where
import Class
data I = I Int
instance C I where
type T I = ()
def = ()
unit tie where
dependency consumer-impl
dependency consumer-abs[Instance=consumer-impl:Impl]
module Tie where
import Downstream
main = print asdf
[1 of 4] Processing common
Instantiating common
[1 of 1] Compiling Class ( common/Class.hs, bkp59.out/common/Class.o )
[2 of 4] Processing consumer-abs
[1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, nothing )
[2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, nothing )
[3 of 4] Processing consumer-impl
Instantiating consumer-impl
[1 of 1] Including common
[1 of 1] Compiling Impl ( consumer-impl/Impl.hs, bkp59.out/consumer-impl/Impl.o )
[4 of 4] Processing tie
Instantiating tie
[1 of 2] Including consumer-impl
[2 of 2] Including consumer-abs[Instance=consumer-impl:Impl]
Instantiating consumer-abs[Instance=consumer-impl:Impl]
[1 of 1] Including common
[1 of 2] Compiling Instance[sig] ( consumer-abs/Instance.hsig, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o )
[2 of 2] Compiling Downstream ( consumer-abs/Downstream.hs, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o )
[1 of 1] Compiling Tie ( tie/Tie.hs, bkp59.out/tie/Tie.o )
-- default method, hs-boot
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
unit common where
module Class where
class Show (T x) => C x where
type T x
type T x = ()
def :: T x
unit consumer-impl where
dependency common
module {-# SOURCE #-} Impl where
import Class
data I = I Int
instance C I where
--type T I = ()
module Downstream where
import Class
import {-# SOURCE #-} Impl
asdf :: C I => String
asdf = show $ def @I
module Impl where
import Class
data I = I Int
instance C I where
type T I = ()
def = ()
unit tie where
dependency consumer-impl
module Tie where
import Downstream
import Impl
main = print asdf
[1 of 3] Processing common
Instantiating common
[1 of 1] Compiling Class ( common/Class.hs, bkp60.out/common/Class.o )
[2 of 3] Processing consumer-impl
Instantiating consumer-impl
[1 of 1] Including common
[1 of 3] Compiling Impl[boot] ( consumer-impl/Impl.hs-boot, bkp60.out/consumer-impl/Impl.o-boot )
[2 of 3] Compiling Downstream ( consumer-impl/Downstream.hs, bkp60.out/consumer-impl/Downstream.o )
[3 of 3] Compiling Impl ( consumer-impl/Impl.hs, bkp60.out/consumer-impl/Impl.o )
[3 of 3] Processing tie
Instantiating tie
[1 of 1] Including consumer-impl
[1 of 1] Compiling Tie ( tie/Tie.hs, bkp60.out/tie/Tie.o )
import ClassDefaultInHsBootA3
import ClassDefaultInHsBootA2
main = print asdf
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- Analogous to module Class from tests/backpack/should_compile/bkp58.bkp
module ClassDefaultInHsBootA1 where
class Show (T x) => C x where
type T x
type T x = Int
def :: T x
{-# LANGUAGE TypeFamilies #-}
module ClassDefaultInHsBootA2 where
import ClassDefaultInHsBootA1
data I = I Int
instance C I where
type T I = ()
def = ()
module ClassDefaultInHsBootA2 where
import ClassDefaultInHsBootA1
data I = I Int
instance C I
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
module ClassDefaultInHsBootA3 where
import ClassDefaultInHsBootA1
import ClassDefaultInHsBootA2
asdf :: String
asdf = show $ def @I
......@@ -724,4 +724,5 @@ test('T18323', normal, compile, [''])
test('T18585', normal, compile, [''])
test('T18831', normal, compile, [''])
test('T15942', normal, compile, [''])
test('ClassDefaultInHsBoot', [extra_files(['ClassDefaultInHsBootA1.hs','ClassDefaultInHsBootA2.hs','ClassDefaultInHsBootA2.hs-boot','ClassDefaultInHsBootA3.hs'])], multimod_compile, ['ClassDefaultInHsBoot', '-v0'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment