1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: cmucl-compat.lisp
6 ;;;; Purpose: Compatiblity library for CMUCL functions
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Feb 2002
10 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:cl-user)
19 (defpackage #:cmucl-compat
23 #:make-sequence-of-type
27 (in-package #:cmucl-compat)
30 (defmacro required-argument ()
31 `(ext:required-argument))
34 (defun required-argument ()
35 (error "~&A required keyword argument was not supplied"))
38 (defmacro shrink-vector (vec len)
39 `(lisp::shrink-vector ,vec ,len))
42 (defmacro shrink-vector (vec len)
43 `(sb-kernel::shrink-vector ,vec ,len))
46 (defmacro shrink-vector (vec len)
47 "Shrinks a vector. Optimized if vector has a fill pointer.
48 Needs to be a macro to overwrite value of VEC."
49 (let ((new-vec (gensym)))
51 ((adjustable-array-p ,vec)
52 (adjust-array ,vec ,len))
53 ((typep ,vec 'simple-array)
54 (let ((,new-vec (make-array ,len :element-type
55 (array-element-type ,vec))))
56 (check-type ,len fixnum)
57 (locally (declare (optimize (speed 3) (safety 0) (space 0)) )
60 (setf (aref ,new-vec i) (aref ,vec i))))
61 (setq ,vec ,new-vec)))
63 (setf (fill-pointer ,vec) ,len)
66 (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec)))
71 (defun make-sequence-of-type (type length)
72 "Returns a sequence of the given TYPE and LENGTH."
73 (make-sequence type length))
76 (if (fboundp 'lisp::make-sequence-of-type)
77 (defun make-sequence-of-type (type len)
78 (lisp::make-sequence-of-type type len))
79 (defun make-sequence-of-type (type len)
80 (common-lisp::make-sequence-of-type type len)))
83 (defun result-type-or-lose (type nil-ok)
84 (unless (or type nil-ok)
85 (error "NIL output type invalid for this sequence function"))
89 ((string simple-string base-string simple-base-string)
96 (error "~S is a bad type specifier for sequence functions." type))
100 (defun result-type-or-lose (type nil-ok)
101 (lisp::result-type-or-lose type nil-ok))