[Git][ghc/ghc][wip/T23479] Use name defined at `GHC.Builtin.Names`

[Serge S. Gulin (@gulin.serge)]

Serge S. Gulin pushed to branch wip/T23479 at Glasgow Haskell Compiler / GHC


Commits:
f77bdc66 by Serge S. Gulin at 2024-08-26T15:48:25+03:00
Use name defined at `GHC.Builtin.Names`

- - - - -


2 changed files:

- compiler/GHC/Builtin/Names.hs
- compiler/GHC/StgToJS/Apply.hs


Changes:

=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -592,7 +592,8 @@ gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM,
     gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS, gHC_INTERNAL_IS_LIST,
     gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL,
     gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL,
-    gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR :: Module
+    gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR,
+    gHC_INTERNAL_JS_PRIM :: Module
 gHC_INTERNAL_BASE                   = mkGhcInternalModule (fsLit "GHC.Internal.Base")
 gHC_INTERNAL_ENUM                   = mkGhcInternalModule (fsLit "GHC.Internal.Enum")
 gHC_INTERNAL_GHCI                   = mkGhcInternalModule (fsLit "GHC.Internal.GHCi")
@@ -635,7 +636,7 @@ gHC_INTERNAL_RANDOM                 = mkGhcInternalModule (fsLit "GHC.Internal.S
 gHC_INTERNAL_EXTS                   = mkGhcInternalModule (fsLit "GHC.Internal.Exts")
 gHC_INTERNAL_IS_LIST                = mkGhcInternalModule (fsLit "GHC.Internal.IsList")
 gHC_INTERNAL_CONTROL_EXCEPTION_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Control.Exception.Base")
-gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context")
+gHC_INTERNAL_EXCEPTION_CONTEXT      = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context")
 gHC_INTERNAL_GENERICS               = mkGhcInternalModule (fsLit "GHC.Internal.Generics")
 gHC_INTERNAL_TYPEERROR              = mkGhcInternalModule (fsLit "GHC.Internal.TypeError")
 gHC_INTERNAL_TYPELITS               = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits")
@@ -646,6 +647,8 @@ gHC_INTERNAL_DATA_COERCE            = mkGhcInternalModule (fsLit "GHC.Internal.D
 gHC_INTERNAL_DEBUG_TRACE            = mkGhcInternalModule (fsLit "GHC.Internal.Debug.Trace")
 gHC_INTERNAL_UNSAFE_COERCE          = mkGhcInternalModule (fsLit "GHC.Internal.Unsafe.Coerce")
 gHC_INTERNAL_FOREIGN_C_CONSTPTR     = mkGhcInternalModule (fsLit "GHC.Internal.Foreign.C.ConstPtr")
+gHC_INTERNAL_JS_PRIM                = mkGhcInternalModule (fsLit "GHC.Internal.JS.Prim")
+gHC_INTERNAL_WASM_PRIM_TYPES        = mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")
 
 gHC_INTERNAL_SRCLOC :: Module
 gHC_INTERNAL_SRCLOC = mkGhcInternalModule (fsLit "GHC.Internal.SrcLoc")
@@ -1679,7 +1682,10 @@ constPtrConName =
     tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey
 
 jsvalTyConName :: Name
-jsvalTyConName = tcQual (mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")) (fsLit "JSVal") jsvalTyConKey
+jsvalTyConName = tcQual gHC_INTERNAL_WASM_PRIM_TYPES (fsLit "JSVal") jsvalTyConKey
+
+unsafeUnpackJSStringUtf8ShShName :: Name
+unsafeUnpackJSStringUtf8ShShName = tcQual gHC_INTERNAL_JS_PRIM (fsLit "unsafeUnpackJSStringUtf8##") unsafeUnpackJSStringUtf8ShShKey
 
 {-
 ************************************************************************
@@ -2082,6 +2088,7 @@ typeSymbolKindConNameKey, typeCharKindConNameKey,
   , typeNatLogTyFamNameKey
   , typeConsSymbolTyFamNameKey, typeUnconsSymbolTyFamNameKey
   , typeCharToNatTyFamNameKey, typeNatToCharTyFamNameKey
+  , exceptionContextTyConKey, unsafeUnpackJSStringUtf8ShShKey
   :: Unique
 typeSymbolKindConNameKey  = mkPreludeTyConUnique 400
 typeCharKindConNameKey    = mkPreludeTyConUnique 401
@@ -2104,9 +2111,10 @@ constPtrTyConKey = mkPreludeTyConUnique 417
 
 jsvalTyConKey = mkPreludeTyConUnique 418
 
-exceptionContextTyConKey :: Unique
 exceptionContextTyConKey = mkPreludeTyConUnique 420
 
+unsafeUnpackJSStringUtf8ShShKey  = mkPreludeTyConUnique 421
+
 {-
 ************************************************************************
 *                                                                      *


=====================================
compiler/GHC/StgToJS/Apply.hs
=====================================
@@ -52,7 +52,6 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.CostCentre
 import GHC.Types.RepType (mightBeFunTy)
-import GHC.Types.Name (nameModule_maybe, OccName (occNameFS), nameOccName)
 
 import GHC.Stg.Syntax
 
@@ -62,8 +61,6 @@ import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.Type hiding (typeSize)
 
-import GHC.Unit.Module (moduleNameFS, GenModule (moduleName), unitIdString, moduleUnitId)
-
 import GHC.Utils.Misc
 import GHC.Utils.Monad
 import GHC.Utils.Panic
@@ -73,7 +70,6 @@ import GHC.Data.FastString
 import qualified Data.Bits as Bits
 import Data.Monoid
 import Data.Array
-import Data.List (isPrefixOf)
 
 -- | Pre-generated functions for fast Apply.
 -- These are bundled with the RTS.
@@ -91,14 +87,6 @@ rtsApply cfg = jBlock
      , moveRegs2
      ]
 
-matchVarName :: String -> FastString -> FastString -> Id -> Bool
-matchVarName pkg modu occ (idName -> n)
-  | Just m <- nameModule_maybe n =
-    occ  == occNameFS (nameOccName n) &&
-    modu == moduleNameFS (moduleName m) &&
-    pkg `isPrefixOf` unitIdString (moduleUnitId m)
-  | otherwise = False
-
 -- | Generate an application of some args to an Id.
 --
 -- The case where args is null is common as it's used to generate the evaluation
@@ -120,7 +108,7 @@ genApp ctx i args
     -- We detect if the Id is unsafeUnpackJSStringUtf8## applied to a string literal,
     -- if so then we convert the unsafeUnpack to a call to h$decode.
     | [StgVarArg v] <- args
-    , matchVarName "ghc-internal" "GHC.Internal.JS.Prim" "unsafeUnpackJSStringUtf8##" i
+    , idName i == unsafeUnpackJSStringUtf8ShShName
     -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588
     -- Comment by Josh Meredith  <josh.meredith at iohk.io>
     -- `typex_expr` can throw an error for certain bindings so it's important



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f77bdc667683da5e7eda7d6685b789da7fe40136

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f77bdc667683da5e7eda7d6685b789da7fe40136
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240826/d982a0d9/attachment-0001.html>