Implement "roles" into GHC.

Roles are a solution to the GeneralizedNewtypeDeriving type-safety
problem.

Roles were first described in the "Generative type abstraction" paper,
by Stephanie Weirich, Dimitrios Vytiniotis, Simon PJ, and Steve Zdancewic.
The implementation is a little different than that paper. For a quick
primer, check out Note [Roles] in Coercion. Also see
http://ghc.haskell.org/trac/ghc/wiki/Roles
and
http://ghc.haskell.org/trac/ghc/wiki/RolesImplementation
For a more formal treatment, check out docs/core-spec/core-spec.pdf.

This fixes Trac #1496, #4846, #7148.

3 files changed, 15 insertions, 2 deletions

diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs
index 8a612fbb60..859908e266 100644
--- a/compiler/utils/Maybes.lhs
+++ b/compiler/utils/Maybes.lhs
@@ -14,6 +14,7 @@ module Maybes (
         mapCatMaybes,
         allMaybes,
         firstJust, firstJusts,
+        whenIsJust,
         expectJust,
         maybeToBool,
 
@@ -68,6 +69,10 @@ mapCatMaybes _ [] = []
 mapCatMaybes f (x:xs) = case f x of
                         Just y  -> y : mapCatMaybes f xs
                         Nothing -> mapCatMaybes f xs
+
+whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenIsJust (Just x) f = f x
+whenIsJust Nothing  _ = return ()
 \end{code}
 
 \begin{code}
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 680300abd4..862af99443 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -20,7 +20,7 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 
 \begin{code}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
 
 {-# OPTIONS -Wall #-}
 module UniqFM (
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 6d42ce7dfe..dd947ffd93 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -14,7 +14,7 @@ module Util (
 
         -- * General list processing
         zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
-        zipLazy, stretchZipWith,
+        zipLazy, stretchZipWith, zipWithAndUnzip,
 
         unzipWith,
 
@@ -351,6 +351,14 @@ mapAndUnzip3 f (x:xs)
     in
     (r1:rs1, r2:rs2, r3:rs3)
 
+zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d])
+zipWithAndUnzip f (a:as) (b:bs)
+  = let (r1,  r2)  = f a b
+        (rs1, rs2) = zipWithAndUnzip f as bs
+    in
+    (r1:rs1, r2:rs2)
+zipWithAndUnzip _ _ _ = ([],[])
+
 mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])
 mapAccumL2 f s1 s2 xs = (s1', s2', ys)
   where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of