[Git][ghc/ghc][wip/js-staging] 2 commits: Minor cleanup in compactor

[Sylvain Henry (@hsyl20)]

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


Commits:
7866b112 by Sylvain Henry at 2022-09-30T14:59:47+02:00
Minor cleanup in compactor

- - - - -
dde60479 by Sylvain Henry at 2022-09-30T14:59:47+02:00
Fix encoding of unboxed strings (don't pass through FastString/h$str)

- - - - -


1 changed file:

- compiler/GHC/StgToJS/Linker/Compactor.hs


Changes:

=====================================
compiler/GHC/StgToJS/Linker/Compactor.hs
=====================================
@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE LambdaCase          #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -152,21 +153,25 @@ staticInitStat _prof (StaticInfo i sv cc) =
 
 -- | declare and do first-pass init of a global object (create JS object for heap objects)
 staticDeclStat :: StaticInfo -> JStat
-staticDeclStat (StaticInfo si sv _) =
-  let si' = TxtI si
-      ssv (StaticUnboxed u)       = Just (ssu u)
-      ssv (StaticThunk Nothing)   = Nothing
-      ssv _                       = Just (app "h$d" [])
-      ssu (StaticUnboxedBool b)   = app "h$p" [toJExpr b]
-      ssu (StaticUnboxedInt i)    = app "h$p" [toJExpr i]
-      ssu (StaticUnboxedDouble d) = app "h$p" [toJExpr (unSaneDouble d)]
-      ssu (StaticUnboxedString str) = ApplExpr (initStr str) []
-      ssu StaticUnboxedStringOffset {} = 0
-  in  maybe (appS "h$di" [toJExpr si']) (\v -> DeclStat si' `mappend` (toJExpr si' |= v)) (ssv sv)
-
--- | JS expression corresponding to a static string
-initStr :: BS.ByteString -> JExpr
-initStr str = app "h$str" [ValExpr (JStr . mkFastStringByteString $! str)]
+staticDeclStat (StaticInfo global_name static_value _) = decl
+  where
+    global_ident = TxtI global_name
+    decl_init v  = DeclStat global_ident `mappend` (toJExpr global_ident |= v)
+    decl_no_init = appS "h$di" [toJExpr global_ident]
+
+    decl = case static_value of
+      StaticUnboxed u     -> decl_init (unboxed_expr u)
+      StaticThunk Nothing -> decl_no_init -- CAF initialized in an alternative way
+      _                   -> decl_init (app "h$d" [])
+
+    unboxed_expr = \case
+      StaticUnboxedBool b          -> app "h$p" [toJExpr b]
+      StaticUnboxedInt i           -> app "h$p" [toJExpr i]
+      StaticUnboxedDouble d        -> app "h$p" [toJExpr (unSaneDouble d)]
+      StaticUnboxedString str      -> app "h$rawStringData" [ValExpr (to_byte_list str)]
+      StaticUnboxedStringOffset {} -> 0
+
+    to_byte_list = JList . map (Int . fromIntegral) . BS.unpack
 
 -- | rename a heap object, which means adding it to the
 --  static init table in addition to the renamer
@@ -240,20 +245,6 @@ staticIdentsA :: (FastString -> FastString) -> StaticArg -> StaticArg
 staticIdentsA f (StaticObjArg t) = StaticObjArg $! f t
 staticIdentsA _ x = x
 
-
-{- |
-  The Base data structure contains the information we need
-  to do incremental linking against a base bundle.
-
-  base file format:
-  GHCJSBASE
-  [renamer state]
-  [linkedPackages]
-  [packages]
-  [modules]
-  [symbols]
- -}
-
 staticInfoArgs :: Applicative f => (StaticArg -> f StaticArg) -> StaticInfo -> f StaticInfo
 staticInfoArgs f (StaticInfo si sv sa) = StaticInfo si <$> staticValArgs f sv <*> pure sa
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498a188253026c5d510ef2adb24aeb63e532e1ae...dde604795a1f09b28eb50f3c52b71d41fc618a9b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498a188253026c5d510ef2adb24aeb63e532e1ae...dde604795a1f09b28eb50f3c52b71d41fc618a9b
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/20220930/673edc96/attachment-0001.html>