Commit 98de5f47 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Turn an ASSERT into a WARN

This is to do with SPECIALISE pragmas in instance declarations,
which I need to think more about
parent 6bb68af6
...@@ -144,9 +144,9 @@ dsHsBind auto_scc rest (AbsBinds [] [] exports binds) ...@@ -144,9 +144,9 @@ dsHsBind auto_scc rest (AbsBinds [] [] exports binds)
ar_env = mkArityEnv binds ar_env = mkArityEnv binds
do_one (lcl_id, rhs) do_one (lcl_id, rhs)
| Just (_, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id | Just (_, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id
= ASSERT( null spec_prags ) -- Not overloaded = WARN( not (null spec_prags), ppr gbl_id $$ ppr spec_prags ) -- Not overloaded
makeCorePair gbl_id (lookupArity ar_env lcl_id) $ makeCorePair gbl_id (lookupArity ar_env lcl_id)
addAutoScc auto_scc gbl_id rhs (addAutoScc auto_scc gbl_id rhs)
| otherwise = (lcl_id, rhs) | otherwise = (lcl_id, rhs)
...@@ -228,14 +228,14 @@ dsHsBind auto_scc rest (AbsBinds tyvars [] exports binds) ...@@ -228,14 +228,14 @@ dsHsBind auto_scc rest (AbsBinds tyvars [] exports binds)
do_one lg_binds (lcl_id, rhs) do_one lg_binds (lcl_id, rhs)
| Just (id_tvs, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id | Just (id_tvs, gbl_id, _, spec_prags) <- lookupVarEnv env lcl_id
= ASSERT( null spec_prags ) -- Not overloaded = WARN( not (null spec_prags), ppr gbl_id $$ ppr spec_prags ) -- Not overloaded
let rhs' = addAutoScc auto_scc gbl_id $ (let rhs' = addAutoScc auto_scc gbl_id $
mkLams id_tvs $ mkLams id_tvs $
mkLets [ NonRec tv (Type (lookupVarEnv_NF arby_env tv)) mkLets [ NonRec tv (Type (lookupVarEnv_NF arby_env tv))
| tv <- tyvars, not (tv `elem` id_tvs)] $ | tv <- tyvars, not (tv `elem` id_tvs)] $
add_lets lg_binds rhs add_lets lg_binds rhs
in return (mk_lg_bind lcl_id gbl_id id_tvs, 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 | otherwise
= do { non_exp_gbl_id <- newUniqueId lcl_id (mkForAllTys tyvars (idType lcl_id)) = do { non_exp_gbl_id <- newUniqueId lcl_id (mkForAllTys tyvars (idType lcl_id))
; return (mk_lg_bind lcl_id non_exp_gbl_id tyvars, ; return (mk_lg_bind lcl_id non_exp_gbl_id tyvars,
......
...@@ -477,6 +477,9 @@ data SpecPrag ...@@ -477,6 +477,9 @@ data SpecPrag
= SpecPrag = SpecPrag
HsWrapper -- An wrapper, that specialises the polymorphic function HsWrapper -- An wrapper, that specialises the polymorphic function
InlinePragma -- Inlining spec for the specialised function InlinePragma -- Inlining spec for the specialised function
instance Outputable SpecPrag where
ppr (SpecPrag _ p) = ptext (sLit "SpecPrag") <+> ppr p
\end{code} \end{code}
\begin{code} \begin{code}
......
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