Verify that known-key uniques fit in interface file

Here we introduce a debug check asserting that all uniques in
knownKeyNames will fit in the space allowed in the interface file's
symbol encoding.

Test Plan: Validate

Reviewers: austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2845

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