projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Tidy-up sweep, following the Great Skolemisation Simplification
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcBinds.lhs
diff --git
a/compiler/typecheck/TcBinds.lhs
b/compiler/typecheck/TcBinds.lhs
index
a191b82
..
638f692
100644
(file)
--- a/
compiler/typecheck/TcBinds.lhs
+++ b/
compiler/typecheck/TcBinds.lhs
@@
-130,14
+130,12
@@
tcLocalBinds (HsValBinds binds) thing_inside
tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
= do { (given_ips, ip_binds') <- mapAndUnzipM (wrapLocSndM tc_ip_bind) ip_binds
tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
= do { (given_ips, ip_binds') <- mapAndUnzipM (wrapLocSndM tc_ip_bind) ip_binds
- ; let ip_tvs = foldr (unionVarSet . tyVarsOfType . idType) emptyVarSet given_ips
-- If the binding binds ?x = E, we must now
-- discharge any ?x constraints in expr_lie
-- If the binding binds ?x = E, we must now
-- discharge any ?x constraints in expr_lie
+ -- See Note [Implicit parameter untouchables]
; (ev_binds, result) <- checkConstraints (IPSkol ips)
; (ev_binds, result) <- checkConstraints (IPSkol ips)
- ip_tvs -- See Note [Implicit parameter untouchables]
- [] given_ips $
- thing_inside
+ [] given_ips thing_inside
; return (HsIPBinds (IPBinds ip_binds' ev_binds), result) }
where
; return (HsIPBinds (IPBinds ip_binds' ev_binds), result) }
where
@@
-164,6
+162,9
@@
doesn't float that solved constraint out (it's not an unsolved
wanted. Result disaster: the (Num alpha) is again solved, this
time by defaulting. No no no.
wanted. Result disaster: the (Num alpha) is again solved, this
time by defaulting. No no no.
+However [Oct 10] this is all handled automatically by the
+untouchable-range idea.
+
\begin{code}
tcValBinds :: TopLevelFlag
-> HsValBinds Name -> TcM thing
\begin{code}
tcValBinds :: TopLevelFlag
-> HsValBinds Name -> TcM thing
@@
-393,7
+394,7
@@
tcPolyCheck sig@(TcSigInfo { sig_id = id, sig_tvs = tvs, sig_scoped = scoped
; let skol_info = SigSkol (FunSigCtxt (idName id))
; (ev_binds, (binds', [mono_info]))
; let skol_info = SigSkol (FunSigCtxt (idName id))
; (ev_binds, (binds', [mono_info]))
- <- checkConstraints skol_info emptyVarSet tvs ev_vars $
+ <- checkConstraints skol_info tvs ev_vars $
tcExtendTyVarEnv2 (scoped `zip` mkTyVarTys tvs) $
tcMonoBinds (\_ -> Just sig) LetLclBndr rec_tc bind_list
tcExtendTyVarEnv2 (scoped `zip` mkTyVarTys tvs) $
tcMonoBinds (\_ -> Just sig) LetLclBndr rec_tc bind_list
@@
-495,7
+496,9
@@
mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
get_sig _ = Nothing
add_arity (L _ n) inl_prag -- Adjust inl_sat field to match visible arity of function
get_sig _ = Nothing
add_arity (L _ n) inl_prag -- Adjust inl_sat field to match visible arity of function
- | Just ar <- lookupNameEnv ar_env n = inl_prag { inl_sat = Just ar }
+ | Just ar <- lookupNameEnv ar_env n,
+ Inline <- inl_inline inl_prag = inl_prag { inl_sat = Just ar }
+ -- add arity only for real INLINE pragmas, not INLINABLE
| otherwise = inl_prag
prag_env :: NameEnv [LSig Name]
| otherwise = inl_prag
prag_env :: NameEnv [LSig Name]