mkHsTyApp, mkHsDictApp, mkHsConApp,
mkHsTyLam, mkHsDictLam, mkHsLet,
- idsToMonoBinds,
-- re-exported from TcEnv
TcId, tcInstId,
import HsSyn -- oodles of it
-- others:
-import Id ( idName, idType, idUnfolding, setIdType, omitIfaceSigForId, isIP, Id )
+import Id ( idName, idType, isLocalId, setIdType, isIP, Id )
import DataCon ( dataConWrapId )
-import TcEnv ( tcLookupGlobal_maybe, tcExtendGlobalValEnv, tcGetEnv,
+import TcEnv ( tcLookupGlobal_maybe, tcExtendGlobalValEnv,
TcEnv, TcId, tcInstId
)
import TcMonad
import TcType ( zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType, zonkTcSigTyVars
)
-import Name ( isLocallyDefined )
import CoreSyn ( Expr )
-import CoreUnfold( unfoldingTemplate )
import BasicTypes ( RecFlag(..) )
import Bag
import Outputable
+import HscTypes ( TyThing(..) )
\end{code}
mkHsLet mbinds expr = HsLet (MonoBind mbinds [] Recursive) expr
mkHsConApp data_con tys args = foldl HsApp (HsVar (dataConWrapId data_con) `mkHsTyApp` tys) args
-
-idsToMonoBinds :: [Id] -> TcMonoBinds
-idsToMonoBinds ids
- = andMonoBindList [ CoreMonoBind id (unfoldingTemplate (idUnfolding id))
- | id <- ids
- ]
\end{code}
%************************************************************************
zonkIdOcc :: TcId -> NF_TcM Id
zonkIdOcc id
- | not (isLocallyDefined id) || omitIfaceSigForId id || isIP id
- -- The omitIfaceSigForId thing may look wierd but it's quite
- -- sensible really. We're avoiding looking up superclass selectors
+ | not (isLocalId id) || isIP id
+ -- We're avoiding looking up superclass selectors
-- and constructors; zonking them is a no-op anyway, and the
-- superclass selectors aren't in the environment anyway.
= returnNF_Tc id
let
new_id = case maybe_id' of
Just (AnId id') -> id'
- other -> pprTrace "zonkIdOcc: " (ppr id) id
+ other -> pprTrace "zonkIdOcc:" (ppr id) id
in
returnNF_Tc new_id
\end{code}
zonkStmts [] = returnNF_Tc []
+zonkStmts (ParStmtOut bndrstmtss : stmts)
+ = mapNF_Tc (mapNF_Tc zonkId) bndrss `thenNF_Tc` \ new_bndrss ->
+ let new_binders = concat new_bndrss in
+ mapNF_Tc zonkStmts stmtss `thenNF_Tc` \ new_stmtss ->
+ tcExtendGlobalValEnv new_binders $
+ zonkStmts stmts `thenNF_Tc` \ new_stmts ->
+ returnNF_Tc (ParStmtOut (zip new_bndrss new_stmtss) : new_stmts)
+ where (bndrss, stmtss) = unzip bndrstmtss
+
zonkStmts [ReturnStmt expr]
= zonkExpr expr `thenNF_Tc` \ new_expr ->
returnNF_Tc [ReturnStmt new_expr]