Simon Hengel pushed to branch wip/sol/hie-wierd-in-as-external at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • compiler/GHC/Iface/Ext/Binary.hs
    ... ... @@ -17,7 +17,6 @@ where
    17 17
     
    
    18 18
     import GHC.Prelude
    
    19 19
     
    
    20
    -import GHC.Builtin.Utils
    
    21 20
     import GHC.Settings.Utils         ( maybeRead )
    
    22 21
     import GHC.Settings.Config        ( cProjectVersion )
    
    23 22
     import GHC.Utils.Binary
    
    ... ... @@ -28,10 +27,8 @@ import GHC.Iface.Binary ( putAllTables )
    28 27
     import GHC.Types.Name
    
    29 28
     import GHC.Types.Name.Cache
    
    30 29
     import GHC.Types.SrcLoc as SrcLoc
    
    31
    -import GHC.Types.Unique
    
    32 30
     import GHC.Types.Unique.FM
    
    33 31
     import qualified GHC.Utils.Binary as Binary
    
    34
    -import GHC.Utils.Outputable
    
    35 32
     import GHC.Utils.Panic
    
    36 33
     
    
    37 34
     import qualified Data.Array        as A
    
    ... ... @@ -290,6 +287,9 @@ fromHieName nc hie_name = do
    290 287
       case hie_name of
    
    291 288
         ExternalName mod occ span -> updateNameCache nc mod occ $ \cache -> do
    
    292 289
           case lookupOrigNameCache cache mod occ of
    
    290
    +        -- Note that this may be a wired-in name (provided that the NameCache
    
    291
    +        -- was initialized with known-key names, which is always the case if you
    
    292
    +        -- use `newNameCache`).
    
    293 293
             Just name -> pure (cache, name)
    
    294 294
             Nothing   -> do
    
    295 295
               uniq <- takeUniqFromNameCache nc
    
    ... ... @@ -302,11 +302,6 @@ fromHieName nc hie_name = do
    302 302
           -- don't update the NameCache for local names
    
    303 303
           pure $ mkInternalName uniq occ span
    
    304 304
     
    
    305
    -    KnownKeyName u -> case lookupKnownKeyName u of
    
    306
    -      Nothing -> pprPanic "fromHieName:unknown known-key unique"
    
    307
    -                          (ppr u)
    
    308
    -      Just n -> pure n
    
    309
    -
    
    310 305
     -- ** Reading and writing `HieName`'s
    
    311 306
     
    
    312 307
     putHieName :: WriteBinHandle -> HieName -> IO ()
    
    ... ... @@ -316,9 +311,6 @@ putHieName bh (ExternalName mod occ span) = do
    316 311
     putHieName bh (LocalName occName span) = do
    
    317 312
       putByte bh 1
    
    318 313
       put_ bh (occName, BinSrcSpan span)
    
    319
    -putHieName bh (KnownKeyName uniq) = do
    
    320
    -  putByte bh 2
    
    321
    -  put_ bh $ unpkUnique uniq
    
    322 314
     
    
    323 315
     getHieName :: ReadBinHandle -> IO HieName
    
    324 316
     getHieName bh = do
    
    ... ... @@ -330,7 +322,4 @@ getHieName bh = do
    330 322
         1 -> do
    
    331 323
           (occ, span) <- get bh
    
    332 324
           return $ LocalName occ $ unBinSrcSpan span
    
    333
    -    2 -> do
    
    334
    -      (c,i) <- get bh
    
    335
    -      return $ KnownKeyName $ mkUnique c i
    
    336 325
         _ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag"

  • compiler/GHC/Iface/Ext/Types.hs
    ... ... @@ -19,14 +19,12 @@ import GHC.Prelude
    19 19
     import GHC.Settings.Config
    
    20 20
     import GHC.Utils.Binary
    
    21 21
     import GHC.Data.FastString
    
    22
    -import GHC.Builtin.Utils
    
    23 22
     import GHC.Iface.Type
    
    24 23
     import GHC.Unit.Module            ( ModuleName, Module )
    
    25 24
     import GHC.Types.Name
    
    26 25
     import GHC.Utils.Outputable hiding ( (<>) )
    
    27 26
     import GHC.Types.SrcLoc
    
    28 27
     import GHC.Types.Avail
    
    29
    -import GHC.Types.Unique
    
    30 28
     import qualified GHC.Utils.Outputable as O ( (<>) )
    
    31 29
     import GHC.Utils.Panic
    
    32 30
     import GHC.Core.ConLike           ( ConLike(..) )
    
    ... ... @@ -766,7 +764,6 @@ instance Binary TyVarScope where
    766 764
     data HieName
    
    767 765
       = ExternalName !Module !OccName !SrcSpan
    
    768 766
       | LocalName !OccName !SrcSpan
    
    769
    -  | KnownKeyName !Unique
    
    770 767
       deriving (Eq)
    
    771 768
     
    
    772 769
     instance Ord HieName where
    
    ... ... @@ -774,34 +771,28 @@ instance Ord HieName where
    774 771
         -- TODO (int-index): Perhaps use RealSrcSpan in HieName?
    
    775 772
       compare (LocalName a b) (LocalName c d) = compare a c S.<> leftmost_smallest b d
    
    776 773
         -- TODO (int-index): Perhaps use RealSrcSpan in HieName?
    
    777
    -  compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
    
    778
    -    -- Not actually non deterministic as it is a KnownKey
    
    779 774
       compare ExternalName{} _ = LT
    
    780 775
       compare LocalName{} ExternalName{} = GT
    
    781
    -  compare LocalName{} _ = LT
    
    782
    -  compare KnownKeyName{} _ = GT
    
    783 776
     
    
    784 777
     instance Outputable HieName where
    
    785 778
       ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
    
    786 779
       ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
    
    787
    -  ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
    
    788 780
     
    
    789 781
     hieNameOcc :: HieName -> OccName
    
    790 782
     hieNameOcc (ExternalName _ occ _) = occ
    
    791 783
     hieNameOcc (LocalName occ _) = occ
    
    792
    -hieNameOcc (KnownKeyName u) =
    
    793
    -  case lookupKnownKeyName u of
    
    794
    -    Just n -> nameOccName n
    
    795
    -    Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
    
    796
    -                        (ppr u)
    
    797 784
     
    
    798 785
     toHieName :: Name -> HieName
    
    799
    -toHieName name
    
    800
    -  | isKnownKeyName name = KnownKeyName (nameUnique name)
    
    801
    -  | isExternalName name = ExternalName (nameModule name)
    
    802
    -                                       (nameOccName name)
    
    803
    -                                       (removeBufSpan $ nameSrcSpan name)
    
    804
    -  | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name)
    
    786
    +toHieName name =
    
    787
    +  case nameModule_maybe name of
    
    788
    +    Nothing -> LocalName occName span
    
    789
    +    Just m -> ExternalName m occName span
    
    790
    +  where
    
    791
    +    occName :: OccName
    
    792
    +    occName = nameOccName name
    
    793
    +
    
    794
    +    span :: SrcSpan
    
    795
    +    span = removeBufSpan $ nameSrcSpan name
    
    805 796
     
    
    806 797
     
    
    807 798
     {- Note [Capture Entity Information]
    

  • compiler/GHC/Types/Name/Cache.hs
    ... ... @@ -101,9 +101,14 @@ OrigNameCache at all? Good question; after all,
    101 101
       3) Loading of interface files encodes names via Uniques, as detailed in
    
    102 102
          Note [Symbol table representation of names] in GHC.Iface.Binary
    
    103 103
     
    
    104
    -It turns out that we end up looking up built-in syntax in the cache when we
    
    105
    -generate Haddock documentation. E.g. if we don't find tuple data constructors
    
    106
    -there, hyperlinks won't work as expected. Test case: haddockHtmlTest (Bug923.hs)
    
    104
    +
    
    105
    +However note that:
    
    106
    +  1) It turns out that we end up looking up built-in syntax in the cache when
    
    107
    +     we generate Haddock documentation. E.g. if we don't find tuple data
    
    108
    +     constructors there, hyperlinks won't work as expected. Test case:
    
    109
    +     haddockHtmlTest (Bug923.hs)
    
    110
    +  2) HIE de-serialization relies on wired-in names, including built-in syntax,
    
    111
    +     being present in the OrigNameCache.
    
    107 112
     -}
    
    108 113
     
    
    109 114
     -- | The NameCache makes sure that there is just one Unique assigned for
    

  • utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
    ... ... @@ -229,10 +229,7 @@ writeInterfaceFile filename iface = do
    229 229
       return ()
    
    230 230
     
    
    231 231
     freshNameCache :: IO NameCache
    
    232
    -freshNameCache =
    
    233
    -  initNameCache
    
    234
    -    'a' -- ??
    
    235
    -    []
    
    232
    +freshNameCache = newNameCache
    
    236 233
     
    
    237 234
     -- | Read a Haddock (@.haddock@) interface file. Return either an
    
    238 235
     -- 'InterfaceFile' or an error message.