Make {-# UNPACK #-} work for type/data family invocations

This fixes most of Trac #3990.  Consider
  data family D a
  data instance D Double = CD Int Int
  data T = T {-# UNPACK #-} !(D Double)
Then we want the (D Double unpacked).

To do this we need to construct a suitable coercion, and it's much
safer to record that coercion in the interface file, lest the in-scope
instances differ somehow.  That in turn means elaborating the HsBang
type to include a coercion.

To do that I moved HsBang from BasicTypes to DataCon, which caused
quite a few minor knock-on changes.

Interface-file format has changed!

Still to do: need to do knot-tying to allow instances to take effect
within the same module.

1 files changed, 9 insertions, 11 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 8226b426c3..7f612ec970 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -748,21 +748,19 @@ instance Binary InlineSpec where
                   2 -> return Inlinable
                   _ -> return NoInline
 
-instance Binary HsBang where
-    put_ bh HsNoBang       = putByte bh 0
-    put_ bh (HsBang False) = putByte bh 1
-    put_ bh (HsBang True)  = putByte bh 2
-    put_ bh HsUnpack       = putByte bh 3
-    put_ bh HsStrict       = putByte bh 4
+instance Binary IfaceBang where
+    put_ bh IfNoBang        = putByte bh 0
+    put_ bh IfStrict        = putByte bh 1
+    put_ bh IfUnpack        = putByte bh 2
+    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
 
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return HsNoBang
-              1 -> do return (HsBang False)
-              2 -> do return (HsBang True)
-              3 -> do return HsUnpack
-              _ -> do return HsStrict
+              0 -> do return IfNoBang
+              1 -> do return IfStrict
+              2 -> do return IfUnpack
+              _ -> do { a <- get bh; return (IfUnpackCo a) }
 
 instance Binary TupleSort where
     put_ bh BoxedTuple      = putByte bh 0