diff options
| author | simonpj@microsoft.com <unknown> | 2009-10-30 18:00:51 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-10-30 18:00:51 +0000 |
| commit | 98de5f474de6eb5dc9b2e2ec582e02902fdb3856 (patch) | |
| tree | 95be1208940a7d65213a763922f009433b601f34 /compiler | |
| parent | 6bb68af67f4782e1d02f186c1a6c01ff4e430202 (diff) | |
| download | haskell-98de5f474de6eb5dc9b2e2ec582e02902fdb3856.tar.gz | |
Turn an ASSERT into a WARN
This is to do with SPECIALISE pragmas in instance declarations,
which I need to think more about
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/deSugar/DsBinds.lhs | 20 | ||||
| -rw-r--r-- | compiler/hsSyn/HsBinds.lhs | 3 |
2 files changed, 13 insertions, 10 deletions
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 0222594095..04c84cd77b 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -144,9 +144,9 @@ dsHsBind auto_scc rest (AbsBinds [] [] exports binds) ar_env = mkArityEnv binds do_one (lcl_id, rhs) | Just (_, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id - = ASSERT( null spec_prags ) -- Not overloaded - makeCorePair gbl_id (lookupArity ar_env lcl_id) $ - addAutoScc auto_scc gbl_id rhs + = WARN( not (null spec_prags), ppr gbl_id $$ ppr spec_prags ) -- Not overloaded + makeCorePair gbl_id (lookupArity ar_env lcl_id) + (addAutoScc auto_scc gbl_id rhs) | otherwise = (lcl_id, rhs) @@ -228,14 +228,14 @@ dsHsBind auto_scc rest (AbsBinds tyvars [] exports binds) do_one lg_binds (lcl_id, rhs) | Just (id_tvs, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id - = ASSERT( null spec_prags ) -- Not overloaded - 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 + = WARN( not (null spec_prags), ppr gbl_id $$ ppr spec_prags ) -- Not overloaded + (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 in return (mk_lg_bind lcl_id gbl_id id_tvs, - makeCorePair gbl_id (lookupArity ar_env lcl_id) rhs') + makeCorePair gbl_id (lookupArity ar_env lcl_id) rhs')) | 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, diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index a6d8523e93..ba3dbd68bf 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -477,6 +477,9 @@ data SpecPrag = SpecPrag HsWrapper -- An wrapper, that specialises the polymorphic function InlinePragma -- Inlining spec for the specialised function + +instance Outputable SpecPrag where + ppr (SpecPrag _ p) = ptext (sLit "SpecPrag") <+> ppr p \end{code} \begin{code} |