-dsHsBind auto_scc rest (AbsBinds [] [] exports binds)
- = do { core_prs <- ds_lhs_binds NoSccs binds
- ; let env = mkABEnv exports
- do_one (lcl_id, rhs)
- | Just (_, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id
- = do { let rhs' = addAutoScc auto_scc gbl_id rhs
- ; (spec_binds, rules) <- dsSpecs gbl_id (Let (Rec core_prs) rhs') spec_prags
- -- See Note [Specialising in no-dict case]
- ; let gbl_id' = addIdSpecialisations gbl_id rules
- main_bind = makeCorePair gbl_id' False 0 rhs'
- ; return (main_bind : spec_binds) }
-
- | otherwise = return [(lcl_id, rhs)]
-
- locals' = [(lcl_id, Var gbl_id) | (_, gbl_id, lcl_id, _) <- exports]
- -- Note [Rules and inlining]
- ; export_binds <- mapM do_one core_prs
- ; return (concat export_binds ++ locals' ++ rest) }
- -- No Rec needed here (contrast the other AbsBinds cases)
- -- because we can rely on the enclosing dsBind to wrap in Rec
-
-
-dsHsBind auto_scc rest (AbsBinds tyvars [] exports binds)
- | opt_DsMultiTyVar -- This (static) debug flag just lets us
- -- switch on and off this optimisation to
- -- see if it has any impact; it is on by default
- = -- Note [Abstracting over tyvars only]
- do { core_prs <- ds_lhs_binds NoSccs binds
- ; let arby_env = mkArbitraryTypeEnv tyvars exports
- bndrs = mkVarSet (map fst core_prs)
-
- add_lets | core_prs `lengthExceeds` 10 = add_some
- | otherwise = mkLets
- add_some lg_binds rhs = mkLets [ NonRec b r | NonRec b r <- lg_binds
- , b `elemVarSet` fvs] rhs
- where
- fvs = exprSomeFreeVars (`elemVarSet` bndrs) rhs
-
- env = mkABEnv exports
- mk_lg_bind lcl_id gbl_id tyvars
- = NonRec (setIdInfo lcl_id vanillaIdInfo)
- -- Nuke the IdInfo so that no old unfoldings
- -- confuse use (it might mention something not
- -- even in scope at the new site
- (mkTyApps (Var gbl_id) (mkTyVarTys tyvars))
-
- do_one lg_binds (lcl_id, rhs)
- | Just (id_tvs, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id
- = do { let rhs' = addAutoScc auto_scc gbl_id $
- mkLams id_tvs $
- mkLets [ NonRec tv (Type (lookupVarEnv_NF arby_env tv))
- | tv <- tyvars, not (tv `elem` id_tvs)] $
- add_lets lg_binds rhs
- ; (spec_binds, rules) <- dsSpecs gbl_id rhs' spec_prags
- ; let gbl_id' = addIdSpecialisations gbl_id rules
- main_bind = makeCorePair gbl_id' False 0 rhs'
- ; return (mk_lg_bind lcl_id gbl_id' id_tvs, main_bind : spec_binds) }
- | otherwise
- = do { non_exp_gbl_id <- newUniqueId lcl_id (mkForAllTys tyvars (idType lcl_id))
- ; return (mk_lg_bind lcl_id non_exp_gbl_id tyvars,
- [(non_exp_gbl_id, mkLams tyvars (add_lets lg_binds rhs))]) }
-
- ; (_, core_prs') <- fixDs (\ ~(lg_binds, _) -> mapAndUnzipM (do_one lg_binds) core_prs)
- ; return (concat core_prs' ++ rest) }
-
- -- Another common case: one exported variable