/[gcl]/gcl/cmpnew/gcl_cmpeval.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmpeval.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by camm, Fri Nov 25 16:27:32 2005 UTC revision 1.40 by camm, Wed Nov 30 19:09:08 2005 UTC
# Line 703  Line 703 
703           (out (gensym))           (out (gensym))
704           (lh (gensym))           (lh (gensym))
705           (sv (gensym))           (sv (gensym))
706             (fv (gensym))
707           (p  (gensym))           (p  (gensym))
708           (cv  (gensym))           (cv  (gensym))
709           (tmp  (gensym))           (tmp  (gensym))
# Line 712  Line 713 
713           (tf `(funcall ,fn ,@tf))           (tf `(funcall ,fn ,@tf))
714           (tf (if test-not `(not ,tf) tf))           (tf (if test-not `(not ,tf) tf))
715    
716           (tf (if (and sum (not ivp)) (if (= (length vars) 1) `(if ,sv ,tf ,first) (baboon)) tf))           (tf (if (and sum (not ivp)) (if (= (length vars) 1) `(if ,fv ,tf ,first) (baboon)) tf))
717    
718           (inf (mapcar (lambda (x)           (inf (mapcar (lambda (x)
719                          `(,(car x) ,(cadr x) (if (typep ,(cadr x) 'vector) ,(car x) (cdr ,(car x))))) gs))                          `(,(car x) ,(cadr x) (if (typep ,(cadr x) 'vector) ,(car x) (cdr ,(car x))))) gs))
# Line 724  Line 725 
725                                            :element-type (cmp-array-element-type ,@vars)))) lf))                                            :element-type (cmp-array-element-type ,@vars)))) lf))
726           (lf (if (or dest (eq newseq :list))           (lf (if (or dest (eq newseq :list))
727                   `(,@lf (,p (unless (typep ,dest 'vector) ,dest))) lf))                   `(,@lf (,p (unless (typep ,dest 'vector) ,dest))) lf))
728           (lf (if sum `(,@lf (,sv ,iv)) lf))           (lf (if sum `(,@lf (,fv ,ivp) (,sv ,iv)) lf))
729           (lf (if count `(,@lf (,cv 0)) lf))           (lf (if count `(,@lf (,cv 0)) lf))
730           (lf (if (eq newseq :list ) `(,@lf ,lh) lf))           (lf (if (eq newseq :list ) `(,@lf ,lh) lf))
731           (inf (if (or dest (eq newseq :list))           (inf (if (or dest (eq newseq :list))
# Line 735  Line 736 
736                                                         (if ,p (cdr (rplacd ,p ,tmp))                                                         (if ,p (cdr (rplacd ,p ,tmp))
737                                                           (setq ,lh ,tmp)))) nil))                                                           (setq ,lh ,tmp)))) nil))
738                     ((eq newseq :vector) `(and (setf (aref ,out ,i) ,tf) nil))                     ((eq newseq :vector) `(and (setf (aref ,out ,i) ,tf) nil))
739                     (sum `(progn (setq ,sv ,tf) nil))                     (sum `(progn (setq ,sv ,tf ,fv t) nil))
740                     (count `(progn (when ,tf (incf ,cv)) nil))                     (count `(progn (when ,tf (incf ,cv)) nil))
741                     (tf)))                     (tf)))
742           (tf (if start `(when (>= ,i ,start) ,tf) tf))           (tf (if start `(when (>= ,i ,start) ,tf) tf))
# Line 750  Line 751 
751           (rf (cond (dest dest)           (rf (cond (dest dest)
752                     ((eq newseq :list) lh)                     ((eq newseq :list) lh)
753                     ((eq newseq :vector) out)                     ((eq newseq :vector) out)
754                     (sum sv)                     (sum `(if ,fv ,sv (funcall ,fn)))
755                     (count cv)                     (count cv)
756                     (pos `(unless (= ,i ,l) ,i))                     (pos `(unless (= ,i ,l) ,i))
757                     ((if ret `(funcall ,ret ,(caar gs)) (caar gs))))))                     ((if ret `(funcall ,ret ,(caar gs)) (caar gs))))))

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26