1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00

Explicitly test for undefined arguments to handle false values like 0

This commit is contained in:
Ian Price 2015-06-24 19:57:28 +01:00
parent b631576f13
commit 89029a54f4
3 changed files with 52 additions and 8 deletions

View file

@ -15,6 +15,8 @@
make-branch branch make-branch branch
make-var var make-var var
make-binop binop make-binop binop
make-ternary ternary
make-prefix prefix
print-statement)) print-statement))
@ -59,6 +61,8 @@
(define-js-type branch test then else) (define-js-type branch test then else)
(define-js-type var id exp) (define-js-type var id exp)
(define-js-type binop op arg1 arg2) (define-js-type binop op arg1 arg2)
(define-js-type ternary test then else)
(define-js-type prefix op expr)
(define (unparse-js exp) (define (unparse-js exp)
(match exp (match exp
@ -85,7 +89,12 @@
(($ var id exp) (($ var id exp)
`(var ,id ,(unparse-js exp))) `(var ,id ,(unparse-js exp)))
(($ binop op arg1 arg2) (($ 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) (define (print-exp exp port)
(match exp (match exp
@ -136,17 +145,41 @@
(print-binop op port) (print-binop op port)
(display "(" port) (display "(" port)
(print-exp arg2 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) (define (print-binop op port)
(case op (case op
((or) (display "||" port)) ((or) (display "||" port))
((and) (display "&&" port)) ((and) (display "&&" port))
((=) (display "==" port)) ((=) (display "==" port))
((+ - < <= > >=) (format port "~a" op)) ((+ - < <= > >= ===) (format port "~a" op))
(else (else
(throw 'unprintable-binop op)))) (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) (define (print-statement stmt port)
(match stmt (match stmt
(($ var id exp) (($ var id exp)

View file

@ -40,7 +40,15 @@
(flatten-block else))) (flatten-block else)))
(($ call function args) (($ call function args)
(make-call (flatten-exp function) (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) (define (maybe-make-block exp)
(match exp (match exp
((exp) exp) ((exp) exp)

View file

@ -104,10 +104,13 @@
(define (bind-opt-args opts num-drop) (define (bind-opt-args opts num-drop)
(map (lambda (opt idx) (map (lambda (opt idx)
(make-var (rename-id opt) (make-var (rename-id opt)
(make-binop 'or (let ((arg (make-refine (make-id "arguments")
(make-refine (make-id "arguments") (make-const (+ num-drop idx)))))
(make-const (+ num-drop idx))) (make-ternary (make-binop '===
(make-refine *scheme* (make-const "UNDEFINED"))))) (make-prefix 'typeof arg)
(make-id "undefined"))
(make-refine *scheme* (make-const "UNDEFINED"))
arg))))
opts opts
(iota (length opts)))) (iota (length opts))))