Fix scoped type variables for expression type signatures

[ghc-hetmet.git] / compiler / iface / LoadIface.lhs

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 21332fa..d4cd503 100644 (file)
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -20,8 +20,9 @@ import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRule, tcIfaceInst )
 
 import DynFlags                ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
 import IfaceSyn                ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
-                         IfaceConDecls(..), IfaceIdInfo(..) )
-import IfaceEnv                ( newGlobalBinder )
+                         IfaceConDecls(..), IfaceFamInst(..), 
+                         IfaceIdInfo(..) )
+import IfaceEnv                ( newGlobalBinder, lookupIfaceTc )
 import HscTypes                ( ModIface(..), TyThing, IfaceExport, Usage(..), 
                          Deprecs(..), Dependencies(..),
                          emptyModIface, EpsStats(..), GenAvailInfo(..),
@@ -36,7 +37,6 @@ import BasicTypes     ( Version, initialVersion,
                          Fixity(..), FixityDirection(..), isMarkedStrict )
 import TcRnMonad
 import Type             ( TyThing(..) )
-import Class           ( classATs )
 
 import PrelNames       ( gHC_PRIM )
 import PrelInfo                ( ghcPrimExports )
@@ -51,7 +51,7 @@ import Module
 import OccName         ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc,
                          mkClassDataConOcc, mkSuperDictSelOcc,
                          mkDataConWrapperOcc, mkDataConWorkerOcc,
-                         mkNewTyCoOcc, mkInstTyTcOcc, mkInstTyCoOcc ) 
+                         mkNewTyCoOcc, mkInstTyCoOcc ) 
 import SrcLoc          ( importedSrcLoc )
 import Maybes          ( MaybeErr(..) )
 import ErrUtils         ( Message )
@@ -195,7 +195,6 @@ loadInterface doc_str mod from
 
        -- READ THE MODULE IN
        ; read_result <- findAndReadIface doc_str mod hi_boot_file
-       ; dflags <- getDOpts
        ; case read_result of {
            Failed err -> do
                { let fake_iface = emptyModIface mod
@@ -208,7 +207,7 @@ loadInterface doc_str mod from
                ; returnM (Failed err) } ;
 
        -- Found and parsed!
-           Succeeded (iface, file_path)                        -- Sanity check:
+           Succeeded (iface, file_path)        -- Sanity check:
                | ImportBySystem <- from,       --   system-importing...
                  modulePackageId (mi_module iface) == thisPackage dflags,
                                                --   a home-package module...
@@ -290,16 +289,19 @@ loadDecls ignore_prags ver_decls
        ; return (concat thingss)
        }
 
-loadDecl :: Bool                       -- Don't load pragmas into the decl pool
+loadDecl :: Bool                   -- Don't load pragmas into the decl pool
         -> Module
          -> (Version, IfaceDecl)
-         -> IfL [(Name,TyThing)]       -- The list can be poked eagerly, but the
-                                       -- TyThings are forkM'd thunks
+         -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
+                                   -- TyThings are forkM'd thunks
 loadDecl ignore_prags mod (_version, decl)
   = do         {       -- Populate the name cache with final versions of all 
                -- the names associated with the decl
          main_name      <- mk_new_bndr mod Nothing (ifName decl)
-       ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) 
+       ; parent_name    <- case ifFamily decl of  -- make family the parent
+                             Just famTyCon -> lookupIfaceTc famTyCon
+                             _             -> return main_name
+       ; implicit_names <- mapM (mk_new_bndr mod (Just parent_name)) 
                                 (ifaceDeclSubBndrs decl)
 
        -- Typecheck the thing, lazily
@@ -335,6 +337,11 @@ loadDecl ignore_prags mod (_version, decl)
                          (importedSrcLoc (showSDoc (ppr (moduleName mod))))
                        -- ToDo: qualify with the package name if necessary
 
+    ifFamily (IfaceData {
+               ifFamInst = Just (IfaceFamInst {ifFamInstTyCon = famTyCon})})
+               = Just famTyCon
+    ifFamily _ = Nothing
+
     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
 
 discardDeclPrags :: IfaceDecl -> IfaceDecl
@@ -409,9 +416,8 @@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 ifaceDeclSubBndrs _other = []
 
 -- coercion for data/newtype family instances
-famInstCo Nothing              baseOcc = []
-famInstCo (Just (_, _, index)) baseOcc = [mkInstTyTcOcc index baseOcc,
-                                         mkInstTyCoOcc index baseOcc]
+famInstCo Nothing  baseOcc = []
+famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 \end{code}