Permalink
Browse files

support for converting consecutive :stat-s into :seq-s, other small f…

…ixes
  • Loading branch information...
1 parent 6e4d252 commit 1872ad8d1f68f3985f5b5224feb2198875016616 @mishoo committed Oct 8, 2010
Showing with 30 additions and 13 deletions.
  1. +30 −13 src/squeeze.lisp
View
@@ -62,19 +62,36 @@
`(:binary :&& ,cond ,then))))
(tighten (statements)
- (let (ret)
- (setf ret (loop :for i :in statements
- :if (eq (car i) :block) :nconc (cadr i)
- :else :collect i))
- (setf ret (loop :for this :in ret
- :with prev = nil
- :if (and prev (or (and (eq (car this) :var) (eq (car prev) :var))
- (and (eq (car this) :const) (eq (car prev) :const))))
- :do (nconc (cadr prev) (cadr this))
- :else :collect this :do (setq prev this)))
- (when no-seqs
- (return-from tighten ret))
- (error "Implement seqs"))))
+ (setf statements (loop :for i :in statements
+ :if (eq (car i) :block) :nconc (cadr i)
+ :else :collect i))
+ (setf statements (loop :for this :in statements
+ :with prev = nil
+
+ ;; XXX: the following should safely remove some unreachable code (but maybe we should warn instead?)
+ ;; :when (member (car this) '(:return :throw :continue :break))
+ ;; :collect this :into ret :and :do (return ret)
+
+ :if (and prev (or (and (eq (car this) :var) (eq (car prev) :var))
+ (and (eq (car this) :const) (eq (car prev) :const))))
+ :do (nconc (cadr prev) (cadr this))
+ :else
+ :collect this :into ret :and :do (setf prev this)
+ :finally (return ret)))
+ (when no-seqs
+ (return-from tighten statements))
+ (setf statements (loop :for this :in statements
+ :with prev = nil
+ :if (not prev)
+ :collect this
+ :and :do (when (eq (car this) :stat)
+ (setf prev this))
+ :else :if (and (eq (car prev) :stat)
+ (eq (car this) :stat))
+ :do (setf (cadr prev) `(:seq ,(cadr prev)
+ ,(cadr this)))
+ :else :collect this :and :do (setf prev nil)))
+ statements))
(ast-walk (ast expr walk)
(ast-case expr

0 comments on commit 1872ad8

Please sign in to comment.