-- Extend the envt right away with all
-- the Ids declared with type signatures
- ; gla_exts <- doptM Opt_GlasgowExts
+ ; poly_rec <- doptM Opt_RelaxedPolyRec
; (binds', thing) <- tcExtendIdEnv poly_ids $
- tc_val_binds gla_exts top_lvl sig_fn prag_fn
+ tc_val_binds poly_rec top_lvl sig_fn prag_fn
binds thing_inside
; return (ValBindsOut binds' sigs, thing) }
-- Typecheck a whole lot of value bindings,
-- one strongly-connected component at a time
-tc_val_binds gla_exts top_lvl sig_fn prag_fn [] thing_inside
+tc_val_binds poly_rec top_lvl sig_fn prag_fn [] thing_inside
= do { thing <- thing_inside
; return ([], thing) }
-tc_val_binds gla_exts top_lvl sig_fn prag_fn (group : groups) thing_inside
+tc_val_binds poly_rec top_lvl sig_fn prag_fn (group : groups) thing_inside
= do { (group', (groups', thing))
- <- tc_group gla_exts top_lvl sig_fn prag_fn group $
- tc_val_binds gla_exts top_lvl sig_fn prag_fn groups thing_inside
+ <- tc_group poly_rec top_lvl sig_fn prag_fn group $
+ tc_val_binds poly_rec top_lvl sig_fn prag_fn groups thing_inside
; return (group' ++ groups', thing) }
------------------------
-- We get a list of groups back, because there may
-- be specialisations etc as well
-tc_group gla_exts top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
+tc_group poly_rec top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
-- A single non-recursive binding
-- We want to keep non-recursive things non-recursive
-- so that we desugar unlifted bindings correctly
= do { (binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn NonRecursive binds thing_inside
; return ([(NonRecursive, b) | b <- binds], thing) }
-tc_group gla_exts top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
- | not gla_exts -- Recursive group, normal Haskell 98 route
+tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
+ | not poly_rec -- Recursive group, normal Haskell 98 route
= do { (binds1, thing) <- tc_haskell98 top_lvl sig_fn prag_fn Recursive binds thing_inside
; return ([(Recursive, unionManyBags binds1)], thing) }
-- e.g. f = \(x::forall a. a->a) -> <body>
-- We want to infer a higher-rank type for f
setSrcSpan b_loc $
- do { ((co_fn, matches'), rhs_ty) <- tcInfer (tcMatchesFun name matches)
+ do { ((co_fn, matches'), rhs_ty) <- tcInfer (tcMatchesFun name inf matches)
-- Check for an unboxed tuple type
-- f = (# True, False #)
| (name, tv) <- sig_scoped tc_sig `zip` sig_tvs tc_sig ]
; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs $
- tcMatchesFun mono_name matches mono_ty
+ tcMatchesFun mono_name inf matches mono_ty
; let fun_bind' = FunBind { fun_id = L nm_loc mono_id,
fun_infix = inf, fun_matches = matches',
-------------------
tcRhs :: TcMonoBind -> TcM (HsBind TcId)
tcRhs (TcFunBind info fun'@(L _ mono_id) inf matches)
- = do { (co_fn, matches') <- tcMatchesFun (idName mono_id) matches
- (idType mono_id)
+ = do { (co_fn, matches') <- tcMatchesFun (idName mono_id) inf
+ matches (idType mono_id)
; return (FunBind { fun_id = fun', fun_infix = inf, fun_matches = matches',
bind_fvs = placeHolderNames, fun_co_fn = co_fn,
fun_tick = Nothing }) }