summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/backpack/RnModIface.hs4
-rw-r--r--compiler/iface/LoadIface.hs2
-rw-r--r--compiler/iface/MkIface.hs5
-rw-r--r--compiler/main/HscTypes.hs16
-rw-r--r--compiler/prelude/PrelInfo.hs8
-rw-r--r--compiler/typecheck/TcBackpack.hs3
-rw-r--r--compiler/utils/Binary.hs23
7 files changed, 46 insertions, 15 deletions
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index 2199965d13..2b9cdc1b01 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -101,7 +101,7 @@ rnModIface hsc_env insts nsubst iface = do
sig_of <- case mi_sig_of iface of
Nothing -> return Nothing
Just x -> fmap Just (rnModule x)
- exports <- mapM rnAvailInfo (mi_exports iface)
+ exports <- mapM rnAvailInfo (mi_exports_arr iface)
decls <- mapM rnIfaceDecl' (mi_decls iface)
insts <- mapM rnIfaceClsInst (mi_insts iface)
fams <- mapM rnIfaceFamInst (mi_fam_insts iface)
@@ -113,7 +113,7 @@ rnModIface hsc_env insts nsubst iface = do
, mi_sig_of = sig_of
, mi_insts = insts
, mi_fam_insts = fams
- , mi_exports = exports
+ , mi_exports_arr = exports
, mi_decls = decls
, mi_deps = deps }
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index b91d984b9a..54a051dc17 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -947,7 +947,7 @@ initExternalPackageState
ghcPrimIface :: ModIface
ghcPrimIface
= (emptyModIface gHC_PRIM) {
- mi_exports = ghcPrimExports,
+ mi_exports_arr = ghcPrimExports,
mi_decls = [],
mi_fixities = fixities,
mi_fix_fn = mkIfaceFixCache fixities
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index a12cff2226..72b5e1f2a5 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -115,6 +115,7 @@ import Data.List
import qualified Data.Map as Map
import Data.Ord
import Data.IORef
+import Data.Array
import System.Directory
import System.FilePath
@@ -260,7 +261,9 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_hsc_src = hsc_src,
mi_deps = deps,
mi_usages = usages,
- mi_exports = mkIfaceExports exports,
+ mi_exports_arr = let
+ exports_list = mkIfaceExports exports
+ in listArray (0, length exports_list - 1) exports_list,
-- Sort these lexicographically, so that
-- the result is stable across compilations
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index b7baa57dff..9b2cd42505 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -77,7 +77,7 @@ module HscTypes (
-- * Interfaces
ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
- emptyIfaceWarnCache, mi_boot, mi_fix,
+ emptyIfaceWarnCache, mi_boot, mi_fix, mi_exports,
mi_semantic_module,
mi_free_holes,
renameFreeHoles,
@@ -210,13 +210,14 @@ import qualified GHC.LanguageExtensions as LangExt
import Foreign
import Control.Monad ( guard, liftM, ap )
-import Data.Foldable ( foldl' )
+import Data.Foldable ( foldl', toList )
import Data.IORef
import Data.Time
import Exception
import System.FilePath
import Control.Concurrent
import System.Process ( ProcessHandle )
+import Data.Array
-- -----------------------------------------------------------------------------
-- Compilation state
@@ -877,7 +878,7 @@ data ModIface
-- NOT STRICT! we read this field lazily from the interface file
-- It is *only* consulted by the recompilation checker
- mi_exports :: ![IfaceExport],
+ mi_exports_arr :: !(Array Int IfaceExport),
-- ^ Exports
-- Kept sorted by (mod,occ), to make version comparisons easier
-- Records the modules that are the declaration points for things
@@ -995,6 +996,9 @@ mi_free_holes iface =
where
cands = map fst (dep_mods (mi_deps iface))
+mi_exports :: ModIface -> [IfaceExport]
+mi_exports = toList . mi_exports_arr
+
-- | Given a set of free holes, and a unit identifier, rename
-- the free holes according to the instantiation of the unit
-- identifier. For example, if we have A and B free, and
@@ -1022,7 +1026,7 @@ instance Binary ModIface where
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
- mi_exports = exports,
+ mi_exports_arr = exports,
mi_exp_hash = exp_hash,
mi_used_th = used_th,
mi_fixities = fixities,
@@ -1103,7 +1107,7 @@ instance Binary ModIface where
mi_finsts = hasFamInsts,
mi_deps = deps,
mi_usages = usages,
- mi_exports = exports,
+ mi_exports_arr = exports,
mi_exp_hash = exp_hash,
mi_used_th = used_th,
mi_anns = anns,
@@ -1141,7 +1145,7 @@ emptyModIface mod
mi_hsc_src = HsSrcFile,
mi_deps = noDependencies,
mi_usages = [],
- mi_exports = [],
+ mi_exports_arr = array (0,-1) [],
mi_exp_hash = fingerprint0,
mi_used_th = False,
mi_fixities = [],
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 8d1f140ca2..06b79d0537 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -247,13 +247,13 @@ GHC.Prim "exports" all the primops and primitive types, some
wired-in Ids.
-}
-ghcPrimExports :: [IfaceExport]
-ghcPrimExports
- = map (avail . idName) ghcPrimIds ++
+ghcPrimExports :: Array Int IfaceExport
+ghcPrimExports = let
+ exports_list = map (avail . idName) ghcPrimIds ++
map (avail . idName . primOpId) allThePrimOps ++
[ AvailTC n [n] []
| tc <- funTyCon : primTyCons, let n = tyConName tc ]
-
+ in listArray (0, length exports_list - 1) exports_list
{-
************************************************************************
* *
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index 31055fdb7c..83d7c0a34e 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -66,6 +66,7 @@ import Util
import Control.Monad
import Data.List (find, foldl')
+import Data.Array
import {-# SOURCE #-} TcRnDriver
@@ -362,7 +363,7 @@ tcRnMergeSignatures hsc_env hpm orig_tcg_env iface =
thinModIface :: [AvailInfo] -> ModIface -> ModIface
thinModIface avails iface =
iface {
- mi_exports = avails,
+ mi_exports_arr = listArray (0, length avails - 1) avails,
-- mi_fixities = ...,
-- mi_warns = ...,
-- mi_anns = ...,
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index a7bbfd51ad..9dfe2d7d80 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -73,6 +73,8 @@ import SrcLoc
import Foreign
import Data.Array
+import Data.Array.IO
+import Data.Array.Unsafe
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
@@ -93,6 +95,7 @@ import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO.Error ( mkIOError, eofErrorType )
import GHC.Real ( Ratio(..) )
import GHC.Serialized
+import Data.Foldable
type BinArray = ForeignPtr Word8
@@ -413,6 +416,26 @@ instance Binary a => Binary [a] where
loop n = do a <- get bh; as <- loop (n-1); return (a:as)
loop len
+instance Binary a => Binary (Array Int a) where
+ put_ bh l = do
+ let len = length l
+ if (len < 0xff)
+ then putByte bh (fromIntegral len :: Word8)
+ else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)
+ mapM_ (put_ bh) l
+ get bh = do
+ b <- getByte bh
+ len <- if b == 0xff
+ then get bh
+ else return (fromIntegral b :: Word32)
+ let last_index = fromIntegral len - 1
+ arr <- newIOArray_ (0, last_index)
+ when (len > 0) $ for_ [0..last_index] $
+ \i -> get bh >>= writeArray arr i
+ unsafeFreeze arr
+ where
+ newIOArray_ = newArray_ :: (Int, Int) -> IO (IOArray Int a)
+
instance (Binary a, Binary b) => Binary (a,b) where
put_ bh (a,b) = do put_ bh a; put_ bh b
get bh = do a <- get bh
View Lorry Controller Status