[Git][ghc/ghc][wip/js-staging] Primops: T4442 finishes ByteArrayAs still fails

[doyougnu (@doyougnu)]

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


Commits:
ee6f41dd by doyougnu at 2022-09-07T14:28:20-04:00
Primops: T4442 finishes ByteArrayAs still fails

- - - - -


1 changed file:

- compiler/GHC/StgToJS/Prim.hs


Changes:

=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -1038,20 +1038,28 @@ genPrim prof ty op = case op of
   IndexByteArrayOp_Word8AsChar      -> \[r] [a,i] -> PrimInline $ r |= dv_u8  a i
   IndexByteArrayOp_Word8AsWideChar  -> \[r] [a,i] -> PrimInline $ r |= dv_i32 a i
   IndexByteArrayOp_Word8AsAddr      -> \[r1,r2] [a,i] ->
-    PrimInline $ jVar \t -> mconcat
-    [-- grab the "array" property
-      t |= a .^ "arr"
-    -- make sure we have a non-empty array
-    , ifBlockS (t .&&. t .! i)
-      -- we do, r1 is the ArrayBuffer, r2 is the payload offset
-      [ r1 |= t
-      , r2 |= dv_u32 t i
-      ]
-      -- we don't
-      [ r1 |= null_
-      , r2 |= zero_
-      ]
-    ]
+      PrimInline $ jVar \x -> mconcat
+        [ x |= i .<<. two_
+        , ifS (a .^ "arr" .&&. a .^ "arr" .! x)
+               (mconcat [ r1 |= a .^ "arr" .! x .! zero_
+                        , r2 |= a .^ "arr" .! x .! one_
+                        ])
+               (mconcat [r1 |= null_, r2 |= one_])
+        ]
+    -- PrimInline $ jVar \t -> mconcat
+    -- [-- grab the "array" property
+    --   t |= a .^ "arr"
+    -- -- make sure we have a non-empty array
+    -- , ifBlockS (t .&&. t .! i)
+    --   -- we do, r1 is the ArrayBuffer, r2 is the payload offset
+    --   [ r1 |= t
+    --   , r2 |= dv_u32 t i
+    --   ]
+    --   -- we don't
+    --   [ r1 |= null_
+    --   , r2 |= zero_
+    --   ]
+    -- ]
   IndexByteArrayOp_Word8AsFloat     -> \[r] [a,i] -> PrimInline $ r |= dv_f32 a i
   IndexByteArrayOp_Word8AsDouble    -> \[r] [a,i] -> PrimInline $ r |= dv_f32 a i
   IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->
@@ -1079,20 +1087,28 @@ genPrim prof ty op = case op of
   ReadByteArrayOp_Word8AsChar       -> \[r] [a,i] -> PrimInline $ r |= dv_u8  a i
   ReadByteArrayOp_Word8AsWideChar   -> \[r] [a,i] -> PrimInline $ r |= dv_i32 a i
   ReadByteArrayOp_Word8AsAddr       -> \[r1,r2] [a,i] ->
-    PrimInline $ jVar \t -> mconcat
-    [-- grab the "array" property
-      t |= a .^ "arr"
-    -- make sure we have a non-empty array
-    , ifBlockS (t .&&. t .! i)
-      -- we do, r1 is the ArrayBuffer, r2 is the payload offset
-      [ r1 |= t
-      , r2 |= dv_u32 t i
-      ]
-      -- we don't
-      [ r1 |= null_
-      , r2 |= zero_
-      ]
-    ]
+      PrimInline $ jVar \x -> mconcat
+        [ x |= i .<<. two_
+        , ifS (a .^ "arr" .&&. a .^ "arr" .! x)
+               (mconcat [ r1 |= a .^ "arr" .! x .! zero_
+                        , r2 |= a .^ "arr" .! x .! one_
+                        ])
+               (mconcat [r1 |= null_, r2 |= one_])
+        ]
+    -- PrimInline $ jVar \t -> mconcat
+    -- [-- grab the "array" property
+    --   t |= a .^ "arr"
+    -- -- make sure we have a non-empty array
+    -- , ifBlockS (t .&&. t .! i)
+    --   -- we do, r1 is the ArrayBuffer, r2 is the payload offset
+    --   [ r1 |= t
+    --   , r2 |= dv_u32 t i
+    --   ]
+    --   -- we don't
+    --   [ r1 |= null_
+    --   , r2 |= zero_
+    --   ]
+    -- ]
   ReadByteArrayOp_Word8AsFloat      -> \[r] [a,i] -> PrimInline $ r |= dv_f32 a i
   ReadByteArrayOp_Word8AsDouble     -> \[r] [a,i] -> PrimInline $ r |= dv_f32 a i
   ReadByteArrayOp_Word8AsStablePtr  -> \[r1,r2] [a,i] ->
@@ -1121,13 +1137,19 @@ genPrim prof ty op = case op of
   WriteByteArrayOp_Word8AsWideChar  -> \[] [a,i,e] -> PrimInline $ dv_s_i32 a i e
   WriteByteArrayOp_Word8AsAddr      -> \[] [a,i,e1,e2] ->
     PrimInline $ mconcat
-    [ ifS (Not (a .^ "arr"))
-          -- if we don't have the "arr" property then make it
-          (a .^ "arr" |= ValExpr (JList []))
-          -- else noop
-          mempty
-    , dv_s_i32 (a .^ "arr") i (ValExpr (JList [e1, e2]))
-    ]
+      [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty
+      , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])
+      ]
+
+    -- PrimInline $ mconcat
+    -- [ ifS (Not (a .^ "arr"))
+    --       -- if we don't have the "arr" property then make it with length 8
+    --       -- bytes, 4 for the Addr, 4 for the offset
+    --       (newByteArray (a .^ "arr") (Int 8))
+    --       -- else noop
+    --       mempty
+    -- , dv_s_i32 (a .^ "arr") i (ValExpr (JList [e1, e2]))
+    -- ]
   WriteByteArrayOp_Word8AsFloat     -> \[] [a,i,e] -> PrimInline $ dv_s_f32 a i e
   WriteByteArrayOp_Word8AsDouble    -> \[] [a,i,e] -> PrimInline $ dv_s_f32 a i e
   WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline $ dv_s_i32 a i e2



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee6f41ddb1d8ad45959d0fec5d7f61f1fd0141cd
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/20220912/834cce9c/attachment-0001.html>