Re: SLOOP -> ANSI LOOP translation
- Subject: Re: SLOOP -> ANSI LOOP translation
- From: ole.rohne at cern
- Date: Wed, 27 Oct 2004 22:24:59 +0200
Jim> I have spent some time with your patches. At first, I brazenly assumed
Jim> that I understood them well enough to apply them to the current cvs. I
Jim> found that make check hung on rtest2.mac. The lines
Jim> M:MATRIX([A,0],[B,1]);
Jim> M^2;
Jim> send maxima into an infinite loop.
The culprit was NLEFT in clmacs.lisp - it exposes a very subtle
difference in the LOOP/SLOOP semantics. I accidentally overlooked it
when I ported my patches to recent-CVS, and fooled myself at running
the tests with the stock maxima.core - no wonder I never saw a timing
difference...
I apologize for your wasted time, and I hope you could have another
go with the appended patches.
Ole
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/asum.lisp new/asum.lisp
--- src/asum.lisp 2004-10-04 08:51:49.000000000 +0200
+++ new/asum.lisp 2004-10-16 22:05:44.000000000 +0200
@@ -20,7 +20,7 @@
(sloop for (x y) on
'(%cot %tan %csc %sin %sec %cos %coth %tanh %csch %sinh %sech %cosh)
- by 'cddr do (putprop x y 'recip) (putprop y x 'recip))
+ by #'cddr do (putprop x y 'recip) (putprop y x 'recip))
(defun nill () '(nil))
@@ -89,7 +89,7 @@
(sloop for i from 1 to n
do (setq j (mod i m))
(setf (aref vec j) (* (aref vec j) i)))
- (sloop for v in-array vec
+ (sloop for v across vec
do (setq ans (* ans v)))
ans))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/clmacs.lisp new/clmacs.lisp
--- src/clmacs.lisp 2004-10-21 11:50:00.000000000 +0200
+++ new/clmacs.lisp 2004-10-27 21:52:34.907221320 +0200
@@ -289,9 +289,9 @@
(setq plist (symbol-plist plist)))
((consp plist) (setq plist (cdr plist)))
(t (return-from oldget nil)))
- (sloop for tail on plist by 'cddr
+ (sloop for tail on plist by #'cddr
when (eq (car tail) indic)
- do (loop-return (second tail))))
+ do (return (second tail))))
(defun safe-get (sym prop)
(and (symbolp sym) (get sym prop)))
@@ -305,9 +305,9 @@
(setq plist (symbol-plist plist)))
((consp plist) (setq plist (cdr plist)))
(t (return-from getl nil)))
- (sloop for tail on plist by 'cddr
+ (sloop for tail on plist by #'cddr
when (memq (car tail) indicator-list)
- do (loop-return tail)))
+ do (return tail)))
;;this is the get of maclisp
;; works on symbols and plists
@@ -427,12 +427,6 @@
`(let ((,g ,x))
(cons ,y ,g))))))
-(defun nleft (n x &optional tail)
- (sloop for v on (nthcdr n x)
- for w on x
- when (eq v tail) do (return w)
- finally (return w)))
-
(defun make-equal-hash-table (not-dim1)
(let ((table (make-hash-table :test 'equal)))
(or not-dim1 (setf (gethash 'dim1 table) t))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/comm2.lisp new/comm2.lisp
--- src/comm2.lisp 2004-10-18 09:04:04.000000000 +0200
+++ new/comm2.lisp 2004-10-18 09:31:34.000000000 +0200
@@ -688,8 +688,7 @@
(let ((dim1 (gethash 'dim1 arra)))
(return
(list* '(mlist) '$hash_table (if dim1 1 t)
- (sloop for (u v)
- in-table arra
+ (sloop for u being the hash-keys in arra using (hash-value v)
when (not (eq u 'dim1))
collect
(if (progn v dim1) ;;ignore v
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/commac.lisp new/commac.lisp
--- src/commac.lisp 2004-10-21 11:50:00.000000000 +0200
+++ new/commac.lisp 2004-10-27 21:05:15.965806016 +0200
@@ -443,7 +443,7 @@
(setf (nth (f1- i)l) val) val)
(defun listify1 (n narg-rest-argument)
- (cond ((minusp n) (copy-list (nleft (f- n) narg-rest-argument)) )
+ (cond ((minusp n) (copy-list (last narg-rest-argument (f- n))) )
((zerop n) nil)
(t (firstn n narg-rest-argument))))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/csimp.lisp new/csimp.lisp
--- src/csimp.lisp 2004-10-04 08:51:50.000000000 +0200
+++ new/csimp.lisp 2004-10-16 22:08:16.000000000 +0200
@@ -41,7 +41,7 @@
%cot %acot %sec %asec %csc %acsc
%sinh %asinh %cosh %acosh %tanh %atanh
%coth %acoth %sech %asech %csch %acsch)
- by 'cddr
+ by #'cddr
do (putprop a b '$inverse) (putprop b a '$inverse))
(defmfun $demoivre (exp)
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/factor.lisp new/factor.lisp
--- src/factor.lisp 2004-10-04 08:51:51.000000000 +0200
+++ new/factor.lisp 2004-10-16 22:10:49.000000000 +0200
@@ -62,7 +62,7 @@
(null (zl-delete 1 (oddelm (cdr (cfactor $factorflag))))))
(defun primcyclo (n &aux *g* (nl (cfactorw n)))
- (setq nl (sloop for (c e) on nl by 'cddr
+ (setq nl (sloop for (c e) on nl by #'cddr
nconc (*make-list e c)))
(let ((res (cyclotomic (list n nl))))
(cond ((consp res) (p-terms res))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/hayat.lisp new/hayat.lisp
--- src/hayat.lisp 2004-09-30 12:50:37.000000000 +0200
+++ new/hayat.lisp 2004-10-16 21:54:18.000000000 +0200
@@ -1868,7 +1868,7 @@
%ASINH (EXPASIN-FUNS ((1 . 1) 1 . 1) -1)
%GAMMA (EXPGAM-FUN ((-1 . 1) 1 . 1))
$PSI (EXPPLYGAM-FUNS plygam-ord))
- by 'cddr
+ by #'cddr
do (putprop fun exp 'EXP-FORM))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/lmdcls.lisp new/lmdcls.lisp
--- src/lmdcls.lisp 2004-10-21 11:50:00.000000000 +0200
+++ new/lmdcls.lisp 2004-10-27 19:18:50.139599160 +0200
@@ -32,7 +32,7 @@
#-gcl '(:compile-toplevel :load-toplevel :execute) )
(t #+gcl '(eval compile) #-gcl '(:compile-toplevel :execute)))
,@(sloop for v in decl-specs
- unless (member (car v) '(special unspecial)) do nil
+ unless (member (car v) '(special unspecial)) nconc nil
else
when (eql (car v) 'unspecial)
collect `(progn
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/loop.lisp new/loop.lisp
--- src/loop.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new/loop.lisp 2004-10-27 11:13:29.000000000 +0200
@@ -0,0 +1,3 @@
+(in-package "CL-SLOOP")
+(defmacro sloop (&rest body) `(loop ,@body))
+
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/macdes.lisp new/macdes.lisp
--- src/macdes.lisp 2004-10-21 11:50:00.000000000 +0200
+++ new/macdes.lisp 2004-10-27 11:37:34.000000000 +0200
@@ -108,7 +108,6 @@
(setq top (meval* top))
(numberp top)))
(sloop for i from lis to top
- nodeclare t
do (set var1 i)
append
(apply 'create-list1
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/maxima new/maxima
--- src/maxima 2004-10-27 09:57:29.000000000 +0200
+++ new/maxima 2004-10-27 12:06:45.000000000 +0200
@@ -22,13 +22,13 @@
if [ "$layout_autotools" = "true" ]; then
MAXIMA_DEFAULT_IMAGESDIR=$libdir/$PACKAGE/$MAXIMA_VERSION
else
- MAXIMA_DEFAULT_IMAGESDIR=$top_srcdir/src
+ MAXIMA_DEFAULT_IMAGESDIR=$top_srcdir/new
fi
if [ -n "$MAXIMA_PREFIX" ]; then
if [ "$layout_autotools" = "true" ]; then
MAXIMA_IMAGESDIR=`unixize "$MAXIMA_PREFIX"`/lib/$PACKAGE/$MAXIMA_VERSION
else
- MAXIMA_IMAGESDIR=`unixize "$MAXIMA_PREFIX"`/src
+ MAXIMA_IMAGESDIR=`unixize "$MAXIMA_PREFIX"`/new
fi
else
MAXIMA_IMAGESDIR="$MAXIMA_DEFAULT_IMAGESDIR"
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/maxima-package.lisp new/maxima-package.lisp
--- src/maxima-package.lisp 2004-10-21 11:50:01.000000000 +0200
+++ new/maxima-package.lisp 2004-10-27 11:12:00.000000000 +0200
@@ -13,15 +13,12 @@
;; GCL has SLOOP built in but it's slightly different now...
(defpackage "CL-SLOOP"
(:use "COMMON-LISP")
- (:shadow "LOOP-FINISH")
- (:export "LOOP-RETURN" "SLOOP" "DEF-LOOP-COLLECT" "DEF-LOOP-MAP"
- "DEF-LOOP-FOR" "DEF-LOOP-MACRO" "LOCAL-FINISH" "LOOP-FINISH"))
+ (:export "SLOOP"))
(defpackage "MAXIMA"
(:use "COMMON-LISP" "COMMAND-LINE")
(:nicknames "CL-MACSYMA" "CL-MAXIMA" "MACSYMA")
- (:shadowing-import-from "CL-SLOOP" "LOOP-FINISH")
- (:import-from "CL-SLOOP" "LOOP-RETURN" "LOCAL-FINISH" "SLOOP")
+ (:import-from "CL-SLOOP" "SLOOP")
(:shadow complement ;(maxmac)
continue ;(macsys): part of the top-level loop
// ;(clmacs): arithmetic operator
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/maxima.system new/maxima.system
--- src/maxima.system 2004-10-27 21:49:11.355165936 +0200
+++ new/maxima.system 2004-10-27 21:48:27.660808488 +0200
@@ -47,8 +47,8 @@
(:module info :source-pathname ""
:components ((:file "nregex")
(:file "cl-info")))
- (:module sloop :source-pathname ""
- :components ((:file "sloop")))
+ (:module loop :source-pathname ""
+ :components ((:file "loop")))
(:module declarations :source-pathname ""
:components ((:file "lmdcls")))
(:module destructuring-let :source-pathname ""
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/mdebug.lisp new/mdebug.lisp
--- src/mdebug.lisp 2004-10-21 11:50:01.000000000 +0200
+++ new/mdebug.lisp 2004-10-27 11:37:33.000000000 +0200
@@ -120,7 +120,7 @@
(cond ((and (symbolp sym)(get sym prop)(equal (symbol-package sym)
(find-package package)))
(return-from complete-prop sym)))
- (sloop for vv in-package package
+ (sloop for vv being the symbols of package
when (and (get vv prop)
(eql #+gcl (string-match sym vv)
#-gcl (search (symbol-name sym)
@@ -473,7 +473,7 @@
(dolist (v (complete-prop key 'keyword 'break-doc t))
(format t "~&~%~(~s~) ~a" v (get v 'break-doc)))))
(t
- (sloop for vv in-package 'keyword
+ (sloop for vv being the symbols of 'keyword
when (get vv 'break-command)
collect (cons vv (or (get vv 'break-doc) "Undocumented"))
into all
@@ -524,7 +524,7 @@
(cond ((or (stringp fun)
(and (mstringp fun) (setq fun ($sconcat fun))))
(let ((file fun) start)
- (sloop named joe for vv in-package 'maxima with tem and linfo
+ (sloop named joe for vv being the symbols of 'maxima with tem with linfo
when (and (typep (setq tem (set-full-lineinfo vv))
'vector)
(setq linfo (get-lineinfo (aref tem 1)))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/nrat4.lisp new/nrat4.lisp
--- src/nrat4.lisp 2004-10-18 09:04:05.000000000 +0200
+++ new/nrat4.lisp 2004-10-18 09:31:31.000000000 +0200
@@ -193,18 +193,18 @@
(defun everysubst00 (x i z)
(sloop with ans = (rzero)
- for (exp coef) on (everysubst i z *alpha) by 'pt-red
+ for (exp coef) on (everysubst i z *alpha) by #'pt-red
do (setq ans (ratplus ans (rattimes (cons coef 1) (ratexpt x exp) t)))
finally (return ans)))
(defun everysubst0 (x i z)
(sloop with ans = (pzero)
- for (exp coef) on (everysubst i z *alpha) by 'pt-red
+ for (exp coef) on (everysubst i z *alpha) by #'pt-red
do (setq ans (pplus ans (xptimes coef (pexpt x exp))))
finally (return ans)))
(defun everysubst1 (a b maxpow)
- (sloop for (exp coef) on (p-terms b) by 'pt-red
+ (sloop for (exp coef) on (p-terms b) by #'pt-red
for part = (everysubst a coef maxpow)
nconc (if (= 0 exp) part
(everysubst2 part (make-poly (p-var b) exp 1)))))
@@ -299,7 +299,7 @@
(defun prodcoef1 (a b)
(sloop with ans = (pzero)
- for (bexp bcoef) on (p-terms b) by 'pt-red
+ for (bexp bcoef) on (p-terms b) by #'pt-red
for part = (prodcoef a bcoef)
unless (pzerop part)
do (setq ans (pplus ans (psimp (p-var b) (list bexp part))))
@@ -568,7 +568,7 @@
(defun goodform (l) ;;bad -> good
- (sloop for (exp coef) on l by 'pt-red
+ (sloop for (exp coef) on l by #'pt-red
collect (cons exp coef)))
(defun factorlogs (l)
@@ -633,7 +633,7 @@
(defun nmt (p any)
(cond ((pcoefp p)
(if (or any (cminusp p)) 1 0))
- (t (sloop for lp on (p-terms p) by 'pt-red
+ (t (sloop for lp on (p-terms p) by #'pt-red
sum (nmt (cadr lp) any)))))
(defun nmterms (p)
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/numth.lisp new/numth.lisp
--- src/numth.lisp 2004-10-04 08:51:54.000000000 +0200
+++ new/numth.lisp 2004-10-16 22:12:36.000000000 +0200
@@ -371,7 +371,7 @@
(return ans)))
(defun multiply-gcfactors (lis)
- (sloop for (term exp) on (cddr lis) by 'cddr
+ (sloop for (term exp) on (cddr lis) by #'cddr
with answ = (cond ((numberp (car lis))(list (pexpt (car lis) (second lis)) 0))
(t(gcexpt (car lis) (second lis))))
when (numberp term)
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/plot.lisp new/plot.lisp
--- src/plot.lisp 2004-10-21 11:50:01.000000000 +0200
+++ new/plot.lisp 2004-10-27 11:38:46.000000000 +0200
@@ -331,8 +331,7 @@
(setq x (aref pts j))
(setq y (aref pts (+ j 1)))
(setq z (aref pts (+ j 2)))
- (sloop for i below 3 with a = 0.0
- declare (double-float a)
+ (sloop for i below 3 with a of-type double-float = 0.0
do
(setq a (* x (aref rot (+ (* 3 i) 0))))
(setq a (+ a (* y (aref rot (+ (* 3 i) 1)))))
@@ -1134,7 +1133,7 @@
($mgnuplot
(format st "~%~%# \"~a\"~%" plot-name))
)
- (sloop for (v w) on (cdr (draw2d v range )) by 'cddr
+ (sloop for (v w) on (cdr (draw2d v range )) by #'cddr
do
(cond ((eq v 'moveto)
(cond
@@ -1825,8 +1824,7 @@
;; we do the x y z separately:
(sloop for off from 0 to 2
with ar = (polygon-pts pl)
- with i = 0
- declare (fixnum i)
+ with i of-type fixnum = 0
do (setq i off)
(format $pstream "~%{")
(sloop
@@ -1853,8 +1851,7 @@
with m = (* 3 (+ 1 (nth 2 grid)))
collect (aref ar (+ 1 (* i m)))))
(z (sloop for i to (nth 3 grid)
- with k = 2
- declare (fixnum k)
+ with k of-type fixnum = 2
collect
(sloop for j to (nth 2 grid)
collect (aref ar k)
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/rat3a.lisp new/rat3a.lisp
--- src/rat3a.lisp 2004-10-18 09:04:06.000000000 +0200
+++ new/rat3a.lisp 2004-10-18 09:31:31.000000000 +0200
@@ -404,7 +404,7 @@
(t (psimp (p-var p) (pcsub2 (p-terms p) vals vars)))))
(defun pcsub2 (terms vals vars)
- (sloop for (exp coef) on terms by 'pt-red
+ (sloop for (exp coef) on terms by #'pt-red
unless (pzerop (setq coef (pcsub coef vals vars)))
nconc (list exp coef)))
@@ -517,13 +517,13 @@
(cons (p-var p) (pminus1 (p-terms p)))))
(defun pminus1 (x)
- (sloop for (exp coef) on x by 'pt-red
+ (sloop for (exp coef) on x by #'pt-red
nconc (list exp (pminus coef))))
(defmfun pmod (p)
(if (pcoefp p) (cmod p)
(psimp (car p)
- (sloop for (exp coef) on (p-terms p) by 'pt-red
+ (sloop for (exp coef) on (p-terms p) by #'pt-red
unless (pzerop (setq coef (pmod coef)))
nconc (list exp coef)))))
@@ -548,7 +548,7 @@
(psimp (p-var p) (pcquotient1 (p-terms p) q)))
(defun pcquotient1 (p1 q)
- (sloop for (exp coef) on p1 by 'pt-red
+ (sloop for (exp coef) on p1 by #'pt-red
nconc (list exp (pquotient coef q))))
(declare-top(special k q*)
@@ -698,7 +698,7 @@
uuu)
(defun pcetimes1 (y e c) ;C*V^E*Y
- (sloop for (exp coef) on y by 'pt-red
+ (sloop for (exp coef) on y by #'pt-red
unless (pzerop (setq coef (ptimes c coef)))
nconc (list (f+ e exp) coef)))
@@ -707,7 +707,7 @@
(psimp (p-var p) (pctimes1 c (p-terms p)))))
(defun pctimes1 (c terms)
- (sloop for (exp coef) on terms by 'pt-red
+ (sloop for (exp coef) on terms by #'pt-red
unless (pzerop (setq coef (ptimes c coef)))
nconc (list exp coef)))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/rat3c.lisp new/rat3c.lisp
--- src/rat3c.lisp 2004-10-04 08:51:55.000000000 +0200
+++ new/rat3c.lisp 2004-10-16 22:13:45.000000000 +0200
@@ -549,7 +549,7 @@
(cond ((or (pcoefp p) (pointergp v (p-var p))) (list 0 p))
((eq (p-var p) v) (p-terms p))
((sloop with ans
- for (exp coef) on (p-terms p) by 'pt-red
+ for (exp coef) on (p-terms p) by #'pt-red
do (setq ans (pplus1 ans
(everysubst2 (poly-in-var coef v)
(list (p-var p) exp 1))))
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' -x '*.orig' -x '.#*' -x 'maxout.*' src/risch.lisp new/risch.lisp
--- src/risch.lisp 2004-10-18 09:04:06.000000000 +0200
+++ new/risch.lisp 2004-10-18 09:31:29.000000000 +0200
@@ -957,7 +957,7 @@
(cond ((or (pcoefp p) (not (eq 'mexpt (get (p-var p) 'leadop))))
(list (list p oarg (ptimes p exps))))
(t (sloop with narg = (get (p-var p) 'rischarg)
- for (exp coef) on (p-terms p) by 'pt-red
+ for (exp coef) on (p-terms p) by #'pt-red
nconc (explist coef
(r+ oarg (r* exp narg))
(ptimes exps