diff --git a/wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp b/wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp index a0e9827..e29b1d9 100644 --- a/wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp +++ b/wip-duuqnd/user-side-compiler/middle/compile-node-to-ir.lisp @@ -74,7 +74,7 @@ (then-iblock (make-instance 'iblock :name "then")) (else-iblock (make-instance 'iblock :name "else")) (continuation (if else-exists-p - (make-instance 'iblock :name "merge") + (make-instance 'iblock-merge :name "merge") else-iblock))) (build-insert-end (make-instance 'ir-if diff --git a/wip-duuqnd/user-side-compiler/middle/jigs.lisp b/wip-duuqnd/user-side-compiler/middle/jigs.lisp index 4097bfb..e3aebed 100644 --- a/wip-duuqnd/user-side-compiler/middle/jigs.lisp +++ b/wip-duuqnd/user-side-compiler/middle/jigs.lisp @@ -40,19 +40,33 @@ ;;; Compilation setup -(defun fix-iblock-flow (iblock) - (let ((reached '())) +(defun fix-iblock-flow (start-iblock) + (let ((reached '()) + (last nil) + (deferred '())) (labels - ((fix (iblock prev) + ((fix-deferred () + (unless (null deferred) + (loop :for after :in (nreverse (pop deferred)) + :do (fix after last)))) + (fix (iblock prev) (unless (member iblock reached) (push iblock reached) - (setf (next iblock) - (first (successors iblock)) - (prev iblock) prev) - (loop :for prev := iblock :then s - :for s :in (successors iblock) - :do (fix s prev))))) - (fix iblock nil)))) + (unless (null prev) + (setf (next prev) iblock)) + (setf (prev iblock) prev + last iblock) + (fix-deferred) + (push '() deferred) + (loop :for s :in (successors iblock) + :if (typep s 'iblock-merge) + :do (pushnew s (car deferred)) + :else + :do (fix s last)) + (when (null prev) + (loop :until (null deferred) + :do (fix-deferred)))))) + (fix start-iblock nil)))) (defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body) `(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program))) diff --git a/wip-duuqnd/user-side-compiler/middle/structure.lisp b/wip-duuqnd/user-side-compiler/middle/structure.lisp index c1329f5..79f8468 100644 --- a/wip-duuqnd/user-side-compiler/middle/structure.lisp +++ b/wip-duuqnd/user-side-compiler/middle/structure.lisp @@ -12,6 +12,8 @@ (%prev :accessor prev :type (or null iblock) :initform nil) (%name :accessor name :initarg :name :initform nil))) +(defclass iblock-merge (iblock) ()) + (defmethod find-variable (reference (search-from ir-program)) (multiple-value-bind (var existsp) (gethash reference (variables search-from))