[Git][ghc/ghc][wip/jsSaturate] JS: refactor jsSaturate to return a saturated IR (#23328)

Josh Meredith (@JoshMeredith) gitlab at gitlab.haskell.org
Mon May 1 06:50:24 UTC 2023



Josh Meredith pushed to branch wip/jsSaturate at Glasgow Haskell Compiler / GHC


Commits:
56208ad0 by Josh Meredith at 2023-05-01T06:49:56+00:00
JS: refactor jsSaturate to return a saturated IR (#23328)

- - - - -


6 changed files:

- compiler/GHC/JS/Transform.hs
- compiler/GHC/StgToJS/CodeGen.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/StgToJS/Monad.hs
- compiler/GHC/StgToJS/Rts/Rts.hs


Changes:

=====================================
compiler/GHC/JS/Transform.hs
=====================================
@@ -22,7 +22,6 @@ module GHC.JS.Transform
   , composOpM_
   , composOpFold
   , satJExpr
-  , satJStat
   )
 where
 
@@ -200,8 +199,8 @@ jmcompos ret app f' v =
 
 -- | Given an optional prefix, fills in all free variable names with a supply
 -- of names generated by the prefix.
-jsSaturate :: (JMacro a) => Maybe FastString -> a -> a
-jsSaturate str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str)
+jsSaturate' :: (JMacro a) => Maybe FastString -> a -> a
+jsSaturate' str x = evalState (runIdentSupply $ jsSaturate_ x) (newIdentSupply str)
 
 jsSaturate_ :: (JMacro a) => a -> IdentSupply a
 jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
@@ -219,9 +218,9 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
 --
 -- This will be moved after GHC.JS.Syntax is removed
 --------------------------------------------------------------------------------
-satJStat :: JStat -> Sat.JStat
-satJStat = witness . proof
-  where proof = jsSaturate Nothing
+jsSaturate :: Maybe FastString -> JStat -> Sat.JStat
+jsSaturate str = witness . proof str
+  where proof = jsSaturate'
 
         -- This is an Applicative but we can't use it because no type variables :(
         witness :: JStat -> Sat.JStat
@@ -315,5 +314,5 @@ satJVal = go
     go (JStr f)    = Sat.JStr   f
     go (JRegEx f)  = Sat.JRegEx f
     go (JHash m)   = Sat.JHash (satJExpr <$> m)
-    go (JFunc args body) = Sat.JFunc args (satJStat body)
+    go (JFunc args body) = Sat.JFunc args (jsSaturate Nothing body)
     go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly"


=====================================
compiler/GHC/StgToJS/CodeGen.hs
=====================================
@@ -134,7 +134,6 @@ genUnits m ss spt_entries foreign_stubs = do
         staticInit <-
           initStaticPtrs spt_entries
         let stat = ( -- O.optimize .
-                     satJStat .
                      jsSaturate (Just $ modulePrefix m 1)
                    $ mconcat (reverse glbl) <> staticInit)
         let syms = [moduleGlobalSymbol m]
@@ -208,7 +207,7 @@ genUnits m ss spt_entries foreign_stubs = do
               _extraTl   <- State.gets (ggsToplevelStats . gsGroup)
               si        <- State.gets (ggsStatic . gsGroup)
               let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2
-              let stat =  satJStat $ jsSaturate (Just $ modulePrefix m n) body
+              let stat = jsSaturate (Just $ modulePrefix m n) body
               let ids = [bnd]
               syms <- (\(TxtI i) -> [i]) <$> identForId bnd
               let oi = ObjUnit
@@ -246,7 +245,6 @@ genUnits m ss spt_entries foreign_stubs = do
               topDeps  = collectTopIds decl
               required = hasExport decl
               stat     = -- Opt.optimize .
-                         satJStat .
                          jsSaturate (Just $ modulePrefix m n)
                        $ mconcat (reverse extraTl) <> tl
           syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps


=====================================
compiler/GHC/StgToJS/FFI.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Prelude
 import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
+import qualified GHC.JS.Syntax as Sat
 
 import GHC.StgToJS.Arg
 import GHC.StgToJS.ExprCtx
@@ -176,7 +177,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i)
      arg_ty = stgArgType a
      r      = uTypeVt arg_ty
 
-saturateFFI :: JMacro a => Int -> a -> a
+saturateFFI :: Int -> JStat -> Sat.JStat
 saturateFFI u = jsSaturate (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u)
 
 genForeignCall :: HasDebugCallStack


=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -332,7 +332,7 @@ renderLinker h mods jsFiles = do
     pure (mod_mod, mod_size)
 
   -- commoned up metadata
-  !meta_length <- fromIntegral <$> putJS (satJStat meta)
+  !meta_length <- fromIntegral <$> putJS (jsSaturate Nothing meta)
 
   -- module exports
   mapM_ (putBS . cmc_exports) compacted_mods


=====================================
compiler/GHC/StgToJS/Monad.hs
=====================================
@@ -25,6 +25,7 @@ where
 import GHC.Prelude
 
 import GHC.JS.Unsat.Syntax
+import qualified GHC.JS.Syntax as Sat
 import GHC.JS.Transform
 
 import GHC.StgToJS.Types
@@ -160,7 +161,7 @@ data GlobalOcc = GlobalOcc
 
 -- | Return number of occurrences of every global id used in the given JStat.
 -- Sort by increasing occurrence count.
-globalOccs :: JStat -> G [GlobalOcc]
+globalOccs :: Sat.JStat -> G [GlobalOcc]
 globalOccs jst = do
   GlobalIdCache gidc <- getGlobalIdCache
   -- build a map form Ident Unique to (Ident, Id, Count)


=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -30,6 +30,7 @@ import GHC.Prelude
 import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
+import qualified GHC.JS.Syntax as Sat
 
 import GHC.StgToJS.Apply
 import GHC.StgToJS.Closure
@@ -298,7 +299,7 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo
     ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct)))
 
 -- | JS payload declaring the RTS functions.
-rtsDecls :: JStat
+rtsDecls :: Sat.JStat
 rtsDecls = jsSaturate (Just "h$RTSD") $
   mconcat [ TxtI "h$currentThread"   ||= null_                   -- thread state object for current thread
           , TxtI "h$stack"           ||= null_                   -- stack for the current thread
@@ -314,14 +315,14 @@ rtsDecls = jsSaturate (Just "h$RTSD") $
 
 -- | print the embedded RTS to a String
 rtsText :: StgToJSConfig -> String
-rtsText = show . pretty . satJStat . rts
+rtsText = show . pretty . rts
 
 -- | print the RTS declarations to a String.
 rtsDeclsText :: String
-rtsDeclsText = show . pretty . satJStat $ rtsDecls
+rtsDeclsText = show . pretty $ rtsDecls
 
 -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform'
-rts :: StgToJSConfig -> JStat
+rts :: StgToJSConfig -> Sat.JStat
 rts = jsSaturate (Just "h$RTS") . rts'
 
 -- | JS Payload which defines the embedded RTS.



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56208ad05b5fe4d26821652bf3564fdb51307b39
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/20230501/f56a8fc7/attachment-0001.html>


More information about the ghc-commits mailing list