dev-lisp/series: bump to 2.2.9_p20070808-r1 adding SCL support.

4 files changed, 343 insertions, 3 deletions

diff --git a/dev-lisp/series/Manifest b/dev-lisp/series/Manifest
index 47b7a4bc..0c351cb7 100644
--- a/dev-lisp/series/Manifest
+++ b/dev-lisp/series/Manifest
@@ -1,3 +1,4 @@
-AUX 2.2.9_p20070808-ecl-fix.patch 396 RMD160 c31834dfe293ba8846847d19e55eb6f63c20b3ed SHA1 e4c0e6e79897ff26af55efa763187b8274a4cbde SHA256 2c999ae893dc8e57ae32cf7d32126b5855d3decac5cb9bbc04ed5efa4af00737
+AUX 2.2.9_p20070808-ecl-support.patch 396 RMD160 c31834dfe293ba8846847d19e55eb6f63c20b3ed SHA1 e4c0e6e79897ff26af55efa763187b8274a4cbde SHA256 2c999ae893dc8e57ae32cf7d32126b5855d3decac5cb9bbc04ed5efa4af00737
+AUX 2.2.9_p20070808-scl-support.patch 13692 RMD160 39dd5ddc8ab9b7979bc6b04f410ae3c20fd5b855 SHA1 e385cd2c8ae7b81fa4c5e937a934986e0dc3a468 SHA256 035c6ca58a2343019e7e1143e36fed5b7484e03f3723de8c4a4aa1dc1568fc68
 DIST series-2.2.9_p20070808.tar.bz2 124045 RMD160 e1315f09b4ed9e856d319be74d129174a5daade2 SHA1 5938c996e6b894abdca76a703974228ffda87540 SHA256 3a1926446f9fc19f7637ea21af7fc6978515c3ef6b1037dd84311b1035219b31
-EBUILD series-2.2.9_p20070808.ebuild 594 RMD160 93b491a49111affa7ce6b1b803a5252f3ac5ab5e SHA1 712cb225d5cfb9c32c3def3bb9d4981746bc4106 SHA256 3d75fa048a9c8d0469827626e473f4cbdb04f7ba964f905f2682485d0e9337c6
+EBUILD series-2.2.9_p20070808-r1.ebuild 644 RMD160 a7823558ebcdb4cd392f806cdf303017c17fc965 SHA1 1b592ea1cdcd92d5b5aec3356bb47a1993c9d4ee SHA256 564a13ed5a827c71e56c7b5945abd00cb985dbace66d6ffc94ff11c232bc1084
diff --git a/dev-lisp/series/files/2.2.9_p20070808-ecl-fix.patch b/dev-lisp/series/files/2.2.9_p20070808-ecl-support.patch
index 512e5dcc..512e5dcc 100644
--- a/dev-lisp/series/files/2.2.9_p20070808-ecl-fix.patch
+++ b/dev-lisp/series/files/2.2.9_p20070808-ecl-support.patch
diff --git a/dev-lisp/series/files/2.2.9_p20070808-scl-support.patch b/dev-lisp/series/files/2.2.9_p20070808-scl-support.patch
new file mode 100644
index 00000000..4d338d19
--- /dev/null
+++ b/dev-lisp/series/files/2.2.9_p20070808-scl-support.patch
@@ -0,0 +1,338 @@
+Author: Stelian Ionescu <sionescu@common-lisp.net>
+Date: 2008-10-26
+Status: Pending
+Description: Add Scieneer Common Lisp support
+
+diff -Naur series-2.2.9.orig/s-code.lisp series-2.2.9/s-code.lisp
+--- series-2.2.9.orig/s-code.lisp	2007-08-08 17:07:45.000000000 +0200
++++ series-2.2.9/s-code.lisp	2008-10-26 13:13:54.000000000 +0100
+@@ -794,9 +794,9 @@
+   "T enables implicit mapping in optimized expressions")
+ 
+ (defconst-once /ext-conflicts/
+-  #+cmu '(collect iterate)
++  #+(or cmu scl) '(collect iterate)
+   #+allegro-v6.1 '(until)
+-  #-(or cmu allegro-v6.1) '())
++  #-(or cmu scl allegro-v6.1) '())
+ 
+ 
+ (defconst-once /series-forms/
+@@ -943,7 +943,7 @@
+ 			   (setq z x)))))
+ 		 l2))))))
+ 
+-  (cl:defun n-gensyms (n &optional (root "G"))
++  (cl:defun n-gensyms (n &optional (root (symbol-name '#:g)))
+     "Generate n uninterned symbols with basename root"
+     (do ((i n (1- i))
+ 	 (l nil (cons (gensym root) l)))
+@@ -1608,7 +1608,7 @@
+ 				    (cl:let ((value (eval (first operands))))
+ 				      (or (null value)
+ 					  (null (cdr operands))
+-					  (foldable-constant-expression-p `(AND ,@(rest operands)) env))))))
++					  (foldable-constant-expression-p `(and ,@(rest operands)) env))))))
+ 
+ 		  ;; COND can be folded if first clause is foldable
+ 		      (cond (or (null operands)
+@@ -1616,7 +1616,7 @@
+ 				     (cl:let ((value (eval (car (first operands)))))
+ 				       (if value
+ 					   (foldable-constant-expression-p* (cdr (first operands)) env)
+-					   (foldable-constant-expression-p `(COND ,@(rest operands)) env))))))
++					   (foldable-constant-expression-p `(cond ,@(rest operands)) env))))))
+ 		      (declare t)
+ 
+ 		  ;; IF can be folded if condition is foldable
+@@ -1640,7 +1640,7 @@
+ 				    (cl:let ((value (eval (first operands))))
+ 				      (or value
+ 					  (null (cdr operands))
+-					  (foldable-constant-expression-p `(OR ,@(rest operands)) env))))))
++					  (foldable-constant-expression-p `(or ,@(rest operands)) env))))))
+ 
+ 		  ;; THE can be folded if the value clause is foldable
+ 		      (the (foldable-constant-expression-p (second operands) env))
+@@ -1877,16 +1877,16 @@
+         (set-dispatch-macro-character #\# #\M (cl:function abbreviated-map-fn-reader)))
+         (when (not (eq pkg spkg))
+ 	  ;;This is here because UNTIL and COLLECT are loop clauses.
+-	  (cl:multiple-value-bind (sym code) (find-symbol "UNTIL" pkg)
++	  (cl:multiple-value-bind (sym code) (find-symbol (symbol-name '#:until) pkg)
+ 	    (when (and sym (eq code :internal)
+ 		       (not (boundp sym)) (not (fboundp sym)) (null (symbol-plist sym)))
+ 	      (unintern sym pkg)))
+-	  (cl:multiple-value-bind (sym code) (find-symbol "COLLECT" pkg)
++	  (cl:multiple-value-bind (sym code) (find-symbol (symbol-name '#:collect) pkg)
+ 	    (when (and sym (eq code :internal)
+ 		       (not (boundp sym)) (not (fboundp sym)) (null (symbol-plist sym)))
+ 	      (unintern sym pkg)))
+-	  #+(or cmu Harlequin-Common-Lisp)
+-	  (unintern 'series "COMMON-LISP-USER")
++	  #+(or cmu scl Harlequin-Common-Lisp)
++	  (unintern 'series :common-lisp-user)
+ 	  (shadowing-import /ext-conflicts/ pkg)
+ 	  (use-package :series pkg)
+ 	  (when shadow (shadowing-import /series-forms/ pkg))
+@@ -3340,7 +3340,7 @@
+ (cl:defun isolate-non-series (n code)
+   (cl:multiple-value-bind (exp free-ins free-outs)
+       (handle-non-series-stuff code)
+-    (cl:let* ((vars (n-gensyms n "OUT-"))
++    (cl:let* ((vars (n-gensyms n (symbol-name '#:out-)))
+ 	      (mapped-inputs nil)
+ 	      (frag (make-frag :aux (makeaux (mapcar #'(lambda (v) (list v t)) vars)))))
+       (dolist (entry free-ins)
+@@ -3631,7 +3631,7 @@
+             ((< n current-n)
+              (mapc #'(lambda (r) (when (not (free-out r)) (kill-ret r)))
+                    (nthcdr n (rets frag))))
+-            (t (dolist (v (n-gensyms (- n current-n) "XTRA-"))
++            (t (dolist (v (n-gensyms (- n current-n) (symbol-name '#:xtra-)))
+                  (+ret (make-sym :var v) frag)
+ 		 (add-literal-aux frag v t nil))))
+       (mapc #'coerce-to-type types (rets frag))))
+@@ -3746,7 +3746,7 @@
+ (defstruct (generator (:conc-name nil) (:type list))
+   gen-state gen-base (current-alter-info nil))
+ 
+-#+(or :lispworks :cmu :excl :sbcl)
++#+(or :lispworks :cmu :scl :excl :sbcl)
+ (deftype generator () 'cons)
+ 
+ (cl:defun generator (s)
+@@ -3850,7 +3850,7 @@
+ ;; print out series because that probably does a better job than this
+ ;; routine would.  We basically print out series as if it were a list
+ ;; of items.
+-#+cmu
++#+(or cmu scl)
+ (cl:defun print-series (series stream depth)
+   (cl:let ((generator (generator series))
+ 	   (first-p t)
+@@ -4356,7 +4356,7 @@
+ ;; This function converts a type to a "canonical" type.  Mainly meant
+ ;; to handle things that have been deftype'd.  We want to convert that
+ ;; deftype'd thing to the underlying Lisp type.  
+-#+cmu
++#+(or cmu scl)
+ (cl:defun canonical-type (type)
+   (kernel:type-specifier (c::specifier-type (if (and (not (atom type))
+                                                      (eq 'quote (first type)))
+@@ -4366,7 +4366,7 @@
+ (cl:defun canonical-type (type)
+   (ext:type-expand type))
+ 
+-#-(or cmu CLISP)
++#-(or cmu scl CLISP)
+ (cl:defun canonical-type (type)
+   type)
+ 
+@@ -6381,13 +6381,13 @@
+ 	         ((seq ,(optif *type* 'sequence))
+ 		  (index vector-index+ 0))
+ 		 ()              
+-		 (#-:cmu
++		 (#-(or :cmu :scl)
+ 		  (setq seq (make-sequence seq-type limit))
+ 		  ;; For some reason seq isn't initialized when
+ 		  ;; *optimize-series-expressions* is nil and this
+ 		  ;; errors out in CMUCL.  This makes sure seq is
+ 		  ;; initialized to something.
+-		  #+:cmu
++		  #+(or :cmu :scl)
+ 		  (setq seq (if seq
+ 				seq
+ 			      (make-sequence seq-type limit)))
+@@ -6984,8 +6984,8 @@
+   (cl:let* ((types (decode-type-arg (must-be-quoted type)))
+ 	    (params nil)
+ 	    (frag (make-frag :impure :fun))
+-	    (in-vars (n-gensyms (length args) "M-"))
+-	    (out-vars (n-gensyms (length types) "ITEMS-"))
++	    (in-vars (n-gensyms (length args) (symbol-name '#:m-)))
++	    (out-vars (n-gensyms (length types) (symbol-name '#:items-)))
+ 	    (*state* nil))
+     (dolist (var out-vars)
+       (+ret (make-sym :var var :series-var-p t) frag))
+@@ -7005,13 +7005,13 @@
+   (cl:let* ((types (decode-type-arg (must-be-quoted type)))
+             (params nil)
+             (frag (make-frag :impure :fun))
+-            (state-vars (n-gensyms (length types) "STATE-"))
+-            (out-vars (n-gensyms (length types) "ITEMS-"))
++            (state-vars (n-gensyms (length types) (symbol-name '#:state-)))
++            (out-vars (n-gensyms (length types) (symbol-name '#:items-)))
+             (*state* nil))
+     (when wrap-fn
+       (add-wrapper frag wrap-fn))
+     (dolist (var out-vars)
+-      (+ret (make-sym :var var :series-var-p T) frag))
++      (+ret (make-sym :var var :series-var-p t) frag))
+     (setf (aux frag)
+           (makeaux (append (mapcar #'list state-vars types)
+                            (mapcar #'list out-vars types))))
+@@ -7029,14 +7029,14 @@
+                 `(,@(if test-p
+                         `((if ,(car (handle-fn-call frag nil test
+ state-vars))
+-                              (go ,END))))
++                              (go ,end))))
+                     ,output-expr
+                     ,(car (handle-fn-call frag state-vars step state-vars
+ t))))
+         (cl:let ((done (new-var 'd)))
+           (add-literal-aux frag done 'boolean nil)
+           (setf (body frag)
+-                `((if ,done (go ,END))
++                `((if ,done (go ,end))
+                   ,(car (handle-fn-call frag (list done) test state-vars))
+                   ,output-expr
+                   (if (not ,done)
+@@ -7050,8 +7050,8 @@
+   (cl:let* ((types (decode-type-arg (must-be-quoted type)))
+ 	    (params nil)
+ 	    (frag (make-frag :impure :fun))
+-	    (in-vars (n-gensyms (length args) "ITEMS-"))
+-	    (out-vars (n-gensyms (length types) "C-"))
++	    (in-vars (n-gensyms (length args) (symbol-name '#:items-)))
++	    (out-vars (n-gensyms (length types) (symbol-name '#:c-)))
+ 	    (*state* nil))
+     (when wrap-fn
+       (add-wrapper frag wrap-fn))
+@@ -7266,8 +7266,8 @@
+   (cl:let* ((types (decode-type-arg (must-be-quoted type)))
+ 	    (params nil)
+ 	    (frag (make-frag :impure :fun))
+-	    (in-vars (n-gensyms (length args) "ITEMS-"))
+-	    (out-vars (n-gensyms (length types) "C-"))
++	    (in-vars (n-gensyms (length args) (symbol-name '#:items-)))
++	    (out-vars (n-gensyms (length types) (symbol-name '#:c-)))
+ 	    (*state* nil))
+     (dolist (var out-vars)
+       (+ret (make-sym :var var :series-var-p t) frag))
+@@ -7934,8 +7934,8 @@
+   :optimizer
+   (cl:let* ((params (list series))
+ 	    (frag (make-frag))
+-	    (input-vars (n-gensyms (length other-inputs) "STATE-IN-"))
+-	    (state-vars (n-gensyms (length other-inputs) "STATE-"))
++	    (input-vars (n-gensyms (length other-inputs) (symbol-name '#:state-in-)))
++	    (state-vars (n-gensyms (length other-inputs) (symbol-name '#:state-)))
+ 	    (var (new-var 'items)))
+     (+ret (make-sym :var var :series-var-p t) frag)
+     (+arg (make-sym :var var :series-var-p t) frag)
+@@ -8461,7 +8461,7 @@
+                 (mapcar #'alter-fn items-list))
+  :optimizer
+   (cl:let* ((args (copy-list items-list))
+-	    (vars (n-gensyms (length args) "COTRUNC-"))
++	    (vars (n-gensyms (length args) (symbol-name '#:cotrunc-)))
+ 	    (ports (mapcar #'(lambda (v) (list v t)) vars)))
+     (apply-frag
+       (literal-frag `(,ports ,(copy-list ports) nil nil nil nil nil nil nil))
+@@ -9015,7 +9015,7 @@
+  :optimizer
+   (cl:let* ((params nil)
+               (frag (make-frag :impure nil))
+-              (item-vars (n-gensyms (1+ (length items-i)) "ITEMS-"))
++              (item-vars (n-gensyms (1+ (length items-i)) (symbol-name '#:items-)))
+               (*state* nil))
+     (multiple-value-setq (pred params) (handle-fn-arg frag pred params))
+     (setq params (mapcar #'retify (nconc params (cons items-1 items-i))))
+@@ -9412,7 +9412,7 @@
+           (rrs 3 "~%M argument " m " to CHUNK fails to be a positive integer."))
+          ((not (typep n 'positive-integer))
+           (rrs 4 "~%N argument " n " to CHUNK fails to be a positive integer."))
+-         (t (cl:let* ((vars (n-gensyms m "CHUNK-"))
++         (t (cl:let* ((vars (n-gensyms m (symbol-name '#:chunk-)))
+                         (outs (mapcar #'(lambda (v) (list v t)) vars))
+                         (auxes (mapcar #'(lambda (v)
+                                            `(,v ,(copy-list
+diff -Naur series-2.2.9.orig/s-package.lisp series-2.2.9/s-package.lisp
+--- series-2.2.9.orig/s-package.lisp	2004-12-15 18:18:57.000000000 +0100
++++ series-2.2.9/s-package.lisp	2008-10-26 13:14:31.000000000 +0100
+@@ -99,7 +99,7 @@
+     (rename-package "LISP" "COMMON-LISP" '("LISP" "CL"))))
+ 
+ ;;; Note this is really too early, but we need it here
+-#+(or draft-ansi-cl draft-ansi-cl-2 ansi-cl allegro cmu sbcl Genera Harlequin-Common-Lisp CLISP mcl)
++#+(or draft-ansi-cl draft-ansi-cl-2 ansi-cl allegro cmu scl sbcl Genera Harlequin-Common-Lisp CLISP mcl)
+ (cl:eval-when (load eval compile)
+   (cl:pushnew ':series-ansi cl:*features*))
+ 
+@@ -154,7 +154,7 @@
+     )
+   (:shadow
+    #:let #:let* #:multiple-value-bind #:funcall #:defun
+-   #+cmu "COLLECT" #+cmu "ITERATE")
++   #+(or cmu scl) #:collect #+(or cmu scl) #:iterate)
+   #+Harlequin-Common-Lisp
+   (:import-from "LISPWORKS" "COMPILER-LET")
+   #+Genera
+@@ -163,8 +163,8 @@
+   (:import-from #:cltl1 #:compiler-let)
+   #+CLISP
+   (:import-from "EXT" "COMPILER-LET")
+-  #+cmu
+-  (:import-from "EXT" "COMPILER-LET")
++  #+(or cmu scl)
++  (:import-from :ext #:compiler-let)
+   #+mcl
+   (:import-from "CCL" "COMPILER-LET")
+   #+sbcl
+@@ -208,7 +208,7 @@
+ #-(or series-ansi)
+ (eval-when (compile load eval)
+   (in-package "SERIES" :use '("LISP"))
+-  (shadow '(let let* multiple-value-bind funcall defun eval-when #+cmu collect #+cmu iterate))
++  (shadow '(let let* multiple-value-bind funcall defun eval-when #+(or cmu scl) collect #+(or cmu scl) iterate))
+ ) ; end of eval-when
+ 
+ #-(or series-ansi)
+diff -Naur series-2.2.9.orig/s-test.lisp series-2.2.9/s-test.lisp
+--- series-2.2.9.orig/s-test.lisp	2007-07-10 19:45:46.000000000 +0200
++++ series-2.2.9/s-test.lisp	2008-10-26 13:15:44.000000000 +0100
+@@ -198,8 +198,7 @@
+ ;;;;
+ 
+ (series::eval-when (:compile-toplevel :load-toplevel :execute)
+-  #-allegro-modern (in-package "COMMON-LISP-USER")
+-  #+allegro-modern (in-package "common-lisp-user")
++  (in-package :common-lisp-user)
+ 
+   #+(and :allegro-version>= (version>= 5 0) (not (version>= 5 1)))
+   (defadvice make-sequence :before
+@@ -310,11 +309,13 @@
+ 	   ;; Harlequin, but for CMUCL, it causes some tests to fail
+ 	   ;; that otherwise would pass because the compiler generates
+ 	   ;; a warning.
+-	   #-(or cmu allegro) (*break-on-warnings* t)
+-	   #+(or cmu allegro harlequin) (*break-on-signals* #+(or cmu allegro) nil
+-							    #-(or cmu allegro) 'warning)
++	   #-(or cmu scl allegro)
++	   (*break-on-warnings* t)
++	   #+(or cmu scl allegro harlequin)
++	   (*break-on-signals* #+(or cmu scl allegro) nil
++			       #-(or cmu scl allegro) 'warning)
+ 	   ;; Don't print out "Compiling..." messages
+-	   #+cmu
++	   #+(or cmu scl)
+ 	   (*compile-print* nil)
+ 	   (r (multiple-value-list
+ 		(eval (form entry)))))
+@@ -1463,12 +1464,7 @@
+ ;these are weird tests checking for particular bugs in old versions
+ (defok 318 (ton (multiple-value-list
+ 		      (let ((strings (choose-if #'stringp
+-						(scan '(1 2
+-							#-allegro-modern
+-							"COND"
+-							#+allegro-modern
+-							"cond"
+-							4)))))
++						(scan `(1 2 ,(symbol-name 'cond) 4)))))
+ 			(find-symbol (collect-first strings)))))
+   (cond :inherited))
+ (defcmukernel 319 (td (defun weighted-sum (numbers weights)
diff --git a/dev-lisp/series/series-2.2.9_p20070808.ebuild b/dev-lisp/series/series-2.2.9_p20070808-r1.ebuild
index d56bf86b..ca2742c5 100644
--- a/dev-lisp/series/series-2.2.9_p20070808.ebuild
+++ b/dev-lisp/series/series-2.2.9_p20070808-r1.ebuild
@@ -16,7 +16,8 @@ DEPEND="!dev-lisp/cl-${PN}"
 src_unpack() {
 	unpack ${A}
 	cd "${S}"
-	epatch "${FILESDIR}"/${PV}-ecl-fix.patch
+	epatch "${FILESDIR}"/${PV}-ecl-support.patch
+	epatch "${FILESDIR}"/${PV}-scl-support.patch
 }
 
 src_install() {