diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/basicTypes/Unique.hs | 10 | ||||
-rw-r--r-- | compiler/iface/BinIface.hs | 4 | ||||
-rw-r--r-- | compiler/prelude/PrelInfo.hs | 5 |
3 files changed, 18 insertions, 1 deletions
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index a6ac670407..f93a4b1bab 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -36,6 +36,7 @@ module Unique ( newTagUnique, -- Used in CgCase initTyVarUnique, nonDetCmpUnique, + isValidKnownKeyUnique, -- Used in PrelInfo.knownKeyNamesOkay -- ** Making built-in uniques @@ -157,6 +158,15 @@ unpkUnique (MkUnique u) in (tag, i) +-- | The interface file symbol-table encoding assumes that known-key uniques fit +-- in 30-bits; verify this. +-- +-- See Note [Symbol table representation of names] in BinIface for details. +isValidKnownKeyUnique :: Unique -> Bool +isValidKnownKeyUnique u = + case unpkUnique u of + (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22) + {- ************************************************************************ * * diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 3de647d415..ad1e8456e8 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -293,7 +293,9 @@ serialiseName bh name _ = do -- 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx -- A normal name. x is an index into the symbol table -- 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy --- A known-key name. x is the Unique's Char, y is the int part +-- A known-key name. x is the Unique's Char, y is the int part. We assume that +-- all known-key uniques fit in this space. This is asserted by +-- PrelInfo.knownKeyNamesOkay. -- -- During serialization we check for known-key things using isKnownKeyName. -- During deserialization we use lookupKnownKeyName to get from the unique back diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs index b9eb9da5ce..471b61ee09 100644 --- a/compiler/prelude/PrelInfo.hs +++ b/compiler/prelude/PrelInfo.hs @@ -46,6 +46,7 @@ module PrelInfo ( #include "HsVersions.h" import KnownUniques +import Unique ( isValidKnownKeyUnique ) import ConLike ( ConLike(..) ) import THNames ( templateHaskellNames ) @@ -158,6 +159,10 @@ knownKeyNames -- | Check the known-key names list of consistency. knownKeyNamesOkay :: [Name] -> Maybe String knownKeyNamesOkay all_names + | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names + = Just $ " Out-of-range known-key uniques: [" + ++ intercalate ", " (map (occNameString . nameOccName) ns) ++ + "]" | null badNamesPairs = Nothing | otherwise |