projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2000-10-25 13:51:50 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
main
/
HscTypes.lhs
diff --git
a/ghc/compiler/main/HscTypes.lhs
b/ghc/compiler/main/HscTypes.lhs
index
5c8c685
..
9150218
100644
(file)
--- a/
ghc/compiler/main/HscTypes.lhs
+++ b/
ghc/compiler/main/HscTypes.lhs
@@
-16,7
+16,7
@@
module HscTypes (
VersionInfo(..), initialVersionInfo,
VersionInfo(..), initialVersionInfo,
- TyThing(..), groupTyThings,
+ TyThing(..), groupTyThings, isTyClThing,
TypeEnv, extendTypeEnv, lookupTypeEnv,
TypeEnv, extendTypeEnv, lookupTypeEnv,
@@
-30,6
+30,7
@@
module HscTypes (
Deprecations(..), lookupDeprec,
InstEnv, ClsInstEnv, DFunId,
Deprecations(..), lookupDeprec,
InstEnv, ClsInstEnv, DFunId,
+ PackageInstEnv, PackageRuleBase,
GlobalRdrEnv, RdrAvailInfo,
GlobalRdrEnv, RdrAvailInfo,
@@
-51,8
+52,8
@@
import OccName ( OccName )
import Module ( Module, ModuleName, ModuleEnv,
lookupModuleEnv, lookupModuleEnvByName
)
import Module ( Module, ModuleName, ModuleEnv,
lookupModuleEnv, lookupModuleEnvByName
)
+import Rules ( RuleBase )
import VarSet ( TyVarSet )
import VarSet ( TyVarSet )
-import VarEnv ( emptyVarEnv )
import Id ( Id )
import Class ( Class )
import TyCon ( TyCon )
import Id ( Id )
import Class ( Class )
import TyCon ( TyCon )
@@
-60,10
+61,10
@@
import TyCon ( TyCon )
import BasicTypes ( Version, initialVersion, Fixity )
import HsSyn ( DeprecTxt )
import BasicTypes ( Version, initialVersion, Fixity )
import HsSyn ( DeprecTxt )
-import RdrHsSyn ( RdrNameHsDecl )
-import RnHsSyn ( RenamedTyClDecl, RenamedIfaceSig, RenamedRuleDecl, RenamedInstDecl )
+import RdrHsSyn ( RdrNameHsDecl, RdrNameTyClDecl )
+import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
-import CoreSyn ( CoreRule )
+import CoreSyn ( CoreRule, IdCoreRule )
import Type ( Type )
import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
import Type ( Type )
import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
@@
-138,7
+139,6
@@
data ModIface
}
data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
}
data IfaceDecls = IfaceDecls { dcl_tycl :: [RenamedTyClDecl], -- Sorted
- dcl_sigs :: [RenamedIfaceSig], -- Sorted
dcl_rules :: [RenamedRuleDecl], -- Sorted
dcl_insts :: [RenamedInstDecl] } -- Unsorted
dcl_rules :: [RenamedRuleDecl], -- Sorted
dcl_insts :: [RenamedInstDecl] } -- Unsorted
@@
-149,7
+149,7
@@
data ModDetails
-- The next three fields are created by the typechecker
md_types :: TypeEnv,
md_insts :: [DFunId], -- Dfun-ids for the instances in this module
-- The next three fields are created by the typechecker
md_types :: TypeEnv,
md_insts :: [DFunId], -- Dfun-ids for the instances in this module
- md_rules :: RuleEnv -- Domain may include Ids from other modules
+ md_rules :: [IdCoreRule] -- Domain may include Ids from other modules
}
\end{code}
}
\end{code}
@@
-158,7
+158,7
@@
emptyModDetails :: ModDetails
emptyModDetails
= ModDetails { md_types = emptyTypeEnv,
md_insts = [],
emptyModDetails
= ModDetails { md_types = emptyTypeEnv,
md_insts = [],
- md_rules = emptyRuleEnv
+ md_rules = []
}
emptyModIface :: Module -> ModIface
}
emptyModIface :: Module -> ModIface
@@
-215,6
+215,11
@@
data TyThing = AnId Id
| ATyCon TyCon
| AClass Class
| ATyCon TyCon
| AClass Class
+isTyClThing :: TyThing -> Bool
+isTyClThing (ATyCon _) = True
+isTyClThing (AClass _) = True
+isTyClThing (AnId _) = False
+
instance NamedThing TyThing where
getName (AnId id) = getName id
getName (ATyCon tc) = getName tc
instance NamedThing TyThing where
getName (AnId id) = getName id
getName (ATyCon tc) = getName tc
@@
-300,12
+305,9
@@
lookupDeprec iface name
DeprecSome env -> lookupNameEnv env name
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
DeprecSome env -> lookupNameEnv env name
type InstEnv = UniqFM ClsInstEnv -- Maps Class to instances for that class
+
type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
type DFunId = Id
type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
type DFunId = Id
-
-type RuleEnv = NameEnv [CoreRule]
-
-emptyRuleEnv = emptyVarEnv
\end{code}
\end{code}
@@
-382,14
+384,18
@@
data PersistentCompilerState
= PCS {
pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules
-- the mi_decls component is empty
= PCS {
pcs_PIT :: PackageIfaceTable, -- Domain = non-home-package modules
-- the mi_decls component is empty
+
pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules
-- except that the InstEnv components is empty
pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules
-- except that the InstEnv components is empty
- pcs_insts :: InstEnv, -- The total InstEnv accumulated from all
+
+ pcs_insts :: PackageInstEnv, -- The total InstEnv accumulated from all
-- the non-home-package modules
-- the non-home-package modules
- pcs_rules :: RuleEnv, -- Ditto RuleEnv
+
+ pcs_rules :: PackageRuleBase, -- Ditto RuleEnv
pcs_PRS :: PersistentRenamerState
}
pcs_PRS :: PersistentRenamerState
}
+
\end{code}
The @PersistentRenamerState@ persists across successive calls to the
\end{code}
The @PersistentRenamerState@ persists across successive calls to the
@@
-412,6
+418,9
@@
It contains:
interface files but not yet sucked in, renamed, and typechecked
\begin{code}
interface files but not yet sucked in, renamed, and typechecked
\begin{code}
+type PackageRuleBase = RuleBase
+type PackageInstEnv = InstEnv
+
data PersistentRenamerState
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
data PersistentRenamerState
= PRS { prsOrig :: OrigNameEnv,
prsDecls :: DeclsMap,
@@
-451,7
+460,7
@@
including the constructors of a type decl etc. The Bool is True just
for the 'main' Name.
\begin{code}
for the 'main' Name.
\begin{code}
-type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameHsDecl))
+type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl))
type IfaceInsts = Bag GatedDecl
type IfaceRules = Bag GatedDecl
type IfaceInsts = Bag GatedDecl
type IfaceRules = Bag GatedDecl