[Guile-commits] 38/99: Explicitly test for undefined arguments to handle false values like 0

[Christopher Allan Webber]

cwebber pushed a commit to branch compile-to-js-merge
in repository guile.

commit 89029a54f43e7698e7ddb5f72ada4c44ec5a1c68
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Wed Jun 24 19:57:28 2015 +0100

    Explicitly test for undefined arguments to handle false values like 0
---
 module/language/javascript.scm               | 39 +++++++++++++++++++++++++---
 module/language/javascript/simplify.scm      | 10 ++++++-
 module/language/js-il/compile-javascript.scm | 11 +++++---
 3 files changed, 52 insertions(+), 8 deletions(-)

diff --git a/module/language/javascript.scm b/module/language/javascript.scm
index 741282a..8829b3b 100644
--- a/module/language/javascript.scm
+++ b/module/language/javascript.scm
@@ -15,6 +15,8 @@
             make-branch branch
             make-var var
             make-binop binop
+            make-ternary ternary
+            make-prefix prefix
 
             print-statement))
 
@@ -59,6 +61,8 @@
 (define-js-type branch test then else)
 (define-js-type var id exp)
 (define-js-type binop op arg1 arg2)
+(define-js-type ternary test then else)
+(define-js-type prefix op expr)
 
 (define (unparse-js exp)
   (match exp
@@ -85,7 +89,12 @@
     (($ var id exp)
      `(var ,id ,(unparse-js exp)))
     (($ binop op arg1 arg2)
-     `(binop ,op ,(unparse-js arg1) ,(unparse-js arg2)))))
+     `(binop ,op ,(unparse-js arg1) ,(unparse-js arg2)))
+    (($ ternary test then else)
+     `(ternary ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
+    (($ prefix op expr)
+     `(prefix ,op ,(unparse-js expr)))
+    ))
 
 (define (print-exp exp port)
   (match exp
@@ -136,17 +145,41 @@
      (print-binop op port)
      (display "(" port)
      (print-exp arg2 port)
-     (display ")" port))))
+     (display ")" port))
+
+    (($ ternary test then else)
+     (display "(" port)
+     (print-exp test port)
+     (display ") ? (" port)
+     (print-exp then port)
+     (display ") : (" port)
+     (print-exp else port)
+     (display ")" port))
+
+    (($ prefix op exp)
+     (print-prefix op port)
+     (display "(" port)
+     (print-exp exp port)
+     (display ")" port))
+    ))
 
 (define (print-binop op port)
   (case op
     ((or) (display "||" port))
     ((and) (display "&&" port))
     ((=) (display "==" port))
-    ((+ - < <= > >=) (format port "~a" op))
+    ((+ - < <= > >= ===) (format port "~a" op))
     (else
      (throw 'unprintable-binop op))))
 
+(define (print-prefix op port)
+  (case op
+    ((not) (display "!" port))
+    ((typeof + -)
+     (format port "~a" op))
+    (else
+     (throw 'unprintable-prefix op))))
+
 (define (print-statement stmt port)
   (match stmt
     (($ var id exp)
diff --git a/module/language/javascript/simplify.scm 
b/module/language/javascript/simplify.scm
index b3360aa..2e3bde5 100644
--- a/module/language/javascript/simplify.scm
+++ b/module/language/javascript/simplify.scm
@@ -40,7 +40,15 @@
                     (flatten-block else)))
       (($ call function args)
        (make-call (flatten-exp function)
-                  (map flatten-exp args)))))
+                  (map flatten-exp args)))
+
+      (($ ternary test then else)
+       (make-ternary (flatten-exp test)
+                     (flatten-exp then)
+                     (flatten-exp else)))
+      (($ prefix op exp)
+       (make-prefix op (flatten-exp exp)))
+      ))
   (define (maybe-make-block exp)
     (match exp
       ((exp) exp)
diff --git a/module/language/js-il/compile-javascript.scm 
b/module/language/js-il/compile-javascript.scm
index 2645b4c..67a3492 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -104,10 +104,13 @@
 (define (bind-opt-args opts num-drop)
   (map (lambda (opt idx)
          (make-var (rename-id opt)
-                   (make-binop 'or
-                               (make-refine (make-id "arguments")
-                                            (make-const (+ num-drop idx)))
-                               (make-refine *scheme* (make-const 
"UNDEFINED")))))
+                   (let ((arg (make-refine (make-id "arguments")
+                                            (make-const (+ num-drop idx)))))
+                     (make-ternary (make-binop '===
+                                               (make-prefix 'typeof arg)
+                                               (make-id "undefined"))
+                                   (make-refine *scheme* (make-const 
"UNDEFINED"))
+                                   arg))))
        opts
        (iota (length opts))))