Document HscTypes, refactor it somewhat, remove unused type and add MonadThings

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

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 4bc6a48..b36aad5 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -68,7 +68,7 @@ This module takes
 An IfaceDecl is populated with RdrNames, and these are not renamed to
 Names before typechecking, because there should be no scope errors etc.
 
 An IfaceDecl is populated with RdrNames, and these are not renamed to
 Names before typechecking, because there should be no scope errors etc.
 

-       -- For (b) consider: f = $(...h....)
+       -- For (b) consider: f = \$(...h....)

        -- where h is imported, and calls f via an hi-boot file.  
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole 
        -- where h is imported, and calls f via an hi-boot file.  
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole 

@@ -354,7 +354,7 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdI
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
        ; info <- tcIdInfo ignore_prags name ty info
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
        ; info <- tcIdInfo ignore_prags name ty info

-       ; return (AnId (mkVanillaGlobal name ty info)) }
+       ; return (AnId (mkVanillaGlobalWithInfo name ty info)) }

 
 tcIfaceDecl _
            (IfaceData {ifName = occ_name, 
 
 tcIfaceDecl _
            (IfaceData {ifName = occ_name, 

@@ -525,7 +525,7 @@ tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 --     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 --     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $

--- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
+-- the above line doesn't work, but this below does => CPP in Haskell = evil!

     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
                     tcIfaceTyCon tycon
          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
                     tcIfaceTyCon tycon
          let mb_tcs' = map (fmap ifaceTyConName) mb_tcs

@@ -880,6 +880,7 @@ tcIdInfo ignore_prags name ty info
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 

+    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo

     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)
     tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
     tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)

@@ -980,14 +981,14 @@ tcIfaceGlobal name
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing

-                       Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
+                       Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  

                                                (ppr name $$ ppr type_env) }
 
          ; _ -> do
 
                                                (ppr name $$ ppr type_env) }
 
          ; _ -> do
 

-       { (eps,hpt) <- getEpsAndHpt
-       ; dflags <- getDOpts
-       ; case lookupType dflags hpt (eps_PTE eps) name of {
+       { hsc_env <- getTopEnv
+        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+       ; case mb_thing of {

            Just thing -> return thing ;
            Nothing    -> do
 
            Just thing -> return thing ;
            Nothing    -> do
 

@@ -1125,13 +1126,13 @@ newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside

-  = do { name <- newIfaceName (mkTyVarOcc occ)
+  = do { name <- newIfaceName (mkTyVarOccFS occ)

        ; tyvar <- mk_iface_tyvar name kind
        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 
 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 bindIfaceTyVars bndrs thing_inside
        ; tyvar <- mk_iface_tyvar name kind
        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 
 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 bindIfaceTyVars bndrs thing_inside

-  = do { names <- newIfaceNames (map mkTyVarOcc occs)
+  = do { names <- newIfaceNames (map mkTyVarOccFS occs)

        ; tyvars <- zipWithM mk_iface_tyvar names kinds
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
        ; tyvars <- zipWithM mk_iface_tyvar names kinds
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where