projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Massive patch for the first months work adding System FC to GHC #26
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcEnv.lhs
diff --git
a/compiler/typecheck/TcEnv.lhs
b/compiler/typecheck/TcEnv.lhs
index
497ba23
..
be1ce9b
100644
(file)
--- a/
compiler/typecheck/TcEnv.lhs
+++ b/
compiler/typecheck/TcEnv.lhs
@@
-11,7
+11,7
@@
module TcEnv(
tcExtendGlobalEnv,
tcExtendGlobalValEnv,
tcLookupLocatedGlobal, tcLookupGlobal,
tcExtendGlobalEnv,
tcExtendGlobalValEnv,
tcLookupLocatedGlobal, tcLookupGlobal,
- tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
+ tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
tcLookupLocatedClass,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
tcLookupLocatedClass,
@@
-64,14
+64,11
@@
import InstEnv ( Instance, DFunId, instanceDFunId, instanceHead )
import DataCon ( DataCon )
import TyCon ( TyCon )
import Class ( Class )
import DataCon ( DataCon )
import TyCon ( TyCon )
import Class ( Class )
-import Name ( Name, NamedThing(..), getSrcLoc, nameModule, isExternalName )
+import Name ( Name, NamedThing(..), getSrcLoc, nameModule )
import PrelNames ( thFAKE )
import NameEnv
import OccName ( mkDFunOcc, occNameString )
import PrelNames ( thFAKE )
import NameEnv
import OccName ( mkDFunOcc, occNameString )
-import HscTypes ( extendTypeEnvList, lookupType,
- TyThing(..), tyThingId, tyThingDataCon,
- ExternalPackageState(..) )
-
+import HscTypes ( extendTypeEnvList, lookupType, TyThing(..), ExternalPackageState(..) )
import SrcLoc ( SrcLoc, Located(..) )
import Outputable
\end{code}
import SrcLoc ( SrcLoc, Located(..) )
import Outputable
\end{code}
@@
-107,7
+104,8
@@
tcLookupGlobal name
-- Try global envt
{ (eps,hpt) <- getEpsAndHpt
-- Try global envt
{ (eps,hpt) <- getEpsAndHpt
- ; case lookupType hpt (eps_PTE eps) name of {
+ ; dflags <- getDOpts
+ ; case lookupType dflags hpt (eps_PTE eps) name of {
Just thing -> return thing ;
Nothing -> do
Just thing -> return thing ;
Nothing -> do
@@
-121,16
+119,19
@@
tcLookupGlobal name
tcImportDecl name -- Go find it in an interface
}}}}}
tcImportDecl name -- Go find it in an interface
}}}}}
-tcLookupGlobalId :: Name -> TcM Id
--- Never used for Haskell-source DataCons, hence no ADataCon case
-tcLookupGlobalId name
+tcLookupField :: Name -> TcM Id -- Returns the selector Id
+tcLookupField name
= tcLookupGlobal name `thenM` \ thing ->
= tcLookupGlobal name `thenM` \ thing ->
- return (tyThingId thing)
+ case thing of
+ AnId id -> return id
+ other -> wrongThingErr "field name" (AGlobal thing) name
tcLookupDataCon :: Name -> TcM DataCon
tcLookupDataCon :: Name -> TcM DataCon
-tcLookupDataCon con_name
- = tcLookupGlobal con_name `thenM` \ thing ->
- return (tyThingDataCon thing)
+tcLookupDataCon name
+ = tcLookupGlobal name `thenM` \ thing ->
+ case thing of
+ ADataCon con -> return con
+ other -> wrongThingErr "data constructor" (AGlobal thing) name
tcLookupClass :: Name -> TcM Class
tcLookupClass name
tcLookupClass :: Name -> TcM Class
tcLookupClass name
@@
-387,6
+388,8
@@
find_thing ignore_it tidy_env (ATyVar tv ty)
bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
in
returnM (tidy_env1, Just msg)
bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
in
returnM (tidy_env1, Just msg)
+
+find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
\end{code}
\begin{code}
\end{code}
\begin{code}