movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12745 Modified Files: more-macros.lisp Log Message: Changed dolist a bit. Date: Thu Jun 10 12:27:36 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.10 movitz/losp/muerte/more-macros.lisp:1.11 --- movitz/losp/muerte/more-macros.lisp:1.10 Wed Jun 9 16:04:26 2004 +++ movitz/losp/muerte/more-macros.lisp Thu Jun 10 12:27:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.10 2004/06/09 23:04:26 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.11 2004/06/10 19:27:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -129,15 +129,11 @@ ,@declarations-and-body))) (defmacro dolist ((var list-form &optional result-form) &body declarations-and-body) - (let ((cons-var (gensym (format nil "dolist-cons-var-~A-" var))) - (loop-tag (gensym "dolist-loop-tag-"))) - `(prog ((,cons-var ,list-form)) - ,loop-tag - (when ,cons-var - (let ((,var (pop ,cons-var))) - ,@declarations-and-body) - (go ,loop-tag)) - ,(when result-form `(return ,result-form))))) + (let ((cons-var (gensym "dolist-cons-"))) + `(do ((,cons-var ,list-form)) + ((null ,cons-var) ,result-form) + (let ((,var (pop ,cons-var))) + ,@declarations-and-body)))) (defmacro letf* (bindings &body body &environment env) "Does what one might expect, saving the old values and setting the generalized @@ -315,8 +311,7 @@ (define-compiler-macro %bignum-bigits (x) `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) ,x) - (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum - 'movitz::length)) + (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12124 Modified Files: functions.lisp Log Message: (setf funobj-constant-ref) had a nasty bug wrt. jumpers: The jumper would be off-by-2, causing very 'interesting' effects. Date: Thu Jun 10 12:26:33 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.12 movitz/losp/muerte/functions.lisp:1.13 --- movitz/losp/muerte/functions.lisp:1.12 Thu Jun 10 05:09:15 2004 +++ movitz/losp/muerte/functions.lisp Thu Jun 10 12:26:33 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.12 2004/06/10 12:09:15 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.13 2004/06/10 19:26:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -312,16 +312,16 @@ (assert (below value (length (funobj-code-vector funobj))) (value) "The jumper value ~D is invalid because the code-vector's size is ~D." value (length (funobj-code-vector funobj))) - (progn ;; without-gc + (progn ;; XXX without-gc (with-inline-assembly (:returns :nothing) - (:compile-two-forms (:eax :ecx) funobj index) - (:leal (:ecx :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)) - :ebx) ; dest. address into ebx. - (:compile-form (:result-mode :untagged-fixnum-ecx) value) + (:compile-two-forms (:eax :edx) funobj index) + (:compile-form (:result-mode :ecx) value) + (:movl #.movitz:+code-vector-transient-word+ :ebx) (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) - :ecx) - (:movl :ecx (:ebx)) - (:xorl :ebx :ebx))) + :ebx) ; code-vector (word) into ebx + (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) ; value + (:movl :ecx (:eax :edx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0))) + (:addl :ebx (:eax :edx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0))))) value))) (defun funobj-debug-info (funobj)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10428 Modified Files: integers.lisp Log Message: Added a really stupid /, and a slightly improved logxor. Date: Thu Jun 10 12:25:05 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.36 movitz/losp/muerte/integers.lisp:1.37 --- movitz/losp/muerte/integers.lisp:1.36 Thu Jun 10 06:31:14 2004 +++ movitz/losp/muerte/integers.lisp Thu Jun 10 12:25:05 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.36 2004/06/10 13:31:14 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.37 2004/06/10 19:25:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1277,6 +1277,19 @@ (do-it))) )))) +(defun / (number &rest denominators) + (declare (dynamic-extent denominators)) + (cond + ((null denominators) + (make-ratio 1 number)) + ((null (cdr denominators)) + (multiple-value-bind (q r) + (truncate number (first denominators)) + (if (= 0 r) + q + (error "Don't know how to divide ~S by ~S." number (first denominators))))) + (t (reduce '/ denominators :initial-value number)))) + (defun round (number &optional (divisor 1)) "Mathematical rounding." (multiple-value-bind (quotient remainder) @@ -1536,11 +1549,14 @@ (1 (x) x) (2 (x y) (number-double-dispatch (x y) + (((eql 0) t) y) + ((t (eql 0)) x) ((fixnum fixnum) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) x) - (:compile-form (:result-mode :ebx) y) - (:xorl :ebx :eax))))) + (:compile-form (:result-mode :ecx) y) + ;; (:orl #.movitz:+movitz-fixnum-zmask+ :ecx) + (:xorl :ecx :eax))))) (t (&rest integers) (declare (dynamic-extent integers)) (if (null integers)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2326 Modified Files: sequences.lisp Log Message: Slightly better make-sequence and concatenate. Date: Thu Jun 10 09:28:55 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.10 movitz/losp/muerte/sequences.lisp:1.11 --- movitz/losp/muerte/sequences.lisp:1.10 Thu Jun 10 06:51:24 2004 +++ movitz/losp/muerte/sequences.lisp Thu Jun 10 09:28:55 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.10 2004/06/10 13:51:24 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.11 2004/06/10 16:28:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1586,6 +1586,8 @@ (if (not initial-element-p) (make-string size) (make-string size :initial-element initial-element))) + (vector + (make-array size :initial-element initial-element)) (list (make-list size :initial-element initial-element)))) @@ -1600,10 +1602,11 @@ (copy-seq (first sequences))) ((= 0 (length (first sequences))) (apply #'concatenate result-type (cdr sequences))) - ((eq result-type 'vector) - (let* ((r (make-array (let ((length 0)) - (dolist (s sequences length) - (incf length (length s)))))) + ((member result-type '(vector string)) + (let* ((r (make-sequence result-type + (let ((length 0)) + (dolist (s sequences length) + (incf length (length s)))))) (i 0)) (dolist (s sequences) (replace r s :start1 i)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv2124 Modified Files: debugger.lisp Log Message: match-code-pattern still wasn't quite right. This should do it. Date: Thu Jun 10 09:28:27 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.12 movitz/losp/x86-pc/debugger.lisp:1.13 --- movitz/losp/x86-pc/debugger.lisp:1.12 Thu Jun 10 08:06:52 2004 +++ movitz/losp/x86-pc/debugger.lisp Thu Jun 10 09:28:27 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.12 2004/06/10 15:06:52 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.13 2004/06/10 16:28:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -177,7 +177,7 @@ (setf result-register (second p) result-position (third p))) (:or - (dolist (sub-pattern (cdr p)) + (dolist (sub-pattern (cdr p) (return-from match-code-pattern nil)) (multiple-value-bind (success-p sub-result-register sub-result-position new-ip) (match-code-pattern sub-pattern code-vector ip register) (when success-p @@ -185,8 +185,7 @@ (setf result-register sub-result-register result-position sub-result-position)) (setf ip new-ip) - (return)))) - (return nil)) + (return))))) (:* (let ((max-times (second p)) ; (:kleene-star <max-times> <sub-pattern>) (sub-pattern (third p))) (dotimes (i max-times)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv11860 Modified Files: debugger.lisp Log Message: Fixed a stupid bug in match-code-pattern. Date: Thu Jun 10 08:06:52 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.11 movitz/losp/x86-pc/debugger.lisp:1.12 --- movitz/losp/x86-pc/debugger.lisp:1.11 Wed Jun 2 07:31:20 2004 +++ movitz/losp/x86-pc/debugger.lisp Thu Jun 10 08:06:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.11 2004/06/02 14:31:20 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.12 2004/06/10 15:06:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -177,7 +177,7 @@ (setf result-register (second p) result-position (third p))) (:or - (dolist (sub-pattern (cdr p) (return nil)) + (dolist (sub-pattern (cdr p)) (multiple-value-bind (success-p sub-result-register sub-result-position new-ip) (match-code-pattern sub-pattern code-vector ip register) (when success-p @@ -185,7 +185,8 @@ (setf result-register sub-result-register result-position sub-result-position)) (setf ip new-ip) - (return))))) + (return)))) + (return nil)) (:* (let ((max-times (second p)) ; (:kleene-star <max-times> <sub-pattern>) (sub-pattern (third p))) (dotimes (i max-times) @@ -484,11 +485,11 @@ (function (let ((delta (code-vector-offset (funobj-code-vector funobj) eip))) (if delta - (format t "{Interrupt ~D in ~W at PC offset ~D." + (format t "{Exception ~D in ~W at PC offset ~D." exception (funobj-name funobj) delta) - (format t "{Interrupt ~D in ~W at EIP=#x~X. [#x~X]}" + (format t "{Exception ~D in ~W at EIP=#x~X. [#x~X]}" exception (funobj-name funobj) eip interrupt-frame)))) - (t (format t "{Interrupt ~D with ESI=#x~Z and EIP=#x~X. [#x~X]}" + (t (format t "{Exception ~D with ESI=#x~Z and EIP=#x~X. [#x~X]}" exception funobj eip interrupt-frame)))))))) (function (let ((name (funobj-name funobj)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7988 Modified Files: typep.lisp Log Message: Added vectorp. Date: Thu Jun 10 06:51:53 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.16 movitz/losp/muerte/typep.lisp:1.17 --- movitz/losp/muerte/typep.lisp:1.16 Wed Jun 9 16:05:34 2004 +++ movitz/losp/muerte/typep.lisp Thu Jun 10 06:51:53 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.16 2004/06/09 23:05:34 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.17 2004/06/10 13:51:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -467,6 +467,9 @@ (define-simple-typep (cons consp) (obj) (typep obj 'cons)) + +(define-simple-typep (vector vectorp) (obj) + (typep obj 'vector)) (define-simple-typep (pointer pointerp) (obj) (typep obj 'pointer))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7737 Modified Files: sequences.lisp Log Message: Somewhat improved concatenate, for (eq result-type 'vector). Date: Thu Jun 10 06:51:24 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.9 movitz/losp/muerte/sequences.lisp:1.10 --- movitz/losp/muerte/sequences.lisp:1.9 Thu Jun 10 05:21:11 2004 +++ movitz/losp/muerte/sequences.lisp Thu Jun 10 06:51:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.9 2004/06/10 12:21:11 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.10 2004/06/10 13:51:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1600,6 +1600,15 @@ (copy-seq (first sequences))) ((= 0 (length (first sequences))) (apply #'concatenate result-type (cdr sequences))) + ((eq result-type 'vector) + (let* ((r (make-array (let ((length 0)) + (dolist (s sequences length) + (incf length (length s)))))) + (i 0)) + (dolist (s sequences) + (replace r s :start1 i) + (incf i (length s))) + r)) (t (error "Can't concatenate ~S yet: ~:S" result-type sequences))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12671 Modified Files: integers.lisp Log Message: Added logior for (positive) bignums. Date: Thu Jun 10 06:31:14 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.35 movitz/losp/muerte/integers.lisp:1.36 --- movitz/losp/muerte/integers.lisp:1.35 Wed Jun 9 19:13:19 2004 +++ movitz/losp/muerte/integers.lisp Thu Jun 10 06:31:14 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.35 2004/06/10 02:13:19 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.36 2004/06/10 13:31:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1459,28 +1459,59 @@ (:notl :ecx) (:andl :ecx :eax))))) -(defun logior%2op (x y) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) x) - (:compile-form (:result-mode :ebx) y) - (:testb #.movitz::+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107))) - (:testb #.movitz::+movitz-fixnum-zmask+ :bl) - (:jnz '(:sub-program () (:movl :ebx :eax) (:int 107))) - (:orl :ebx :eax))) - - -(define-compiler-macro logior%2op (&whole form x y) - (cond - ((and (movitz:movitz-constantp x) (movitz:movitz-constantp y)) - (logior (movitz::movitz-eval x) (movitz::movitz-eval y))) - (t form))) - (defun logior (&rest integers) - (declare (dynamic-extent integers)) - (if (null integers) - 0 - (reduce #'logior%2op integers))) + (numargs-case + (1 (x) x) + (2 (x y) + (number-double-dispatch (x y) + ((fixnum fixnum) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) x y) + (:orl :ebx :eax))) + ((positive-fixnum positive-bignum) + (macrolet + ((do-it () + `(let ((r (copy-bignum y))) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) r x) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:orl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))) + (do-it))) + ((positive-bignum positive-fixnum) + (macrolet + ((do-it () + `(let ((r (copy-bignum x))) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) r y) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) + (:orl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))))))) + (do-it))) + ((positive-bignum positive-bignum) + (if (< (%bignum-bigits x) (%bignum-bigits y)) + (logior y x) + (let ((r (copy-bignum x))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) r y) + (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) + ,(* -1 movitz:+movitz-fixnum-factor+)) + :edx) ; EDX is loop counter + or-loop + (:movl (:ebx :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) + (:orl :ecx + (:eax :edx ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:subl 4 :edx) + (:jnc 'or-loop)))) + (do-it))))))) + (t (&rest integers) + (declare (dynamic-extent integers)) + (if (null integers) + 0 + (reduce #'logior integers))))) (define-compiler-macro logior (&whole form &rest integers) (let ((constant-folded-integers (loop for x in integers @@ -1496,8 +1527,8 @@ (case (length constant-folded-integers) (0 0) (1 (first constant-folded-integers)) - (2 `(logior%2op ,(first constant-folded-integers) ,(second constant-folded-integers))) - (t `(logior (logior%2op ,(first constant-folded-integers) ,(second constant-folded-integers)) + (2 `(no-macro-call logior ,(first constant-folded-integers) ,(second constant-folded-integers))) + (t `(logior (logior ,(first constant-folded-integers) ,(second constant-folded-integers)) ,@(cddr constant-folded-integers)))))) (defun logxor (&rest integers) @@ -1535,7 +1566,6 @@ (:cmpl ,(* (1- movitz:+movitz-fixnum-bits+) movitz:+movitz-fixnum-factor+) :ecx) (:ja '(:sub-program (outside-fixnum) - (:break) (:addl #x80000000 :eax) ; sign into carry (:sbbl :ecx :ecx) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by Frode Vatvedt Fjeld 10 Jun '04

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24484 Modified Files: sequences.lisp Log Message: Added a trivial delete-if-not, and incomplete make-sequence and concatenate. Date: Thu Jun 10 05:21:11 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.8 movitz/losp/muerte/sequences.lisp:1.9 --- movitz/losp/muerte/sequences.lisp:1.8 Thu May 20 10:48:04 2004 +++ movitz/losp/muerte/sequences.lisp Thu Jun 10 05:21:11 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.8 2004/05/20 17:48:04 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.9 2004/06/10 12:21:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1268,6 +1268,10 @@ (vector (error "vector delete-if not implemented.")))) +(defun delete-if-not (test sequence &rest key-args) + (declare (dynamic-extent key-args)) + (apply 'delete-if (complement test) sequence key-args)) + (defun remove-duplicates (sequence &key (test 'eql) (key 'identity) (start 0) end test-not from-end) (when test-not (setf test (complement test-not))) @@ -1575,6 +1579,27 @@ (if (eq list-1 (cdr head)) (return list-1)))))) +(defun make-sequence (result-type size &key (initial-element nil initial-element-p)) + "=> sequence" + (ecase result-type + (string + (if (not initial-element-p) + (make-string size) + (make-string size :initial-element initial-element))) + (list + (make-list size :initial-element initial-element)))) - +(defun concatenate (result-type &rest sequences) + "=> result-sequence" + (declare (dynamic-extent sequences)) + (cond + ((null sequences) + (make-sequence result-type 0)) + ((and (null (rest sequences)) + (typep (first sequences) result-type)) + (copy-seq (first sequences))) + ((= 0 (length (first sequences))) + (apply #'concatenate result-type (cdr sequences))) + (t (error "Can't concatenate ~S yet: ~:S" result-type sequences)))) +

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs