[Git][ghc/ghc][wip/js-staging] 3 commits: Minor cleanup
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Mon Oct 3 12:19:57 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
221a33c3 by Sylvain Henry at 2022-10-03T14:11:34+02:00
Minor cleanup
- - - - -
592b13c1 by Sylvain Henry at 2022-10-03T14:11:57+02:00
Add log1p and expm1 (fix cgrun078)
- - - - -
cc972678 by Sylvain Henry at 2022-10-03T14:16:45+02:00
Assume existence of Math.fround and use it in Float's primops
- - - - -
4 changed files:
- compiler/GHC/JS/Make.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Prim.hs
- rts/js/arith.js
Changes:
=====================================
compiler/GHC/JS/Make.hs
=====================================
@@ -122,7 +122,8 @@ module GHC.JS.Make
-- ** Math functions
-- $math
, math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin,
- math_atan, math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh
+ math_atan, math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh,
+ math_cosh, math_sinh, math_tanh, math_expm1, math_log1p, math_fround
-- * Statement helpers
, decl
-- * Miscellaneous
@@ -592,7 +593,8 @@ math_ :: FastString -> [JExpr] -> JExpr
math_ op args = ApplExpr (math .^ op) args
math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin, math_atan,
- math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh, math_sign
+ math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh, math_sign,
+ math_sinh, math_cosh, math_tanh, math_expm1, math_log1p, math_fround
:: [JExpr] -> JExpr
math_log = math_ "log"
math_sin = math_ "sin"
@@ -609,6 +611,12 @@ math_sqrt = math_ "sqrt"
math_asinh = math_ "asinh"
math_acosh = math_ "acosh"
math_atanh = math_ "atanh"
+math_sinh = math_ "sinh"
+math_cosh = math_ "cosh"
+math_tanh = math_ "tanh"
+math_expm1 = math_ "expm1"
+math_log1p = math_ "log1p"
+math_fround = math_ "fround"
instance Num JExpr where
x + y = InfixExpr AddOp x y
=====================================
compiler/GHC/StgToJS/FFI.hs
=====================================
@@ -194,7 +194,7 @@ parseFFIPattern' callback javascriptCc pat t ret args
where
(TxtI i') = i
err = pprPanic "parseFFIPattern': invalid placeholder, check function type"
- (vcat [text pat, text (unpackFS i'), ppr args, ppr t])
+ (vcat [text pat, ppr i', ppr args, ppr t])
traceCall cs as
| csTraceForeign cs = ApplStat (var "h$traceForeign") [toJExpr pat, toJExpr as]
| otherwise = mempty
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -468,11 +468,11 @@ genPrim prof ty op = case op of
DoubleNegOp -> \[r] [x] -> PrimInline $ r |= Negate x
DoubleFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]
DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= i32 x
- DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= app "h$fround" [x]
+ DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= math_fround [x]
DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x]
- DoubleExpM1Op -> \[r] [x] -> PrimInline $ r |= math_exp [x]
+ DoubleExpM1Op -> \[r] [x] -> PrimInline $ r |= math_expm1 [x]
DoubleLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x]
- DoubleLog1POp -> \[r] [x] -> PrimInline $ r |= math_log [x]
+ DoubleLog1POp -> \[r] [x] -> PrimInline $ r |= math_log1p [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]
@@ -480,9 +480,9 @@ genPrim prof ty op = case op of
DoubleAsinOp -> \[r] [x] -> PrimInline $ r |= math_asin [x]
DoubleAcosOp -> \[r] [x] -> PrimInline $ r |= math_acos [x]
DoubleAtanOp -> \[r] [x] -> PrimInline $ r |= math_atan [x]
- DoubleSinhOp -> \[r] [x] -> PrimInline $ r |= (math_exp [x] `Sub` math_exp [Negate x]) `Div` two_
- DoubleCoshOp -> \[r] [x] -> PrimInline $ r |= (math_exp [x] `Add` math_exp [Negate x]) `Div` two_
- DoubleTanhOp -> \[r] [x] -> PrimInline $ r |= (math_exp [Mul two_ x] `Sub` one_) `Div` (math_exp [Mul two_ x] `Add` one_)
+ DoubleSinhOp -> \[r] [x] -> PrimInline $ r |= math_sinh [x]
+ DoubleCoshOp -> \[r] [x] -> PrimInline $ r |= math_cosh [x]
+ DoubleTanhOp -> \[r] [x] -> PrimInline $ r |= math_tanh [x]
DoubleAsinhOp -> \[r] [x] -> PrimInline $ r |= math_asinh [x]
DoubleAcoshOp -> \[r] [x] -> PrimInline $ r |= math_acosh [x]
DoubleAtanhOp -> \[r] [x] -> PrimInline $ r |= math_atanh [x]
@@ -498,31 +498,31 @@ genPrim prof ty op = case op of
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)
- 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
- FloatDivOp -> \[r] [x,y] -> PrimInline $ r |= Div x y
+ FloatAddOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Add x y]
+ FloatSubOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Sub x y]
+ FloatMulOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Mul x y]
+ FloatDivOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Div x y]
FloatNegOp -> \[r] [x] -> PrimInline $ r |= Negate x
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]
- FloatTanOp -> \[r] [x] -> PrimInline $ r |= math_tan [x]
- FloatAsinOp -> \[r] [x] -> PrimInline $ r |= math_asin [x]
- FloatAcosOp -> \[r] [x] -> PrimInline $ r |= math_acos [x]
- FloatAtanOp -> \[r] [x] -> PrimInline $ r |= math_atan [x]
- FloatSinhOp -> \[r] [x] -> PrimInline $ r |= (math_exp [x] `Sub` math_exp [Negate x]) `Div` two_
- FloatCoshOp -> \[r] [x] -> PrimInline $ r |= (math_exp [x] `Add` math_exp [Negate x]) `Div` two_
- FloatTanhOp -> \[r] [x] -> PrimInline $ r |= (math_exp [Mul two_ x] `Sub` one_) `Div` (math_exp [Mul two_ x] `Add` one_)
- FloatAsinhOp -> \[r] [x] -> PrimInline $ r |= math_asinh [x]
- FloatAcoshOp -> \[r] [x] -> PrimInline $ r |= math_acosh [x]
- FloatAtanhOp -> \[r] [x] -> PrimInline $ r |= math_atanh [x]
- FloatPowerOp -> \[r] [x,y] -> PrimInline $ r |= math_pow [x,y]
+ FloatExpOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_exp [x]]
+ FloatExpM1Op -> \[r] [x] -> PrimInline $ r |= math_fround [math_expm1 [x]]
+ FloatLogOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log [x]]
+ FloatLog1POp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log1p [x]]
+ FloatSqrtOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sqrt [x]]
+ FloatSinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sin [x]]
+ FloatCosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cos [x]]
+ FloatTanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tan [x]]
+ FloatAsinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asin [x]]
+ FloatAcosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acos [x]]
+ FloatAtanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atan [x]]
+ FloatSinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sinh [x]]
+ FloatCoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cosh [x]]
+ FloatTanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tanh [x]]
+ FloatAsinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asinh [x]]
+ FloatAcoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acosh [x]]
+ FloatAtanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atanh [x]]
+ FloatPowerOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [math_pow [x,y]]
FloatToDoubleOp -> \[r] [x] -> PrimInline $ r |= x
FloatDecode_IntOp -> \[s,e] [x] -> PrimInline $ appT [s,e] "h$decodeFloatInt" [x]
=====================================
rts/js/arith.js
=====================================
@@ -528,20 +528,6 @@ function h$ctz64(x1,x2) {
return (x2 === 0) ? 32 + h$ctz32(x1) : h$ctz32(x2);
}
-var h$fround = null;
-if(typeof Math.fround === 'function') {
- h$fround = function(f) {
- TRACE_ARITH("fround (native): " + f);
- return Math.fround(f);
- }
-} else {
- h$fround = function(f) {
- TRACE_ARITH("fround (buffer): " + f);
- h$convertFloat[0] = f;
- return h$convertFloat[0];
- }
-}
-
function h$decodeDoubleInt64(d) {
TRACE_ARITH("decodeDoubleInt64: " + d);
if(isNaN(d)) {
@@ -592,12 +578,12 @@ function h$__word_encodeDouble(j,e) {
function h$__int_encodeFloat(j,e) {
if (!j) return 0;
- return h$fround((j|0) * (2 ** (e|0)));
+ return Math.fround((j|0) * (2 ** (e|0)));
}
function h$__word_encodeFloat(j,e) {
if (!j) return 0;
- return h$fround((j>>>0) * (2 ** (e|0)));
+ return Math.fround((j>>>0) * (2 ** (e|0)));
}
function h$stg_word32ToFloatzh(v) {
@@ -622,3 +608,19 @@ function h$stg_doubleToWord64zh(v) {
var h = h$convertWord[1];
RETURN_UBX_TUP2(h,l);
}
+
+function h$log1p(x) {
+ return Math.log1p(x);
+}
+
+function h$log1pf(x) {
+ return Math.fround(Math.log1p(x));
+}
+
+function h$expm1(x) {
+ return Math.expm1(x);
+}
+
+function h$expm1f(x) {
+ return Math.fround(Math.expm1(x));
+}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/109e40c9c08822cbbb4eba3b52f448cd8a050895...cc9726781384cff4f46fd8b5a08529485ce40a7d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/109e40c9c08822cbbb4eba3b52f448cd8a050895...cc9726781384cff4f46fd8b5a08529485ce40a7d
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/20221003/241bc7f9/attachment-0001.html>
More information about the ghc-commits
mailing list