SLOOP -> ANSI LOOP translation
- Subject: SLOOP -> ANSI LOOP translation
- From: ole.rohne at cern
- Date: Wed, 20 Oct 2004 09:30:49 +0200
Jim> My biggest (but not only) problem with SLOOP is that I'm not perfectly
Jim> sure what it does. I'll look at your patches. Are you confident you
Jim> understand the differences between LOOP and SLOOP?
To the extent that I'm confident, the difference is the syntax for
declarations and special purpose iteration (vectors etc). Maxima
doesn't use the fancy stuff like IN-FRINGE or AVERAGING etc.
>> Please contact me about the patches, or tell me if it is ok to post a
>> 15k message to the list.
Jim> 15k is OK for the list. Context diffs are preferable.
The diffs are "unified", hope that's ok...
In order to minimize patch length, I keep the SLOOP symbol, but make
it a trivial macro expanding to the standard LOOP. The final
"sed -e's/sloop/loop/g'" is not included here.
Ole
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' 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' src/clmacs.lisp new/clmacs.lisp
--- src/clmacs.lisp 2004-10-04 08:51:49.000000000 +0200
+++ new/clmacs.lisp 2004-10-16 21:50:22.000000000 +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
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' 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' 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' 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' 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' src/lmdcls.lisp new/lmdcls.lisp
--- src/lmdcls.lisp 2004-10-04 08:51:52.000000000 +0200
+++ new/lmdcls.lisp 2004-10-16 21:25:46.000000000 +0200
@@ -32,8 +32,6 @@
#-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
- else
when (eql (car v) 'unspecial)
collect `(progn
,@(sloop for w in (cdr v)
@@ -41,7 +39,9 @@
#-excl 'special
#+excl 'excl::.globally-special.)
#+gcl `(make-unspecial ',w)))
- else collect `(proclaim ',v))))
+ else
+ when (eql (car v) 'special)
+ collect `(proclaim ',v))))
;;this list should contain all specials required by runtime or more
;;than one macsyma file, except for some specials declared in the macro
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' src/loop.lisp new/loop.lisp
--- src/loop.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new/loop.lisp 2004-10-18 13:22:39.000000000 +0200
@@ -0,0 +1,3 @@
+(in-package "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' src/macdes.lisp new/macdes.lisp
--- src/macdes.lisp 2004-10-04 08:51:52.000000000 +0200
+++ new/macdes.lisp 2004-10-16 21:59:30.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' src/maxima-package.lisp new/maxima-package.lisp
--- src/maxima-package.lisp 2004-10-18 09:04:05.000000000 +0200
+++ new/maxima-package.lisp 2004-10-18 09:31:32.000000000 +0200
@@ -34,7 +34,6 @@
(in-package "SLOOP" )
-(shadow '(loop-finish) (find-package "SLOOP"))
(or (find-package "MAXIMA")
@@ -42,7 +41,7 @@
:nicknames '("CL-MACSYMA" "CL-MAXIMA" "MACSYMA")
:use '("LISP")))
-(shadowing-import '(sloop::loop-return sloop::local-finish sloop::loop-finish sloop::sloop) "MAXIMA")
+(shadowing-import '(sloop::sloop) "MAXIMA")
(shadow '(complement continue tan sinh cosh tanh #+ti file-position ) 'cl-maxima)
diff -Nru -x .cvsignore -x CVS -x '*~' -x '#*#' -x '*.mk' -x '*.x86f' -x '*.err' -x '*.fasl' -x '*.core' src/maxima.system new/maxima.system
--- src/maxima.system 2004-10-13 10:00:26.000000000 +0200
+++ new/maxima.system 2004-10-15 21:20:12.000000000 +0200
@@ -51,8 +51,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' src/mdebug.lisp new/mdebug.lisp
--- src/mdebug.lisp 2004-10-04 08:51:52.000000000 +0200
+++ new/mdebug.lisp 2004-10-16 22:04:23.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' 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' 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' src/plot.lisp new/plot.lisp
--- src/plot.lisp 2004-10-04 08:51:54.000000000 +0200
+++ new/plot.lisp 2004-10-16 22:21:04.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' 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' 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' 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