mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 05:12:38 -08:00
Code Issues Projects Releases Packages Wiki Activity

C2FMLA-AND reduced to the simplest form.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-17 17:20:20 +02:00
parent 59cffab21a
commit 8787e482ba
1 changed files with 18 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

32
src/cmp/cmpif.lsp
View file

@ -225,21 +225,25 @@
*destination*))
(close-inline-blocks))))))
(defun jump-true-destination? ()
(let ((dest *destination*))
(and (consp dest) (eq (car dest) 'JUMP-TRUE))))
(defun jump-false-destination? ()
(let ((dest *destination*))
(and (consp dest) (eq (car dest) 'JUMP-FALSE))))
(defun c2fmla-and (butlast last)
(with-exit-label (normal-exit)
(let* ((dest *destination*))
(cond ((and (consp dest) (eq (car dest) 'JUMP-TRUE))
(CJT *current-c2form* (second dest) normal-exit))
((and (consp dest) (eq (car dest) 'JUMP-FALSE))
(mapc #'c2expr* butlast)
(c2expr last))
(t
(with-exit-label (false-label)
(let ((*destination* `(JUMP-FALSE ,false-label)))
(mapc #'c2expr* butlast))
(c2expr last)
(wt-nl) (wt-go normal-exit))
(unwind-exit nil))))))
(if (jump-false-destination?)
(progn
(mapc #'c2expr* butlast)
(c2expr last))
(with-exit-label (normal-exit)
(with-exit-label (false-label)
(let ((*destination* `(JUMP-FALSE ,false-label)))
(mapc #'c2expr* butlast))
(c2expr last))
(unwind-exit nil))))
(defun c2fmla-or (butlast last)
(let* ((normal-exit (next-label))