X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Fcmucl-compat.lisp;h=8b2b5a5b6758d373b8018b8d7ff0454bb20da3d5;hb=36d17cf365b7fe0dcab77450c3caf5961efa3985;hp=a479bc1e687181d3a61ce0fa718c55425c4efbba;hpb=998937376fa6f9ce29bd3c7954fb0ebca91c37d7;p=clsql.git diff --git a/base/cmucl-compat.lisp b/base/cmucl-compat.lisp index a479bc1..8b2b5a5 100644 --- a/base/cmucl-compat.lisp +++ b/base/cmucl-compat.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: cmucl-compat.lisp,v 1.1 2002/09/30 10:19:01 kevin Exp $ +;;;; $Id: cmucl-compat.lisp,v 1.3 2002/10/21 07:45:49 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -20,6 +20,7 @@ (in-package :cl-user) (defpackage :cmucl-compat + (:use #:common-lisp) (:export #:shrink-vector #:make-sequence-of-type @@ -28,19 +29,23 @@ )) (in-package :cmucl-compat) -#+cmu +#+(or cmu scl) (defmacro required-argument () `(ext:required-argument)) -#-cmu +#-(or cmu scl) (defun required-argument () (error "~&A required keyword argument was not supplied")) -#+cmu +#+(or cmu scl) (defmacro shrink-vector (vec len) `(lisp::shrink-vector ,vec ,len)) -#-cmu +#+sbcl +(defmacro shrink-vector (vec len) + `(sb-kernel::shrink-vector ,vec ,len)) + +#-(or cmu sbcl scl) (defmacro shrink-vector (vec len) "Shrinks a vector. Optimized if vector has a fill pointer. Needs to be a macro to overwrite value of VEC." @@ -64,7 +69,7 @@ Needs to be a macro to overwrite value of VEC." -#-cmu +#-(or cmu sbcl scl) (defun make-sequence-of-type (type length) "Returns a sequence of the given TYPE and LENGTH." (declare (fixnum length)) @@ -85,15 +90,18 @@ Needs to be a macro to overwrite value of VEC." (make-sequence-of-type (result-type-or-lose type t) length)))) -#+cmu +#+(or cmu scl) (if (fboundp 'lisp::make-sequence-of-type) (defun make-sequence-of-type (type len) (lisp::make-sequence-of-type type len)) (defun make-sequence-of-type (type len) (system::make-sequence-of-type type len))) - -#-cmu +#+sbcl +(defun make-sequence-of-type (type len) + (sb-impl::make-sequence-of-type type len)) + +#-(or cmu sbcl scl) (defun result-type-or-lose (type nil-ok) (unless (or type nil-ok) (error "NIL output type invalid for this sequence function")) @@ -110,6 +118,10 @@ Needs to be a macro to overwrite value of VEC." (error "~S is a bad type specifier for sequence functions." type)) )) -#+cmu +#+(or cmu scl) (defun result-type-or-lose (type nil-ok) (lisp::result-type-or-lose type nil-ok)) + +#+sbcl +(defun result-type-or-lose (type nil-ok) + (sb-impl::result-type-or-lose type nil-ok))