From 709d2737da56b9ecbd9598bab911e3feefdfb42c Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Sat, 11 May 2013 00:42:14 +0100 Subject: [PATCH] Fix recursive conditional --- experimental/compiler.lisp | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/experimental/compiler.lisp b/experimental/compiler.lisp index 72faa37..19ace52 100644 --- 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)) -- 1.7.10.4