[commit: ghc] wip/T12618: magictDict built-in rule: Also match ConApp (27cab4f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T12618
Link       : http://ghc.haskell.org/trac/ghc/changeset/27cab4fa5556f962e63234c36d6d8a8e049da4ee/ghc

>---------------------------------------------------------------

commit 27cab4fa5556f962e63234c36d6d8a8e049da4ee
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Oct 14 23:20:12 2016 -0400

    magictDict built-in rule: Also match ConApp


>---------------------------------------------------------------

27cab4fa5556f962e63234c36d6d8a8e049da4ee
 compiler/prelude/PrelRules.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index f637fd3..231cec1 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -31,7 +31,7 @@ import PrimOp      ( PrimOp(..), tagToEnumKey )
 import TysWiredIn
 import TysPrim
 import TyCon       ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon, unwrapNewTyCon_maybe )
-import DataCon     ( dataConTag, dataConTyCon )
+import DataCon     ( dataConTag, dataConTyCon, dataConRepType )
 import CoreUtils   ( cheapEqExpr, exprIsHNF )
 import CoreUnfold  ( exprIsConApp_maybe )
 import Type
@@ -1187,6 +1187,14 @@ match_inline _ = Nothing
 -- See Note [magicDictId magic] in `basicTypes/MkId.hs`
 -- for a description of what is going on here.
 match_magicDict :: [Expr CoreBndr] -> Maybe (Expr CoreBndr)
+match_magicDict [Type _, ConApp dc [Type a, Type _ , f], x, y ]
+  | Just (fieldTy, _)   <- splitFunTy_maybe $ dropForAlls $ dataConRepType dc
+  , Just (dictTy, _)    <- splitFunTy_maybe fieldTy
+  , Just dictTc         <- tyConAppTyCon_maybe dictTy
+  , Just (_,_,co)       <- unwrapNewTyCon_maybe dictTc
+  = Just
+  $ f `App` Cast x (mkSymCo (mkUnbranchedAxInstCo Representational co [a] []))
+      `App` y
 match_magicDict [Type _, Var wrap `App` Type a `App` Type _ `App` f, x, y ]
   | Just (fieldTy, _)   <- splitFunTy_maybe $ dropForAlls $ idType wrap
   , Just (dictTy, _)    <- splitFunTy_maybe fieldTy