move AvailInfo and related things into its own module
authorSimon Marlow <marlowsd@gmail.com>
Sat, 17 Sep 2011 18:05:43 +0000 (19:05 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 21 Sep 2011 08:53:10 +0000 (09:53 +0100)
19 files changed:
compiler/basicTypes/Avail.hs [new file with mode: 0644]
compiler/deSugar/Desugar.lhs
compiler/ghc.cabal.in
compiler/iface/BinIface.hs
compiler/iface/IfaceEnv.lhs
compiler/iface/LoadIface.lhs
compiler/iface/MkIface.lhs
compiler/main/GHC.hs
compiler/main/HscTypes.lhs
compiler/main/InteractiveEval.hs
compiler/main/TidyPgm.lhs
compiler/prelude/PrelInfo.lhs
compiler/rename/RnBinds.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnNames.lhs
compiler/rename/RnSource.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnTypes.lhs
compiler/typecheck/TcTyDecls.lhs

diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs
new file mode 100644 (file)
index 0000000..8bf622e
--- /dev/null
@@ -0,0 +1,107 @@
+--
+-- (c) The University of Glasgow
+--
+
+module Avail (
+    Avails,
+    AvailInfo(..),
+    availsToNameSet,
+    availsToNameEnv,
+    availName, availNames,
+    stableAvailCmp,
+    gresFromAvails,
+    gresFromAvail
+  ) where
+
+import Name
+import NameEnv
+import NameSet
+import RdrName
+
+import Outputable
+import Util
+
+-- -----------------------------------------------------------------------------
+-- The AvailInfo type
+
+-- | Records what things are "available", i.e. in scope
+data AvailInfo = Avail Name     -- ^ An ordinary identifier in scope
+              | AvailTC Name
+                        [Name]  -- ^ A type or class in scope. Parameters:
+                                --
+                                --  1) The name of the type or class
+                                --  2) The available pieces of type or class.
+                                -- 
+                                -- The AvailTC Invariant:
+                                 --   * If the type or class is itself
+                                --     to be in scope, it must be
+                                --     *first* in this list.  Thus,
+                                 --     typically: @AvailTC Eq [Eq, ==, \/=]@
+               deriving( Eq )
+                        -- Equality used when deciding if the
+                        -- interface has changed
+
+-- | A collection of 'AvailInfo' - several things that are \"available\"
+type Avails      = [AvailInfo]
+
+-- | Compare lexicographically
+stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
+stableAvailCmp (Avail n1)     (Avail n2)     = n1 `stableNameCmp` n2
+stableAvailCmp (Avail {})     (AvailTC {})   = LT
+stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
+                                               (cmpList stableNameCmp ns ms)
+stableAvailCmp (AvailTC {})   (Avail {})     = GT
+
+
+-- -----------------------------------------------------------------------------
+-- Operations on AvailInfo
+
+availsToNameSet :: [AvailInfo] -> NameSet
+availsToNameSet avails = foldr add emptyNameSet avails
+      where add avail set = addListToNameSet set (availNames avail)
+
+availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
+availsToNameEnv avails = foldr add emptyNameEnv avails
+     where add avail env = extendNameEnvList env
+                                (zip (availNames avail) (repeat avail))
+
+-- | Just the main name made available, i.e. not the available pieces
+-- of type or class brought into scope by the 'GenAvailInfo'
+availName :: AvailInfo -> Name
+availName (Avail n)     = n
+availName (AvailTC n _) = n
+
+-- | All names made available by the availability information
+availNames :: AvailInfo -> [Name]
+availNames (Avail n)      = [n]
+availNames (AvailTC _ ns) = ns
+
+-- | make a 'GlobalRdrEnv' where all the elements point to the same
+-- Provenance (useful for "hiding" imports, or imports with
+-- no details).
+gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
+gresFromAvails prov avails
+  = concatMap (gresFromAvail (const prov)) avails
+
+gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
+gresFromAvail prov_fn avail
+  = [ GRE {gre_name = n,
+           gre_par = parent n avail,
+           gre_prov = prov_fn n}
+    | n <- availNames avail ]
+  where
+    parent _ (Avail _)                 = NoParent
+    parent n (AvailTC m _) | n == m    = NoParent
+                           | otherwise = ParentIs m
+
+-- -----------------------------------------------------------------------------
+-- Printing
+
+instance Outputable AvailInfo where
+   ppr = pprAvail
+
+pprAvail :: AvailInfo -> SDoc
+pprAvail (Avail n)      = ppr n
+pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
+
+
index 9001ec7..d85ff0a 100644 (file)
@@ -16,6 +16,7 @@ import TcRnTypes
 import MkIface
 import Id
 import Name
+import Avail
 import CoreSyn
 import CoreSubst
 import PprCore
index eea42bf..01bbeb0 100644 (file)
@@ -146,6 +146,7 @@ Library
         vectorise
 
     Exposed-Modules:
+        Avail
         BasicTypes
         DataCon
         Demand
index 55ab378..083e85c 100644 (file)
@@ -21,6 +21,7 @@ import Annotations
 import IfaceSyn
 import Module
 import Name
+import Avail
 import VarEnv
 import DynFlags
 import UniqFM
index 798164c..98c21fd 100644 (file)
@@ -27,6 +27,7 @@ import Type
 import DataCon
 import Var
 import Name
+import Avail
 import PrelNames
 import Module
 import UniqFM
index b9e72a6..bbee042 100644 (file)
@@ -43,6 +43,7 @@ import InstEnv
 import FamInstEnv
 import Name
 import NameEnv
+import Avail
 import Module
 import Maybes
 import ErrUtils
index c56e985..1688d23 100644 (file)
@@ -75,6 +75,7 @@ import VarEnv
 import VarSet
 import Var
 import Name
+import Avail
 import RdrName
 import NameEnv
 import NameSet
index d803ea8..928f21e 100644 (file)
@@ -265,6 +265,7 @@ import TyCon
 import Class
 import DataCon
 import Name             hiding ( varName )
+import Avail
 import InstEnv
 import FamInstEnv
 import SrcLoc
@@ -276,8 +277,7 @@ import HscTypes
 import DynFlags
 import StaticFlagParser
 import qualified StaticFlags
-import SysTools     ( initSysTools, cleanTempFiles, 
-                      cleanTempDirs )
+import SysTools
 import Annotations
 import Module
 import UniqFM
index 0b90fd9..79c5c13 100644 (file)
@@ -74,9 +74,7 @@ module HscTypes (
        WhetherHasOrphans, IsBootInterface, Usage(..), 
        Dependencies(..), noDependencies,
        NameCache(..), OrigNameCache, OrigIParamCache,
-       Avails, availsToNameSet, availsToNameEnv, availName, availNames,
-        AvailInfo(..), gresFromAvails, gresFromAvail,
-        IfaceExport, stableAvailCmp,
+        IfaceExport,
 
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
@@ -116,6 +114,7 @@ import {-# SOURCE #-}  InteractiveEval ( Resume )
 import HsSyn
 import RdrName
 import Name
+import Avail
 import NameEnv
 import NameSet  
 import Module
@@ -695,6 +694,9 @@ data ModIface
                 -- See Note [RnNames . Trust Own Package]
      }
 
+-- | The original names declared of a certain module that are exported
+type IfaceExport = AvailInfo
+
 -- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
 -- for home modules only. Information relating to packages will be loaded into
 -- global environments in 'ExternalPackageState'.
@@ -1473,82 +1475,6 @@ plusWarns _ (WarnAll t) = WarnAll t
 plusWarns (WarnAll t) _ = WarnAll t
 plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
 \end{code}
-\begin{code}
--- | A collection of 'AvailInfo' - several things that are \"available\"
-type Avails      = [AvailInfo]
-
--- | Records what things are "available", i.e. in scope
-data AvailInfo = Avail Name     -- ^ An ordinary identifier in scope
-              | AvailTC Name
-                        [Name]  -- ^ A type or class in scope. Parameters:
-                                --
-                                --  1) The name of the type or class
-                                --  2) The available pieces of type or class.
-                                -- 
-                                -- The AvailTC Invariant:
-                                --   * If the type or class is itself
-                                --     to be in scope, it must be *first* in this list.
-                                --     Thus, typically: @AvailTC Eq [Eq, ==, \/=]@
-               deriving( Eq )
-                       -- Equality used when deciding if the interface has changed
-
--- | The original names declared of a certain module that are exported
-type IfaceExport = AvailInfo
-
-availsToNameSet :: [AvailInfo] -> NameSet
-availsToNameSet avails = foldr add emptyNameSet avails
-      where add avail set = addListToNameSet set (availNames avail)
-
-availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
-availsToNameEnv avails = foldr add emptyNameEnv avails
-     where add avail env = extendNameEnvList env
-                                (zip (availNames avail) (repeat avail))
-
--- | Just the main name made available, i.e. not the available pieces
--- of type or class brought into scope by the 'GenAvailInfo'
-availName :: AvailInfo -> Name
-availName (Avail n)     = n
-availName (AvailTC n _) = n
-
--- | All names made available by the availability information
-availNames :: AvailInfo -> [Name]
-availNames (Avail n)      = [n]
-availNames (AvailTC _ ns) = ns
-
--- | make a 'GlobalRdrEnv' where all the elements point to the same
--- import declaration (useful for "hiding" imports, or imports with
--- no details).
-gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
-gresFromAvails prov avails
-  = concatMap (gresFromAvail (const prov)) avails
-
-gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
-gresFromAvail prov_fn avail
-  = [ GRE {gre_name = n,
-           gre_par = parent n avail,
-           gre_prov = prov_fn n}
-    | n <- availNames avail ]
-  where
-    parent _ (Avail _)                 = NoParent
-    parent n (AvailTC m _) | n == m    = NoParent
-                           | otherwise = ParentIs m
-
-
-instance Outputable AvailInfo where
-   ppr = pprAvail
-
-pprAvail :: AvailInfo -> SDoc
-pprAvail (Avail n)      = ppr n
-pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
-
-stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
--- Compare lexicographically
-stableAvailCmp (Avail n1)     (Avail n2)     = n1 `stableNameCmp` n2
-stableAvailCmp (Avail {})     (AvailTC {})   = LT
-stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
-                                               (cmpList stableNameCmp ns ms)
-stableAvailCmp (AvailTC {})   (Avail {})     = GT
-\end{code}
 
 \begin{code}
 -- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
index 3e763d5..47beb27 100644 (file)
@@ -49,6 +49,7 @@ import Var
 import Id
 import Name             hiding ( varName )
 import NameSet
+import Avail
 import RdrName
 import PrelNames (pRELUDE)
 import VarSet
index 050931c..2d90c2c 100644 (file)
@@ -31,8 +31,9 @@ import Demand
 import BasicTypes
 import Name hiding (varName)
 import NameSet
-import IfaceEnv
 import NameEnv
+import Avail
+import IfaceEnv
 import TcType
 import DataCon
 import TyCon
index f99f9ca..5c02313 100644 (file)
@@ -22,21 +22,20 @@ module PrelInfo (
 
 #include "HsVersions.h"
 
-import PrelNames        ( basicKnownKeyNames,
-                          hasKey, charDataConKey, intDataConKey,
-                          numericClassKeys, standardClassKeys )
+import PrelNames
 import PrelRules
-import PrimOp          ( PrimOp, allThePrimOps, primOpTag, maxPrimOpTag )
-import DataCon         ( DataCon )
-import Id              ( Id, idName )
-import MkId            -- All of it, for re-export
-import TysPrim         ( primTyCons )
-import TysWiredIn      ( wiredInTyCons )
-import HscTypes        ( TyThing(..), implicitTyThings, AvailInfo(..), IfaceExport )
-import Class           ( Class, classKey )
-import Type            ( funTyCon )
-import TyCon           ( tyConName )
-import Util            ( isIn )
+import Avail
+import PrimOp
+import DataCon
+import Id
+import MkId
+import TysPrim
+import TysWiredIn
+import HscTypes
+import Class
+import Type
+import TyCon
+import Util
 
 import Data.Array
 \end{code}
index 5fd0f1c..ad46cb0 100644 (file)
@@ -29,16 +29,13 @@ import HsSyn
 import RnHsSyn
 import TcRnMonad
 import RnTypes        ( rnIPName, rnHsSigType, rnLHsType, checkPrecMatch )
-import RnPat          (rnPats, rnBindPat,
-                       NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker
-                      )
-                      
+import RnPat
 import RnEnv
 import DynFlags
 import Name
 import NameEnv
 import NameSet
-import RdrName         ( RdrName, rdrNameOcc )
+import RdrName          ( RdrName, rdrNameOcc )
 import SrcLoc
 import ListSetOps      ( findDupsEq )
 import BasicTypes      ( RecFlag(..) )
index cfdeab2..9771ab1 100644 (file)
@@ -36,17 +36,18 @@ module RnEnv (
 #include "HsVersions.h"
 
 import LoadIface       ( loadInterfaceForName, loadSrcInterface )
-import IfaceEnv                ( lookupOrig, newGlobalBinder, updNameCache, extendNameCache )
+import IfaceEnv
 import HsSyn
 import RdrHsSyn                ( extractHsTyRdrTyVars )
 import RdrName
-import HscTypes                ( NameCache(..), availNames, ModIface(..), FixItem(..), lookupFixity)
+import HscTypes
 import TcEnv           ( tcLookupDataCon, tcLookupField, isBrackStage )
 import TcRnMonad
 import Id              ( isRecordSelector )
 import Name
 import NameSet
 import NameEnv
+import Avail
 import Module           ( ModuleName, moduleName )
 import UniqFM
 import DataCon         ( dataConFieldLabels )
index 574550f..ce14ad2 100644 (file)
@@ -25,6 +25,7 @@ import Module
 import Name
 import NameEnv
 import NameSet
+import Avail
 import HscTypes
 import RdrName
 import Outputable
index 0a3d3ff..1d7e956 100644 (file)
@@ -20,11 +20,9 @@ import RdrName
 import RdrHsSyn                ( extractHsRhoRdrTyVars )
 import RnHsSyn
 import RnTypes
-import RnBinds         ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, 
-                          renameSigs, mkSigTvFn, makeMiniFixityEnv )
+import RnBinds
 import RnEnv
-import RnNames         ( getLocalNonValBinders, extendGlobalRdrEnvRn, lookupTcdName )
-import HscTypes        ( AvailInfo(..) )
+import RnNames
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcRnMonad
 import Kind             ( liftedTypeKind )
@@ -33,9 +31,10 @@ import ForeignCall   ( CCallTarget(..) )
 import Module
 import HscTypes                ( Warnings(..), plusWarns )
 import Class           ( FunDep )
-import Name            ( Name, nameOccName )
+import Name
 import NameSet
 import NameEnv
+import Avail
 import Outputable
 import Bag
 import FastString
index 21b71b2..ed05220 100644 (file)
@@ -66,6 +66,7 @@ import UniqFM
 import Name
 import NameEnv
 import NameSet
+import Avail
 import TyCon
 import SrcLoc
 import HscTypes
index 58c3aa6..937cbac 100644 (file)
@@ -76,6 +76,7 @@ import RdrName
 import Name
 import NameEnv
 import NameSet
+import Avail
 import Var
 import VarEnv
 import Module
index 02ac0b8..4314fb5 100644 (file)
@@ -26,6 +26,7 @@ import DataCon
 import Name
 import NameEnv
 import NameSet
+import Avail
 import Digraph
 import BasicTypes
 import SrcLoc