From e8aa8ccba0c40884765281b21ff8f4411802dd41 Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <eir@cis.upenn.edu>
Date: Fri, 2 Aug 2013 15:47:03 +0100
Subject: 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.
---
 compiler/cmm/SMRep.lhs | 42 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 40 insertions(+), 2 deletions(-)

(limited to 'compiler/cmm/SMRep.lhs')

diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 6f569ef6fa..c54f6d5f9d 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -16,6 +16,11 @@ module SMRep (
         WordOff, ByteOff,
         roundUpToWords,
 
+#if __GLASGOW_HASKELL__ > 706
+        -- ** Immutable arrays of StgWords
+        UArrayStgWord, listArray, toByteArray,
+#endif
+
         -- * Closure repesentation
         SMRep(..), -- CmmInfo sees the rep; no one else does
         IsStatic,
@@ -49,8 +54,13 @@ import DynFlags
 import Outputable
 import Platform
 import FastString
+import qualified Data.Array.Base as Array
+
+#if __GLASGOW_HASKELL__ > 706
+import GHC.Base ( ByteArray# )
+import Data.Ix
+#endif
 
-import Data.Array.Base
 import Data.Char( ord )
 import Data.Word
 import Data.Bits
@@ -80,7 +90,11 @@ newtype StgWord = StgWord Word64
 #if __GLASGOW_HASKELL__ < 706
               Num,
 #endif
-              Bits, IArray UArray)
+
+#if __GLASGOW_HASKELL__ <= 706
+              Array.IArray Array.UArray,
+#endif
+              Bits)
 
 fromStgWord :: StgWord -> Integer
 fromStgWord (StgWord i) = toInteger i
@@ -125,6 +139,30 @@ hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
 hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+                Immutable arrays of StgWords
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+
+#if __GLASGOW_HASKELL__ > 706
+-- TODO: Improve with newtype coercions!
+
+newtype UArrayStgWord i = UArrayStgWord (Array.UArray i Word64)
+
+listArray :: Ix i => (i, i) -> [StgWord] -> UArrayStgWord i
+listArray (i,j) words
+  = UArrayStgWord $ Array.listArray (i,j) (map unStgWord words)
+  where unStgWord (StgWord w64) = w64
+
+toByteArray :: UArrayStgWord i -> ByteArray#
+toByteArray (UArrayStgWord (Array.UArray _ _ _ b)) = b
+
+#endif
+
+\end{code}
 
 %************************************************************************
 %*                                                                      *
-- 
cgit v1.2.1