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
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
14 ;;;; CLSQL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (in-package #:cl-user)
21 (defpackage #:cmucl-compat
25 #:make-sequence-of-type
29 (in-package #:cmucl-compat)
32 (defmacro required-argument ()
33 `(ext:required-argument))
36 (defun required-argument ()
37 (error "~&A required keyword argument was not supplied"))
40 (defmacro shrink-vector (vec len)
41 `(lisp::shrink-vector ,vec ,len))
44 (defmacro shrink-vector (vec len)
45 `(sb-kernel::shrink-vector ,vec ,len))
48 (defmacro shrink-vector (vec len)
49 "Shrinks a vector. Optimized if vector has a fill pointer.
50 Needs to be a macro to overwrite value of VEC."
51 (let ((new-vec (gensym)))
53 ((adjustable-array-p ,vec)
54 (adjust-array ,vec ,len))
55 ((typep ,vec 'simple-array)
56 (let ((,new-vec (make-array ,len :element-type
57 (array-element-type ,vec))))
58 (check-type ,len fixnum)
59 (locally (declare (optimize (speed 3) (safety 0) (space 0)) )
62 (setf (aref ,new-vec i) (aref ,vec i))))
63 (setq ,vec ,new-vec)))
65 (setf (fill-pointer ,vec) ,len)
68 (error "Unable to shrink vector ~S which is type-of ~S" ,vec (type-of ,vec)))
73 (defun make-sequence-of-type (type length)
74 "Returns a sequence of the given TYPE and LENGTH."
75 (make-sequence type length))
78 (if (fboundp 'lisp::make-sequence-of-type)
79 (defun make-sequence-of-type (type len)
80 (lisp::make-sequence-of-type type len))
81 (defun make-sequence-of-type (type len)
82 (common-lisp::make-sequence-of-type type len)))
85 (defun result-type-or-lose (type nil-ok)
86 (unless (or type nil-ok)
87 (error "NIL output type invalid for this sequence function"))
91 ((string simple-string base-string simple-base-string)
98 (error "~S is a bad type specifier for sequence functions." type))
102 (defun result-type-or-lose (type nil-ok)
103 (lisp::result-type-or-lose type nil-ok))