X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Floop.lisp;h=e4ad5e9dddfae5e5db87ee73be7ec6f1c4c4aecd;hb=79c4a7fec90e697d1a5896c7883ff24d562bad6d;hp=1af7d78ec23845279e74d15b79c932bc560bd6f0;hpb=56ea5e2724c898e2507b1347306a725705fa386b;p=sbcl.git diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 1af7d78..e4ad5e9 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -98,7 +98,7 @@ (sb!int:defmacro-mundanely loop-collect-rplacd (&environment env (head-var tail-var &optional user-head-var) form) - (setq form (sb!xc:macroexpand form env)) + (setq form (sb!int:%macroexpand form env)) (flet ((cdr-wrap (form n) (declare (fixnum n)) (do () ((<= n 4) (setq form `(,(case n @@ -349,7 +349,7 @@ code to be loaded. (and (consp x) (or (not (eq (car x) 'car)) (not (symbolp (cadr x))) - (not (symbolp (setq x (sb!xc:macroexpand x env))))) + (not (symbolp (setq x (sb!int:%macroexpand x env))))) (cons x nil))) (cdr val)) `(,val)))) @@ -657,7 +657,7 @@ code to be loaded. ;;@@@@ ???? (declare (function list-size (list) fixnum)) (cond ((constantp x) 1) ((symbolp x) (multiple-value-bind (new-form expanded-p) - (sb!xc:macroexpand-1 x env) + (sb!int:%macroexpand-1 x env) (if expanded-p (estimate-code-size-1 new-form env) 1))) @@ -703,7 +703,7 @@ code to be loaded. (member fn *estimate-code-size-punt*)) (throw 'estimate-code-size nil)) (t (multiple-value-bind (new-form expanded-p) - (sb!xc:macroexpand-1 x env) + (sb!int:%macroexpand-1 x env) (if expanded-p (estimate-code-size-1 new-form env) (f 3)))))))) @@ -1161,7 +1161,6 @@ code to be loaded. (defun loop-get-collection-info (collector class default-type) (let ((form (loop-get-form)) - (dtype (or (loop-optional-type) default-type)) (name (when (loop-tequal (car *loop-source-code*) 'into) (loop-pop-source) (loop-pop-source)))) @@ -1169,7 +1168,8 @@ code to be loaded. (loop-error "The value accumulation recipient name, ~S, is not a symbol." name)) (unless name (loop-disallow-aggregate-booleans)) - (let ((cruft (find (the symbol name) *loop-collection-cruft* + (let ((dtype (or (loop-optional-type) default-type)) + (cruft (find (the symbol name) *loop-collection-cruft* :key #'loop-collector-name))) (cond ((not cruft) (when (and name (loop-var-p name))