729 |
;;;List of all the value-accumulation descriptor structures in the loop. |
;;;List of all the value-accumulation descriptor structures in the loop. |
730 |
;;; See loop-get-collection-info. |
;;; See loop-get-collection-info. |
731 |
(defvar *loop-collection-cruft*) ; for multiple COLLECTs (etc) |
(defvar *loop-collection-cruft*) ; for multiple COLLECTs (etc) |
732 |
|
|
733 |
|
;;;Flag indicating value accumulation without into |
734 |
|
(defvar *loop-collection-no-into*) |
735 |
|
|
736 |
|
|
737 |
|
|
738 |
|
|
739 |
|
|
740 |
;;;; Code Analysis Stuff |
;;;; Code Analysis Stuff |
1023 |
(*loop-when-it-variable* nil) |
(*loop-when-it-variable* nil) |
1024 |
(*loop-never-stepped-variable* nil) |
(*loop-never-stepped-variable* nil) |
1025 |
(*loop-names* nil) |
(*loop-names* nil) |
1026 |
|
(*loop-collection-no-into* nil) |
1027 |
(*loop-collection-cruft* nil)) |
(*loop-collection-cruft* nil)) |
1028 |
(loop-iteration-driver) |
(loop-iteration-driver) |
1029 |
(loop-bind-block) |
(loop-bind-block) |
1033 |
,(nreverse *loop-body*) |
,(nreverse *loop-body*) |
1034 |
,(nreverse *loop-after-body*) |
,(nreverse *loop-after-body*) |
1035 |
,(nreconc *loop-epilogue* (nreverse *loop-after-epilogue*))))) |
,(nreconc *loop-epilogue* (nreverse *loop-after-epilogue*))))) |
1036 |
(do () (nil) |
; (do () (nil) |
1037 |
(setq answer `(block ,(pop *loop-names*) ,answer)) |
; (setq answer `(block ,(pop *loop-names*) ,answer)) |
1038 |
(unless *loop-names* (return nil))) |
; (unless *loop-names* (return nil))) |
1039 |
|
; (setq answer `(block ,(car *loop-names*) ,answer)) |
1040 |
(dolist (entry *loop-bind-stack*) |
(dolist (entry *loop-bind-stack*) |
1041 |
(let ((vars (first entry)) |
(let ((vars (first entry)) |
1042 |
(dcls (second entry)) |
(dcls (second entry)) |
1056 |
`((destructuring-bind ,@crocks |
`((destructuring-bind ,@crocks |
1057 |
,@forms)) |
,@forms)) |
1058 |
forms))))))) |
forms))))))) |
1059 |
|
(setq answer `(block ,(car *loop-names*) ,answer)) |
1060 |
answer))) |
answer))) |
1061 |
|
|
1062 |
|
|
1114 |
(defun loop-emit-final-value (form) |
(defun loop-emit-final-value (form) |
1115 |
(push (loop-construct-return form) *loop-after-epilogue*) |
(push (loop-construct-return form) *loop-after-epilogue*) |
1116 |
(when *loop-final-value-culprit* |
(when *loop-final-value-culprit* |
1117 |
(loop-warn "LOOP clause is providing a value for the iteration,~@ |
(if *loop-collection-no-into* |
1118 |
|
(specific-error :invalid-form "LOOP clause is providing a value for the iteration,~@ |
1119 |
|
however one was already established by a ~S clause." |
1120 |
|
*loop-final-value-culprit*) |
1121 |
|
(loop-warn "LOOP clause is providing a value for the iteration,~@ |
1122 |
however one was already established by a ~S clause." |
however one was already established by a ~S clause." |
1123 |
*loop-final-value-culprit*)) |
*loop-final-value-culprit*))) |
1124 |
(setq *loop-final-value-culprit* (car *loop-source-context*))) |
(setq *loop-final-value-culprit* (car *loop-source-context*))) |
1125 |
|
|
1126 |
|
|
1358 |
|
|
1359 |
|
|
1360 |
(defun loop-get-collection-info (collector class default-type) |
(defun loop-get-collection-info (collector class default-type) |
1361 |
|
(unless (loop-tequal (car *loop-source-code*)'into) |
1362 |
|
(setq *loop-collection-no-into* t)) |
1363 |
(let ((form (loop-get-form)) |
(let ((form (loop-get-form)) |
1364 |
(dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type))) |
(dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type))) |
1365 |
(name (when (loop-tequal (car *loop-source-code*) 'into) |
(name (when (loop-tequal (car *loop-source-code*) 'into) |
1476 |
(defun loop-do-thereis (restrictive) |
(defun loop-do-thereis (restrictive) |
1477 |
(when restrictive (loop-disallow-conditional)) |
(when restrictive (loop-disallow-conditional)) |
1478 |
(loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form)) |
(loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form)) |
1479 |
,(loop-construct-return *loop-when-it-variable*)))) |
,(loop-construct-return *loop-when-it-variable*))) |
1480 |
|
(loop-emit-final-value nil)) |
1481 |
|
|
1482 |
|
|
1483 |
(defun loop-do-while (negate kwd &aux (form (loop-get-form))) |
(defun loop-do-while (negate kwd &aux (form (loop-get-form))) |