mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

Add binop type

Browse source
This commit is contained in:
Ian Price 2015-06-08 18:02:01 +01:00
parent 41023d5b4c
commit 30afdcd976
1 changed files with 24 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

26
module/language/javascript.scm
View file

@ -14,6 +14,7 @@
make-refine refine make-refine refine
make-branch branch make-branch branch
make-var var make-var var
make-binop binop
print-statement)) print-statement))
@ -57,6 +58,7 @@
(define-js-type refine id field) (define-js-type refine id field)
(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 (unparse-js exp) (define (unparse-js exp)
(match exp (match exp
@ -81,7 +83,9 @@
(block ,@(map unparse-js then)) (block ,@(map unparse-js then))
(block ,@(map unparse-js else)))) (block ,@(map unparse-js else))))
(($ var id exp) (($ var id exp)
`(var ,id ,(unparse-js exp))))) `(var ,id ,(unparse-js exp)))
(($ binop op arg1 arg2)
`(binop ,op ,arg1 ,arg2))))
(define (print-exp exp port) (define (print-exp exp port)
(match exp (match exp
@ -123,7 +127,25 @@
(($ new expr) (($ new expr)
(format port "new ") (format port "new ")
(print-exp expr port)))) (print-exp expr port))
(($ binop op arg1 arg2)
(display "(" port)
(print-exp arg1 port)
(display ")" port)
(print-binop op port)
(display "(" port)
(print-exp arg2 port)
(display ")" port))))
(define (print-binop op port)
(case op
((or) (display "||" port))
((and) (display "&&" port))
((=) (display "==" port))
((+ - < <= > >=) (format port "~a" op))
(else
(throw 'unprintable-binop op))))
(define (print-statement stmt port) (define (print-statement stmt port)
(match stmt (match stmt