Re: [Gcl-devel] Re: possible dotimes enhancement

[Camm Maguire]

Greetings!  Paul sorry to bother you again today on this.  How is this
for a dotimes?

=============================================================================
(defmacro dotimes ((var form &optional (val nil)) &rest body
                                                  &aux (temp (gensym)) tdec 
tplus)

;; 
;; first check if compiler has info on form in surrounding scope
;; only care about fixnum optimization
;;

  (dolist (v compiler::*vars*)
    (when (and (eq (compiler::var-name v) form) (eq (compiler::var-type v) 
'fixnum))
      (setq tdec `(declare (type fixnum ,temp)))))

;; 
;; Then check if form has been declared in body
;; only care about fixnum optimization
;;


  (unless tdec
    (dolist (v body) 
      (when (eq (car v) 'declare) 
        (let ((vv (cadr v)))
          (when (eq (car vv) 'type)
            (setq vv (cdr vv)))
          (when (eq (car vv) 'fixnum)
            (dolist (vvv (cdr vv))
              (when (eq vvv form)
                (setq tdec `(declare (type fixnum ,temp))))))))))

;; 
;; Finally check if var has been declared in body
;; only care about fixnum optimization
;; make sure to eval form once in general and check positivity
;;

  (unless tdec
    (dolist (v body) 
      (when (eq (car v) 'declare) 
        (let ((vv (cadr v)))
          (when (eq (car vv) 'type)
            (setq vv (cdr vv)))
          (when (eq (car vv) 'fixnum)
            (dolist (vvv (cdr vv))
              (when (eq vvv var)
                (setq tplus t)
                (setq tdec `(declare (type fixnum ,temp))))))))))
    
  (when tdec
    (setq body (cons tdec body)))
  (if tplus
      `(let* ((,temp ,form))
         (cond ((plusp ,temp)
                (do* ((,temp ,form) (,var 0 (1+ ,var)))
                     ((>= ,var ,temp) ,val)
                     ,@body))
               (t
                (let ((,var 0))
                  ,val))))
    `(do* ((,temp ,form) (,var 0 (1+ ,var)))
          ((>= ,var ,temp) ,val)
          ,@body)
    ))
=============================================================================
(defun foo3 (n)   (dotimes (i n)   (format t "~S~%" i)))
static void L1()
{register object *base=vs_base;
        register object *sup=base+VM1; VC1
        vs_check;
        {object V1;
        V1=(base[0]);
        vs_top=sup;
        goto TTL;
TTL:;
        {register object V2;
        register object V3;
        V2= (V1);
        V3= small_fixnum(0);
        goto T4;
T4:;
        if(!(number_compare((V3),(V2))>=0)){
        goto T5;}
        base[1]= Cnil;
        vs_top=(vs_base=base+1)+1;
        return;
        goto T5;
T5:;
        base[1]= Ct;
        base[2]= VV[0];
        base[3]= (V3);
        vs_top=(vs_base=base+1)+3;
        Lformat();
        vs_top=sup;
        V3= one_plus((V3));
        goto T4;}
        }
}
=============================================================================
(defun foo2 (n)   (dotimes (i n) (declare (fixnum i))  (format t
    "~S~%" i)))
static void L1()
{register object *base=vs_base;
        register object *sup=base+VM1; VC1
        vs_check;
        {object V1;
        V1=(base[0]);
        vs_top=sup;
        goto TTL;
TTL:;
        if(!(number_compare(small_fixnum(0),V1)<0)){
        goto T2;}
        {register long V3;
        register long V4;
        V3= fix((V1));
        V4= 0;
        goto T7;
T7:;
        if(!((V4)>=(V3))){
        goto T8;}
        base[1]= Cnil;
        vs_top=(vs_base=base+1)+1;
        return;
        goto T8;
T8:;
        base[1]= Ct;
        base[2]= VV[0];
        base[3]= CMPmake_fixnum(V4);
        vs_top=(vs_base=base+1)+3;
        Lformat();
        vs_top=sup;
        V4= (long)(V4)+1;
        goto T7;}
        goto T2;
T2:;
        base[1]= Cnil;
        vs_top=(vs_base=base+1)+1;
        return;
        }
}
=============================================================================
(defun foo1 (n)   (dotimes (i n) (declare (fixnum i n))  (format t
    "~S~%" i)))
static void L1()
{register object *base=vs_base;
        register object *sup=base+VM1; VC1
        vs_check;
        {object V1;
        V1=(base[0]);
        vs_top=sup;
        goto TTL;
TTL:;
        {register long V2;
        register long V3;
        V2= fix((V1));
        V3= 0;
        goto T4;
T4:;
        if(!((V3)>=(V2))){
        goto T5;}
        base[1]= Cnil;
        vs_top=(vs_base=base+1)+1;
        return;
        goto T5;
T5:;
        base[1]= Ct;
        base[2]= VV[0];
        base[3]= CMPmake_fixnum(V3);
        vs_top=(vs_base=base+1)+3;
        Lformat();
        vs_top=sup;
        V3= (long)(V3)+1;
        goto T4;}
        }
}
=============================================================================
(defun foo (n)  (declare (fixnum n)) (dotimes (i n) (declare (fixnum
    i))  (format t "~S~%" i)))
static void L1()
{register object *base=vs_base;
        register object *sup=base+VM1; VC1
        vs_check;
        {long V1;
        V1=fix(base[0]);
        vs_top=sup;
        goto TTL;
TTL:;
        {register long V2;
        register long V3;
        V2= V1;
        V3= 0;
        goto T4;
T4:;
        if(!((V3)>=(V2))){
        goto T5;}
        base[1]= Cnil;
        vs_top=(vs_base=base+1)+1;
        return;
        goto T5;
T5:;
        base[1]= Ct;
        base[2]= VV[0];
        base[3]= CMPmake_fixnum(V3);
        vs_top=(vs_base=base+1)+3;
        Lformat();
        vs_top=sup;
        V3= (long)(V3)+1;
        goto T4;}
        }
}
=============================================================================

Take care,
-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah