Commit 44334d44 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Tabs -> Spaces

parent b03e62fc
......@@ -84,9 +84,9 @@ dictionaries, which we resolve at the module level.
\begin{code}
tcTopBinds :: HsValBinds Name
-> TcM ( LHsBinds TcId -- Typechecked bindings
, [LTcSpecPrag] -- SPECIALISE prags for imported Ids
, TcLclEnv) -- Augmented environment
-> TcM ( LHsBinds TcId -- Typechecked bindings
, [LTcSpecPrag] -- SPECIALISE prags for imported Ids
, TcLclEnv) -- Augmented environment
-- Note: returning the TcLclEnv is more than we really
-- want. The bit we care about is the local bindings
......@@ -230,7 +230,7 @@ tc_group top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
= do { (binds1, ids, closed) <- tcPolyBinds top_lvl sig_fn prag_fn
NonRecursive NonRecursive
NonRecursive NonRecursive
(bagToList binds)
; thing <- tcExtendLetEnv closed ids thing_inside
; return ( [(NonRecursive, binds1)], thing) }
......@@ -241,8 +241,8 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
-- any references to variables with type signatures.
do { traceTc "tc_group rec" (pprLHsBinds binds)
; (binds1, _ids, thing) <- go sccs
-- Here is where we should do bindInstsOfLocalFuns
-- if we start having Methods again
-- Here is where we should do bindInstsOfLocalFuns
-- if we start having Methods again
; return ([(Recursive, binds1)], thing) }
-- Rec them all together
where
......@@ -289,11 +289,11 @@ bindersOfHsBind (VarBind {}) = panic "bindersOfHsBind VarBind"
------------------------
tcPolyBinds :: TopLevelFlag -> SigFun -> PragFun
-> RecFlag -- Whether the group is really recursive
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> [LHsBind Name]
-> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
-> RecFlag -- Whether the group is really recursive
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> [LHsBind Name]
-> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
-- Typechecks a single bunch of bindings all together,
-- and generalises them. The bunch may be only part of a recursive
......@@ -327,7 +327,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
InferGen mn cl -> tcPolyInfer mn cl tc_sig_fn prag_fn rec_tc bind_list
CheckGen sig -> tcPolyCheck sig prag_fn rec_tc bind_list
-- Check whether strict bindings are ok
-- Check whether strict bindings are ok
-- These must be non-recursive etc, and are not generalised
-- They desugar to a case expression in the end
; checkStrictBinds top_lvl rec_group bind_list poly_ids
......@@ -338,7 +338,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
loc = foldr1 combineSrcSpans (map getLoc bind_list)
-- The mbinds have been dependency analysed and
-- may no longer be adjacent; so find the narrowest
-- span that includes them all
-- span that includes them all
------------------
tcPolyNoGen
......@@ -357,21 +357,21 @@ tcPolyNoGen tc_sig_fn prag_fn rec_tc bind_list
where
tc_mono_info (name, _, mono_id)
= do { mono_ty' <- zonkTcTypeCarefully (idType mono_id)
-- Zonk, mainly to expose unboxed types to checkStrictBinds
-- Zonk, mainly to expose unboxed types to checkStrictBinds
; let mono_id' = setIdType mono_id mono_ty'
; _specs <- tcSpecPrags mono_id' (prag_fn name)
; return mono_id' }
-- NB: tcPrags generates error messages for
-- specialisation pragmas for non-overloaded sigs
-- Indeed that is why we call it here!
-- So we can safely ignore _specs
-- NB: tcPrags generates error messages for
-- specialisation pragmas for non-overloaded sigs
-- Indeed that is why we call it here!
-- So we can safely ignore _specs
------------------
tcPolyCheck :: TcSigInfo -> PragFun
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> [LHsBind Name]
-> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
-> [LHsBind Name]
-> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
-- There is just one binding,
-- it binds a single variable,
-- it has a signature,
......@@ -405,8 +405,8 @@ tcPolyCheck sig@(TcSigInfo { sig_id = poly_id, sig_tvs = tvs, sig_scoped = scope
------------------
tcPolyInfer
:: Bool -- True <=> apply the monomorphism restriction
-> Bool -- True <=> free vars have closed types
:: Bool -- True <=> apply the monomorphism restriction
-> Bool -- True <=> free vars have closed types
-> TcSigFun -> PragFun
-> RecFlag -- Whether it's recursive after breaking
-- dependencies based on type signatures
......@@ -425,8 +425,8 @@ tcPolyInfer mono closed tc_sig_fn prag_fn rec_tc bind_list
; loc <- getSrcSpanM
; let poly_ids = map abe_poly exports
final_closed | closed && not mr_bites = TopLevel
| otherwise = NotTopLevel
final_closed | closed && not mr_bites = TopLevel
| otherwise = NotTopLevel
abs_bind = L loc $
AbsBinds { abs_tvs = qtvs
, abs_ev_vars = givens, abs_ev_binds = ev_binds
......@@ -441,7 +441,7 @@ tcPolyInfer mono closed tc_sig_fn prag_fn rec_tc bind_list
--------------
mkExport :: PragFun
-> [TyVar] -> TcThetaType -- Both already zonked
-> [TyVar] -> TcThetaType -- Both already zonked
-> MonoBindInfo
-> TcM (ABExport Id)
-- mkExport generates exports with
......@@ -474,16 +474,16 @@ mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id)
; traceTc "mkExport: check sig"
(ppr poly_name $$ ppr sel_poly_ty $$ ppr (idType poly_id))
-- Perform the impedence-matching and ambiguity check
-- right away. If it fails, we want to fail now (and recover
-- in tcPolyBinds). If we delay checking, we get an error cascade.
-- Remember we are in the tcPolyInfer case, so the type envt is
-- closed (unless we are doing NoMonoLocalBinds in which case all bets
-- are off)
-- Perform the impedence-matching and ambiguity check
-- right away. If it fails, we want to fail now (and recover
-- in tcPolyBinds). If we delay checking, we get an error cascade.
-- Remember we are in the tcPolyInfer case, so the type envt is
-- closed (unless we are doing NoMonoLocalBinds in which case all bets
-- are off)
; (wrap, wanted) <- addErrCtxtM (mk_msg poly_id) $
captureConstraints $
tcSubType origin sig_ctxt sel_poly_ty (idType poly_id)
; ev_binds <- simplifyAmbiguityCheck poly_name wanted
; ev_binds <- simplifyAmbiguityCheck poly_name wanted
; return (ABE { abe_wrap = mkWpLet (EvBinds ev_binds) <.> wrap
, abe_poly = poly_id
......@@ -539,7 +539,7 @@ mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
lhsBindArity :: LHsBind Name -> NameEnv Arity -> NameEnv Arity
lhsBindArity (L _ (FunBind { fun_id = id, fun_matches = ms })) env
= extendNameEnv env (unLoc id) (matchGroupArity ms)
lhsBindArity _ env = env -- PatBind/VarBind
lhsBindArity _ env = env -- PatBind/VarBind
------------------
tcSpecPrags :: Id -> [LSig Name]
......@@ -571,7 +571,7 @@ tcSpec poly_id prag@(SpecSig _ hs_ty inl)
do { spec_ty <- tcHsSigType sig_ctxt hs_ty
; warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl))
(ptext (sLit "SPECIALISE pragma for non-overloaded function") <+> quotes (ppr poly_id))
-- Note [SPECIALISE pragmas]
-- Note [SPECIALISE pragmas]
; wrap <- tcSubType origin sig_ctxt (idType poly_id) spec_ty
; return (SpecPrag poly_id wrap inl) }
where
......@@ -628,7 +628,7 @@ impSpecErr name
tcVectDecls :: [LVectDecl Name] -> TcM ([LVectDecl TcId])
tcVectDecls decls
= do { decls' <- mapM (wrapLocM tcVect) decls
; let ids = map lvectDeclName decls'
; let ids = [lvectDeclName decl | decl <- decls', not $ lvectInstDecl decl]
dups = findDupsEq (==) ids
; mapM_ reportVectDups dups
; traceTcConstraints "End of tcVectDecls"
......@@ -912,7 +912,7 @@ unifyCtxts :: [TcSigInfo] -> TcM ()
unifyCtxts [] = return ()
unifyCtxts (sig1 : sigs)
= do { traceTc "unifyCtxts" (ppr (sig1 : sigs))
; mapM_ unify_ctxt sigs }
; mapM_ unify_ctxt sigs }
where
theta1 = sig_theta sig1
unify_ctxt :: TcSigInfo -> TcM ()
......@@ -1177,7 +1177,7 @@ tcInstSigs sig_fn bndrs
= do { prs <- mapMaybeM (tcInstSig sig_fn use_skols) bndrs
; return (lookupNameEnv (mkNameEnv prs)) }
where
use_skols = isSingleton bndrs -- See Note [Signature skolems]
use_skols = isSingleton bndrs -- See Note [Signature skolems]
tcInstSig :: SigFun -> Bool -> Name -> TcM (Maybe (Name, TcSigInfo))
-- For use_skols :: Bool see Note [Signature skolems]
......@@ -1195,7 +1195,7 @@ tcInstSig sig_fn use_skols name
then tcInstType tcInstSkolTyVars poly_ty
else tcInstType tcInstSigTyVars poly_ty
; let sig = TcSigInfo { sig_id = poly_id
, sig_scoped = scoped_tvs
, sig_scoped = scoped_tvs
, sig_tvs = tvs, sig_theta = theta, sig_tau = tau
, sig_loc = loc }
; return (Just (name, sig)) }
......@@ -1204,14 +1204,14 @@ tcInstSig sig_fn use_skols name
-------------------------------
data GeneralisationPlan
= NoGen -- No generalisation, no AbsBinds
= NoGen -- No generalisation, no AbsBinds
| InferGen -- Implicit generalisation; there is an AbsBinds
Bool -- True <=> apply the MR; generalise only unconstrained type vars
| InferGen -- Implicit generalisation; there is an AbsBinds
Bool -- True <=> apply the MR; generalise only unconstrained type vars
Bool -- True <=> bindings mention only variables with closed types
-- See Note [Bindings with closed types] in TcRnTypes
-- See Note [Bindings with closed types] in TcRnTypes
| CheckGen TcSigInfo -- Explicit generalisation; there is an AbsBinds
| CheckGen TcSigInfo -- Explicit generalisation; there is an AbsBinds
-- A consequence of the no-AbsBinds choice (NoGen) is that there is
-- no "polymorphic Id" and "monmomorphic Id"; there is just the one
......@@ -1227,7 +1227,7 @@ decideGeneralisationPlan
decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
| bang_pat_binds = NoGen
| Just sig <- one_funbind_with_sig binds = CheckGen sig
| mono_local_binds = NoGen
| mono_local_binds = NoGen
| otherwise = InferGen mono_restriction closed_flag
where
......@@ -1244,25 +1244,25 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
is_closed_ns :: NameSet -> Bool -> Bool
is_closed_ns ns b = foldNameSet ((&&) . is_closed_id) b ns
-- ns are the Names referred to from the RHS of this bind
-- ns are the Names referred to from the RHS of this bind
is_closed_id :: Name -> Bool
-- See Note [Bindings with closed types] in TcRnTypes
is_closed_id name
| name `elemNameSet` bndr_set
= True -- Ignore binders in this groups, of course
= True -- Ignore binders in this groups, of course
| Just thing <- lookupNameEnv type_env name
= case thing of
ATcId { tct_closed = cl } -> isTopLevel cl -- This is the key line
ATyVar {} -> False -- In-scope type variables
AGlobal {} -> True -- are not closed!
ATyVar {} -> False -- In-scope type variables
AGlobal {} -> True -- are not closed!
AThing {} -> pprPanic "is_closed_id" (ppr name)
| otherwise
= WARN( isInternalName name, ppr name ) True
-- The free-var set for a top level binding mentions
-- imported things too, so that we can report unused imports
-- These won't be in the local type env.
-- Ditto class method etc from the current module
-- The free-var set for a top level binding mentions
-- imported things too, so that we can report unused imports
-- These won't be in the local type env.
-- Ditto class method etc from the current module
closed_flag = foldr (is_closed_ns . bind_fvs) True binds
......
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