diff --git a/module/language/javascript.scm b/module/language/javascript.scm index 741282a61..8829b3be0 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 b3360aa40..2e3bde5f0 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 2645b4c99..67a34921d 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))))