Verified Commit fd993de3 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Fix bug in SWITCH handling of nested blocks

parent 9b9177f9
......@@ -65,18 +65,13 @@
(define-statement-operator switch (test-expr &rest clauses)
`(ps-js:switch ,(compile-expression test-expr)
,@(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'ps-js:default
(let ((in-case? t))
(compile-expression val)))
(mapcan (lambda (x)
(let* ((in-case? t)
(exp (compile-statement x)))
(if (and (listp exp) (eq 'ps-js:block (car exp)))
(cdr exp)
(list exp))))
body)))))
,@(let ((in-case? t))
(loop for (val . body) in clauses collect
(cons (if (eq val 'default)
'ps-js:default
(compile-expression val))
(flatten-blocks
(mapcar #'compile-statement body)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; objects
......
......@@ -148,12 +148,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; blocks and control flow
(defun flatten-blocks (body)
(when body
(if (and (listp (car body)) (eq 'ps-js:block (caar body)))
(append (cdr (car body)) (flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body))))))
(defun compile-progn (body)
(let ((block (flatten-blocks (mapcar #'ps-compile body))))
(append (remove-if #'constantp (butlast block))
......@@ -224,14 +218,18 @@
__PS_MV_REG ,values-list)
,firstval))))
(define-statement-operator %simple-lexical-return (&rest value)
`(ps-js:return ,@value))
(defun return-exp (tag &optional (value nil value?))
(flet ((lexical-return ()
(let ((X (when value? (list (compile-expression value)))))
(if (and (not returning-values?) clear-multiple-values?)
`(ps-js:block
(ps-js:= __PS_MV_REG [])
(ps-js:return ,@X))
`(ps-js:return ,@X)))))
(ps-compile
(if (and (not returning-values?) clear-multiple-values?)
`(progn
(setf __PS_MV_REG (list))
(%simple-lexical-return ,@X))
`(%simple-lexical-return ,@X))))))
(acond
((eql tag *current-block-tag*)
(compile-statement
......@@ -306,7 +304,8 @@
1)
((eq 'break (car (last cbody)))
2))
(let ((result-form (ps-macroexpand (car (last cbody it)))))
(let ((result-form (ps-macroexpand
(car (last cbody it)))))
`(,cvalue
,@(butlast cbody it)
(return-from ,tag
......
......@@ -118,6 +118,13 @@ Use GETPROP, @, or CHAIN instead."
((atom x) (cons x acc))
(t (flatten (car x) (flatten (cdr x) acc)))))
(defun flatten-blocks (body)
(when body
(if (and (listp (car body)) (eq 'ps-js:block (caar body)))
(append (flatten-blocks (cdr (car body)))
(flatten-blocks (cdr body)))
(cons (car body) (flatten-blocks (cdr body))))))
(defun tree-find (A tree)
(or (equal A tree)
(when (consp tree)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment