Support for using only partial pieces of included signatures.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 27 Dec 2016 02:39:01 +0000 (18:39 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Wed, 11 Jan 2017 14:53:52 +0000 (06:53 -0800)
Summary:
Generally speaking, it's not possible to "hide" a requirement from a
package you include, because if there is some module relying on that
requirement, well, you can't just wish it out of existence.

However, some packages don't have any modules.  For these, we can
validly thin out requirements; indeed, this is very convenient if
someone has published a large signature package but you only want
some of the definitions.

This patchset tweaks the interpretation of export lists in
signatures: in particular, they no longer need to refer to
entities that are defined locally; they range over both the current
signature as well as any signatures that were inherited from
signature packages (defined by having zero exposed modules.)

In the process of doing this, I cleaned up a number of other
things:

* rnModIface and rnModExports now report errors that occurred
  during renaming and can propagate these to the TcM monad.
  This is important because in the current semantics, you can
  thin out a type which is referenced by a value you keep;
  in this situation, we need to error (to ensure that all
  types in signatures are rooted, so that we can determine
  their identities).

* I ended up introducing a new construct 'dependency signature;
  to bkp files, to make it easier to tell if we were depending
  on a signature package.  It's not difficult for Cabal to
  figure this out (I already have a patch for it.)

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D2904

GHC Trac Issues: #12994

45 files changed:
compiler/backpack/BkpSyn.hs
compiler/backpack/DriverBkp.hs
compiler/backpack/NameShape.hs
compiler/backpack/RnModIface.hs
compiler/iface/LoadIface.hs
compiler/main/HeaderInfo.hs
compiler/main/HscMain.hs
compiler/parser/Parser.y
compiler/typecheck/TcBackpack.hs
compiler/typecheck/TcRnExports.hs
testsuite/tests/backpack/reexport/bkpreex01.bkp
testsuite/tests/backpack/reexport/bkpreex02.bkp
testsuite/tests/backpack/reexport/bkpreex03.bkp
testsuite/tests/backpack/reexport/bkpreex04.bkp
testsuite/tests/backpack/reexport/bkpreex06.bkp
testsuite/tests/backpack/should_compile/all.T
testsuite/tests/backpack/should_compile/bkp15.bkp
testsuite/tests/backpack/should_compile/bkp15.stderr
testsuite/tests/backpack/should_compile/bkp25.bkp
testsuite/tests/backpack/should_compile/bkp28.bkp
testsuite/tests/backpack/should_compile/bkp43.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_compile/bkp43.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_compile/bkp44.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_compile/bkp44.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/all.T
testsuite/tests/backpack/should_fail/bkpfail03.bkp
testsuite/tests/backpack/should_fail/bkpfail05.bkp
testsuite/tests/backpack/should_fail/bkpfail19.bkp
testsuite/tests/backpack/should_fail/bkpfail20.bkp
testsuite/tests/backpack/should_fail/bkpfail21.bkp
testsuite/tests/backpack/should_fail/bkpfail29.stderr
testsuite/tests/backpack/should_fail/bkpfail30.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail30.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail31.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail31.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail32.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail32.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail33.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail33.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail34.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail34.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail35.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail35.stderr [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail36.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_fail/bkpfail36.stderr [new file with mode: 0644]

index e019d03..a7e4db3 100644 (file)
@@ -68,7 +68,12 @@ type LHsUnitDecl n = Located (HsUnitDecl n)
 -- | An include of another unit
 data IncludeDecl n = IncludeDecl {
         idUnitId :: LHsUnitId n,
-        idModRenaming :: Maybe [ LRenaming ]
+        idModRenaming :: Maybe [ LRenaming ],
+        -- | Is this a @dependency signature@ include?  If so,
+        -- we don't compile this include when we instantiate this
+        -- unit (as there should not be any modules brought into
+        -- scope.)
+        idSignatureInclude :: Bool
     }
 
 -- | Rename a module from one name to another.  The identity renaming
index fc46ce1..595cb25 100644 (file)
@@ -104,11 +104,20 @@ computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
     reqs = uniqDSetToList (unionManyUniqDSets (map (get_reqs . unLoc) (hsunitBody unit)))
     get_reqs (DeclD SignatureD (L _ modname) _) = unitUniqDSet modname
     get_reqs (DeclD ModuleD _ _) = emptyUniqDSet
-    get_reqs (IncludeD (IncludeDecl (L _ hsuid) _)) =
+    get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) =
         unitIdFreeHoles (convertHsUnitId hsuid)
 
 -- | Tiny enum for all types of Backpack operations we may do.
-data SessionType = ExeSession | TcSession | CompSession
+data SessionType
+    -- | A compilation operation which will result in a
+    -- runnable executable being produced.
+    = ExeSession
+    -- | A type-checking operation which produces only
+    -- interface files, no object files.
+    | TcSession
+    -- | A compilation operation which produces both
+    -- interface files and object files.
+    | CompSession
     deriving (Eq)
 
 -- | Create a temporary Session to do some sort of type checking or
@@ -208,11 +217,19 @@ compileUnit cid insts = do
     lunit <- getSource cid
     buildUnit CompSession cid insts lunit
 
--- Invariant: this NEVER returns InstalledUnitId
-hsunitDeps :: HsUnit HsComponentId -> [(UnitId, ModRenaming)]
-hsunitDeps unit = concatMap get_dep (hsunitBody unit)
+-- | Compute the dependencies with instantiations of a syntactic
+-- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a
+-- unit file, return the 'UnitId' corresponding to @p[A=<A>]@.
+-- The @include_sigs@ parameter controls whether or not we also
+-- include @dependency signature@ declarations in this calculation.
+--
+-- Invariant: this NEVER returns InstalledUnitId.
+hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(UnitId, ModRenaming)]
+hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
   where
-    get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn))) = [(convertHsUnitId hsuid, go mb_lrn)]
+    get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn is_sig)))
+        | include_sigs || not is_sig = [(convertHsUnitId hsuid, go mb_lrn)]
+        | otherwise = []
       where
         go Nothing = ModRenaming True []
         go (Just lrns) = ModRenaming False (map convRn lrns)
@@ -223,7 +240,11 @@ hsunitDeps unit = concatMap get_dep (hsunitBody unit)
 
 buildUnit :: SessionType -> ComponentId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
 buildUnit session cid insts lunit = do
-    let deps_w_rns = hsunitDeps (unLoc lunit)
+    -- NB: include signature dependencies ONLY when typechecking.
+    -- If we're compiling, it's not necessary to recursively
+    -- compile a signature since it isn't going to produce
+    -- any object files.
+    let deps_w_rns = hsunitDeps (session == TcSession) (unLoc lunit)
         raw_deps = map fst deps_w_rns
     dflags <- getDynFlags
     -- The compilation dependencies are just the appropriately filled
@@ -273,11 +294,7 @@ buildUnit session cid insts lunit = do
             obj_files = concatMap getOfiles linkables
 
         let compat_fs = (case cid of ComponentId fs -> fs)
-            cand_compat_pn = PackageName compat_fs
-            compat_pn = case session of
-                            TcSession -> cand_compat_pn
-                            _ | [] <- insts -> cand_compat_pn
-                              | otherwise -> PackageName compat_fs
+            compat_pn = PackageName compat_fs
 
         return InstalledPackageInfo {
             -- Stub data
@@ -336,7 +353,7 @@ buildUnit session cid insts lunit = do
 compileExe :: LHsUnit HsComponentId -> BkpM ()
 compileExe lunit = do
     msgUnitId mainUnitId
-    let deps_w_rns = hsunitDeps (unLoc lunit)
+    let deps_w_rns = hsunitDeps False (unLoc lunit)
         deps = map fst deps_w_rns
         -- no renaming necessary
     forM_ (zip [1..] deps) $ \(i, dep) ->
@@ -562,7 +579,8 @@ renameHsUnits dflags m units = map (fmap renameHsUnit) units
     renameHsUnitDecl (IncludeD idecl) =
         IncludeD IncludeDecl {
             idUnitId = fmap renameHsUnitId (idUnitId idecl),
-            idModRenaming = idModRenaming idecl
+            idModRenaming = idModRenaming idecl,
+            idSignatureInclude = idSignatureInclude idecl
         }
 
     renameHsUnitId :: HsUnitId PackageName -> HsUnitId HsComponentId
@@ -713,7 +731,9 @@ hsModuleToModSummary :: PackageName
                      -> Located (HsModule RdrName)
                      -> BkpM ModSummary
 hsModuleToModSummary pn hsc_src modname
-                     hsmod@(L loc (HsModule _ _ imps _ _ _)) = do
+                     hsmod = do
+    let imps = hsmodImports (unLoc hsmod)
+        loc  = getLoc hsmod
     hsc_env <- getSession
     -- Sort of the same deal as in DriverPipeline's getLocation
     -- Use the PACKAGE NAME to find the location
index ea6e193..0804d71 100644 (file)
@@ -7,6 +7,7 @@ module NameShape(
     extendNameShape,
     nameShapeExports,
     substNameShape,
+    maybeSubstNameShape,
     ) where
 
 #include "HsVersions.h"
@@ -134,6 +135,15 @@ substNameShape ns n | nameModule n == ns_module ns
                     | otherwise
                     = n
 
+-- | Like 'substNameShape', but returns @Nothing@ if no substitution
+-- works.
+maybeSubstNameShape :: NameShape -> Name -> Maybe Name
+maybeSubstNameShape ns n
+    | nameModule n == ns_module ns
+    = lookupOccEnv (ns_map ns) (occName n)
+    | otherwise
+    = Nothing
+
 -- | The 'Module' of any 'Name's a 'NameShape' has action over.
 ns_module :: NameShape -> Module
 ns_module = mkHoleModule . ns_mod_name
index 4861628..0a95849 100644 (file)
@@ -9,10 +9,13 @@
 module RnModIface(
     rnModIface,
     rnModExports,
+    tcRnModIface,
+    tcRnModExports,
     ) where
 
 #include "HsVersions.h"
 
+import SrcLoc
 import Outputable
 import HscTypes
 import Module
@@ -21,6 +24,7 @@ import Avail
 import IfaceSyn
 import FieldLabel
 import Var
+import ErrUtils
 
 import Name
 import TcRnMonad
@@ -34,9 +38,39 @@ import DynFlags
 
 import qualified Data.Traversable as T
 
+import Bag
+import Data.IORef
 import NameShape
 import IfaceEnv
 
+tcRnMsgMaybe :: IO (Either ErrorMessages a) -> TcM a
+tcRnMsgMaybe do_this = do
+    r <- liftIO $ do_this
+    case r of
+        Left errs -> do
+            addMessages (emptyBag, errs)
+            failM
+        Right x -> return x
+
+tcRnModIface :: [(ModuleName, Module)] -> Maybe NameShape -> ModIface -> TcM ModIface
+tcRnModIface x y z = do
+    hsc_env <- getTopEnv
+    tcRnMsgMaybe $ rnModIface hsc_env x y z
+
+tcRnModExports :: [(ModuleName, Module)] -> ModIface -> TcM [AvailInfo]
+tcRnModExports x y = do
+    hsc_env <- getTopEnv
+    tcRnMsgMaybe $ rnModExports hsc_env x y
+
+failWithRn :: SDoc -> ShIfM a
+failWithRn doc = do
+    errs_var <- fmap sh_if_errs getGblEnv
+    dflags <- getDynFlags
+    errs <- readTcRef errs_var
+    -- TODO: maybe associate this with a source location?
+    writeTcRef errs_var (errs `snocBag` mkPlainErrMsg dflags noSrcSpan doc)
+    failM
+
 -- | What we have a generalized ModIface, which corresponds to
 -- a module that looks like p[A=<A>]:B.  We need a *specific* ModIface, e.g.
 -- p[A=q():A]:B (or maybe even p[A=<B>]:B) which we load
@@ -58,7 +92,7 @@ import IfaceEnv
 -- should be Foo.T; then we'll also rename this (this is used
 -- when loading an interface to merge it into a requirement.)
 rnModIface :: HscEnv -> [(ModuleName, Module)] -> Maybe NameShape
-           -> ModIface -> IO ModIface
+           -> ModIface -> IO (Either ErrorMessages ModIface)
 rnModIface hsc_env insts nsubst iface = do
     initRnIface hsc_env iface insts nsubst $ do
         mod <- rnModule (mi_module iface)
@@ -81,7 +115,7 @@ rnModIface hsc_env insts nsubst iface = do
 
 -- | Rename just the exports of a 'ModIface'.  Useful when we're doing
 -- shaping prior to signature merging.
-rnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO [AvailInfo]
+rnModExports :: HscEnv -> [(ModuleName, Module)] -> ModIface -> IO (Either ErrorMessages [AvailInfo])
 rnModExports hsc_env insts iface
     = initRnIface hsc_env iface insts Nothing
     $ mapM rnAvailInfo (mi_exports iface)
@@ -94,19 +128,28 @@ rnModExports hsc_env insts iface
 ************************************************************************
 -}
 
--- | Initialize the 'ShIfM' monad.
+-- | Run a computation in the 'ShIfM' monad.
 initRnIface :: HscEnv -> ModIface -> [(ModuleName, Module)] -> Maybe NameShape
-            -> ShIfM a -> IO a
-initRnIface hsc_env iface insts nsubst do_this =
-    let hsubst = listToUFM insts
-        rn_mod = renameHoleModule (hsc_dflags hsc_env) hsubst
+            -> ShIfM a -> IO (Either ErrorMessages a)
+initRnIface hsc_env iface insts nsubst do_this = do
+    errs_var <- newIORef emptyBag
+    let dflags = hsc_dflags hsc_env
+        hsubst = listToUFM insts
+        rn_mod = renameHoleModule dflags hsubst
         env = ShIfEnv {
             sh_if_module = rn_mod (mi_module iface),
             sh_if_semantic_module = rn_mod (mi_semantic_module iface),
             sh_if_hole_subst = listToUFM insts,
-            sh_if_shape = nsubst
+            sh_if_shape = nsubst,
+            sh_if_errs = errs_var
         }
-    in initTcRnIf 'c' hsc_env env () do_this
+    -- Modeled off of 'initTc'
+    res <- initTcRnIf 'c' hsc_env env () $ tryM do_this
+    msgs <- readIORef errs_var
+    case res of
+        Left _                          -> return (Left msgs)
+        Right r | not (isEmptyBag msgs) -> return (Left msgs)
+                | otherwise             -> return (Right r)
 
 -- | Environment for 'ShIfM' monads.
 data ShIfEnv = ShIfEnv {
@@ -123,7 +166,9 @@ data ShIfEnv = ShIfEnv {
         -- the names in the interface.  If this is 'Nothing', then
         -- we just load the target interface and look at the export
         -- list to determine the renaming.
-        sh_if_shape :: Maybe NameShape
+        sh_if_shape :: Maybe NameShape,
+        -- Mutable reference to keep track of errors (similar to 'tcl_errs')
+        sh_if_errs :: IORef ErrorMessages
     }
 
 getHoleSubst :: ShIfM ShHoleSubst
@@ -215,10 +260,21 @@ rnIfaceGlobal n = do
        , isHoleModule m'
       -- NB: this could be Nothing for computeExports, we have
       -- nothing to say.
-      -> do fmap (case mb_nsubst of
-                   Nothing -> id
-                   Just nsubst -> substNameShape nsubst)
-                $ setNameModule (Just m') n
+      -> do n' <- setNameModule (Just m') n
+            case mb_nsubst of
+                Nothing -> return n'
+                Just nsubst ->
+                    case maybeSubstNameShape nsubst n' of
+                        -- TODO: would love to have context
+                        -- TODO: This will give an unpleasant message if n'
+                        -- is a constructor; then we'll suggest adding T
+                        -- but it won't work.
+                        Nothing -> failWithRn $ vcat [
+                            text "The identifier" <+> ppr (occName n') <+>
+                                text "does not exist in the local signature.",
+                            parens (text "Try adding it to the export list of the hsig file.")
+                            ]
+                        Just n'' -> return n''
        -- Fastpath: we are renaming p[H=<H>]:A.T, in which case the
        -- export list is irrelevant.
        | not (isHoleModule m)
@@ -239,7 +295,14 @@ rnIfaceGlobal n = do
             iface <- liftIO . initIfaceCheck (text "rnIfaceGlobal") hsc_env
                             $ loadSysInterface (text "rnIfaceGlobal") m''
             let nsubst = mkNameShape (moduleName m) (mi_exports iface)
-            return (substNameShape nsubst n)
+            case maybeSubstNameShape nsubst n of
+                Nothing -> failWithRn $ vcat [
+                    text "The identifier" <+> ppr (occName n) <+>
+                        -- NB: report m' because it's more user-friendly
+                        text "does not exist in the signature for" <+> ppr m',
+                    parens (text "Try adding it to the export list in that hsig file.")
+                    ]
+                Just n' -> return n'
 
 -- | Rename a DFun name. Here is where we ensure that DFuns have the correct
 -- module as described in Note [Bogus DFun renamings].
index 921943a..7c138c4 100644 (file)
@@ -75,6 +75,7 @@ import RnModIface
 import UniqDSet
 
 import Control.Monad
+import Control.Exception
 import Data.IORef
 import System.FilePath
 
@@ -540,8 +541,12 @@ computeInterface doc_str hi_boot_file mod0 = do
             case r of
                 Succeeded (iface0, path) -> do
                     hsc_env <- getTopEnv
-                    r <- liftIO (rnModIface hsc_env (indefUnitIdInsts (indefModuleUnitId indef)) Nothing iface0)
-                    return (Succeeded (r, path))
+                    r <- liftIO $
+                        rnModIface hsc_env (indefUnitIdInsts (indefModuleUnitId indef))
+                                   Nothing iface0
+                    case r of
+                        Right x -> return (Succeeded (x, path))
+                        Left errs -> liftIO . throwIO . mkSrcErr $ errs
                 Failed err -> return (Failed err)
         (mod, _) ->
             findAndReadIface doc_str mod hi_boot_file
index ceb566c..6dd16f6 100644 (file)
@@ -74,8 +74,10 @@ getImports dflags buf filename source_filename = do
         then throwIO $ mkSrcErr errs
         else
           case rdr_module of
-            L _ (HsModule mb_mod _ imps _ _ _) ->
+            L _ hsmod ->
               let
+                mb_mod = hsmodName hsmod
+                imps = hsmodImports hsmod
                 main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename) 1 1)
                 mod = mb_mod `orElse` L main_loc mAIN_NAME
                 (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
index 2fc7341..eb56a54 100644 (file)
@@ -414,7 +414,7 @@ hscTypecheck keep_rn mod_summary mb_rdr_module = do
             if hsc_src == HsigFile
                 then do (iface, _, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 Nothing
                         ioMsgMaybe $
-                            tcRnMergeSignatures hsc_env (tcg_top_loc tc_result0) iface
+                            tcRnMergeSignatures hsc_env (tcg_top_loc tc_result0) hpm iface
                 else return tc_result0
 
 -- wrapper around tcRnModule to handle safe haskell extras
index fadb8e7..5119ab4 100644 (file)
@@ -643,7 +643,12 @@ unitdecl :: { LHsUnitDecl PackageName }
              { sL1 $2 $ DeclD SignatureD $3 Nothing }
         | 'dependency' unitid mayberns
              { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2
-                                              , idModRenaming = $3 }) }
+                                              , idModRenaming = $3
+                                              , idSignatureInclude = False }) }
+        | 'dependency' 'signature' unitid
+             { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $3
+                                              , idModRenaming = Nothing
+                                              , idSignatureInclude = True }) }
 
 -----------------------------------------------------------------------------
 -- Module Header
index 1cf3393..7c44ef0 100644 (file)
@@ -17,6 +17,7 @@ module TcBackpack (
 ) where
 
 import Packages
+import TcRnExports
 import DynFlags
 import HsSyn
 import RdrName
@@ -46,6 +47,7 @@ import FastString
 import Maybes
 import TcEnv
 import Var
+import IfaceSyn
 import PrelNames
 import qualified Data.Map as Map
 
@@ -311,18 +313,42 @@ tcRnCheckUnitId hsc_env uid =
 
 -- | Top-level driver for signature merging (run after typechecking
 -- an @hsig@ file).
-tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> ModIface
+tcRnMergeSignatures :: HscEnv -> RealSrcSpan -> HsParsedModule -> ModIface
                     -> IO (Messages, Maybe TcGblEnv)
-tcRnMergeSignatures hsc_env real_loc iface =
+tcRnMergeSignatures hsc_env real_loc hsmod iface =
   withTiming (pure dflags)
              (text "Signature merging" <+> brackets (ppr this_mod))
              (const ()) $
   initTc hsc_env HsigFile False this_mod real_loc $
-    mergeSignatures iface
+    mergeSignatures hsmod iface
  where
   dflags   = hsc_dflags hsc_env
   this_mod = mi_module iface
 
+thinModIface :: [AvailInfo] -> ModIface -> ModIface
+thinModIface avails iface =
+    iface {
+        mi_exports = avails,
+        -- mi_fixities = ...,
+        -- mi_warns = ...,
+        -- mi_anns = ...,
+        -- TODO: The use of nameOccName here is a bit dodgy, because
+        -- perhaps there might be two IfaceTopBndr that are the same
+        -- OccName but different Name.  Requires better understanding
+        -- of invariants here.
+        mi_decls = filter (decl_pred . snd) (mi_decls iface)
+        -- mi_insts = ...,
+        -- mi_fam_insts = ...,
+    }
+  where
+    occs = mkOccSet [ occName n
+                    | a <- avails
+                    , n <- availNames a ]
+    -- NB: Never drop DFuns
+    decl_pred IfaceId{ ifIdDetails = IfDFunId } = True
+    decl_pred decl =
+        nameOccName (ifName decl) `elemOccSet` occs
+
 -- Note [Blank hsigs for all requirements]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- One invariant that a client of GHC must uphold is that there
@@ -336,8 +362,8 @@ tcRnMergeSignatures hsc_env real_loc iface =
 -- from 'requirementMerges' into this signature, producing
 -- a final 'TcGblEnv' that matches the local signature and
 -- all required signatures.
-mergeSignatures :: ModIface -> TcRn TcGblEnv
-mergeSignatures lcl_iface0 = do
+mergeSignatures :: HsParsedModule -> ModIface -> TcRn TcGblEnv
+mergeSignatures hsmod lcl_iface0 = do
     -- The lcl_iface0 is the ModIface for the local hsig
     -- file, which is guaranteed to exist, see
     -- Note [Blank hsigs for all requirements]
@@ -346,41 +372,68 @@ mergeSignatures lcl_iface0 = do
     tcg_env <- getGblEnv
     let outer_mod = tcg_mod tcg_env
         inner_mod = tcg_semantic_mod tcg_env
+        mb_exports = hsmodExports (unLoc (hpm_module hsmod))
 
     -- STEP 1: Figure out all of the external signature interfaces
     -- we are going to merge in.
     let reqs = requirementMerges dflags (moduleName (tcg_mod tcg_env))
 
     -- STEP 2: Read in the RAW forms of all of these interfaces
-    ireq_ifaces <- forM reqs $ \(IndefModule iuid mod_name) ->
+    ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
            fmap fst
          . withException
          . flip (findAndReadIface (text "mergeSignatures")) False
          $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
 
     -- STEP 3: Get the unrenamed exports of all these interfaces, and
-    -- dO shaping on them.
+    -- do shaping on them.
     let extend_ns nsubst as = liftIO $ extendNameShape hsc_env nsubst as
-        gen_subst nsubst ((IndefModule iuid _), ireq_iface) = do
+        gen_subst (nsubst,ifaces) (imod@(IndefModule iuid _), ireq_iface) = do
             let insts = indefUnitIdInsts iuid
-            as1 <- liftIO $ rnModExports hsc_env insts ireq_iface
-            mb_r <- extend_ns nsubst as1
+            as1 <- tcRnModExports insts ireq_iface
+            let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
+                pkg = getInstalledPackageDetails dflags inst_uid
+                rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing as1)
+            (thinned_iface, as2) <- case mb_exports of
+                    Just (L loc _)
+                      | null (exposedModules pkg) -> setSrcSpan loc $ do
+                        -- Suppress missing errors; we'll pick em up
+                        -- when we test exports on the final thing
+                        (msgs, mb_r) <- tryTc $
+                            setGblEnv tcg_env {
+                                tcg_rdr_env = rdr_env
+                            } $ exports_from_avail mb_exports rdr_env
+                                    (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
+                        case mb_r of
+                            Just (_, as2) -> return (thinModIface as2 ireq_iface, as2)
+                            Nothing -> addMessages msgs >> failM
+                    _ -> return (ireq_iface, as1)
+            mb_r <- extend_ns nsubst as2
             case mb_r of
                 Left err -> failWithTc err
-                Right nsubst' -> return nsubst'
+                Right nsubst' -> return (nsubst',(imod, thinned_iface):ifaces)
         nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0)
-    nsubst <- foldM gen_subst nsubst0 (zip reqs ireq_ifaces)
-    let exports = nameShapeExports nsubst
-    tcg_env <- return tcg_env {
-        tcg_rdr_env = mkGlobalRdrEnv (gresFromAvails Nothing exports),
+    (nsubst, rev_thinned_ifaces) <- foldM gen_subst (nsubst0, []) (zip reqs ireq_ifaces0)
+    let thinned_ifaces = reverse rev_thinned_ifaces
+        exports        = nameShapeExports nsubst
+        rdr_env        = mkGlobalRdrEnv (gresFromAvails Nothing exports)
+    setGblEnv tcg_env {
+        tcg_rdr_env = rdr_env,
         tcg_exports = exports,
         tcg_dus     = usesOnly (availsToNameSetWithSelectors exports)
-        }
+        } $ do
+    tcg_env <- getGblEnv
+
+    -- Make sure we didn't refer to anything that doesn't actually exist
+    _ <- exports_from_avail mb_exports rdr_env
+                        (tcg_imports tcg_env) (tcg_semantic_mod tcg_env)
+
+    failIfErrsM
 
     -- STEP 4: Rename the interfaces
-    ext_ifaces <- forM (zip reqs ireq_ifaces) $ \((IndefModule iuid _), ireq_iface) ->
-        liftIO (rnModIface hsc_env (indefUnitIdInsts iuid) (Just nsubst) ireq_iface)
-    lcl_iface <- liftIO $ rnModIface hsc_env (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
+    ext_ifaces <- forM thinned_ifaces $ \((IndefModule iuid _), ireq_iface) ->
+        tcRnModIface (indefUnitIdInsts iuid) (Just nsubst) ireq_iface
+    lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
     let ifaces = lcl_iface : ext_ifaces
 
     -- STEP 5: Typecheck the interfaces
@@ -591,8 +644,7 @@ checkImplements impl_mod (IndefModule uid mod_name) = do
     failIfErrsM
 
     -- STEP 4: Now that the export is complete, rename the interface...
-    hsc_env <- getTopEnv
-    sig_iface <- liftIO $ rnModIface hsc_env insts (Just nsubst) isig_iface
+    sig_iface <- tcRnModIface insts (Just nsubst) isig_iface
 
     -- STEP 5: ...and typecheck it.  (Note that in both cases, the nsubst
     -- lets us determine how top-level identifiers should be handled.)
index 35ff65f..cedd4c7 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
-module TcRnExports (tcRnExports) where
+module TcRnExports (tcRnExports, exports_from_avail) where
 
 import HsSyn
 import PrelNames
@@ -115,7 +115,8 @@ tcRnExports :: Bool       -- False => no 'module M(..) where' header at all
 tcRnExports explicit_mod exports
           tcg_env@TcGblEnv { tcg_mod     = this_mod,
                               tcg_rdr_env = rdr_env,
-                              tcg_imports = imports }
+                              tcg_imports = imports,
+                              tcg_src     = hsc_src }
  = unsetWOptM Opt_WarnWarningsDeprecations $
        -- Do not report deprecations arising from the export
        -- list, to avoid bleating about re-exporting a deprecated
@@ -136,8 +137,14 @@ tcRnExports explicit_mod exports
                         -- ToDo: the 'noLoc' here is unhelpful if 'main'
                         --       turns out to be out of scope
 
+        ; let do_it = exports_from_avail real_exports rdr_env imports this_mod
         ; (rn_exports, final_avails)
-            <- exports_from_avail real_exports rdr_env imports this_mod
+            <- if hsc_src == HsigFile
+                then do (msgs, mb_r) <- tryTc do_it
+                        case mb_r of
+                            Just r  -> return r
+                            Nothing -> addMessages msgs >> failM
+                else checkNoErrs $ do_it
         ; let final_ns     = availsToNameSetWithSelectors final_avails
 
         ; traceRn "rnExports: Exports:" (ppr final_avails)
@@ -185,7 +192,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
 
 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
   = do ExportAccum ie_names _ exports
-        <-  checkNoErrs $ foldAndRecoverM do_litem emptyExportAccum rdr_items
+        <-  foldAndRecoverM do_litem emptyExportAccum rdr_items
        let final_exports = nubAvails exports -- Combine families
        return (Just ie_names, final_exports)
   where
index fa6c36a..9a1c5bd 100644 (file)
@@ -1,11 +1,11 @@
 unit h where
-    signature H(T) where
+    signature H where
         data T
 unit p where
     dependency h[H=<H>]
     module B(T(..)) where
         data T = T
-    signature H(T(..), f) where
+    signature H(module H, T(..)) where
         import B(T(..))
         f :: a -> a
     module A(T) where
index 0224b11..40e2bbb 100644 (file)
@@ -10,7 +10,7 @@ unit timpl where
 unit q where
     dependency timpl
     dependency p[H=<H>,T=<T>]
-    signature T(T) where
+    signature T(module T, T) where
         import TImpl
     module A where
         import H
index 69c2f55..69da4a4 100644 (file)
@@ -3,7 +3,7 @@ unit p where
         data M = M
     module M2 where
         data M = M
-    signature A(M) where
+    signature A(module A, M) where
         import M1
-    signature A(M) where
+    signature A(module A, M) where
         import M2
index 610ebd9..4788b4a 100644 (file)
@@ -3,5 +3,5 @@ unit p where
         data T
     signature B where
         data T
-    signature A(T) where
+    signature A(module A, T) where
         import B(T)
index 2c04b61..7754097 100644 (file)
@@ -1,7 +1,7 @@
 unit p where
     signature A1 where
         data A = A { foo :: Int, bar :: Bool }
-    signature A2(foo) where
+    signature A2(module A2, foo) where
         import A1(foo)
 unit q where
     signature A2 where
index bb77278..299b28a 100644 (file)
@@ -34,3 +34,5 @@ test('bkp39', normal, backpack_compile, [''])
 test('bkp40', normal, backpack_compile, [''])
 test('bkp41', normal, backpack_compile, [''])
 test('bkp42', normal, backpack_compile, [''])
+test('bkp43', normal, backpack_compile, [''])
+test('bkp44', normal, backpack_compile, [''])
index 6eb5364..94678af 100644 (file)
@@ -15,10 +15,13 @@ unit p where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            xa = (==)
+            -- TODO: Putting default definitions in the signature file
+            -- causes references to DFuns, which we choke on. These should
+            -- be disallowed.
+            -- xa = (==)
             y :: a -> a -> Ordering
-            default y :: Ord a => a -> a -> Ordering
-            y = compare
+            -- default y :: Ord a => a -> a -> Ordering
+            -- y = compare
             {-# MINIMAL xa | y #-}
         -- type instance Elem Int = Bool
         -- pattern Blub n = ("foo", n)
@@ -37,10 +40,10 @@ unit q where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            xa = (==)
+            -- xa = (==)
             y :: a -> a -> Ordering
-            default y :: Ord a => a -> a -> Ordering
-            y = compare
+            -- default y :: Ord a => a -> a -> Ordering
+            -- y = compare
             {-# MINIMAL xa | y #-}
         -- type instance Elem Int = Bool
         -- pattern Blub n = ("foo", n)
@@ -73,10 +76,10 @@ unit h-impl where
         class Eq a => Bloop a b | a -> b where
             data GMap a (v :: * -> *) :: *
             xa :: a -> a -> Bool
-            xa = (==)
+            -- xa = (==)
             y :: a -> a -> Ordering
-            default y :: Ord a => a -> a -> Ordering
-            y = compare
+            -- default y :: Ord a => a -> a -> Ordering
+            -- y = compare
             {-# MINIMAL xa | y #-}
 unit s where
     dependency r[H=h-impl:H]
index 904ab2d..041b7fe 100644 (file)
@@ -3,14 +3,32 @@ bkp15.bkp:1:26: warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 [1 of 5] Processing p
   [1 of 1] Compiling H[sig]           ( p/H.hsig, nothing )
+
+bkp15.bkp:15:9: warning:
+    • The MINIMAL pragma does not require:
+        ‘xa’ and ‘y’
+      but there is no default implementation.
+    • In the class declaration for ‘Bloop’
 [2 of 5] Processing q
   [1 of 1] Compiling H[sig]           ( q/H.hsig, nothing )
+
+bkp15.bkp:40:9: warning:
+    • The MINIMAL pragma does not require:
+        ‘xa’ and ‘y’
+      but there is no default implementation.
+    • In the class declaration for ‘Bloop’
 [3 of 5] Processing r
   [1 of 2] Compiling H[sig]           ( r/H.hsig, nothing )
   [2 of 2] Compiling M                ( r/M.hs, nothing )
 [4 of 5] Processing h-impl
   Instantiating h-impl
   [1 of 1] Compiling H                ( h-impl/H.hs, bkp15.out/h-impl/H.o )
+
+bkp15.bkp:76:9: warning:
+    • The MINIMAL pragma does not require:
+        ‘xa’ and ‘y’
+      but there is no default implementation.
+    • In the class declaration for ‘Bloop’
 [5 of 5] Processing s
   Instantiating s
   [1 of 1] Including r[H=h-impl:H]
index fb26323..672339f 100644 (file)
@@ -1,7 +1,7 @@
 unit p where
-    signature A(A) where
+    signature A where
         data A
-    signature B(A) where
+    signature B(module B, A) where
         import A
     module P where
         import A
@@ -15,9 +15,9 @@ unit r where
 unit q where
     dependency p[A=<A>,B=<B>]
     dependency r
-    signature A(A) where
+    signature A(module A, A) where
         import Impl(A)
-    signature B(A) where
+    signature B(module B, A) where
         import Impl(A)
     module M where
         import A
index d2e403c..c6f0f45 100644 (file)
@@ -3,7 +3,7 @@ unit i where
         data I = I
 unit p where
     dependency i
-    signature A(I,f,g) where
+    signature A(module A, I) where
         import I
         f :: I -> I
         g :: I
diff --git a/testsuite/tests/backpack/should_compile/bkp43.bkp b/testsuite/tests/backpack/should_compile/bkp43.bkp
new file mode 100644 (file)
index 0000000..60a4990
--- /dev/null
@@ -0,0 +1,20 @@
+unit sig where
+    signature A where
+        x :: Int
+        y :: Int
+
+unit blub where
+    dependency signature sig[A=<A>]
+    signature A (x) where
+        x :: Int
+    module M (y) where
+        import A
+        y = x
+
+unit impl where
+    module A where
+        x :: Int
+        x = 2
+
+unit all where
+    dependency blub[A=impl:A]
diff --git a/testsuite/tests/backpack/should_compile/bkp43.stderr b/testsuite/tests/backpack/should_compile/bkp43.stderr
new file mode 100644 (file)
index 0000000..6915f14
--- /dev/null
@@ -0,0 +1,14 @@
+[1 of 4] Processing sig
+  [1 of 1] Compiling A[sig]           ( sig/A.hsig, nothing )
+[2 of 4] Processing blub
+  [1 of 2] Compiling A[sig]           ( blub/A.hsig, nothing )
+  [2 of 2] Compiling M                ( blub/M.hs, nothing )
+[3 of 4] Processing impl
+  Instantiating impl
+  [1 of 1] Compiling A                ( impl/A.hs, bkp43.out/impl/A.o )
+[4 of 4] Processing all
+  Instantiating all
+  [1 of 1] Including blub[A=impl:A]
+    Instantiating blub[A=impl:A]
+    [1 of 2] Compiling A[sig]           ( blub/A.hsig, bkp43.out/blub/blub-EMBMWyCjWt1EWXmIjSqmRG/A.o )
+    [2 of 2] Compiling M                ( blub/M.hs, bkp43.out/blub/blub-EMBMWyCjWt1EWXmIjSqmRG/M.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp44.bkp b/testsuite/tests/backpack/should_compile/bkp44.bkp
new file mode 100644 (file)
index 0000000..06134b7
--- /dev/null
@@ -0,0 +1,23 @@
+unit p where
+    signature A where
+        data T
+        x :: Bool
+    signature B where
+        import A
+        y :: T
+        z :: Bool
+unit q where
+    dependency signature p[A=<A>,B=<B>]
+    signature A (x) where
+    signature B (z) where
+    module M(y) where
+        import A
+        import B
+        y = x && z
+unit pimpl where
+    module A where
+        x = True
+    module B where
+        z = False
+unit r where
+    dependency q[A=pimpl:A,B=pimpl:B]
diff --git a/testsuite/tests/backpack/should_compile/bkp44.stderr b/testsuite/tests/backpack/should_compile/bkp44.stderr
new file mode 100644 (file)
index 0000000..020dfa6
--- /dev/null
@@ -0,0 +1,18 @@
+[1 of 4] Processing p
+  [1 of 2] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 2] Compiling B[sig]           ( p/B.hsig, nothing )
+[2 of 4] Processing q
+  [1 of 3] Compiling A[sig]           ( q/A.hsig, nothing )
+  [2 of 3] Compiling B[sig]           ( q/B.hsig, nothing )
+  [3 of 3] Compiling M                ( q/M.hs, nothing )
+[3 of 4] Processing pimpl
+  Instantiating pimpl
+  [1 of 2] Compiling A                ( pimpl/A.hs, bkp44.out/pimpl/A.o )
+  [2 of 2] Compiling B                ( pimpl/B.hs, bkp44.out/pimpl/B.o )
+[4 of 4] Processing r
+  Instantiating r
+  [1 of 1] Including q[A=pimpl:A,B=pimpl:B]
+    Instantiating q[A=pimpl:A,B=pimpl:B]
+    [1 of 3] Compiling A[sig]           ( q/A.hsig, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/A.o )
+    [2 of 3] Compiling B[sig]           ( q/B.hsig, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/B.o )
+    [3 of 3] Compiling M                ( q/M.hs, bkp44.out/q/q-BxPafal3NcFHV8AOBzU3fg/M.o )
index f29657a..f55248b 100644 (file)
@@ -25,3 +25,10 @@ test('bkpfail26', normal, backpack_compile_fail, [''])
 test('bkpfail27', normal, backpack_compile_fail, [''])
 test('bkpfail28', normal, backpack_compile_fail, [''])
 test('bkpfail29', normal, backpack_compile_fail, [''])
+test('bkpfail30', normal, backpack_compile_fail, [''])
+test('bkpfail31', normal, backpack_compile_fail, [''])
+test('bkpfail32', normal, backpack_compile_fail, [''])
+test('bkpfail33', normal, backpack_compile_fail, [''])
+test('bkpfail34', normal, backpack_compile_fail, [''])
+test('bkpfail35', normal, backpack_compile_fail, [''])
+test('bkpfail36', normal, backpack_compile_fail, [''])
index 70be6d0..7c622c1 100644 (file)
@@ -1,7 +1,7 @@
 unit q where
     module M1 where
         data M = M
-    signature M2(M) where
+    signature M2(module M2, M) where
         import M1
 unit m2 where
     module M2 where
index 2bf58a1..afc484f 100644 (file)
@@ -10,7 +10,7 @@ unit p where
     -- Known bug: GHC will not eagerly report an error here although
     -- it could, if it more aggressively checked for type-compatibility
     -- when a hole gets resolved
-    signature H(T(..)) where
+    signature H(module H, T(..)) where
         import T
 unit h-impl where
     dependency t-impl
index 1752b7c..9a3f261 100644 (file)
@@ -1,5 +1,5 @@
 unit p where
-    signature ShouldFail(newSTRef) where
+    signature ShouldFail(module ShouldFail, newSTRef) where
         import Data.STRef.Lazy(newSTRef)
 unit q where
     dependency p[ShouldFail=base:Data.STRef]
index 18d4973..9fc243e 100644 (file)
@@ -1,8 +1,8 @@
 unit p where
-    signature A(newSTRef) where
+    signature A(module A, newSTRef) where
         import Data.STRef.Lazy(newSTRef)
 unit q where
-    signature A(newSTRef) where
+    signature A(module A, newSTRef) where
         import Data.STRef.Strict(newSTRef)
 unit r where
     dependency p[A=<B>]
index 322fe51..cb0b9af 100644 (file)
@@ -1,12 +1,12 @@
 unit p where
     signature A where
         data T
-    signature C(T) where
+    signature C(module C, T) where
         import A
 unit q where
     signature B where
         data T
-    signature C(T) where
+    signature C(module C, T) where
         import B
 unit r where
     dependency p[A=<H1>,C=<H3>]
index 8573d11..768365a 100644 (file)
@@ -7,5 +7,5 @@
 
 bkpfail29.bkp:8:9: error:
     Cycle in type synonym declarations:
-      bkpfail29.bkp:8:9-18: {A.S} from external module
-      bkpfail29.bkp:7:9-14: {A.T} from external module
+      bkpfail29.bkp:8:9-18: S from external module
+      bkpfail29.bkp:7:9-14: T from external module
diff --git a/testsuite/tests/backpack/should_fail/bkpfail30.bkp b/testsuite/tests/backpack/should_fail/bkpfail30.bkp
new file mode 100644 (file)
index 0000000..c7b0ca8
--- /dev/null
@@ -0,0 +1,9 @@
+unit p where
+    signature A(x) where
+        data T
+        x :: T
+unit q where
+    module A where
+        x = True
+unit r where
+    dependency p[A=q:A]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail30.stderr b/testsuite/tests/backpack/should_fail/bkpfail30.stderr
new file mode 100644 (file)
index 0000000..7d33256
--- /dev/null
@@ -0,0 +1,6 @@
+[1 of 3] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+
+<no location info>: error:
+    The identifier T does not exist in the local signature.
+    (Try adding it to the export list of the hsig file.)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail31.bkp b/testsuite/tests/backpack/should_fail/bkpfail31.bkp
new file mode 100644 (file)
index 0000000..8815e5b
--- /dev/null
@@ -0,0 +1,16 @@
+unit p where
+    signature A where
+        data T
+        x :: T
+unit q where
+    dependency signature p[A=<A>]
+    signature A (x) where
+    module M where
+        import A
+        y = x
+unit pimpl where
+    module A where
+        -- type T = Bool
+        x = True
+unit r where
+    dependency q[A=pimpl:A]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail31.stderr b/testsuite/tests/backpack/should_fail/bkpfail31.stderr
new file mode 100644 (file)
index 0000000..b5c9bc7
--- /dev/null
@@ -0,0 +1,8 @@
+[1 of 4] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+[2 of 4] Processing q
+  [1 of 2] Compiling A[sig]           ( q/A.hsig, nothing )
+
+<no location info>: error:
+    The identifier T does not exist in the local signature.
+    (Try adding it to the export list of the hsig file.)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail32.bkp b/testsuite/tests/backpack/should_fail/bkpfail32.bkp
new file mode 100644 (file)
index 0000000..9d4f684
--- /dev/null
@@ -0,0 +1,2 @@
+unit p where
+    signature A (T) where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail32.stderr b/testsuite/tests/backpack/should_fail/bkpfail32.stderr
new file mode 100644 (file)
index 0000000..a33ea5b
--- /dev/null
@@ -0,0 +1,5 @@
+[1 of 1] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+
+bkpfail32.bkp:2:18: error:
+    Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/backpack/should_fail/bkpfail33.bkp b/testsuite/tests/backpack/should_fail/bkpfail33.bkp
new file mode 100644 (file)
index 0000000..4c76d81
--- /dev/null
@@ -0,0 +1,5 @@
+unit p where
+    signature A where
+unit q where
+    dependency signature p[A=<A>]
+    signature A (T) where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail33.stderr b/testsuite/tests/backpack/should_fail/bkpfail33.stderr
new file mode 100644 (file)
index 0000000..fd268ad
--- /dev/null
@@ -0,0 +1,7 @@
+[1 of 2] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+[2 of 2] Processing q
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
+
+bkpfail33.bkp:5:18: error:
+    Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/backpack/should_fail/bkpfail34.bkp b/testsuite/tests/backpack/should_fail/bkpfail34.bkp
new file mode 100644 (file)
index 0000000..6ea0002
--- /dev/null
@@ -0,0 +1,7 @@
+unit p where
+    signature A where
+        data T
+        x :: T
+unit q where
+    dependency signature p[A=<A>]
+    signature A (x) where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail34.stderr b/testsuite/tests/backpack/should_fail/bkpfail34.stderr
new file mode 100644 (file)
index 0000000..225e491
--- /dev/null
@@ -0,0 +1,8 @@
+[1 of 2] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+[2 of 2] Processing q
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
+
+<no location info>: error:
+    The identifier T does not exist in the local signature.
+    (Try adding it to the export list of the hsig file.)
diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.bkp b/testsuite/tests/backpack/should_fail/bkpfail35.bkp
new file mode 100644 (file)
index 0000000..adfc14a
--- /dev/null
@@ -0,0 +1,13 @@
+unit p where
+    signature A where
+        x :: Bool
+        y :: Bool
+    module B where
+unit q where
+    dependency signature p[A=<A>]
+    signature A (x) where
+unit aimpl where
+    module A where
+        x = True
+unit r where
+    dependency q[A=aimpl:A]
diff --git a/testsuite/tests/backpack/should_fail/bkpfail35.stderr b/testsuite/tests/backpack/should_fail/bkpfail35.stderr
new file mode 100644 (file)
index 0000000..f90d0e2
--- /dev/null
@@ -0,0 +1,16 @@
+[1 of 4] Processing p
+  [1 of 2] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 2] Compiling B                ( p/B.hs, nothing )
+[2 of 4] Processing q
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )
+[3 of 4] Processing aimpl
+  Instantiating aimpl
+  [1 of 1] Compiling A                ( aimpl/A.hs, bkpfail35.out/aimpl/A.o )
+[4 of 4] Processing r
+  Instantiating r
+  [1 of 1] Including q[A=aimpl:A]
+    Instantiating q[A=aimpl:A]
+    [1 of 1] Compiling A[sig]           ( q/A.hsig, bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/A.o )
+
+bkpfail35.out/q/q-E72T6bb4XRkIeTPWK2mCKa/../A.hi:1:1: error:
+    ‘y’ is exported by the hsig file, but not exported the module ‘aimpl:A’
diff --git a/testsuite/tests/backpack/should_fail/bkpfail36.bkp b/testsuite/tests/backpack/should_fail/bkpfail36.bkp
new file mode 100644 (file)
index 0000000..15ec645
--- /dev/null
@@ -0,0 +1,10 @@
+unit p where
+    signature A where
+        data T
+        x :: Bool
+    signature B where
+        import A
+        y :: T
+unit q where
+    dependency signature p[A=<A>,B=<B>]
+    signature A (x) where
diff --git a/testsuite/tests/backpack/should_fail/bkpfail36.stderr b/testsuite/tests/backpack/should_fail/bkpfail36.stderr
new file mode 100644 (file)
index 0000000..cd65f67
--- /dev/null
@@ -0,0 +1,10 @@
+[1 of 2] Processing p
+  [1 of 2] Compiling A[sig]           ( p/A.hsig, nothing )
+  [2 of 2] Compiling B[sig]           ( p/B.hsig, nothing )
+[2 of 2] Processing q
+  [1 of 2] Compiling A[sig]           ( q/A.hsig, nothing )
+  [2 of 2] Compiling B[sig]           ( q/B.hsig, nothing )
+
+<no location info>: error:
+    The identifier T does not exist in the signature for <A>
+    (Try adding it to the export list in that hsig file.)