X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Floop.lisp;h=1f86e9fc441683178a8279fdcfa432523834619e;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=23d714eb689fa020f998c06e682a111bd02d3e3f;hpb=cb4f56b0581f77e20a7d8cb593891c7bd919c3e9;p=sbcl.git diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 23d714e..1f86e9f 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -709,12 +709,10 @@ code to be loaded. (setq n (+ n (estimate-code-size-1 (cadr l) env) 1)))) ((eq fn 'go) 1) ((eq fn 'function) - ;; This skirts the issue of implementationally-defined - ;; lambda macros by recognizing CL function names and - ;; nothing else. - (if (or (symbolp (cadr x)) - (and (consp (cadr x)) (eq (caadr x) 'setf))) + (if (sb!int:legal-fun-name-p (cadr x)) 1 + ;; FIXME: This tag appears not to be present + ;; anywhere. (throw 'duplicatable-code-p nil))) ((eq fn 'multiple-value-setq) (f (length (second x)) (cddr x))) @@ -1296,10 +1294,10 @@ code to be loaded. (defun loop-do-repeat () (loop-disallow-conditional :repeat) (let ((form (loop-get-form)) - (type 'real)) - (let ((var (loop-make-var (gensym "LOOP-REPEAT-") form type))) - (push `(when (minusp (decf ,var)) (go end-loop)) *loop-before-loop*) - (push `(when (minusp (decf ,var)) (go end-loop)) *loop-after-body*) + (type 'integer)) + (let ((var (loop-make-var (gensym "LOOP-REPEAT-") `(ceiling ,form) type))) + (push `(if (<= ,var 0) (go end-loop) (decf ,var)) *loop-before-loop*) + (push `(if (<= ,var 0) (go end-loop) (decf ,var)) *loop-after-body*) ;; FIXME: What should ;; (loop count t into a ;; repeat 3 @@ -1852,22 +1850,22 @@ code to be loaded. (:hash-value (setq key-var (and other-p other-var) val-var variable))) (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*) - (when (consp key-var) - (setq post-steps - `(,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 (gensym "LOOP-HASH-VAL-TEMP-")) - ,@post-steps)) - (push `(,val-var nil) bindings)) - `(,bindings ;bindings - () ;prologue - () ;pre-test - () ;parallel steps + (when (or (consp key-var) data-type) + (setq post-steps + `(,key-var ,(setq key-var (gensym "LOOP-HASH-KEY-TEMP-")) + ,@post-steps)) + (push `(,key-var nil) bindings)) + (when (or (consp val-var) data-type) + (setq post-steps + `(,val-var ,(setq val-var (gensym "LOOP-HASH-VAL-TEMP-")) + ,@post-steps)) + (push `(,val-var nil) bindings)) + `(,bindings ;bindings + () ;prologue + () ;pre-test + () ;parallel steps (not (multiple-value-setq (,dummy-predicate-var ,key-var ,val-var) - (,next-fn))) ;post-test + (,next-fn))) ;post-test ,post-steps))))) (defun loop-package-symbols-iteration-path (variable data-type prep-phrases