| ... |
... |
@@ -32,7 +32,9 @@ module GHC.Iface.Binary ( |
|
32
|
32
|
|
|
33
|
33
|
import GHC.Prelude
|
|
34
|
34
|
|
|
35
|
|
-import GHC.Builtin ( knownKeyOccMap, lookupWiredInKnownKeyName )
|
|
|
35
|
+import GHC.Builtin ( knownKeyOccMap, wiredInNamesMap )
|
|
|
36
|
+import GHC.Builtin.Uniques( knownUniqueTupleName )
|
|
|
37
|
+
|
|
36
|
38
|
import GHC.Utils.Panic
|
|
37
|
39
|
import GHC.Utils.Binary as Binary
|
|
38
|
40
|
import GHC.Utils.Outputable
|
| ... |
... |
@@ -41,6 +43,7 @@ import GHC.Types.Name |
|
41
|
43
|
import GHC.Types.Unique
|
|
42
|
44
|
import GHC.Types.SrcLoc
|
|
43
|
45
|
import GHC.Types.Name.Cache
|
|
|
46
|
+import GHC.Types.Unique.FM
|
|
44
|
47
|
|
|
45
|
48
|
import GHC.Unit
|
|
46
|
49
|
import GHC.Unit.Module.ModIface
|
| ... |
... |
@@ -721,25 +724,84 @@ getSymbolTable bh name_cache = do |
|
721
|
724
|
{-
|
|
722
|
725
|
Note [Symbol table representation of names]
|
|
723
|
726
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
724
|
|
-An occurrence of a name in an interface file is serialized as a single 32-bit
|
|
725
|
|
-word. The format of this word is:
|
|
726
|
|
- 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
|
|
727
|
|
- A normal name. x is an index into the symbol table
|
|
728
|
|
- 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
|
|
729
|
|
- A wired-in name. x is the Unique's Char, y is the int part. We assume that
|
|
730
|
|
- all wired-in known-key uniques fit in this space. This is asserted by
|
|
731
|
|
- GHC.Builtin.knownKeyNamesOkay.
|
|
732
|
|
-
|
|
733
|
|
-During serialization we check for tuples or wired-in things with 'lookupWiredInKnownKeyName'.
|
|
734
|
|
-During deserialization we use 'lookupWiredInKnownKeyName' to get from the
|
|
735
|
|
-unique back to its tuple or corresponding Name. We use the same oracle function
|
|
736
|
|
-in both directions to make sure it is symmetric.
|
|
737
|
|
-
|
|
738
|
|
-Tuples are a special case of wired-in names that we can construct from the
|
|
739
|
|
-unique alone (see 'knownUniqueTupleName'). Tuples aren't included in the
|
|
740
|
|
-wired-in names map: see Note [Infinite families of known-key names].
|
|
|
727
|
+For serialisation we divide Names into two classes:
|
|
|
728
|
+ * Compact Names are serialised simply as their unique.
|
|
|
729
|
+ * Non-compact Names are entered into the Symbol Table of the interface file,
|
|
|
730
|
+ and serialised as the index into that table
|
|
|
731
|
+
|
|
|
732
|
+In more detail:
|
|
|
733
|
+* Compact Names comprise
|
|
|
734
|
+ - All WiredIn Names
|
|
|
735
|
+ - All Names related to tuples, whether WiredIn or not. See (ST2) below.
|
|
|
736
|
+
|
|
|
737
|
+* The key property of a compact Name is that GHC can compute the Name from
|
|
|
738
|
+ its Unique, via `lookupCompactName`:
|
|
|
739
|
+ - For most wired-in names, we look up in the `wiredInNameMap`.
|
|
|
740
|
+ - For names related to tuples, we use `knownUniqueTupleName`
|
|
|
741
|
+ Tuples aren't included in the wired-in names map: see (ST1) below
|
|
|
742
|
+
|
|
|
743
|
+* Serialisation is done by `putName`:
|
|
|
744
|
+ - When we serialise a compact Name,
|
|
|
745
|
+ we serialise it as a single 32-bit word:
|
|
|
746
|
+ 10xxxxxx xxyyyyyy yyyyyyyy yyyyyyyy
|
|
|
747
|
+ where xxxx is the tag, and yyyy is the payload.
|
|
|
748
|
+ The function `wiredInNamesOkay` checks that the wired-in names all have
|
|
|
749
|
+ uniques that fit into the `yyy` field.
|
|
|
750
|
+
|
|
|
751
|
+ - When we serialise a non-compact name:
|
|
|
752
|
+ - We look it up in the (stateful, growing) symbol table
|
|
|
753
|
+ - If it not there we add it to the symbol table
|
|
|
754
|
+ - We serialise the occurrenc to a single 32-bit word:
|
|
|
755
|
+ 00xxxxxx xxxxxxxx xxxxxxxx xxxxxxxx
|
|
|
756
|
+ where `xxxxx` is an index into the symbol table.
|
|
|
757
|
+
|
|
|
758
|
+* Deserialision is done by `getName`. We read a 32-bit word
|
|
|
759
|
+ - If the MSB is `10` it must be a compact name, so we use
|
|
|
760
|
+ `lookupCompactName` to get from the Unique to the Name.
|
|
|
761
|
+ - If the MSB is `00` it must be a non-compact Name,
|
|
|
762
|
+ so we look it up in the symbol table.
|
|
|
763
|
+
|
|
|
764
|
+Wrinkles:
|
|
|
765
|
+
|
|
|
766
|
+(ST1) There are many, many tuple types and constructors, so we don't put
|
|
|
767
|
+ them in the wiredInNameMap. Instead we put them in a distinct part of the
|
|
|
768
|
+ Unique namespace, and provide
|
|
|
769
|
+ knownUniqueTupleName :: Unique -> Maybe Name
|
|
|
770
|
+ to identify such a Unique and map it to the corresponding Name.
|
|
|
771
|
+ See Note [Infinite families of known-key names].
|
|
|
772
|
+
|
|
|
773
|
+(ST2) A wired-in data constructor, like (#,#) has a related, also wired-in
|
|
|
774
|
+ (promoted) type constructor; see `mkPromotedDataCon`. That type constructor
|
|
|
775
|
+ in turn contains its `TyConRepName` (e.g. $tc'(#,#)) to support Typeable.
|
|
|
776
|
+
|
|
|
777
|
+ That `TyConRepName` is built by `mkPrelTyConRepName`, but it is /not/
|
|
|
778
|
+ wired-in. Why not? Because its definition involves fingerprints etc. (Maybe
|
|
|
779
|
+ it could be made wired-in, but it would tricky, and there is no point.)
|
|
|
780
|
+
|
|
|
781
|
+ Nevertheless, although it is not wired-in, it is /compact/; that is, we can
|
|
|
782
|
+ serialise and de-serialise it using the mechanisms above.
|
|
|
783
|
+
|
|
|
784
|
+ This idea is, however, entirely optional. You could delete the line in
|
|
|
785
|
+ `isCompactName` that tests for `knownUniqueTupleName` and then the
|
|
|
786
|
+ TyConRepNames would be serialised as non-compact names, and everything would
|
|
|
787
|
+ work. Fewer tests, but Typeable-heavy code might have bigger interface files.
|
|
741
|
788
|
-}
|
|
742
|
789
|
|
|
|
790
|
+isCompactName :: Name -> Bool
|
|
|
791
|
+-- See Note [Symbol table representation of names]
|
|
|
792
|
+isCompactName n
|
|
|
793
|
+ | isWiredInName n = True -- This will catch tuples too!
|
|
|
794
|
+ | isJust (knownUniqueTupleName (nameUnique n)) = True -- Optional: see wrinkle (ST2)
|
|
|
795
|
+ | otherwise = False
|
|
|
796
|
+
|
|
|
797
|
+lookupCompactName :: Unique -> Name
|
|
|
798
|
+-- See Note [Symbol table representation of names]
|
|
|
799
|
+lookupCompactName u
|
|
|
800
|
+ | Just n <- knownUniqueTupleName u = n -- See wrinkle (ST1)
|
|
|
801
|
+ | Just n <- lookupUFM_Directly wiredInNamesMap u = n
|
|
|
802
|
+ | otherwise = pprPanic "lookupCompactName" (ppr u $$ char tag $$ ppr ix)
|
|
|
803
|
+ where
|
|
|
804
|
+ (tag, ix) = unpkUniqueGrimily u
|
|
743
|
805
|
|
|
744
|
806
|
-- See Note [Symbol table representation of names]
|
|
745
|
807
|
putName :: BinSymbolTable -> WriteBinHandle -> Name -> IO ()
|
| ... |
... |
@@ -747,7 +809,7 @@ putName BinSymbolTable{ |
|
747
|
809
|
bin_symtab_map = symtab_map_ref,
|
|
748
|
810
|
bin_symtab_next = symtab_next }
|
|
749
|
811
|
bh name
|
|
750
|
|
- | Just _ <- lookupWiredInKnownKeyName (nameUnique name)
|
|
|
812
|
+ | isCompactName name
|
|
751
|
813
|
, let (c, u) = unpkUniqueGrimily (nameUnique name) -- INVARIANT: (ord c) fits in 8 bits
|
|
752
|
814
|
= -- assert (u < 2^(22 :: Int))
|
|
753
|
815
|
put_ bh (0x80000000
|
| ... |
... |
@@ -783,16 +845,10 @@ getSymtabName symtab bh = do |
|
783
|
845
|
i :: Word32 <- get bh
|
|
784
|
846
|
case i .&. 0xC0000000 of
|
|
785
|
847
|
0x00000000 -> return $! symtab ! fromIntegral i
|
|
786
|
|
-
|
|
787
|
|
- 0x80000000 ->
|
|
788
|
|
- let
|
|
|
848
|
+ 0x80000000 -> return $! lookupCompactName u
|
|
|
849
|
+ where
|
|
789
|
850
|
tag = chr (fromIntegral ((i .&. 0x3FC00000) `shiftR` 22))
|
|
790
|
851
|
ix = fromIntegral i .&. 0x003FFFFF
|
|
791
|
852
|
u = mkUniqueGrimilyWithTag tag ix
|
|
792
|
|
- in
|
|
793
|
|
- return $! case lookupWiredInKnownKeyName u of
|
|
794
|
|
- Nothing -> pprPanic "getSymtabName:unknown known-key unique"
|
|
795
|
|
- (ppr i $$ ppr u $$ char tag $$ ppr ix)
|
|
796
|
|
- Just n -> n
|
|
797
|
853
|
|
|
798
|
854
|
_ -> pprPanic "getSymtabName:unknown name tag" (ppr i) |