[Git][ghc/ghc][wip/js-staging] 2 commits: SysTools.Tasks: quiet non-totality warnings

[doyougnu (@doyougnu)]

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


Commits:
286a7604 by doyougnu at 2022-09-19T09:23:46-04:00
SysTools.Tasks: quiet non-totality warnings

- - - - -
c0b9801f by doyougnu at 2022-09-19T09:43:49-04:00
JS.Primops: Add InterlockedExchange Addr Word

- - - - -


2 changed files:

- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/SysTools/Tasks.hs


Changes:

=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -470,7 +470,9 @@ genPrim prof ty op = case op of
   DoubleToIntOp     -> \[r] [x]   -> PrimInline $ r |= i32 x
   DoubleToFloatOp   -> \[r] [x]   -> PrimInline $ r |= app "h$fround" [x]
   DoubleExpOp       -> \[r] [x]   -> PrimInline $ r |= math_exp  [x]
+  DoubleExpM1Op     -> \[r] [x]   -> PrimInline $ r |= math_exp  [x]
   DoubleLogOp       -> \[r] [x]   -> PrimInline $ r |= math_log  [x]
+  DoubleLog1POp     -> \[r] [x]   -> PrimInline $ r |= math_log  [x]
   DoubleSqrtOp      -> \[r] [x]   -> PrimInline $ r |= math_sqrt [x]
   DoubleSinOp       -> \[r] [x]   -> PrimInline $ r |= math_sin  [x]
   DoubleCosOp       -> \[r] [x]   -> PrimInline $ r |= math_cos  [x]
@@ -504,7 +506,9 @@ genPrim prof ty op = case op of
   FloatFabsOp       -> \[r] [x]   -> PrimInline $ r |= math_abs [x]
   FloatToIntOp      -> \[r] [x]   -> PrimInline $ r |= i32 x
   FloatExpOp        -> \[r] [x]   -> PrimInline $ r |= math_exp [x]
+  FloatExpM1Op      -> \[r] [x]   -> PrimInline $ r |= math_exp [x]
   FloatLogOp        -> \[r] [x]   -> PrimInline $ r |= math_log [x]
+  FloatLog1POp      -> \[r] [x]   -> PrimInline $ r |= math_log [x]
   FloatSqrtOp       -> \[r] [x]   -> PrimInline $ r |= math_sqrt [x]
   FloatSinOp        -> \[r] [x]   -> PrimInline $ r |= math_sin [x]
   FloatCosOp        -> \[r] [x]   -> PrimInline $ r |= math_cos [x]
@@ -1027,16 +1031,6 @@ genPrim prof ty op = case op of
   TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len]
   TraceMarkerOp      -> \[] [ed,eo]     -> PrimInline $ appS "h$traceMarker" [ed,eo]
 
------------------------------- Unhandled primops -------------------
-
-  DoubleExpM1Op                     -> unhandledPrimop op
-  DoubleLog1POp                     -> unhandledPrimop op
-  FloatExpM1Op                      -> unhandledPrimop op
-  FloatLog1POp                      -> unhandledPrimop op
-
-  ShrinkSmallMutableArrayOp_Char    -> unhandledPrimop op
-  GetSizeofSmallMutableArrayOp      -> unhandledPrimop op
-
   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] ->
@@ -1161,10 +1155,6 @@ genPrim prof ty op = case op of
                                    mempty
                              ]
 
-
-  InterlockedExchange_Addr          -> unhandledPrimop op
-  InterlockedExchange_Word          -> unhandledPrimop op
-
   CasAddrOp_Addr                    -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $
                     mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2])
                                   (appS "h$memcpy" [a3,o3,a1,o1,8])
@@ -1209,6 +1199,24 @@ genPrim prof ty op = case op of
   FetchOrAddrOp_Word                -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr   r a o v
   FetchXorAddrOp_Word               -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor  r a o v
 
+
+------------------------------ Unhandled primops -------------------
+
+  ShrinkSmallMutableArrayOp_Char    -> unhandledPrimop op
+  GetSizeofSmallMutableArrayOp      -> unhandledPrimop op
+
+  InterlockedExchange_Addr          -> \[r_a,r_o] [a1,o1,a2,o2] -> PrimInline $
+                                                             mconcat [ r_a |= a1
+                                                                     , r_o |= o1
+                                                                     , a1 .! o1 |= a2 .! o2
+                                                                     , o1       |= o2
+                                                                     ]
+  InterlockedExchange_Word          -> \[r] [a,o,w] -> PrimInline $
+                                                       mconcat [ r |= a .! o
+                                                               , dv_s_u32 a o w
+                                                               ]
+
+
   AtomicReadAddrOp_Word             -> unhandledPrimop op
   AtomicWriteAddrOp_Word            -> unhandledPrimop op
 


=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -159,6 +159,10 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do
                         ,pgm_c dflags,    "Asm Compiler")
           RawObject  -> ("c",             []
                         ,pgm_c dflags,    "C Compiler") -- claim C for lack of a better idea
+          --JS backend shouldn't reach here, so we just pass
+          -- strings to satisfy the totality checker
+          LangJs     -> ("js",            []
+                        ,pgm_c dflags,    "JS Backend Compiler")
   userOpts_c   = getOpts dflags opt_c
   userOpts_cxx = getOpts dflags opt_cxx
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5519d574c0b3bed51fb01671de01302925c1240e...c0b9801f7e5e332192fb6f86ae86437e68411287

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5519d574c0b3bed51fb01671de01302925c1240e...c0b9801f7e5e332192fb6f86ae86437e68411287
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/20220919/0e54ef60/attachment-0001.html>