From a1fc7ce3f16e302b19ab39174ee065fa116b6afd Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Fri, 29 Sep 2017 11:39:28 +0100 Subject: [PATCH] Comments only --- compiler/prelude/PrelRules.hs | 17 +++++++++-------- compiler/stranal/WorkWrap.hs | 2 +- compiler/typecheck/TcTyClsDecls.hs | 2 +- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs index 810fd2ba60..8838c4aaff 100644 --- a/compiler/prelude/PrelRules.hs +++ b/compiler/prelude/PrelRules.hs @@ -897,21 +897,22 @@ tagToEnumRule = do _ -> WARN( True, text "tagToEnum# on non-enumeration type" <+> ppr ty ) return $ mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type" -{- -For dataToTag#, we can reduce if either - - (a) the argument is a constructor - (b) the argument is a variable whose unfolding is a known constructor --} - +------------------------------ dataToTagRule :: RuleM CoreExpr +-- Rules for dataToTag# dataToTagRule = a `mplus` b where + -- dataToTag (tagToEnum x) ==> x a = do [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag] <- getArgs guard $ tag_to_enum `hasKey` tagToEnumKey guard $ ty1 `eqType` ty2 - return tag -- dataToTag (tagToEnum x) ==> x + return tag + + -- dataToTag (K e1 e2) ==> tag-of K + -- This also works (via exprIsConApp_maybe) for + -- dataToTag x + -- where x's unfolding is a constructor application b = do dflags <- getDynFlags [_, val_arg] <- getArgs diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 28b0df3404..ac8798e56e 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -182,7 +182,7 @@ If we have where f is strict in y, we might get a more efficient loop by w/w'ing f. But that would make a new unfolding which would overwrite the old -one! So the function would no longer be ININABLE, and in particular +one! So the function would no longer be INLNABLE, and in particular will not be specialised at call sites in other modules. This comes in practice (Trac #6056). diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 876784378c..fa8b2bbdc2 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -3002,7 +3002,7 @@ checkValidRoleAnnots role_annots tc ; _ <- zipWith3M checkRoleAnnot vis_vars the_role_annots vis_roles -- Representational or phantom roles for class parameters -- quickly lead to incoherence. So, we require - -- IncoherentInstances to have them. See #8773. + -- IncoherentInstances to have them. See #8773, #14292 ; incoherent_roles_ok <- xoptM LangExt.IncoherentInstances ; checkTc ( incoherent_roles_ok || (not $ isClassTyCon tc) -- GitLab