[Git][ghc/ghc][master] JS: support rubbish static literals (#25177)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
5092dbff by Sylvain Henry at 2024-08-21T13:12:54-04:00
JS: support rubbish static literals (#25177)

Support for rubbish dynamic literals was added in #24664. This patch
does the same for static literals.

Fix #25177

- - - - -


4 changed files:

- compiler/GHC/StgToJS/Literal.hs
- + testsuite/tests/codeGen/should_compile/T25177.hs
- + testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/codeGen/should_compile/all.T


Changes:

=====================================
compiler/GHC/StgToJS/Literal.hs
=====================================
@@ -115,7 +115,24 @@ genStaticLit = \case
   LitDouble r              -> return [ DoubleLit . SaneDouble . r2d $ r ]
   LitLabel name fod        -> return [ LabelLit (fod == IsFunction) (mkRawSymbol True name)
                                      , IntLit 0 ]
-  l -> pprPanic "genStaticLit" (ppr l)
+  LitRubbish _ rep ->
+    let prim_reps = runtimeRepPrimRep (text "GHC.StgToJS.Literal.genStaticLit") rep
+    in case expectOnly "GHC.StgToJS.Literal.genStaticLit" prim_reps of -- Note [Post-unarisation invariants]
+        BoxedRep _  -> pure [ NullLit ]
+        AddrRep     -> pure [ NullLit, IntLit 0 ]
+        IntRep      -> pure [ IntLit 0 ]
+        Int8Rep     -> pure [ IntLit 0 ]
+        Int16Rep    -> pure [ IntLit 0 ]
+        Int32Rep    -> pure [ IntLit 0 ]
+        Int64Rep    -> pure [ IntLit 0, IntLit 0 ]
+        WordRep     -> pure [ IntLit 0 ]
+        Word8Rep    -> pure [ IntLit 0 ]
+        Word16Rep   -> pure [ IntLit 0 ]
+        Word32Rep   -> pure [ IntLit 0 ]
+        Word64Rep   -> pure [ IntLit 0, IntLit 0 ]
+        FloatRep    -> pure [ DoubleLit (SaneDouble 0) ]
+        DoubleRep   -> pure [ DoubleLit (SaneDouble 0) ]
+        VecRep {}   -> pprPanic "GHC.StgToJS.Literal.genStaticLit: LitRubbish(VecRep) isn't supported" (ppr rep)
 
 -- make an unsigned 32 bit number from this unsigned one, lower 32 bits
 toU32Expr :: Integer -> JStgExpr


=====================================
testsuite/tests/codeGen/should_compile/T25177.hs
=====================================
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+-- only export bar!
+module T25177 (bar) where
+
+import GHC.Exts
+
+data D = D !Word# !Int#
+
+{-# OPAQUE foo #-}
+-- foo has an absent demand on D's Int#
+foo :: D -> Word
+foo (D a _) = W# a
+
+
+bar :: Int# -> IO ()
+bar !x = do
+  -- we allocate a D:
+  --  - used twice: otherwise it is inlined
+  --  - whose second arg:
+  --    - has an absent demand
+  --    - is an unboxed Int# (hence won't be replaced by an "absentError blah"
+  --    but by a LitRubbish)
+  --
+  -- GHC should detect that `17# +# x` is absent. Then it should lift `d` to the
+  -- top-level. This is checked by dumping Core with -ddump-simpl.
+  let d = D 10## (17# +# x)
+  let !r1 = foo d -- luckily CSE doesn't kick in before floating-out `d`...
+  let !r2 = foo d -- otherwise, pass a additional dummy argument to `foo`
+  pure ()


=====================================
testsuite/tests/codeGen/should_compile/T25177.stderr
=====================================
@@ -0,0 +1,17 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 25, types: 31, coercions: 6, joins: 0/0}
+
+foo = \ ds -> case ds of { D a ds1 -> W# a }
+
+d = D 10## RUBBISH(IntRep)
+
+lvl = foo d
+
+bar1 = \ _ eta -> case lvl of { W# ipv -> (# eta, () #) }
+
+bar = bar1 `cast` <Co:6> :: ...
+
+
+


=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -138,3 +138,6 @@ test('callee-no-local', [
   compile,
   ['-ddump-cmm-raw']
 )
+
+# dump Core to ensure that d is defined as: d = D 10## RUBBISH(IntRep)
+test('T25177', normal, compile, ['-O2 -dno-typeable-binds -ddump-simpl -dsuppress-all -dsuppress-uniques -v0'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5092dbff750ee5b6fd082b7eed8574922a2b0bf4
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/20240821/34fd24e2/attachment-0001.html>