[Git][ghc/ghc][wip/js-staging] 3 commits: Fix Driver missing type signature warnings
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Fri Sep 16 15:10:38 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
0c7be294 by doyougnu at 2022-09-16T11:10:17-04:00
Fix Driver missing type signature warnings
- - - - -
8512800f by doyougnu at 2022-09-16T11:10:17-04:00
PipeLine.Execute: silence warnings on JS backend
- - - - -
5519d574 by doyougnu at 2022-09-16T11:10:18-04:00
JS.Primops: Add Bit reverse ops
- - - - -
4 changed files:
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/StgToJS/Prim.hs
- rts/js/arith.js
Changes:
=====================================
compiler/GHC/Driver/Phases.hs
=====================================
@@ -265,7 +265,7 @@ dynlib_suffixes platform = case platformOS platform of
_ -> ["so"]
isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,
- isHaskellUserSrcSuffix, isHaskellSigSuffix
+ isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix
:: String -> Bool
isHaskellishSuffix s = s `elem` haskellish_suffixes
isBackpackishSuffix s = s `elem` backpackish_suffixes
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -131,7 +131,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do
input_fn output_fn
return output_fn
runPhase (T_Js pipe_env hsc_env mb_location js_src) = do
- out_path <- phaseOutputFilenameNew StopLn pipe_env hsc_env Nothing
+ _out_path <- phaseOutputFilenameNew StopLn pipe_env hsc_env Nothing
runJsPhase pipe_env hsc_env mb_location js_src
runPhase (T_Cmm pipe_env hsc_env input_fn) = do
let dflags = hsc_dflags hsc_env
@@ -349,12 +349,11 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
-runJsPhase pipe_env hsc_env location input_fn = do
+runJsPhase pipe_env hsc_env _location input_fn = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
let tmpfs = hsc_tmpfs hsc_env
let unit_env = hsc_unit_env hsc_env
- let platform = ue_platform unit_env
-- the header lets the linker recognize processed JavaScript files
let header = "//JavaScript\n"
@@ -383,7 +382,7 @@ runJsPhase pipe_env hsc_env location input_fn = do
return output_fn
jsFileNeedsCpp :: HscEnv -> FilePath -> IO Bool
-jsFileNeedsCpp hsc_env fn = do
+jsFileNeedsCpp _hsc_env fn = do
opts <- JSHeader.getOptionsFromJsFile fn
pure (JSHeader.CPP `elem` opts)
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -436,23 +436,31 @@ genPrim prof ty op = case op of
BSwap64Op -> \[r1,r2] [x,y] -> PrimInline $ appT [r1,r2] "h$bswap64" [x,y]
BSwapOp -> \[r] [x] -> genPrim prof ty BSwap32Op [r] [x]
+ BRevOp -> \[r] [w] -> genPrim prof ty BRev32Op [r] [w]
+ BRev8Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 24)
+ BRev16Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 16)
+ BRev32Op -> \[r] [w] -> PrimInline $ r |= app "h$reverseWord" [w]
+ BRev64Op -> \[rh,rl] [h,l] -> PrimInline $ mconcat [ rl |= app "h$reverseWord" [h]
+ , rh |= app "h$reverseWord" [l]
+ ]
+
------------------------------ Narrow -------------------------------------------
- Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= (BAnd x (Int 0x7F)) `Sub` (BAnd x (Int 0x80))
+ Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= (BAnd x (Int 0x7F )) `Sub` (BAnd x (Int 0x80))
Narrow16IntOp -> \[r] [x] -> PrimInline $ r |= (BAnd x (Int 0x7FFF)) `Sub` (BAnd x (Int 0x8000))
- Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= i32 x
- Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x
+ Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= i32 x
+ Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x
Narrow16WordOp -> \[r] [x] -> PrimInline $ r |= mask16 x
- Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= u32 x
+ Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= u32 x
------------------------------ Double -------------------------------------------
- DoubleGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)
- DoubleGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)
+ DoubleGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)
+ DoubleGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)
DoubleEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)
DoubleNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)
- DoubleLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)
- DoubleLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)
+ DoubleLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)
+ DoubleLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)
DoubleAddOp -> \[r] [x,y] -> PrimInline $ r |= Add x y
DoubleSubOp -> \[r] [x,y] -> PrimInline $ r |= Sub x y
DoubleMulOp -> \[r] [x,y] -> PrimInline $ r |= Mul x y
@@ -461,12 +469,12 @@ genPrim prof ty op = case op of
DoubleFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]
DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= i32 x
DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= app "h$fround" [x]
- DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x]
- DoubleLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x]
+ DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x]
+ DoubleLogOp -> \[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]
- DoubleTanOp -> \[r] [x] -> PrimInline $ r |= math_tan [x]
+ DoubleSinOp -> \[r] [x] -> PrimInline $ r |= math_sin [x]
+ DoubleCosOp -> \[r] [x] -> PrimInline $ r |= math_cos [x]
+ DoubleTanOp -> \[r] [x] -> PrimInline $ r |= math_tan [x]
DoubleAsinOp -> \[r] [x] -> PrimInline $ r |= math_asin [x]
DoubleAcosOp -> \[r] [x] -> PrimInline $ r |= math_acos [x]
DoubleAtanOp -> \[r] [x] -> PrimInline $ r |= math_atan [x]
@@ -482,12 +490,12 @@ genPrim prof ty op = case op of
------------------------------ Float --------------------------------------------
- FloatGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)
- FloatGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)
+ FloatGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)
+ FloatGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)
FloatEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)
FloatNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)
- FloatLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)
- FloatLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)
+ FloatLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)
+ FloatLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)
FloatAddOp -> \[r] [x,y] -> PrimInline $ r |= Add x y
FloatSubOp -> \[r] [x,y] -> PrimInline $ r |= Sub x y
FloatMulOp -> \[r] [x,y] -> PrimInline $ r |= Mul x y
@@ -1021,12 +1029,6 @@ genPrim prof ty op = case op of
------------------------------ Unhandled primops -------------------
- BRevOp -> unhandledPrimop op
- BRev8Op -> unhandledPrimop op
- BRev16Op -> unhandledPrimop op
- BRev32Op -> unhandledPrimop op
- BRev64Op -> unhandledPrimop op
-
DoubleExpM1Op -> unhandledPrimop op
DoubleLog1POp -> unhandledPrimop op
FloatExpM1Op -> unhandledPrimop op
=====================================
rts/js/arith.js
=====================================
@@ -507,6 +507,24 @@ function h$popCnt64(x1,x2) {
h$popCntTab[(x2>>>24)&0xFF];
}
+function h$reverseWord(w) {
+ /* Reverse the bits in a 32-bit word this trick comes from
+ * https://graphics.stanford.edu/~seander/bithacks.html#ReverseParallel This
+ * method should use a bit more memory than other methods, but we choose it
+ * because it does not rely on any 64bit multiplication or look up tables.
+ * Note that this could be expressed in the Haskell EDSL, but we choose to not
+ * do that for improved sharing in the JIT. Should be O(lg n)
+ */
+ var r = w;
+ r = ((r >>> 1) & 0x55555555) | ((r & 0x55555555) << 1); // swap odd and even bits
+ r = ((r >>> 2) & 0x33333333) | ((r & 0x33333333) << 2); // swap consecutive pairs
+ r = ((r >>> 4) & 0x0F0F0F0F) | ((r & 0x0F0F0F0F) << 4); // swap nibbles
+ r = ((r >>> 8) & 0x00FF00FF) | ((r & 0x00FF00FF) << 8); // swap bytes
+ r = ( r >>> 16 ) | ( r << 16); // swap 2-byte long pairs
+ r = r >>> 0; // ensure w is unsigned
+ return r;
+}
+
function h$bswap64(x1,x2) {
RETURN_UBX_TUP2(UN((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8))
,UN((x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8)));
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be469255d19351212aa0b5cc6cf97534b743f47f...5519d574c0b3bed51fb01671de01302925c1240e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be469255d19351212aa0b5cc6cf97534b743f47f...5519d574c0b3bed51fb01671de01302925c1240e
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/20220916/ddf89e72/attachment-0001.html>
More information about the ghc-commits
mailing list