[Git][ghc/ghc][wip/js-staging] Use FastMutInt in G for uniques

[Sylvain Henry (@hsyl20)]

Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC


Commits:
1e139730 by Sylvain Henry at 2022-10-14T12:18:54+02:00
Use FastMutInt in G for uniques

- - - - -


3 changed files:

- compiler/GHC/StgToJS/Ids.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/StgToJS/Types.hs


Changes:

=====================================
compiler/GHC/StgToJS/Ids.hs
=====================================
@@ -53,8 +53,10 @@ import GHC.Types.Name
 import GHC.Unit.Module
 import GHC.Utils.Encoding (zEncodeString)
 import GHC.Data.FastString
+import GHC.Data.FastMutInt
 
 import Control.Monad
+import Control.Monad.IO.Class
 import qualified Control.Monad.Trans.State.Strict as State
 import qualified Data.Map  as M
 import Data.Maybe
@@ -62,8 +64,12 @@ import Data.Maybe
 -- | Get fresh unique number
 freshUnique :: G Int
 freshUnique = do
-  State.modify (\s -> s { gsId = gsId s + 1})
-  State.gets gsId
+  id_gen <- State.gets gsId
+  liftIO $ do
+    -- no need for atomicFetchAdd as we don't use threads in G
+    v <- readFastMutInt id_gen
+    writeFastMutInt id_gen (v+1)
+    pure v
 
 -- | Get fresh local Ident of the form: h$$unit:module_uniq
 freshIdent :: G Ident


=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Types.ForeignCall
 
 import qualified Control.Monad.Trans.State.Strict as State
 import GHC.Data.FastString
+import GHC.Data.FastMutInt
 
 import qualified Data.Map  as M
 import qualified Data.Set  as S
@@ -48,18 +49,20 @@ import Data.Function
 import GHC.Types.Unique.DSet
 
 runG :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a
-runG config m unfloat action = State.evalStateT action (initState config m unfloat)
-
-initState :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> GenState
-initState config m unfloat = GenState
-  { gsSettings  = config
-  , gsModule    = m
-  , gsId        = 1
-  , gsIdents    = emptyIdCache
-  , gsUnfloated = unfloat
-  , gsGroup     = defaultGenGroupState
-  , gsGlobal    = []
-  }
+runG config m unfloat action = State.evalStateT action =<< initState config m unfloat
+
+initState :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> IO GenState
+initState config m unfloat = do
+  id_gen <- newFastMutInt 1
+  pure $ GenState
+    { gsSettings  = config
+    , gsModule    = m
+    , gsId        = id_gen
+    , gsIdents    = emptyIdCache
+    , gsUnfloated = unfloat
+    , gsGroup     = defaultGenGroupState
+    , gsGlobal    = []
+    }
 
 
 modifyGroup :: (GenGroupState -> GenGroupState) -> G ()


=====================================
compiler/GHC/StgToJS/Types.hs
=====================================
@@ -39,6 +39,7 @@ import Control.Monad.Trans.State.Strict
 import GHC.Utils.Outputable (Outputable (..), text, SDocContext, (<+>), ($$))
 
 import GHC.Data.FastString
+import GHC.Data.FastMutInt
 
 import GHC.Unit.Module
 
@@ -55,9 +56,9 @@ type G = StateT GenState IO
 
 -- | The JS code generator state
 data GenState = GenState
-  { gsSettings  :: StgToJSConfig          -- ^ codegen settings, read-only
+  { gsSettings  :: !StgToJSConfig         -- ^ codegen settings, read-only
   , gsModule    :: !Module                -- ^ current module
-  , gsId        :: !Int                   -- ^ unique number for the id generator
+  , gsId        :: {-# UNPACK #-} !FastMutInt -- ^ unique number for the id generator
   , gsIdents    :: !IdCache               -- ^ hash consing for identifiers from a Unique
   , gsUnfloated :: !(UniqFM Id CgStgExpr) -- ^ unfloated arguments
   , gsGroup     :: GenGroupState          -- ^ state for the current binding group
@@ -159,7 +160,6 @@ instance ToJExpr CIStatic where
 data VarType
   = PtrV     -- ^ pointer = reference to heap object (closure object)
   | VoidV    -- ^ no fields
-  -- | FloatV   -- one field -- no single precision supported
   | DoubleV  -- ^ A Double: one field
   | IntV     -- ^ An Int (32bit because JS): one field
   | LongV    -- ^ A Long: two fields one for the upper 32bits, one for the lower (NB: JS is little endian)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e13973052f5772badafbf7624b345a1a5acb966
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/20221014/2eee6fd7/attachment-0001.html>