1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
guile/module/language/javascript/simplify.scm

56 lines
1.7 KiB
Scheme

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