Commit 40d9e654 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Moved :REPEAT clauses in LOOP to their conforming position.

parent 9cba326c
......@@ -1693,8 +1693,8 @@ NOTE: UNIVERSAL-TIME when present gives a base date with
#||
(loop
:repeat 365
:with day = (gregorian :year 2007 :month 1 :day 1 :hour 12)
:repeat 365
:do (princ day) (terpri) (increment-day day))
(com.informatimago.common-lisp.cesarum.date.utility:as-list-of-numbers
......
......@@ -326,10 +326,12 @@ RETURN: A whole line read from the peek-stream, or NIL in case of end of stream
(with-input-from-string (in "ComMon-Lisp")
(let* ((ps (make-instance 'peek-stream :stream in))
(nc (loop
:repeat n :for ch = (get-future-char ps)
:for ch = (get-future-char ps)
:repeat n
:collect ch :into result :finally (return result)))
(gc (loop
:repeat n :for ch = (getchar ps)
:for ch = (getchar ps)
:repeat n
:collect ch :into result :finally (return result))))
(assert (equal nc gc)))))
:success)
......
......@@ -87,7 +87,7 @@ License:
(,sum ,init-sum) (,delta #x9e3779b9)
(,a (aref ,k 0)) (,b (aref ,k 1))
(,c (aref ,k 2)) (,d (aref ,k 3)))
(loop repeat +n+ do ,@body finally (setf (aref ,w 0) ,y (aref ,w 1) ,z))))
(loop :repeat +n+ :do (progn ,@body) :finally (setf (aref ,w 0) ,y (aref ,w 1) ,z))))
(defmacro c-incf (var expr) `(setf ,var (mod (+ ,var ,expr) #x100000000)))
(defmacro c-decf (var expr) `(setf ,var (mod (- ,var ,expr) #x100000000)))
(defun tea-encipher (v w k)
......
......@@ -824,26 +824,26 @@ but some types are used only for array cells (ie. unboxed values)."
(defun test-ieee-read-double ()
(with-open-file (in "value.ieee-754-double"
:direction :input :element-type '(unsigned-byte 8))
(loop while (< (file-position in) (file-length in))
do (loop repeat 8 for i = 1 then (* i 256)
for v = (read-byte in) then (+ v (* i (read-byte in)))
finally (progn
(let ((*print-base* 16)) (princ v))
(princ " ")
(princ (ieee-754-to-float-64 v))
(terpri))))))
(loop :while (< (file-position in) (file-length in))
:do (loop :for i = 1 :then (* i 256)
:for v = (read-byte in) :then (+ v (* i (read-byte in)))
:repeat 8
:finally (let ((*print-base* 16)) (princ v))
(princ " ")
(princ (ieee-754-to-float-64 v))
(terpri)))))
(defun test-ieee-read-single ()
(with-open-file (in "value.ieee-754-single"
:direction :input :element-type '(unsigned-byte 8))
(loop while (< (file-position in) (file-length in))
do (loop repeat 4 for i = 1 then (* i 256)
for v = (read-byte in) then (+ v (* i (read-byte in)))
finally (progn
(let ((*print-base* 16)) (princ v))
(princ " ")
(princ (ieee-754-to-float-32 v))
(terpri))))))
(loop :while (< (file-position in) (file-length in))
:do (loop :for i = 1 :then (* i 256)
:for v = (read-byte in) :then (+ v (* i (read-byte in)))
:repeat 4
:finally (let ((*print-base* 16)) (princ v))
(princ " ")
(princ (ieee-754-to-float-32 v))
(terpri)))))
(defun test-single-to-ieee (&rest args)
(dolist (arg args)
......@@ -973,15 +973,15 @@ CL-USER>
(defun cvm-list-elt (list index)
(loop for curr = list then (cvm-cdr curr)
repeat index
finally (return (cvm-car curr))))
(loop :for curr = list :then (cvm-cdr curr)
:repeat index
:finally (return (cvm-car curr))))
(defun cvm-member-eq (item list)
(loop for curr = list then (cvm-cdr curr)
until (or (cvm-null curr) (eql (cvm-car curr) item))
finally (return curr)))
(loop :for curr = list :then (cvm-cdr curr)
:until (or (cvm-null curr) (eql (cvm-car curr) item))
:finally (return curr)))
(defun cvm-list-nreverse (list)
......@@ -1014,26 +1014,24 @@ CL-USER>
(cond
((zerop length) +cvm-nil+)
(initial-contents
(loop with head = (cvm-make-cons (car initial-contents) +cvm-nil+)
with tail = head
with new = nil
for item in (cdr initial-contents)
repeat length
do (progn
(setf new (cvm-make-cons item +cvm-nil+))
(cvm-setcdr tail new)
(setf tail new))
finally (return head)))
(loop :with head = (cvm-make-cons (car initial-contents) +cvm-nil+)
:with tail = head
:with new = nil
:for item in (cdr initial-contents)
:repeat length
:do (setf new (cvm-make-cons item +cvm-nil+))
(cvm-setcdr tail new)
(setf tail new)
:finally (return head)))
(t
(loop with head = (cvm-make-cons initial-element +cvm-nil+)
with tail = head
with new = nil
repeat length
do (progn
(setf new (cvm-make-cons initial-element +cvm-nil+))
(cvm-setcdr tail new)
(setf tail new))
finally (return head)))))
(loop :with head = (cvm-make-cons initial-element +cvm-nil+)
:with tail = head
:with new = nil
:repeat length
:do (setf new (cvm-make-cons initial-element +cvm-nil+))
(cvm-setcdr tail new)
(setf tail new)
:finally (return head)))))
;; TODO: implement cvm-push and cvm-pop properly!
......@@ -1186,11 +1184,11 @@ CL-USER>
(values (cvm-fixnum-value (gc-load (incf address)))
(incf address 2)))
((#.ct-array)
(values (loop repeat (cvm-fixnum-value (gc-load (incf address)))
for row-dimension = 1
then (* row-dimension
(cvm-fixnum-value (gc-load (incf address))))
finally (return row-dimension))
(values (loop :for row-dimension = 1
:then (* row-dimension
(cvm-fixnum-value (gc-load (incf address))))
:repeat (cvm-fixnum-value (gc-load (incf address)))
:finally (return row-dimension))
(incf address)))
(otherwise (error "CVM-ROWS: bad argument type ~A (~D)"
(cell-type-label (cvm-type-code (gc-load address)))
......@@ -1577,10 +1575,10 @@ RETURN: When OPERATION is :peek, the value of the slot.
(dump (1+ address) (gc-load (1+ address)) "[el|dm]")
(if (= ct-t (cvm-type-of (gc-load (1+ address))))
(when contents
(loop for address from (+ 2 address)
repeat (- (cvm-size-of object) 2) do
(format stream "~A" margin)
(gc-dump-cell address :stream stream :margin margin)))
(loop :for address from (+ 2 address)
:repeat (- (cvm-size-of object) 2)
:do (format stream "~A" margin)
(gc-dump-cell address :stream stream :margin margin)))
(gc-dump-block (+ 2 address) (- (cvm-size-of object) 2)
stream :margin margin)))
(otherwise
......@@ -1642,20 +1640,20 @@ RETURN: When OPERATION is :peek, the value of the slot.
(setf (aref bitmap address) 2))
(defun gc-bitmap-set-allocated-range (bitmap address size)
(loop repeat size
for i from address do
(assert (evenp (aref bitmap i))) ; 0 or 2
(setf (aref bitmap i) 2)))
(loop :for i :from address
:repeat size
:do (assert (evenp (aref bitmap i))) ; 0 or 2
(setf (aref bitmap i) 2)))
(defun gc-bitmap-set-visited (bitmap address)
(assert (= 2 (aref bitmap address)))
(setf (aref bitmap address) 3))
(defun gc-bitmap-set-visited-range (bitmap address size)
(loop repeat size
for i from address do
(assert (= 2 (aref bitmap i)))
(setf (aref bitmap i) 3)))
(loop :for i :from address
:repeat size
:do (assert (= 2 (aref bitmap i)))
(setf (aref bitmap i) 3)))
(defun gc-bitmap-clear-p (bitmap address) (= 0 (aref bitmap address)))
(defun gc-bitmap-free-p (bitmap address) (= 1 (aref bitmap address)))
......
......@@ -478,8 +478,8 @@ with defbf, or strings containing brainfuck instructions.
(defmacro repeat (repcnt &body body)
(let ((vout (gensym)))
`(with-output-to-string (,vout)
(loop repeat ,repcnt
do ,@(mapcar (lambda (item) `(princ ,item ,vout)) body)))))
(loop :repeat ,repcnt
:do ,@(mapcar (lambda (item) `(princ ,item ,vout)) body)))))
(defmacro while-nz (&body body)
(let ((vout (gensym)))
......
......@@ -107,8 +107,8 @@
(defun dump-machine (machine address length)
"Dumps the MACHINE memory starting from ADDRESS, for LENGTH words."
(loop
:repeat length
:for a :from address
:repeat length
:do (format t "~4,'0X: ~16,'0X ~:*~D~%"
a (aref (machine-memory machine) a)))
machine)
......@@ -310,12 +310,12 @@ When step is true, executes only one step."
(defun encode-ascii (string)
(loop
:repeat +bytes-per-word+
:with word = 0
:for i :from 0
:for byte = (if (< i (length string))
(char-code (aref string i))
0)
:repeat +bytes-per-word+
:do (setf word (+ (* 256 word) byte))
:finally (return word)))
......@@ -394,8 +394,8 @@ and a bit-vector indicating instructions (vs. dcl) in the code vector.
(let* ((string (text (rest statement)))
(size (ceiling (length string) +bytes-per-word+)))
(loop
:repeat size
:for i :from 0 :by +bytes-per-word+
:repeat size
:do (push (encode-ascii (subseq string i (min (length string) (+ i +bytes-per-word+)))) code))
(incf address size)))
(instruction
......@@ -579,9 +579,9 @@ and a bit-vector indicating instructions (vs. dcl) in the code vector.
do (insert (format "%s-op (dcl #b%s)\n"
(first (second entry))
(mapconcat (lambda (bit) (format "%d" bit))
(reverse (loop for n = (first entry) then (truncate n 2)
repeat 8
collect (mod n 2)))
(reverse (loop :for n = (first entry) :then (truncate n 2)
:repeat 8
:collect (mod n 2)))
""))))
move-op (dcl #b00000000)
load-op (dcl #b00010000)
......
......@@ -533,9 +533,9 @@ Prints an ASCII-art representation of the GAME onto the STREAM.
(let* ((cells (game-cells game))
(line (with-output-to-string (out)
(loop
:repeat (array-dimension cells 0)
:initially (princ "+" out)
:do (princ "---+" out)))))
:initially (princ "+" out)
:repeat (array-dimension cells 0)
:do (princ "---+" out)))))
(multiple-value-bind (direction stone-left stone-back stone-right stone-front)
(stone-coverage (game-stone game))
(loop
......
......@@ -85,12 +85,12 @@
(loop
:with bac = (* (truncate col 3) 3)
:with bar = (* (truncate row 3) 3)
:repeat 3
:for i :from bac
:repeat 3
:nconc (loop
:repeat 3
:for j :from bar
:for item = (aref sudoku i j)
:repeat 3
:unless (emptyp item)
:collect item)))
......@@ -190,12 +190,12 @@ RETURN: If an extremum is found: the extremum value; the row; the column;
:when (and (/= j row) (eql val (aref sudoku col j)))
:do (return-from conflictp :col-conflict))
(loop
:repeat 3
:for i :from (* (truncate col 3) 3)
:repeat 3
:when (/= i col)
:do (loop
:repeat 3
:for j :from (* (truncate row 3) 3)
:repeat 3
:when (and (/= j row) (eql val (aref sudoku i j)))
:do (return-from conflictp :reg-conflict)))
nil))
......@@ -264,11 +264,11 @@ RETURN: A list of sudoku solutions boards.
(throw 'sudoku-backtrack nil))))
(loop
:named update-reg
:repeat 3
:for col :from (* (truncate i 3) 3)
:repeat 3
:do (loop
:repeat 3
:for row :from (* (truncate j 3) 3)
:repeat 3
:do (cond
((and (= col i) (= row j)))
((listp (aref sudoku col row))
......
......@@ -29,5 +29,5 @@
(values))
;; (loop repeat 3 do (bt:make-thread (lambda () (sleep 2232))))
;; (loop :repeat 3 :do (bt:make-thread (lambda () (sleep 2232))))
;; (kill-thread)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment