;;;; LOOP-PREFER-POP (not true on CMU CL) and which has since been
;;;; removed. Thus, STEP-FUNCTION stuff could probably be removed too.
\f
-;;;; miscellaneous environment things
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *loop-real-data-type* 'real))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defvar *loop-gentemp* nil)
- (defun loop-gentemp (&optional (pref 'loopvar-))
- (if *loop-gentemp*
- (gentemp (string pref))
- (gensym))))
-
-;;; @@@@ The following form takes a list of variables and a form which
-;;; presumably references those variables, and wraps it somehow so that the
-;;; compiler does not consider those variables have been referenced. The intent
-;;; of this is that iteration variables can be flagged as unused by the
-;;; compiler, e.g. I in (loop for i from 1 to 10 do (print t)), since we will
-;;; tell it when a usage of it is "invisible" or "not to be considered".
-;;;
-;;; We implicitly assume that a setq does not count as a reference. That is,
-;;; the kind of form generated for the above loop construct to step I,
-;;; simplified, is
-;;; `(SETQ I ,(HIDE-VARIABLE-REFERENCES '(I) '(1+ I))).
-;;;
-;;; FIXME: This is a no-op except for Genera, now obsolete, so it
-;;; can be removed.
-(defun hide-variable-references (variable-list form)
- (declare (ignore variable-list))
- form)
-
-;;; @@@@ The following function takes a flag, a variable, and a form which
-;;; presumably references that variable, and wraps it somehow so that the
-;;; compiler does not consider that variable to have been referenced. The
-;;; intent of this is that iteration variables can be flagged as unused by the
-;;; compiler, e.g. I in (loop for i from 1 to 10 do (print t)), since we will
-;;; tell it when a usage of it is "invisible" or "not to be considered".
-;;;
-;;; We implicitly assume that a setq does not count as a reference. That is,
-;;; the kind of form generated for the above loop construct to step I,
-;;; simplified, is
-;;; `(SETQ I ,(HIDE-VARIABLE-REFERENCES T 'I '(1+ I))).
-;;;
-;;; Certain cases require that the "invisibility" of the reference be
-;;; conditional upon something. This occurs in cases of "named" variables (the
-;;; USING clause). For instance, we want IDX in (LOOP FOR E BEING THE
-;;; VECTOR-ELEMENTS OF V USING (INDEX IDX) ...) to be "invisible" when it is
-;;; stepped, so that the user gets informed if IDX is not referenced. However,
-;;; if no USING clause is present, we definitely do not want to be informed
-;;; that some gensym or other is not used.
-;;;
-;;; It is easier for the caller to do this conditionally by passing a flag
-;;; (which happens to be the second value of NAMED-VARIABLE, q.v.) to this
-;;; function than for all callers to contain the conditional invisibility
-;;; construction.
-;;;
-;;; FIXME: This is a no-op except for Genera, now obsolete, so it
-;;; can be removed.
-(defun hide-variable-reference (really-hide variable form)
- (declare (ignore really-hide variable))
- form)
-\f
;;;; list collection macrology
(sb!int:defmacro-mundanely with-loop-list-collection-head
(defun make-loop-minimax (answer-variable type)
(let ((infinity-data (cdr (assoc type
*loop-minimax-type-infinities-alist*
- :test #'subtypep))))
+ :test #'sb!xc:subtypep))))
(make-loop-minimax-internal
:answer-variable answer-variable
:type type
- :temp-variable (loop-gentemp 'loop-maxmin-temp-)
+ :temp-variable (gensym "LOOP-MAXMIN-TEMP-")
:flag-variable (and (not infinity-data)
- (loop-gentemp 'loop-maxmin-flag-))
+ (gensym "LOOP-MAXMIN-FLAG-"))
:operations nil
:infinity-data infinity-data)))
(when (and (cdr (loop-minimax-operations minimax))
(not (loop-minimax-flag-variable minimax)))
(setf (loop-minimax-flag-variable minimax)
- (loop-gentemp 'loop-maxmin-flag-)))
+ (gensym "LOOP-MAXMIN-FLAG-")))
operation)
(sb!int:defmacro-mundanely with-minimax-value (lm &body body)
(let* ((answer-var (loop-minimax-answer-variable lm))
(temp-var (loop-minimax-temp-variable lm))
(flag-var (loop-minimax-flag-variable lm))
- (test
- (hide-variable-reference
- t (loop-minimax-answer-variable lm)
- `(,(ecase operation
- (min '<)
- (max '>))
- ,temp-var ,answer-var))))
+ (test `(,(ecase operation
+ (min '<)
+ (max '>))
+ ,temp-var ,answer-var)))
`(progn
(setq ,temp-var ,form)
(when ,(if flag-var `(or (not ,flag-var) ,test) test)
\f
;;;; LOOP-local variables
-;;;This is the "current" pointer into the LOOP source code.
+;;; This is the "current" pointer into the LOOP source code.
(defvar *loop-source-code*)
-;;;This is the pointer to the original, for things like NAMED that
-;;;insist on being in a particular position
+;;; This is the pointer to the original, for things like NAMED that
+;;; insist on being in a particular position
(defvar *loop-original-source-code*)
-;;;This is *loop-source-code* as of the "last" clause. It is used
-;;;primarily for generating error messages (see loop-error, loop-warn).
+;;; This is *loop-source-code* as of the "last" clause. It is used
+;;; primarily for generating error messages (see loop-error, loop-warn).
(defvar *loop-source-context*)
-;;;List of names for the LOOP, supplied by the NAMED clause.
+;;; list of names for the LOOP, supplied by the NAMED clause
(defvar *loop-names*)
-;;;The macroexpansion environment given to the macro.
+;;; The macroexpansion environment given to the macro.
(defvar *loop-macro-environment*)
-;;;This holds variable names specified with the USING clause.
+;;; This holds variable names specified with the USING clause.
;;; See LOOP-NAMED-VARIABLE.
(defvar *loop-named-variables*)
;;; LETlist-like list being accumulated for one group of parallel bindings.
(defvar *loop-variables*)
-;;;List of declarations being accumulated in parallel with
-;;;*loop-variables*.
+;;; list of declarations being accumulated in parallel with *LOOP-VARIABLES*
(defvar *loop-declarations*)
-;;;Used by LOOP for destructuring binding, if it is doing that itself.
-;;; See loop-make-variable.
+;;; This is used by LOOP for destructuring binding, if it is doing
+;;; that itself. See LOOP-MAKE-VARIABLE.
(defvar *loop-desetq-crocks*)
-;;; List of wrapping forms, innermost first, which go immediately inside
-;;; the current set of parallel bindings being accumulated in
-;;; *loop-variables*. The wrappers are appended onto a body. E.g.,
-;;; this list could conceivably has as its value ((with-open-file (g0001
-;;; g0002 ...))), with g0002 being one of the bindings in
-;;; *loop-variables* (this is why the wrappers go inside of the variable
-;;; bindings).
+;;; list of wrapping forms, innermost first, which go immediately
+;;; inside the current set of parallel bindings being accumulated in
+;;; *LOOP-VARIABLES*. The wrappers are appended onto a body. E.g.,
+;;; this list could conceivably have as its value
+;;; ((WITH-OPEN-FILE (G0001 G0002 ...))),
+;;; with G0002 being one of the bindings in *LOOP-VARIABLES* (This is
+;;; why the wrappers go inside of the variable bindings).
(defvar *loop-wrappers*)
-;;;This accumulates lists of previous values of *loop-variables* and the
-;;;other lists above, for each new nesting of bindings. See
-;;;loop-bind-block.
+;;; This accumulates lists of previous values of *LOOP-VARIABLES* and
+;;; the other lists above, for each new nesting of bindings. See
+;;; LOOP-BIND-BLOCK.
(defvar *loop-bind-stack*)
-;;;This is a LOOP-global variable for the (obsolete) NODECLARE clause
-;;;which inhibits LOOP from actually outputting a type declaration for
-;;;an iteration (or any) variable.
-(defvar *loop-nodeclare*)
-
-;;;This is simply a list of LOOP iteration variables, used for checking
-;;;for duplications.
+;;; This is simply a list of LOOP iteration variables, used for
+;;; checking for duplications.
(defvar *loop-iteration-variables*)
-;;;List of prologue forms of the loop, accumulated in reverse order.
+;;; list of prologue forms of the loop, accumulated in reverse order
(defvar *loop-prologue*)
(defvar *loop-before-loop*)
(defvar *loop-body*)
(defvar *loop-after-body*)
-;;;This is T if we have emitted any body code, so that iteration driving
-;;;clauses can be disallowed. This is not strictly the same as
-;;;checking *loop-body*, because we permit some clauses such as RETURN
-;;;to not be considered "real" body (so as to permit the user to "code"
-;;;an abnormal return value "in loop").
+;;; This is T if we have emitted any body code, so that iteration
+;;; driving clauses can be disallowed. This is not strictly the same
+;;; as checking *LOOP-BODY*, because we permit some clauses such as
+;;; RETURN to not be considered "real" body (so as to permit the user
+;;; to "code" an abnormal return value "in loop").
(defvar *loop-emitted-body*)
-;;;List of epilogue forms (supplied by FINALLY generally), accumulated
-;;; in reverse order.
+;;; list of epilogue forms (supplied by FINALLY generally), accumulated
+;;; in reverse order
(defvar *loop-epilogue*)
-;;;List of epilogue forms which are supplied after the above "user"
-;;;epilogue. "normal" termination return values are provide by putting
-;;;the return form in here. Normally this is done using
-;;;loop-emit-final-value, q.v.
+;;; list of epilogue forms which are supplied after the above "user"
+;;; epilogue. "Normal" termination return values are provide by
+;;; putting the return form in here. Normally this is done using
+;;; LOOP-EMIT-FINAL-VALUE, q.v.
(defvar *loop-after-epilogue*)
-;;;The "culprit" responsible for supplying a final value from the loop.
-;;;This is so loop-emit-final-value can moan about multiple return
-;;;values being supplied.
+;;; the "culprit" responsible for supplying a final value from the
+;;; loop. This is so LOOP-EMIT-FINAL-VALUE can moan about multiple
+;;; return values being supplied.
(defvar *loop-final-value-culprit*)
-;;;If not NIL, we are in some branch of a conditional. Some clauses may
-;;;be disallowed.
+;;; If this is true, we are in some branch of a conditional. Some
+;;; clauses may be disallowed.
(defvar *loop-inside-conditional*)
-;;;If not NIL, this is a temporary bound around the loop for holding the
-;;;temporary value for "it" in things like "when (f) collect it". It
-;;;may be used as a supertemporary by some other things.
+;;; If not NIL, this is a temporary bound around the loop for holding
+;;; the temporary value for "it" in things like "when (f) collect it".
+;;; It may be used as a supertemporary by some other things.
(defvar *loop-when-it-variable*)
-;;;Sometimes we decide we need to fold together parts of the loop, but
-;;;some part of the generated iteration code is different for the first
-;;;and remaining iterations. This variable will be the temporary which
-;;;is the flag used in the loop to tell whether we are in the first or
-;;;remaining iterations.
+;;; Sometimes we decide we need to fold together parts of the loop,
+;;; but some part of the generated iteration code is different for the
+;;; first and remaining iterations. This variable will be the
+;;; temporary which is the flag used in the loop to tell whether we
+;;; are in the first or remaining iterations.
(defvar *loop-never-stepped-variable*)
-;;;List of all the value-accumulation descriptor structures in the loop.
-;;; See loop-get-collection-info.
-(defvar *loop-collection-cruft*) ; for multiple COLLECTs (etc)
+;;; list of all the value-accumulation descriptor structures in the
+;;; loop. See LOOP-GET-COLLECTION-INFO.
+(defvar *loop-collection-cruft*) ; for multiple COLLECTs (etc.)
\f
;;;; code analysis stuff
(when (setq constantp (constantp new-form))
(setq constant-value (eval new-form)))
(when (and constantp expected-type)
- (unless (typep constant-value expected-type)
+ (unless (sb!xc:typep constant-value expected-type)
(loop-warn "The form ~S evaluated to ~S, which was not of the anticipated type ~S."
form constant-value expected-type)
(setq constantp nil constant-value nil)))
(defun loop-code-duplication-threshold (env)
(declare (ignore env))
- (let (;; If we could read optimization declaration information (as with
- ;; the DECLARATION-INFORMATION function (present in CLTL2, removed
- ;; from ANSI standard) we could set these values flexibly. Without
- ;; DECLARATION-INFORMATION, we have to set them to constants.
+ (let (;; If we could read optimization declaration information (as
+ ;; with the DECLARATION-INFORMATION function (present in
+ ;; CLTL2, removed from ANSI standard) we could set these
+ ;; values flexibly. Without DECLARATION-INFORMATION, we have
+ ;; to set them to constants.
(speed 1)
(space 1))
(+ 40 (* (- speed space) 10))))
(push (pop rbefore) main-body)
(pop rafter))
(unless rbefore (return (makebody)))
- ;; The first forms in rbefore & rafter (which are the chronologically
+ ;; The first forms in RBEFORE & RAFTER (which are the chronologically
;; last forms in the list) differ, therefore they cannot be moved
;; into the main body. If everything that chronologically precedes
;; them either differs or is equal but is okay to duplicate, we can
((or (not (setq inc (estimate-code-size (car bb) env)))
(> (incf count inc) threshold))
;; Ok, we have found a non-duplicatable piece of code.
- ;; Everything chronologically after it must be in the central
- ;; body. Everything chronologically at and after lastdiff goes
- ;; into the central body under a flag test.
+ ;; Everything chronologically after it must be in the
+ ;; central body. Everything chronologically at and
+ ;; after LASTDIFF goes into the central body under a
+ ;; flag test.
(let ((then nil) (else nil))
(do () (nil)
(push (pop rbefore) else)
(push `(if ,flagvar ,(pify (psimp then)) ,(pify (psimp else)))
main-body))
;; Everything chronologically before lastdiff until the
- ;; non-duplicatable form (car bb) is the same in rbefore and
- ;; rafter so just copy it into the body
+ ;; non-duplicatable form (CAR BB) is the same in
+ ;; RBEFORE and RAFTER, so just copy it into the body.
(do () (nil)
(pop rafter)
(push (pop rbefore) main-body)
&optional (default-type required-type))
(if (null specified-type)
default-type
- (multiple-value-bind (a b) (subtypep specified-type required-type)
+ (multiple-value-bind (a b) (sb!xc:subtypep specified-type required-type)
(cond ((not b)
(loop-warn "LOOP couldn't verify that ~S is a subtype of the required type ~S."
specified-type required-type))
(*loop-source-context* nil)
(*loop-iteration-variables* nil)
(*loop-variables* nil)
- (*loop-nodeclare* nil)
(*loop-named-variables* nil)
(*loop-declarations* nil)
(*loop-desetq-crocks* nil)
;;;; loop types
(defun loop-typed-init (data-type)
- (when (and data-type (subtypep data-type 'number))
- (if (or (subtypep data-type 'float) (subtypep data-type '(complex float)))
+ (when (and data-type (sb!xc:subtypep data-type 'number))
+ (if (or (sb!xc:subtypep data-type 'float)
+ (sb!xc:subtypep data-type '(complex float)))
(coerce 0 data-type)
0)))
&optional iteration-variable-p)
(cond ((null name)
(cond ((not (null initialization))
- (push (list (setq name (loop-gentemp 'loop-ignore-))
+ (push (list (setq name (gensym "LOOP-IGNORE-"))
initialization)
*loop-variables*)
(push `(ignore ,name) *loop-declarations*))))
(cond (*loop-destructuring-hooks*
(loop-declare-variable name dtype)
(push (list name initialization) *loop-variables*))
- (t (let ((newvar (loop-gentemp 'loop-destructure-)))
+ (t (let ((newvar (gensym "LOOP-DESTRUCTURE-")))
(push (list newvar initialization) *loop-variables*)
;; *LOOP-DESETQ-CROCKS* gathered in reverse order.
(setq *loop-desetq-crocks*
- (list* name newvar *loop-desetq-crocks*))
- ;; FIXME: We can delete this, right?
- #+ignore
- (loop-make-variable name
- nil
- dtype
- iteration-variable-p)))))
+ (list* name newvar *loop-desetq-crocks*))))))
(t (let ((tcar nil) (tcdr nil))
(if (atom dtype) (setq tcar (setq tcdr dtype))
(setq tcar (car dtype) tcdr (cdr dtype)))
(defun loop-declare-variable (name dtype)
(cond ((or (null name) (null dtype) (eq dtype t)) nil)
((symbolp name)
- (unless (or (eq dtype t) (member (the symbol name) *loop-nodeclare*))
+ (unless (sb!xc:subtypep t dtype)
(let ((dtype (let ((init (loop-typed-init dtype)))
- (if (typep init dtype)
- dtype
- `(or (member ,init) ,dtype)))))
+ (if (sb!xc:typep init dtype)
+ dtype
+ `(or (member ,init) ,dtype)))))
(push `(type ,dtype ,name) *loop-declarations*))))
((consp name)
(cond ((consp dtype)
(defun loop-maybe-bind-form (form data-type)
(if (loop-constantp form)
form
- (loop-make-variable (loop-gentemp 'loop-bind-) form data-type)))
+ (loop-make-variable (gensym "LOOP-BIND-") form data-type)))
\f
(defun loop-do-if (for negatep)
(let ((form (loop-get-form)) (*loop-inside-conditional* t) (it-p nil))
(let ((tempvars (loop-collector-tempvars lc)))
(unless tempvars
(setf (loop-collector-tempvars lc)
- (setq tempvars (list* (loop-gentemp 'loop-list-head-)
- (loop-gentemp 'loop-list-tail-)
+ (setq tempvars (list* (gensym "LOOP-LIST-HEAD-")
+ (gensym "LOOP-LIST-TAIL-")
(and (loop-collector-name lc)
(list (loop-collector-name lc))))))
(push `(with-loop-list-collection-head ,tempvars) *loop-wrappers*)
(setf (loop-collector-tempvars lc)
(setq tempvars (list (loop-make-variable
(or (loop-collector-name lc)
- (loop-gentemp 'loop-sum-))
+ (gensym "LOOP-SUM-"))
nil (loop-collector-dtype lc)))))
(unless (loop-collector-name lc)
(loop-emit-final-value (car (loop-collector-tempvars lc)))))
(if (eq specifically 'count)
`(when ,form
(setq ,(car tempvars)
- ,(hide-variable-reference t
- (car tempvars)
- `(1+ ,(car tempvars)))))
+ (1+ ,(car tempvars))))
`(setq ,(car tempvars)
- (+ ,(hide-variable-reference t
- (car tempvars)
- (car tempvars))
+ (+ ,(car tempvars)
,form)))))))
(defun loop-maxmin-collection (specifically)
(multiple-value-bind (lc form)
- (loop-get-collection-info specifically 'maxmin *loop-real-data-type*)
- (loop-check-data-type (loop-collector-dtype lc) *loop-real-data-type*)
+ (loop-get-collection-info specifically 'maxmin 'real)
+ (loop-check-data-type (loop-collector-dtype lc) 'real)
(let ((data (loop-collector-data lc)))
(unless data
(setf (loop-collector-data lc)
(setq data (make-loop-minimax
(or (loop-collector-name lc)
- (loop-gentemp 'loop-maxmin-))
+ (gensym "LOOP-MAXMIN-"))
(loop-collector-dtype lc))))
(unless (loop-collector-name lc)
(loop-emit-final-value (loop-minimax-answer-variable data))))
(defun loop-do-repeat ()
(let ((form (loop-get-form))
(type (loop-check-data-type (loop-optional-type)
- *loop-real-data-type*)))
- (when (and (consp form) (eq (car form) 'the) (subtypep (second form) type))
+ 'real)))
+ (when (and (consp form)
+ (eq (car form) 'the)
+ (sb!xc:subtypep (second form) type))
(setq type (second form)))
(multiple-value-bind (number constantp value)
(loop-constant-fold-if-possible form type)
(cond ((and constantp (<= value 1)) `(t () () () ,(<= value 0) () () ()))
- (t (let ((var (loop-make-variable (loop-gentemp 'loop-repeat-)
+ (t (let ((var (loop-make-variable (gensym "LOOP-REPEAT-")
number
type)))
(if constantp
(defun loop-when-it-variable ()
(or *loop-when-it-variable*
(setq *loop-when-it-variable*
- (loop-make-variable (loop-gentemp 'loop-it-) nil nil))))
+ (loop-make-variable (gensym "LOOP-IT-") nil nil))))
\f
;;;; various FOR/AS subdispatches
(defun loop-for-across (var val data-type)
(loop-make-iteration-variable var nil data-type)
- (let ((vector-var (loop-gentemp 'loop-across-vector-))
- (index-var (loop-gentemp 'loop-across-index-)))
+ (let ((vector-var (gensym "LOOP-ACROSS-VECTOR-"))
+ (index-var (gensym "LOOP-ACROSS-INDEX-")))
(multiple-value-bind (vector-form constantp vector-value)
(loop-constant-fold-if-possible val 'vector)
(loop-make-variable
(loop-make-variable index-var 0 'fixnum)
(let* ((length 0)
(length-form (cond ((not constantp)
- (let ((v (loop-gentemp 'loop-across-limit-)))
+ (let ((v (gensym "LOOP-ACROSS-LIMIT-")))
(push `(setq ,v (length ,vector-var))
*loop-prologue*)
(loop-make-variable v 0 'fixnum)))
((and (consp stepper) (eq (car stepper) 'function))
(list (cadr stepper) listvar))
(t
- `(funcall ,(loop-make-variable (loop-gentemp 'loop-fn-)
+ `(funcall ,(loop-make-variable (gensym "LOOP-FN-")
stepper
'function)
,listvar)))))
(let ((listvar var))
(cond ((and var (symbolp var))
(loop-make-iteration-variable var list data-type))
- (t (loop-make-variable (setq listvar (loop-gentemp)) list 'list)
+ (t (loop-make-variable (setq listvar (gensym)) list 'list)
(loop-make-iteration-variable var nil data-type)))
(let ((list-step (loop-list-step listvar)))
(let* ((first-endtest
- (hide-variable-reference
- (eq var listvar)
- listvar
- ;; the following should use `atom' instead of `endp', per
- ;; [bug2428]
- `(atom ,listvar)))
+ ;; mysterious comment from original CMU CL sources:
+ ;; the following should use `atom' instead of `endp',
+ ;; per [bug2428]
+ `(atom ,listvar))
(other-endtest first-endtest))
(when (and constantp (listp list-value))
(setq first-endtest (null list-value)))
(cond ((eq var listvar)
- ;; Contour of the loop is different because we use the user's
- ;; variable...
- `(() (,listvar ,(hide-variable-reference t listvar list-step))
+ ;; The contour of the loop is different because we
+ ;; use the user's variable...
+ `(() (,listvar ,list-step)
,other-endtest () () () ,first-endtest ()))
(t (let ((step `(,var ,listvar))
(pseudo `(,listvar ,list-step)))
(defun loop-for-in (var val data-type)
(multiple-value-bind (list constantp list-value)
(loop-constant-fold-if-possible val)
- (let ((listvar (loop-gentemp 'loop-list-)))
+ (let ((listvar (gensym "LOOP-LIST-")))
(loop-make-iteration-variable var nil data-type)
(loop-make-variable listvar list 'list)
(let ((list-step (loop-list-step listvar)))
(defun named-variable (name)
(let ((tem (loop-tassoc name *loop-named-variables*)))
(declare (list tem))
- (cond ((null tem) (values (loop-gentemp) nil))
+ (cond ((null tem) (values (gensym) nil))
(t (setq *loop-named-variables* (delete tem *loop-named-variables*))
(values (cdr tem) t)))))
(setq endform (if limit-constantp
`',limit-value
(loop-make-variable
- (loop-gentemp 'loop-limit-) form indexv-type))))
+ (gensym "LOOP-LIMIT-") form indexv-type))))
(:by
(multiple-value-setq (form stepby-constantp stepby)
(loop-constant-fold-if-possible form indexv-type))
(unless stepby-constantp
- (loop-make-variable (setq stepby (loop-gentemp 'loop-step-by-))
+ (loop-make-variable (setq stepby (gensym "LOOP-STEP-BY-"))
form
indexv-type)))
(t (loop-error
(when (or limit-given default-top)
(unless limit-given
(loop-make-variable (setq endform
- (loop-gentemp 'loop-seq-limit-))
+ (gensym "LOOP-SEQ-LIMIT-"))
nil indexv-type)
(push `(setq ,endform ,default-top) *loop-prologue*))
(setq testfn (if inclusive-iteration '> '>=)))
(if (eql stepby 1) `(1- ,indexv) `(- ,indexv ,stepby)))))
(when testfn
(setq test
- (hide-variable-reference t indexv `(,testfn ,indexv ,endform))))
+ `(,testfn ,indexv ,endform)))
(when step-hack
(setq step-hack
- `(,variable ,(hide-variable-reference indexv-user-specified-p
- indexv
- step-hack))))
+ `(,variable ,step-hack)))
(let ((first-test test) (remaining-tests test))
(when (and stepby-constantp start-constantp limit-constantp)
(when (setq first-test
start-value
limit-value))
(setq remaining-tests t)))
- `(() (,indexv ,(hide-variable-reference t indexv step))
+ `(() (,indexv ,step)
,remaining-tests ,step-hack () () ,first-test ,step-hack))))
\f
;;;; interfaces to the master sequencer
(defun loop-for-arithmetic (var val data-type kwd)
(loop-sequencer
- var (loop-check-data-type data-type *loop-real-data-type*) t
+ var (loop-check-data-type data-type 'real) t
nil nil nil nil nil nil
(loop-collect-prepositional-phrases
'((:from :upfrom :downfrom) (:to :upto :downto :above :below) (:by))
(loop-error "too many prepositions!"))
((null prep-phrases)
(loop-error "missing OF or IN in ~S iteration path")))
- (let ((ht-var (loop-gentemp 'loop-hashtab-))
- (next-fn (loop-gentemp 'loop-hashtab-next-))
+ (let ((ht-var (gensym "LOOP-HASHTAB-"))
+ (next-fn (gensym "LOOP-HASHTAB-NEXT-"))
(dummy-predicate-var nil)
(post-steps nil))
(multiple-value-bind (other-var other-p)
(push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*)
(when (consp key-var)
(setq post-steps
- `(,key-var ,(setq key-var (loop-gentemp 'loop-hash-key-temp-))
+ `(,key-var ,(setq key-var (gensym "LOOP-HASH-KEY-TEMP-"))
,@post-steps))
(push `(,key-var nil) bindings))
(when (consp val-var)
(setq post-steps
- `(,val-var ,(setq val-var (loop-gentemp 'loop-hash-val-temp-))
+ `(,val-var ,(setq val-var (gensym "LOOP-HASH-VAL-TEMP-"))
,@post-steps))
(push `(,val-var nil) bindings))
`(,bindings ;bindings
(loop-error "missing OF or IN in ~S iteration path")))
(unless (symbolp variable)
(loop-error "Destructuring is not valid for package symbol iteration."))
- (let ((pkg-var (loop-gentemp 'loop-pkgsym-))
- (next-fn (loop-gentemp 'loop-pkgsym-next-)))
+ (let ((pkg-var (gensym "LOOP-PKGSYM-"))
+ (next-fn (gensym "LOOP-PKGSYM-NEXT-")))
(push `(with-package-iterator (,next-fn ,pkg-var ,@symbol-types))
*loop-wrappers*)
`(((,variable nil ,data-type) (,pkg-var ,(cadar prep-phrases)))
(defun make-ansi-loop-universe (extended-p)
(let ((w (make-standard-loop-universe
- :keywords `((named (loop-do-named))
+ :keywords '((named (loop-do-named))
(initially (loop-do-initially))
(finally (loop-do-finally))
(do (loop-do-do))
(nconc (loop-list-collection nconc))
(nconcing (loop-list-collection nconc))
(count (loop-sum-collection count
- ,*loop-real-data-type*
+ real
fixnum))
(counting (loop-sum-collection count
- ,*loop-real-data-type*
+ real
fixnum))
(sum (loop-sum-collection sum number number))
(summing (loop-sum-collection sum number number))
projects / sbcl.git / blobdiff