Commit 36a3f8f3 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-03-17 10:15:32 by simonpj]

Buglet in compiling hs-boot files
	We should make GlobalIds not LocalIds

	Merge to STABLE
parent eaa4cb42
......@@ -40,11 +40,12 @@ import TcType ( TcTyVar, SkolemInfo(SigSkol),
TcTauType, TcSigmaType,
mkTyVarTy, mkForAllTys, mkFunTys, tyVarsOfType,
mkForAllTy, isUnLiftedType, tcGetTyVar,
mkTyVarTys, tidyOpenTyVar, tidyOpenType )
mkTyVarTys, tidyOpenTyVar )
import Kind ( argTypeKind )
import VarEnv ( TyVarEnv, emptyVarEnv, lookupVarEnv, extendVarEnv, emptyTidyEnv )
import TysPrim ( alphaTyVar )
import Id ( mkLocalId, mkSpecPragmaId, setInlinePragma )
import Id ( Id, mkLocalId, mkVanillaGlobal, mkSpecPragmaId, setInlinePragma )
import IdInfo ( vanillaIdInfo )
import Var ( idType, idName )
import Name ( Name )
import NameSet
......@@ -106,18 +107,16 @@ tcTopBinds binds
glue (HsIPBinds _) _ = panic "Top-level HsIpBinds"
-- Can't have a HsIPBinds at top level
tcHsBootSigs :: [HsBindGroup Name] -> TcM (LHsBinds TcId, TcLclEnv)
tcHsBootSigs :: [HsBindGroup Name] -> TcM [Id]
-- A hs-boot file has only one BindGroup, and it only has type
-- signatures in it. The renamer checked all this
tcHsBootSigs [HsBindGroup _ sigs _]
= do { ids <- mapM (addLocM tc_sig) (filter isVanillaLSig sigs)
; tcExtendIdEnv ids $ do
{ env <- getLclEnv
; return (emptyLHsBinds, env) }}
= mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs)
where
tc_sig (Sig (L _ name) ty)
tc_boot_sig (Sig (L _ name) ty)
= do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkLocalId name sigma_ty) }
; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
-- Notice that we make GlobalIds, not LocalIds
tcBindsAndThen
:: (HsBindGroup TcId -> thing -> thing) -- Combinator
......
......@@ -478,16 +478,14 @@ tcRnHsBootDecls decls
-- Typecheck value declarations
; traceTc (text "Tc5")
; (tc_val_binds, lcl_env) <- tcHsBootSigs (hs_valds rn_group)
; new_ids <- tcHsBootSigs (hs_valds rn_group)
-- Wrap up
-- No simplification or zonking to do
; traceTc (text "Tc7a")
; gbl_env <- getGblEnv
; let { new_ids = [ id | ATcId id _ _ <- varEnvElts (tcl_env lcl_env) ]
; final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
; let { final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
; return (gbl_env { tcg_type_env = final_type_env })
}}}}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment