summaryrefslogtreecommitdiff
path: root/module/language/javascript/simplify.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/javascript/simplify.scm')
-rw-r--r--module/language/javascript/simplify.scm58
1 files changed, 58 insertions, 0 deletions
diff --git a/module/language/javascript/simplify.scm b/module/language/javascript/simplify.scm
new file mode 100644
index 000000000..a26b7fd2e
--- /dev/null
+++ b/module/language/javascript/simplify.scm
@@ -0,0 +1,58 @@
+(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
+ (($ assign id exp)
+ (make-assign id (flatten-exp 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)))
+
+ (($ 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)
+ (match exp
+ ((exp) exp)
+ (exps (make-block exps))))
+ (maybe-make-block (flatten exp '())))