Fix recursive conditional

diff --git a/experimental/compiler.lisp b/experimental/compiler.lisp
index 72faa37..19ace52 100644 (file)
--- a/experimental/compiler.lisp
+++ b/experimental/compiler.lisp
@@ -379,29 +379,33 @@
     (let ((assign (make-assignment :variable var :value value-lvar :lvar (result-lvar))))
       (insert-node assign))))
 
+(define-ir-translator progn (&body body)
+  (dolist (form (butlast body))
+    (ir-convert form))
+  (ir-convert (car (last body)) (result-lvar)))
+
 (define-ir-translator if (test then &optional else)
   (when (conditional-p (cursor-next *cursor*))
     (error "Impossible to insert a conditional after another conditional."))
   ;; Split the basic block if we are in the middle of one.
   (unless (end-of-block-p) (split-block))
-  (let* ((block (cursor-block *cursor*))
-         (test-lvar (make-lvar))
+  (let ((test-lvar (make-lvar))
          (then-block (make-empty-block))
          (else-block (make-empty-block))
-         (join-block (make-empty-block))
-         (tail-block (unlist (block-succ block))))
-    ;; Insert conditional IR
+         (join-block (make-empty-block)))
     (ir-convert test test-lvar)
     (insert-node (make-conditional :test test-lvar :consequent then-block :alternative else-block))
-    ;; Link together the different created basic blocks.
-    (setf (block-succ block)      (list else-block then-block)
-          (block-pred else-block) (list block)
-          (block-pred then-block) (list block)
-          (block-succ then-block) (list join-block)
-          (block-succ else-block) (list join-block)
-          (block-pred join-block) (list else-block then-block)
-          (block-succ join-block) (list tail-block)
-          (block-pred tail-block) (substitute join-block block (block-pred tail-block)))
+    (let* ((block (cursor-block *cursor*))
+           (tail-block (unlist (block-succ block))))
+      ;; Link together the different created basic blocks.
+      (setf (block-succ block)      (list else-block then-block)
+            (block-pred else-block) (list block)
+            (block-pred then-block) (list block)
+            (block-succ then-block) (list join-block)
+            (block-succ else-block) (list join-block)
+            (block-pred join-block) (list else-block then-block)
+            (block-succ join-block) (list tail-block)
+            (block-pred tail-block) (substitute join-block block (block-pred tail-block))))
     ;; Convert he consequent and alternative forms and update cursor.
     (ir-convert then (result-lvar) (cursor :block then-block))
     (ir-convert else (result-lvar) (cursor :block else-block))