Implement unboxed tuples flags

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index bf7d676..f36b205 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -78,8 +78,8 @@ import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
 import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 
 #endif
 
 import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 

-                          unQualOK, ImpDeclSpec(..), Provenance(..),
-                          ImportSpec(..), lookupGlobalRdrEnv )
+                          mkRdrUnqual, ImpDeclSpec(..), Provenance(..),
+                          ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName )

 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 
 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 

@@ -90,7 +90,9 @@ import InstEnv                ( InstEnv, Instance )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )

+import VarEnv

 import VarSet
 import VarSet

+import Var

 import Id
 import Type            ( TyThing(..) )
 
 import Id
 import Type            ( TyThing(..) )
 

@@ -113,7 +115,6 @@ import SrcLoc               ( SrcSpan, Located )
 import UniqFM          ( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )
 import UniqFM          ( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply      ( UniqSupply )
 import FastString      ( FastString )

-

 import StringBuffer    ( StringBuffer )
 
 import System.Time     ( ClockTime )
 import StringBuffer    ( StringBuffer )
 
 import System.Time     ( ClockTime )

@@ -520,9 +521,12 @@ data ModGuts
        mg_fix_env   :: !FixityEnv,      -- Fixity env, for things declared in
                                         --   this module 
 
        mg_fix_env   :: !FixityEnv,      -- Fixity env, for things declared in
                                         --   this module 
 

+       mg_inst_env     :: InstEnv,      -- Class instance enviroment fro
+                                        -- *home-package* modules (including
+                                        -- this one); c.f. tcg_inst_env

        mg_fam_inst_env :: FamInstEnv,   -- Type-family instance enviroment
                                         -- for *home-package* modules (including
        mg_fam_inst_env :: FamInstEnv,   -- Type-family instance enviroment
                                         -- for *home-package* modules (including

-                                        -- this one).  c.f. tcg_fam_inst_env
+                                        -- this one); c.f. tcg_fam_inst_env

 
        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 
 
        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 

@@ -699,19 +703,28 @@ extendInteractiveContext ictxt ids tyvars
 mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
 mkPrintUnqualified env = (qual_name, qual_mod)
   where
 mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
 mkPrintUnqualified env = (qual_name, qual_mod)
   where

-  qual_name mod occ
-        | null gres = Just (moduleName mod)
+  qual_name mod occ    -- The (mod,occ) pair is the original name of the thing
+        | [gre] <- unqual_gres, right_name gre = Nothing
+               -- If there's a unique entity that's in scope unqualified with 'occ'
+               -- AND that entity is the right one, then we can use the unqualified name
+
+        | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre))
+
+        | null qual_gres = Just (moduleName mod)

                 -- it isn't in scope at all, this probably shouldn't happen,
                 -- but we'll qualify it by the original module anyway.
                 -- it isn't in scope at all, this probably shouldn't happen,
                 -- but we'll qualify it by the original module anyway.

-        | any unQualOK gres = Nothing
-        | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is
-          = Just (is_as (is_decl idecl))
-        | otherwise = panic "mkPrintUnqualified" 
+
+       | otherwise = panic "mkPrintUnqualified"

       where
       where

-        gres  = [ gre | gre <- lookupGlobalRdrEnv env occ,
-                       nameModule (gre_name gre) == mod ]
+       right_name gre = nameModule (gre_name gre) == mod
+
+        unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
+        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)

 
 

-  qual_mod mod = Nothing       -- For now...
+       get_qual_mod LocalDef      = moduleName mod
+       get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
+
+  qual_mod mod = Nothing       -- For now, we never qualify module names with their packages

 \end{code}
 
 
 \end{code}
 
 

@@ -1244,26 +1257,51 @@ The following information is generated and consumed by the vectorisation
 subsystem.  It communicates the vectorisation status of declarations from one
 module to another.
 
 subsystem.  It communicates the vectorisation status of declarations from one
 module to another.
 

+Why do we need both f and f_CC in the ModGuts/ModDetails/EPS version VectInfo
+below?  We need to know `f' when converting to IfaceVectInfo.  However, during
+closure conversion, we need to know `f_CC', whose `Var' we cannot lookup based
+on just the OccName easily in a Core pass.
+

 \begin{code}
 \begin{code}

--- ModGuts version
-data VectInfo      = VectInfo {
-                       vectInfoCCVar :: NameSet
-                     }
+-- ModGuts/ModDetails/EPS version
+data VectInfo      
+  = VectInfo {
+      vectInfoCCVar     :: VarEnv  (Var    , Var  ),   -- (f, f_CC) keyed on f
+      vectInfoCCTyCon   :: NameEnv (TyCon  , TyCon),   -- (T, T_CC) keyed on T
+      vectInfoCCDataCon :: NameEnv (DataCon, DataCon), -- (C, C_CC) keyed on C
+      vectInfoCCIso     :: NameEnv (TyCon  , Var)      -- (T, isoT) keyed on T
+    }
+    -- all of this is always tidy, even in ModGuts

 
 -- ModIface version
 
 -- ModIface version

-data IfaceVectInfo = IfaceVectInfo {
-                       ifaceVectInfoCCVar :: [Name]
-                     }
+data IfaceVectInfo 
+  = IfaceVectInfo {
+      ifaceVectInfoCCVar        :: [Name],
+        -- all variables in here have a closure-converted variant;
+        -- the name of the CC'ed variant is determined by `mkCloOcc'
+      ifaceVectInfoCCTyCon      :: [Name],
+        -- all tycons in here have a closure-converted variant;
+        -- the name of the CC'ed variant and those of its data constructors are
+        -- determined by `mkCloTyConOcc' and `mkCloDataConOcc'; the names of
+        -- the isomorphisms is determined by `mkCloIsoOcc'
+      ifaceVectInfoCCTyConReuse :: [Name]              
+        -- the closure-converted form of all the tycons in here coincids with
+        -- the unconverted from; the names of the isomorphisms is determined
+        -- by `mkCloIsoOcc'
+    }

 
 noVectInfo :: VectInfo
 
 noVectInfo :: VectInfo

-noVectInfo = VectInfo emptyNameSet
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv

 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 
 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 

-  VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2)
+  VectInfo (vectInfoCCVar     vi1 `plusVarEnv`  vectInfoCCVar     vi2)
+           (vectInfoCCTyCon   vi1 `plusNameEnv` vectInfoCCTyCon   vi2)
+           (vectInfoCCDataCon vi1 `plusNameEnv` vectInfoCCDataCon vi2)
+           (vectInfoCCIso     vi1 `plusNameEnv` vectInfoCCIso     vi2)

 
 noIfaceVectInfo :: IfaceVectInfo
 
 noIfaceVectInfo :: IfaceVectInfo

-noIfaceVectInfo = IfaceVectInfo []
+noIfaceVectInfo = IfaceVectInfo [] [] []

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************