Set up IBLOCK order during building to fix ordering bug

This commit is contained in:
John Lorentzson 2025-07-29 18:57:33 +02:00
parent 04df970b3a
commit ab9ff442ef
3 changed files with 3 additions and 31 deletions

View file

@ -43,7 +43,6 @@
(builder (make-instance 'builder)))
(build-begin builder iblock)
(compile-node syntax-tree builder)
(fix-iblock-flow iblock)
(unless (null (next iblock))
(make-iblock-names-unique (next iblock)))
iblock))

View file

@ -57,7 +57,9 @@
(defun build-begin (builder iblock)
"Start BUILDER on a fresh IBLOCK."
(when (slot-boundp builder '%iblock)
(setf (program iblock) (program (iblock builder))))
(setf (program iblock) (program (iblock builder))
(next (iblock builder)) iblock
(prev iblock) (iblock builder)))
(setf (insertion-point builder) nil
(iblock builder) iblock))

View file

@ -53,34 +53,6 @@
(setf (name iblock)
(format nil "~A_1" (name iblock)))))))))
(defun fix-iblock-flow (start-iblock)
(let ((reached '())
(last nil)
(deferred '()))
(labels
((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)
(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)))
(,builder (make-instance 'builder)))
@ -90,7 +62,6 @@
,@body)
(when ,add-return-p
(build-insert-end (make-instance 'ir-return) ,builder))
(fix-iblock-flow ,iblock)
(unless (null (next ,iblock))
(make-iblock-names-unique (next ,iblock))))))