\begin{code}
module TcModule (
typecheckModule, typecheckIface, typecheckStmt, typecheckExpr,
+ typecheckExtraDecls,
TcResults(..)
) where
import Id ( Id, idType, idUnfolding )
import Module ( Module, moduleName )
import Name ( Name )
-import NameEnv ( nameEnvElts, lookupNameEnv )
+import NameEnv ( lookupNameEnv )
import TyCon ( tyConGenInfo )
import BasicTypes ( EP(..), Fixity, RecFlag(..) )
import SrcLoc ( noSrcLoc )
import HscTypes ( PersistentCompilerState(..), HomeSymbolTable,
PackageTypeEnv, ModIface(..),
ModDetails(..), DFunId,
- TypeEnv, extendTypeEnvList,
- TyThing(..), implicitTyThingIds,
+ TypeEnv, extendTypeEnvList, typeEnvTyCons, typeEnvElts,
+ TyThing(..),
mkTypeEnv
)
\end{code}
%************************************************************************
%* *
+\subsection{Typechecking extra declarations}
+%* *
+%************************************************************************
+
+\begin{code}
+typecheckExtraDecls
+ :: DynFlags
+ -> PersistentCompilerState
+ -> HomeSymbolTable
+ -> PrintUnqualified -- For error printing
+ -> Module -- Is this really needed
+ -> [RenamedHsDecl] -- extra decls sucked in from interface files
+ -> IO (Maybe PersistentCompilerState)
+
+typecheckExtraDecls dflags pcs hst unqual this_mod decls
+ = typecheck dflags pcs hst unqual $
+ fixTc (\ ~(unf_env, _, _, _, _) ->
+ tcImports unf_env pcs hst get_fixity this_mod decls
+ ) `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
+ ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
+ returnTc new_pcs
+ where
+ get_fixity n = pprPanic "typecheckExpr" (ppr n)
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Typechecking a module}
%* *
%************************************************************************
zonkRules more_local_rules `thenNF_Tc` \ more_local_rules' ->
- let local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
-
- -- Create any necessary "implicit" bindings (data constructors etc)
- -- Should we create bindings for dictionary constructors?
- -- They are always fully applied, and the bindings are just there
- -- to support partial applications. But it's easier to let them through.
- implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
- | id <- implicitTyThingIds local_things
- , let unf = idUnfolding id
- , hasUnfolding unf
- ]
+ let local_things = filter (isLocalThing this_mod) (typeEnvElts (getTcGEnv final_env))
local_type_env :: TypeEnv
local_type_env = mkTypeEnv local_things
new_pcs,
TcResults { tc_env = local_type_env,
tc_insts = map iDFunId local_insts,
- tc_binds = implicit_binds `AndMonoBinds` all_binds',
+ tc_binds = all_binds',
tc_fords = foi_decls ++ foe_decls',
tc_rules = all_local_rules
}
deriv_binds, local_rules) ->
ASSERT(nullBinds deriv_binds)
let
- local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv env))
+ local_things = filter (isLocalThing this_mod) (typeEnvElts (getTcGEnv env))
mod_details = ModDetails { md_types = mkTypeEnv local_things,
md_insts = map iDFunId local_inst_info,
tcExtendGlobalValEnv sig_ids $
- tcIfaceRules (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
+ tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
-- When relinking this module from its interface-file decls
-- we'll have IfaceRules that are in fact local to this module
-- That's the reason we we get any local_rules out here
tcGetEnv `thenTc` \ unf_env ->
let
- all_things = nameEnvElts (getTcGEnv unf_env)
+ all_things = typeEnvElts (getTcGEnv unf_env)
-- sometimes we're compiling in the context of a package module
-- (on the GHCi command line, for example). In this case, we
ppr_rules (tc_rules results),
if dopt Opt_Generics dflags then
- ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
+ ppr_gen_tycons (typeEnvTyCons (tc_env results))
else
empty
]