Greetings!
Do you see a problem with
(defun recognizable-go-form (form)
(case (car form)
((throw go) t)
((let progn) (recognizable-go-form (last form)))
(if (and (recognizable-go-form (caddr form)) (recognizable-go-form
(cadddr form))))))
(defun munge-tagbody (form &optional if res)
(let (r)
(do nil ((not (setq l (pop form))) (nreverse r))
(push
(cond ((and (consp l) (eq (car l) 'if) (recognizable-go-form (caddr
form)) (not (cdddr l)))
`(,(car l) ,(cadr l) ,(caddr l)
(progn ,@(do (q (nf form (cdr nf)))
((or (not nf) (atom (car nf)) (eq 'go (caar nf)))
(setq form nf q (nreverse q)))
(push (car nf) q)))))
(l)) r))))
(defun c1tagbody (body &aux (*tags* *tags*) (info (make-info)))
(setq body (munge-tagbody (portable-source body)))
;;; Establish tags.
...
to transform
COMPILER>(portable-source '(loop for i from 0 to x do (incf i)))
(BLOCK ()
(LET ((I 0) (#:G3322 X))
(DECLARE (TYPE REAL #:G3322) (TYPE REAL I))
(TAGBODY
ANSI-LOOP::NEXT-LOOP
(IF (> I #:G3322) (PROGN (GO ANSI-LOOP::END-LOOP)))
(SETQ I (LET* ((#:G174058 1)) (+ I #:G174058)))
(SETQ I (+ I 1))
(GO ANSI-LOOP::NEXT-LOOP)
ANSI-LOOP::END-LOOP)))
COMPILER>
into the much more optimizable
COMPILER>(munge-tagbody a)
(TAGBODY
ANSI-LOOP::NEXT-LOOP
(IF (> I #:G3321) (PROGN (GO ANSI-LOOP::END-LOOP))
(PROGN
(SETQ I (LET* ((#:G174058 1)) (+ I #:G174058)))
(SETQ I (1+ I))))
(GO ANSI-LOOP::NEXT-LOOP)
ANSI-LOOP::END-LOOP)
???
Take care,
--
Camm Maguire [EMAIL PROTECTED]
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
_______________________________________________
Gcl-devel mailing list
Gcl-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/gcl-devel
