cwebber pushed a commit to branch compile-to-js-merge
in repository guile.
commit 46905ec32223938e7ac4380ec9bdea791fce75d1
Author: Ian Price <[email protected]>
AuthorDate: Sat Jun 13 15:29:13 2015 +0100
Simplify output Javascript
---
module/language/javascript/simplify.scm | 48 ++++++++++++++++++++++++++++
module/language/js-il/compile-javascript.scm | 5 ++-
2 files changed, 52 insertions(+), 1 deletion(-)
diff --git a/module/language/javascript/simplify.scm
b/module/language/javascript/simplify.scm
new file mode 100644
index 0000000..b3360aa
--- /dev/null
+++ b/module/language/javascript/simplify.scm
@@ -0,0 +1,48 @@
+(define-module (language javascript simplify)
+ #:use-module (language javascript)
+ #:use-module (ice-9 match)
+ #:use-module ((srfi srfi-1) #:select (fold-right))
+ #:export (flatten-blocks))
+
+(define (flatten-blocks exp)
+ (define (flatten exp rest)
+ (match exp
+ (($ block statements)
+ (fold-right flatten rest statements))
+ (else
+ (cons (flatten-exp exp) rest))))
+ (define (flatten-block stmts)
+ (fold-right flatten '() stmts))
+ (define (flatten-exp exp)
+ (match exp
+ (($ const c) exp)
+ (($ new exp)
+ (make-new (flatten-exp exp)))
+ (($ return exp)
+ (make-return (flatten-exp exp)))
+ (($ id name) exp)
+ (($ var id exp)
+ (make-var id (flatten-exp exp)))
+ (($ refine id field)
+ (make-refine (flatten-exp id)
+ (flatten-exp field)))
+ (($ binop op arg1 arg2)
+ (make-binop op
+ (flatten-exp arg1)
+ (flatten-exp arg2)))
+ (($ function args body)
+ (make-function args (flatten-block body)))
+ (($ block statements)
+ (maybe-make-block (flatten-block statements)))
+ (($ branch test then else)
+ (make-branch (flatten-exp test)
+ (flatten-block then)
+ (flatten-block else)))
+ (($ call function args)
+ (make-call (flatten-exp function)
+ (map flatten-exp args)))))
+ (define (maybe-make-block exp)
+ (match exp
+ ((exp) exp)
+ (exps (make-block exps))))
+ (maybe-make-block (flatten exp '())))
diff --git a/module/language/js-il/compile-javascript.scm
b/module/language/js-il/compile-javascript.scm
index 3b13e08..ca7cca5 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -3,6 +3,7 @@
#:use-module (ice-9 match)
#:use-module ((language js-il) #:renamer (symbol-prefix-proc 'il:))
#:use-module (language javascript)
+ #:use-module (language javascript simplify)
#:use-module (language js-il direct)
#:use-module (system foreign)
#:export (compile-javascript))
@@ -15,7 +16,9 @@
(define (compile-javascript exp env opts)
(set! exp (remove-immediate-calls exp))
- (values (compile-exp exp) env env))
+ (set! exp (compile-exp exp))
+ (set! exp (flatten-blocks exp))
+ (values exp env env))
(define *scheme* (make-id "scheme"))
