1.0.43.64: loop: remove LOOP-UNIVERSE-ANSI and LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED

  In SBCL both were always T -- delete and simplify code accordingly.

  Also delete stale comment referring to LOOP-PREFER-POP feature and
  STEP-FUNCTION, which are both long gone.

  Patch from Roman Marynchak with minor edits. No changes in
  functionality.

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index d42be8f..1af7d78 100644 (file)
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -87,11 +87,6 @@
 ;;;;
 ;;;; KLUDGE: In SBCL, we only really use variant (1), and any generality
 ;;;; for the other variants is wasted. -- WHN 20000121
-
-;;;; FIXME: the STEP-FUNCTION stuff in the code seems to've been
-;;;; intended to support code which was conditionalized with
-;;;; LOOP-PREFER-POP (not true on CMU CL) and which has since been
-;;;; removed. Thus, STEP-FUNCTION stuff could probably be removed too.
 \f
 ;;;; list collection macrology
 
@@ -281,18 +276,10 @@ code to be loaded.
   path-keywords        ; hash table, value = (fn-name . extra-data)
   type-symbols         ; hash table of type SYMBOLS, test EQ,
                        ; value = CL type specifier
-  type-keywords        ; hash table of type STRINGS, test EQUAL,
+  type-keywords)       ; hash table of type STRINGS, test EQUAL,
                        ; value = CL type spec
-  ansi                 ; NIL, T, or :EXTENDED
-  implicit-for-required) ; see loop-hack-iteration
 (sb!int:def!method print-object ((u loop-universe) stream)
-  (let ((string (case (loop-universe-ansi u)
-                  ((nil) "non-ANSI")
-                  ((t) "ANSI")
-                  (:extended "extended-ANSI")
-                  (t (loop-universe-ansi u)))))
-    (print-unreadable-object (u stream :type t)
-      (write-string string stream))))
+  (print-unreadable-object (u stream :type t :identity t)))
 
 ;;; This is the "current" loop context in use when we are expanding a
 ;;; loop. It gets bound on each invocation of LOOP.
@@ -300,8 +287,7 @@ code to be loaded.
 
 (defun make-standard-loop-universe (&key keywords for-keywords
                                          iteration-keywords path-keywords
-                                         type-keywords type-symbols ansi)
-  (declare (type (member nil t :extended) ansi))
+                                         type-keywords type-symbols)
   (flet ((maketable (entries)
            (let* ((size (length entries))
                   (ht (make-hash-table :size (if (< size 10) 10 size)
@@ -314,8 +300,6 @@ code to be loaded.
       :for-keywords (maketable for-keywords)
       :iteration-keywords (maketable iteration-keywords)
       :path-keywords (maketable path-keywords)
-      :ansi ansi
-      :implicit-for-required (not (null ansi))
       :type-keywords (maketable type-keywords)
       :type-symbols (let* ((size (length type-symbols))
                            (ht (make-hash-table :size (if (< size 10) 10 size)
@@ -1177,7 +1161,7 @@ code to be loaded.
 
 (defun loop-get-collection-info (collector class default-type)
   (let ((form (loop-get-form))
-        (dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type)))
+        (dtype (or (loop-optional-type) default-type))
         (name (when (loop-tequal (car *loop-source-code*) 'into)
                 (loop-pop-source)
                 (loop-pop-source))))
@@ -1185,8 +1169,6 @@ code to be loaded.
       (loop-error "The value accumulation recipient name, ~S, is not a symbol." name))
     (unless name
       (loop-disallow-aggregate-booleans))
-    (unless dtype
-      (setq dtype (or (loop-optional-type) default-type)))
     (let ((cruft (find (the symbol name) *loop-collection-cruft*
                        :key #'loop-collector-name)))
       (cond ((not cruft)
@@ -1393,16 +1375,7 @@ code to be loaded.
                      *loop-after-body*))
         (loop-bind-block)
         (return nil))
-      (loop-pop-source)                         ; Flush the "AND".
-      (when (and (not (loop-universe-implicit-for-required *loop-universe*))
-                 (setq tem
-                       (loop-lookup-keyword
-                        (car *loop-source-code*)
-                        (loop-universe-iteration-keywords *loop-universe*))))
-        ;; The latest ANSI clarification is that the FOR/AS after the AND must
-        ;; NOT be supplied.
-        (loop-pop-source)
-        (setq entry tem)))))
+      (loop-pop-source)))) ; Flush the "AND".
 \f
 ;;;; main iteration drivers
 
@@ -1945,7 +1918,7 @@ code to be loaded.
 \f
 ;;;; ANSI LOOP
 
-(defun make-ansi-loop-universe (extended-p)
+(defun make-ansi-loop-universe ()
   (let ((w (make-standard-loop-universe
              :keywords '((named (loop-do-named))
                          (initially (loop-do-initially))
@@ -2006,8 +1979,7 @@ code to be loaded.
                              simple-bit-vector simple-string simple-vector
                              single-float standard-char stream string
                              base-char symbol t vector)
-             :type-keywords nil
-             :ansi (if extended-p :extended t))))
+             :type-keywords nil)))
     (add-loop-path '(hash-key hash-keys) 'loop-hash-table-iteration-path w
                    :preposition-groups '((:of :in))
                    :inclusive-permitted nil
@@ -2036,7 +2008,7 @@ code to be loaded.
     w))
 
 (defparameter *loop-ansi-universe*
-  (make-ansi-loop-universe nil))
+  (make-ansi-loop-universe))
 
 (defun loop-standard-expansion (keywords-and-forms environment universe)
   (if (and keywords-and-forms (symbolp (car keywords-and-forms)))

diff --git a/version.lisp-expr b/version.lisp-expr
index f184272..3134ff5 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.63"
+"1.0.43.64"