[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] tagbody
From: |
Camm Maguire |
Subject: |
[Gcl-devel] tagbody |
Date: |
24 Nov 2006 17:24:37 -0500 |
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
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 address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
- [Gcl-devel] tagbody,
Camm Maguire <=