Simplify output Javascript

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 '())))

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"))