[Git][ghc/ghc][wip/js-forceBool] JS: fix implementation of forceBool to use JS backend syntax

[Josh Meredith (@JoshMeredith)]

Josh Meredith pushed to branch wip/js-forceBool at Glasgow Haskell Compiler / GHC


Commits:
18c254ad by Josh Meredith at 2023-03-13T03:52:55+00:00
JS: fix implementation of forceBool to use JS backend syntax

- - - - -


4 changed files:

- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- + testsuite/tests/javascript/T23101.hs
- + testsuite/tests/javascript/T23101.stdout
- + testsuite/tests/javascript/all.T


Changes:

=====================================
compiler/GHC/HsToCore/Foreign/JavaScript.hs
=====================================
@@ -639,7 +639,7 @@ jsResultWrapper result_ty
   | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do
 --    result_id <- newSysLocalDs boolTy
     ccall_uniq <- newUnique
-    let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy
+    let forceBool e = mkJsCall ccall_uniq (fsLit "((x) => { return !(!x); })") [e] boolTy
     return
      (Just intPrimTy, \e -> forceBool e)
 


=====================================
testsuite/tests/javascript/T23101.hs
=====================================
@@ -0,0 +1,22 @@
+
+foreign import javascript "(($1) => { return $1; })"
+  bool_id :: Bool -> Bool
+
+foreign import javascript "(($1) => { return !$1; })"
+  bool_not :: Bool -> Bool
+
+foreign import javascript "(($1) => { console.log($1); })"
+  bool_log :: Bool -> IO ()
+
+main :: IO ()
+main = do
+  bool_log True
+  bool_log False
+  bool_log (bool_id True)
+  bool_log (bool_id False)
+  bool_log (bool_not True)
+  bool_log (bool_not False)
+  print (bool_id True)
+  print (bool_id False)
+  print (bool_not True)
+  print (bool_not False)


=====================================
testsuite/tests/javascript/T23101.stdout
=====================================
@@ -0,0 +1,10 @@
+true
+false
+true
+false
+false
+true
+True
+False
+False
+True


=====================================
testsuite/tests/javascript/all.T
=====================================
@@ -0,0 +1,4 @@
+# These are JavaScript-specific tests
+setTestOpts(when(not(js_arch()),skip))
+
+test('T23101', normal, compile_and_run, [''])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18c254ad2a5afb09c478902b878e37eb26b3f2b1
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/20230312/da2a4c8d/attachment-0001.html>