diff options
17 files changed, 269 insertions, 5 deletions
diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs index 5fa26c2c57..baad1622c0 100644 --- a/compiler/GHC/Tc/TyCl/Class.hs +++ b/compiler/GHC/Tc/TyCl/Class.hs @@ -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)) } diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs index b0dfa80f90..4cc8a79e1e 100644 --- a/compiler/GHC/Tc/TyCl/Instance.hs +++ b/compiler/GHC/Tc/TyCl/Instance.hs @@ -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 ) } diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T index 6655e09360..ac8c2a7ed8 100644 --- a/testsuite/tests/backpack/should_compile/all.T +++ b/testsuite/tests/backpack/should_compile/all.T @@ -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, ['']) diff --git a/testsuite/tests/backpack/should_compile/bkp57.bkp b/testsuite/tests/backpack/should_compile/bkp57.bkp new file mode 100644 index 0000000000..51cc19b97c --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp57.bkp @@ -0,0 +1,37 @@ +-- 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 diff --git a/testsuite/tests/backpack/should_compile/bkp57.stderr b/testsuite/tests/backpack/should_compile/bkp57.stderr new file mode 100644 index 0000000000..96f769a402 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp57.stderr @@ -0,0 +1,19 @@ +[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 ) diff --git a/testsuite/tests/backpack/should_compile/bkp58.bkp b/testsuite/tests/backpack/should_compile/bkp58.bkp new file mode 100644 index 0000000000..6055e74496 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp58.bkp @@ -0,0 +1,35 @@ +-- 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 diff --git a/testsuite/tests/backpack/should_compile/bkp58.stderr b/testsuite/tests/backpack/should_compile/bkp58.stderr new file mode 100644 index 0000000000..c5ce8bd55f --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp58.stderr @@ -0,0 +1,13 @@ +[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 ) diff --git a/testsuite/tests/backpack/should_compile/bkp59.bkp b/testsuite/tests/backpack/should_compile/bkp59.bkp new file mode 100644 index 0000000000..7ba77ec6c1 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp59.bkp @@ -0,0 +1,38 @@ +-- 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 diff --git a/testsuite/tests/backpack/should_compile/bkp59.stderr b/testsuite/tests/backpack/should_compile/bkp59.stderr new file mode 100644 index 0000000000..364d6c2601 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp59.stderr @@ -0,0 +1,19 @@ +[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 ) diff --git a/testsuite/tests/backpack/should_compile/bkp60.bkp b/testsuite/tests/backpack/should_compile/bkp60.bkp new file mode 100644 index 0000000000..426ac1a75b --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp60.bkp @@ -0,0 +1,35 @@ +-- 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 diff --git a/testsuite/tests/backpack/should_compile/bkp60.stderr b/testsuite/tests/backpack/should_compile/bkp60.stderr new file mode 100644 index 0000000000..070a908b17 --- /dev/null +++ b/testsuite/tests/backpack/should_compile/bkp60.stderr @@ -0,0 +1,13 @@ +[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 ) diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs new file mode 100644 index 0000000000..c066f70d55 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs @@ -0,0 +1,4 @@ +import ClassDefaultInHsBootA3 +import ClassDefaultInHsBootA2 + +main = print asdf diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs new file mode 100644 index 0000000000..e83e1e8e8f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs @@ -0,0 +1,10 @@ +{-# 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 diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs new file mode 100644 index 0000000000..a4dd9af667 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +module ClassDefaultInHsBootA2 where + +import ClassDefaultInHsBootA1 + +data I = I Int + +instance C I where + type T I = () + def = () diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot new file mode 100644 index 0000000000..79cfe21342 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot @@ -0,0 +1,6 @@ +module ClassDefaultInHsBootA2 where + +import ClassDefaultInHsBootA1 + +data I = I Int +instance C I diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs new file mode 100644 index 0000000000..c47e807608 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +module ClassDefaultInHsBootA3 where + +import ClassDefaultInHsBootA1 +import ClassDefaultInHsBootA2 + +asdf :: String +asdf = show $ def @I diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index ad682924e2..953f2489c7 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -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']) |