diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2013-08-02 15:47:03 +0100 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2013-08-02 15:47:03 +0100 |
| commit | e8aa8ccba0c40884765281b21ff8f4411802dd41 (patch) | |
| tree | e29e041226a8cb34a1aeca77f824b22db5a9be0f /compiler/ghci | |
| parent | 303d3de9b52f67b9234f94d0e77e0933ca572ce7 (diff) | |
| download | haskell-e8aa8ccba0c40884765281b21ff8f4411802dd41.tar.gz | |
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.
Diffstat (limited to 'compiler/ghci')
| -rw-r--r-- | compiler/ghci/ByteCodeAsm.lhs | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 9906467186..e3119a7842 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -41,8 +41,10 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.State.Strict import Data.Array.MArray -import Data.Array.Unboxed ( listArray ) + +import qualified Data.Array.Unboxed as Array import Data.Array.Base ( UArray(..) ) + import Data.Array.Unsafe( castSTUArray ) import Foreign @@ -161,11 +163,11 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d let asm_insns = ssElts final_insns barr a = case a of UArray _lo _hi _n b -> b - insns_arr = listArray (0, n_insns - 1) asm_insns + insns_arr = Array.listArray (0, n_insns - 1) asm_insns !insns_barr = barr insns_arr bitmap_arr = mkBitmapArray dflags bsize bitmap - !bitmap_barr = barr bitmap_arr + !bitmap_barr = toByteArray bitmap_arr ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs @@ -176,9 +178,15 @@ assembleBCO dflags (ProtoBCO nm instrs bitmap bsize arity _origin _malloced) = d return ul_bco +#if __GLASGOW_HASKELL__ > 706 +mkBitmapArray :: DynFlags -> Word16 -> [StgWord] -> UArrayStgWord Int +mkBitmapArray dflags bsize bitmap + = SMRep.listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap) +#else mkBitmapArray :: DynFlags -> Word16 -> [StgWord] -> UArray Int StgWord mkBitmapArray dflags bsize bitmap - = listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap) + = Array.listArray (0, length bitmap) (toStgWord dflags (toInteger bsize) : bitmap) +#endif -- instrs nonptrs ptrs type AsmState = (SizedSeq Word16, |