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:
parent
b631576f13
commit
89029a54f4
3 changed files with 52 additions and 8 deletions
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue