[Git][ghc/ghc][master] JS: Linker: use saturated JExpr
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Apr 1 22:28:13 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00
JS: Linker: use saturated JExpr
Follow on to MR!10142 in pursuit of #22736
- - - - -
2 changed files:
- compiler/GHC/JS/Transform.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
Changes:
=====================================
compiler/GHC/JS/Transform.hs
=====================================
@@ -23,7 +23,6 @@ module GHC.JS.Transform
, composOpFold
, satJExpr
, satJStat
- , unsatJStat
)
where
@@ -321,98 +320,3 @@ satJVal = go
go (JHash m) = Sat.JHash (satJExpr <$> m)
go (JFunc args body) = Sat.JFunc args (satJStat body)
go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly"
-
-unsatJStat :: Sat.JStat -> JStat
-unsatJStat = go_back
- where
- -- This is an Applicative but we can't use it because no type variables :(
- go_back :: Sat.JStat -> JStat
- go_back (Sat.DeclStat i rhs) = DeclStat i (fmap unsatJExpr rhs)
- go_back (Sat.ReturnStat e) = ReturnStat (unsatJExpr e)
- go_back (Sat.IfStat c t e) = IfStat (unsatJExpr c) (go_back t) (go_back e)
- go_back (Sat.WhileStat is_do c e) = WhileStat is_do (unsatJExpr c) (go_back e)
- go_back (Sat.ForInStat is_each i iter body) = ForInStat is_each i
- (unsatJExpr iter)
- (go_back body)
- go_back (Sat.SwitchStat struct ps def) = SwitchStat
- (unsatJExpr struct)
- (map (unsatJExpr *** go_back) ps)
- (go_back def)
- go_back (Sat.TryStat t i c f) = TryStat (go_back t) i (go_back c) (go_back f)
- go_back (Sat.BlockStat bs) = BlockStat $! fmap go_back bs
- go_back (Sat.ApplStat rator rand) = ApplStat (unsatJExpr rator) (unsatJExpr <$> rand)
- go_back (Sat.UOpStat rator rand) = UOpStat (unsatJUOp rator) (unsatJExpr rand)
- go_back (Sat.AssignStat lhs rhs) = AssignStat (unsatJExpr lhs) (unsatJExpr rhs)
- go_back (Sat.LabelStat lbl stmt) = LabelStat lbl (go_back stmt)
- go_back (Sat.BreakStat Nothing) = BreakStat Nothing
- go_back (Sat.BreakStat (Just l)) = BreakStat $! Just l
- go_back (Sat.ContinueStat Nothing) = ContinueStat Nothing
- go_back (Sat.ContinueStat (Just l)) = ContinueStat $! Just l
-
-
-unsatJExpr :: Sat.JExpr -> JExpr
-unsatJExpr = go
- where
- go (Sat.ValExpr v) = ValExpr (unsatJVal v)
- go (Sat.SelExpr obj i) = SelExpr (unsatJExpr obj) i
- go (Sat.IdxExpr o i) = IdxExpr (unsatJExpr o) (unsatJExpr i)
- go (Sat.InfixExpr op l r) = InfixExpr (satOpToJOp op) (unsatJExpr l) (unsatJExpr r)
- go (Sat.UOpExpr op r) = UOpExpr (unsatJUOp op) (unsatJExpr r)
- go (Sat.IfExpr c t e) = IfExpr (unsatJExpr c) (unsatJExpr t) (unsatJExpr e)
- go (Sat.ApplExpr rator rands) = ApplExpr (unsatJExpr rator) (unsatJExpr <$> rands)
-
-satOpToJOp :: Sat.Op -> JOp
-satOpToJOp = go
- where
- go Sat.EqOp = EqOp
- go Sat.StrictEqOp = StrictEqOp
- go Sat.NeqOp = NeqOp
- go Sat.StrictNeqOp = StrictNeqOp
- go Sat.GtOp = GtOp
- go Sat.GeOp = GeOp
- go Sat.LtOp = LtOp
- go Sat.LeOp = LeOp
- go Sat.AddOp = AddOp
- go Sat.SubOp = SubOp
- go Sat.MulOp = MulOp
- go Sat.DivOp = DivOp
- go Sat.ModOp = ModOp
- go Sat.LeftShiftOp = LeftShiftOp
- go Sat.RightShiftOp = RightShiftOp
- go Sat.ZRightShiftOp = ZRightShiftOp
- go Sat.BAndOp = BAndOp
- go Sat.BOrOp = BOrOp
- go Sat.BXorOp = BXorOp
- go Sat.LAndOp = LAndOp
- go Sat.LOrOp = LOrOp
- go Sat.InstanceofOp = InstanceofOp
- go Sat.InOp = InOp
-
-unsatJUOp :: Sat.UOp -> JUOp
-unsatJUOp = go
- where
- go Sat.NotOp = NotOp
- go Sat.BNotOp = BNotOp
- go Sat.NegOp = NegOp
- go Sat.PlusOp = PlusOp
- go Sat.NewOp = NewOp
- go Sat.TypeofOp = TypeofOp
- go Sat.DeleteOp = DeleteOp
- go Sat.YieldOp = YieldOp
- go Sat.VoidOp = VoidOp
- go Sat.PreIncOp = PreIncOp
- go Sat.PostIncOp = PostIncOp
- go Sat.PreDecOp = PreDecOp
- go Sat.PostDecOp = PostDecOp
-
-unsatJVal :: Sat.JVal -> JVal
-unsatJVal = go
- where
- go (Sat.JVar i) = JVar i
- go (Sat.JList xs) = JList (unsatJExpr <$> xs)
- go (Sat.JDouble d) = JDouble (SaneDouble (Sat.unSaneDouble d))
- go (Sat.JInt i) = JInt i
- go (Sat.JStr f) = JStr f
- go (Sat.JRegEx f) = JRegEx f
- go (Sat.JHash m) = JHash (unsatJExpr <$> m)
- go (Sat.JFunc args body) = JFunc args (unsatJStat body)
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -31,6 +31,7 @@ import GHC.Platform.Host (hostPlatformArchOS)
import GHC.JS.Make
import GHC.JS.Unsat.Syntax
+import qualified GHC.JS.Syntax as Sat
import GHC.JS.Transform
import GHC.Driver.Session (DynFlags(..))
@@ -280,7 +281,7 @@ computeLinkDependencies cfg logger target unit_env units objFiles extraStaticDep
-- | Compiled module
data ModuleCode = ModuleCode
{ mc_module :: !Module
- , mc_js_code :: !JStat
+ , mc_js_code :: !Sat.JStat
, mc_exports :: !B.ByteString -- ^ rendered exports
, mc_closures :: ![ClosureInfo]
, mc_statics :: ![StaticInfo]
@@ -293,7 +294,7 @@ data ModuleCode = ModuleCode
-- up into global "metadata" for the whole link.
data CompactedModuleCode = CompactedModuleCode
{ cmc_module :: !Module
- , cmc_js_code :: !JStat
+ , cmc_js_code :: !Sat.JStat
, cmc_exports :: !B.ByteString -- ^ rendered exports
}
@@ -326,7 +327,7 @@ renderLinker h mods jsFiles = do
-- modules themselves
mod_sizes <- forM compacted_mods $ \m -> do
- !mod_size <- fromIntegral <$> putJS (satJStat $! cmc_js_code m)
+ !mod_size <- fromIntegral <$> putJS (cmc_js_code m)
let !mod_mod = cmc_module m
pure (mod_mod, mod_size)
@@ -565,7 +566,7 @@ extractDeps ar_state units deps loc =
mod = depsModule deps
newline = BC.pack "\n"
mk_exports = mconcat . intersperse newline . filter (not . BS.null) . map oiRaw
- mk_js_code = mconcat . map (unsatJStat . oiStat)
+ mk_js_code = mconcat . map oiStat
collectCode l = ModuleCode
{ mc_module = mod
, mc_js_code = mk_js_code l
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e2eb275a1b6d3d1dae9c2864f001bea69d20c2a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e2eb275a1b6d3d1dae9c2864f001bea69d20c2a
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/20230401/37f6bfbc/attachment-0001.html>
More information about the ghc-commits
mailing list