1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00

Simplify output Javascript

This commit is contained in:
Ian Price 2015-06-13 15:29:13 +01:00
parent e9d0f97410
commit 46905ec322
2 changed files with 52 additions and 1 deletions

View file

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