diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-09-17 11:34:28 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-09-17 13:46:28 +0100 |
commit | af7cc9953217d74e88d4d21512e957edd8e97ec9 (patch) | |
tree | 35e6c6b82a87c65a6a28508a357c282deb4f8087 /compiler/iface/BinIface.hs | |
parent | 510f4394b6574c930b71bd430ca2cb8d25022fac (diff) | |
download | haskell-af7cc9953217d74e88d4d21512e957edd8e97ec9.tar.gz |
Implement 'left' and 'right' coercions
This patch finally adds 'left' and 'right' coercions back into
GHC. Trac #7205 gives the details.
The main change is to add a new constructor to Coercion:
data Coercion
= ...
| NthCo Int Coercion -- OLD, still there
| LRCo LeftOrRight Coercion -- NEW
data LeftOrRight = CLeft | CRight
Plus:
* Similar change to TcCoercion
* Use LRCo when decomposing AppTys
* Coercion optimisation needs to handle left/right
The rest is just knock-on effects.
Diffstat (limited to 'compiler/iface/BinIface.hs')
-rw-r--r-- | compiler/iface/BinIface.hs | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index a319f6ed62..362df3fc35 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -20,11 +20,12 @@ module BinIface ( #include "HsVersions.h" import TcRnMonad -import TyCon (TyCon, tyConName, tupleTyConSort, tupleTyConArity, isTupleTyCon) +import TyCon import DataCon (dataConName, dataConWorkId, dataConTyCon) import PrelInfo (wiredInThings, basicKnownKeyNames) import Id (idName, isDataConWorkId_maybe) import CoreSyn (DFunArg(..)) +import Coercion (LeftOrRight(..)) import TysWiredIn import IfaceEnv import HscTypes @@ -1037,6 +1038,15 @@ instance Binary IfaceTyCon where put_ bh (IfaceTc ext) = put_ bh ext get bh = liftM IfaceTc (get bh) +instance Binary LeftOrRight where + put_ bh CLeft = putByte bh 0 + put_ bh CRight = putByte bh 1 + + get bh = do { h <- getByte bh + ; case h of + 0 -> return CLeft + _ -> return CRight } + instance Binary IfaceCoCon where put_ bh (IfaceCoAx n) = do { putByte bh 0; put_ bh n } put_ bh IfaceReflCo = putByte bh 1 @@ -1045,6 +1055,7 @@ instance Binary IfaceCoCon where put_ bh IfaceTransCo = putByte bh 4 put_ bh IfaceInstCo = putByte bh 5 put_ bh (IfaceNthCo d) = do { putByte bh 6; put_ bh d } + put_ bh (IfaceLRCo lr) = do { putByte bh 7; put_ bh lr } get bh = do h <- getByte bh @@ -1056,6 +1067,7 @@ instance Binary IfaceCoCon where 4 -> return IfaceTransCo 5 -> return IfaceInstCo 6 -> do { d <- get bh; return (IfaceNthCo d) } + 7 -> do { lr <- get bh; return (IfaceLRCo lr) } _ -> panic ("get IfaceCoCon " ++ show h) ------------------------------------------------------------------------- |