From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 17 Jul 2007 10:13:38 +0000 (+0000)
Subject: 1.0.7.23: delete a large block of commented-out code from seqtran.lisp
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e6cf9d8e3e0d328e34c0edccd4f0ebc09e9b666f;p=sbcl.git

1.0.7.23: delete a large block of commented-out code from seqtran.lisp

 * This is why we have version control. (But add a comment pointing out
   that this code exists, so that people know where to look for it.)

   The code that is deleted here contains the apparent beginnings of a
   better sequence transform infrastructure: a compiler representation
   of an iteration over a sequence.
---

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index c956a07..62a3630 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -403,205 +403,17 @@
         (t
          (give-up-ir1-transform))))
 
-;;; FIXME: Why is this code commented out? (Why *was* it commented
-;;; out? We inherited this situation from cmucl-2.4.8, with no
-;;; explanation.) Should we just delete this code?
-#|
-;;; This is a frob whose job it is to make it easier to pass around
-;;; the arguments to IR1 transforms. It bundles together the name of
-;;; the argument (which should be referenced in any expansion), and
-;;; the continuation for that argument (or NIL if unsupplied.)
-(defstruct (arg (:constructor %make-arg (name cont))
-                (:copier nil))
-  (name nil :type symbol)
-  (cont nil :type (or continuation null)))
-(defmacro make-arg (name)
-  `(%make-arg ',name ,name))
-
-;;; If Arg is null or its CONT is null, then return Default, otherwise
-;;; return Arg's NAME.
-(defun default-arg (arg default)
-  (declare (type (or arg null) arg))
-  (if (and arg (arg-cont arg))
-      (arg-name arg)
-      default))
-
-;;; If Arg is null or has no CONT, return the default. Otherwise, Arg's
-;;; CONT must be a constant continuation whose value we return. If not, we
-;;; give up.
-(defun arg-constant-value (arg default)
-  (declare (type (or arg null) arg))
-  (if (and arg (arg-cont arg))
-      (let ((cont (arg-cont arg)))
-        (unless (constant-continuation-p cont)
-          (give-up-ir1-transform "Argument is not constant: ~S."
-                                 (arg-name arg)))
-        (continuation-value from-end))
-      default))
-
-;;; If Arg is a constant and is EQL to X, then return T, otherwise NIL. If
-;;; Arg is NIL or its CONT is NIL, then compare to the default.
-(defun arg-eql (arg default x)
-  (declare (type (or arg null) x))
-  (if (and arg (arg-cont arg))
-      (let ((cont (arg-cont arg)))
-        (and (constant-continuation-p cont)
-             (eql (continuation-value cont) x)))
-      (eql default x)))
-
-(defstruct (iterator (:copier nil))
-  ;; The kind of iterator.
-  (kind nil (member :normal :result))
-  ;; A list of LET* bindings to create the initial state.
-  (binds nil :type list)
-  ;; A list of declarations for Binds.
-  (decls nil :type list)
-  ;; A form that returns the current value. This may be set with SETF to set
-  ;; the current value.
-  (current (error "Must specify CURRENT."))
-  ;; In a :NORMAL iterator, a form that tests whether there is a current value.
-  (done nil)
-  ;; In a :RESULT iterator, a form that truncates the result at the current
-  ;; position and returns it.
-  (result nil)
-  ;; A form that returns the initial total number of values. The result is
-  ;; undefined after NEXT has been evaluated.
-  (length (error "Must specify LENGTH."))
-  ;; A form that advances the state to the next value. It is an error to call
-  ;; this when the iterator is Done.
-  (next (error "Must specify NEXT.")))
-
-;;; Type of an index var that can go negative (in the from-end case.)
-(deftype neg-index ()
-  `(integer -1 ,most-positive-fixnum))
-
-;;; Return an ITERATOR structure describing how to iterate over an arbitrary
-;;; sequence. Sequence is a variable bound to the sequence, and Type is the
-;;; type of the sequence. If true, INDEX is a variable that should be bound to
-;;; the index of the current element in the sequence.
-;;;
-;;; If we can't tell whether the sequence is a list or a vector, or whether
-;;; the iteration is forward or backward, then GIVE-UP.
-(defun make-sequence-iterator (sequence type &key start end from-end index)
-  (declare (symbol sequence) (type ctype type)
-           (type (or arg null) start end from-end)
-           (type (or symbol null) index))
-  (let ((from-end (arg-constant-value from-end nil)))
-    (cond ((csubtypep type (specifier-type 'vector))
-           (let* ((n-stop (gensym))
-                  (n-idx (or index (gensym)))
-                  (start (default-arg 0 start))
-                  (end (default-arg `(length ,sequence) end)))
-             (make-iterator
-              :kind :normal
-              :binds `((,n-idx ,(if from-end `(1- ,end) ,start))
-                       (,n-stop ,(if from-end `(1- ,start) ,end)))
-              :decls `((type neg-index ,n-idx ,n-stop))
-              :current `(aref ,sequence ,n-idx)
-              :done `(,(if from-end '<= '>=) ,n-idx ,n-stop)
-              :next `(setq ,n-idx
-                           ,(if from-end `(1- ,n-idx) `(1+ ,n-idx)))
-              :length (if from-end
-                          `(- ,n-idx ,n-stop)
-                          `(- ,n-stop ,n-idx)))))
-          ((csubtypep type (specifier-type 'list))
-           (let* ((n-stop (if (and end (not from-end)) (gensym) nil))
-                  (n-current (gensym))
-                  (start-p (not (arg-eql start 0 0)))
-                  (end-p (not (arg-eql end nil nil)))
-                  (start (default-arg start 0))
-                  (end (default-arg end nil)))
-             (make-iterator
-              :binds `((,n-current
-                        ,(if from-end
-                             (if (or start-p end-p)
-                                 `(nreverse (subseq ,sequence ,start
-                                                    ,@(when end `(,end))))
-                                 `(reverse ,sequence))
-                             (if start-p
-                                 `(nthcdr ,start ,sequence)
-                                 sequence)))
-                       ,@(when n-stop
-                           `((,n-stop (nthcdr (the index
-                                                   (- ,end ,start))
-                                              ,n-current))))
-                       ,@(when index
-                           `((,index ,(if from-end `(1- ,end) start)))))
-              :kind :normal
-              :decls `((list ,n-current ,n-end)
-                       ,@(when index `((type neg-index ,index))))
-              :current `(car ,n-current)
-              :done `(eq ,n-current ,n-stop)
-              :length `(- ,(or end `(length ,sequence)) ,start)
-              :next `(progn
-                       (setq ,n-current (cdr ,n-current))
-                       ,@(when index
-                           `((setq ,n-idx
-                                   ,(if from-end
-                                        `(1- ,index)
-                                        `(1+ ,index)))))))))
-          (t
-           (give-up-ir1-transform
-            "can't tell whether sequence is a list or a vector")))))
-
-;;; Make an iterator used for constructing result sequences. Name is a
-;;; variable to be bound to the result sequence. Type is the type of result
-;;; sequence to make. Length is an expression to be evaluated to get the
-;;; maximum length of the result (not evaluated in list case.)
-(defun make-result-sequence-iterator (name type length)
-  (declare (symbol name) (type ctype type))
-
-;;; Define each NAME as a local macro that will call the value of the
-;;; function arg with the given arguments. If the argument isn't known to be a
-;;; function, give them an efficiency note and reference a coerced version.
-(defmacro coerce-funs (specs &body body)
-  #!+sb-doc
-  "COERCE-FUNCTIONS ({(Name Fun-Arg Default)}*) Form*"
-  (collect ((binds)
-            (defs))
-    (dolist (spec specs)
-      `(let ((body (progn ,@body))
-             (n-fun (arg-name ,(second spec)))
-             (fun-cont (arg-cont ,(second spec))))
-         (cond ((not fun-cont)
-                `(macrolet ((,',(first spec) (&rest args)
-                             `(,',',(third spec) ,@args)))
-                   ,body))
-               ((not (csubtypep (continuation-type fun-cont)
-                                (specifier-type 'function)))
-                (when (policy *compiler-error-context*
-                              (> speed inhibit-warnings))
-                  (compiler-notify
-                   "~S may not be a function, so must coerce at run-time."
-                   n-fun))
-                (once-only ((n-fun `(if (functionp ,n-fun)
-                                        ,n-fun
-                                        (symbol-function ,n-fun))))
-                  `(macrolet ((,',(first spec) (&rest args)
-                               `(funcall ,',n-fun ,@args)))
-                     ,body)))
-               (t
-                `(macrolet ((,',(first spec) (&rest args)
-                              `(funcall ,',n-fun ,@args)))
-                   ,body)))))))
-
-;;; Wrap code around the result of the body to define Name as a local macro
-;;; that returns true when its arguments satisfy the test according to the Args
-;;; Test and Test-Not. If both Test and Test-Not are supplied, abort the
-;;; transform.
-(defmacro with-sequence-test ((name test test-not) &body body)
-  `(let ((not-p (arg-cont ,test-not)))
-     (when (and (arg-cont ,test) not-p)
-       (abort-ir1-transform "Both ~S and ~S were supplied."
-                            (arg-name ,test)
-                            (arg-name ,test-not)))
-     (coerce-funs ((,name (if not-p ,test-not ,test) eql))
-       ,@body)))
-|#
-
+
 ;;;; hairy sequence transforms
 
 ;;; FIXME: no hairy sequence transforms in SBCL?
+;;;
+;;; There used to be a bunch of commented out code about here,
+;;; containing the (apparent) beginning of hairy sequence transform
+;;; infrastructure. People interested in implementing better sequence
+;;; transforms might want to look at it for inspiration, even though
+;;; the actual code is ancient CMUCL -- and hence bitrotted. The code
+;;; was deleted in 1.0.7.23.
 
 ;;;; string operations
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 93f0421..f2cea43 100644
--- 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.7.22"
+"1.0.7.23"