Commit 3375438b authored by cvs-fast-export's avatar cvs-fast-export

Synthetic commit for tag patch-363

parent da828e96
--- orig/xml/xml-parse.lisp
+++ mod/xml/xml-parse.lisp
@@ -525,7 +525,10 @@
(declaim (type (simple-array rune (*))
*scratch-pad* *scratch-pad-2* *scratch-pad-3* *scratch-pad-4*))
-(defmacro with-scratch-pads (() &body body)
+(defmacro with-scratch-pads (#-clisp ()
+ ;; clisp does not allow () as macro argument list
+ #+clisp (&key &allow-other-keys)
+ &body body)
`(let ((*scratch-pad* (make-array 1024 :element-type 'rune))
(*scratch-pad-2* (make-array 1024 :element-type 'rune))
(*scratch-pad-3* (make-array 1024 :element-type 'rune))
Time required for parsing a simple document (wc: 99621 298859 3267087).
;; CXML with NIL builder
;; (cxml:parse-file "~/test.xml" nil)
; cpu time (non-gc) 12,940 msec user, 20 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 12,940 msec user, 20 msec system
; real time 12,991 msec
; space allocation:
; 4,184,599 cons cells, 47,682,392 other bytes, 0 static bytes
;; CXML with xmls-compatible builder
;; (cxml:parse-file "~/test.xml" (cxml-xmls:make-xmls-builder))
; cpu time (non-gc) 14,370 msec user, 20 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 14,370 msec user, 20 msec system
; real time 14,387 msec
; space allocation:
; 8,667,564 cons cells, 47,682,600 other bytes, 0 static bytes
;; For comparison: xmls.lisp
;; (with-open-file (s "~/test.xml") (xmls:parse s :compress-whitespace nil))
; cpu time (non-gc) 27,440 msec user, 50 msec system
; cpu time (gc) 860 msec user, 0 msec system
; cpu time (total) 28,300 msec user, 50 msec system
; real time 28,813 msec
; space allocation:
; 14,821,161 cons cells, 243,886,592 other bytes, 0 static bytes
;; CXML with DOM builder
;; (cxml:parse-file "~/test.xml" (dom:make-dom-builder))
; cpu time (non-gc) 34,900 msec user, 40 msec system
; cpu time (gc) 760 msec user, 0 msec system
; cpu time (total) 35,660 msec user, 40 msec system
; real time 35,822 msec
; space allocation:
; 14,645,503 cons cells, 300,235,640 other bytes, 0 static bytes
* looking for david@knowledgetools.de--cxml/cxml--devel--1.0--patch-309 to compare with
* comparing to david@knowledgetools.de--cxml/cxml--devel--1.0--patch-309
M xml/xmls-compat.lisp
* modified files
--- orig/xml/xmls-compat.lisp
+++ mod/xml/xmls-compat.lisp
@@ -12,7 +12,8 @@
(defpackage cxml-xmls
(:use :cl :runes)
(:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children
- #:make-xmls-builder #:map-node))
+ #:make-xmls-builder #:map-node
+ #:*identifier-case*))
(in-package :cxml-xmls)
@@ -64,6 +65,10 @@
;;;; SAX-Handler (Parser)
+(defvar *identifier-case* nil
+ "One of NIL (don't intern names), :PRESERVE, :UPCASE, :DOWNCASE, or :INVERT
+ (intern name into the keyword package after adjusting case).")
+
(defclass xmls-builder ()
((element-stack :initform nil :accessor element-stack)
(root :initform nil :accessor root)))
@@ -74,16 +79,46 @@
(defmethod sax:end-document ((handler xmls-builder))
(root handler))
+(defun string-invert-case (str)
+ (map 'string
+ (lambda (c)
+ (cond
+ ((upper-case-p c) (char-downcase c))
+ ((lower-case-p c) (char-upcase c))
+ (t c)))
+ str))
+
+(defun maybe-intern (name)
+ (if *identifier-case*
+ (let ((str (if (stringp name) name (rod-string name))))
+ (intern (ecase *identifier-case*
+ (:preserve str)
+ (:upcase (string-upcase str))
+ (:downcase (string-downcase str))
+ (:invert (string-invert-case str)))
+ :keyword))
+ name))
+
+(defun maybe-stringify (name)
+ (if (symbolp name)
+ (let ((str (symbol-name name)))
+ (ecase *identifier-case*
+ (:preserve str)
+ (:upcase (string-downcase str))
+ (:downcase (string-upcase str))
+ (:invert (string-invert-case str))))
+ name))
+
(defmethod sax:start-element
((handler xmls-builder) namespace-uri local-name qname attributes)
(declare (ignore namespace-uri))
(setf local-name (or local-name qname))
(let* ((attributes
(mapcar (lambda (attr)
- (list (sax:attribute-qname attr)
+ (list (maybe-intern (sax:attribute-qname attr))
(sax:attribute-value attr)))
attributes))
- (node (make-node :name local-name
+ (node (make-node :name (maybe-intern local-name)
:ns (let ((lq (length qname))
(ll (length local-name)))
(if (eql lq ll)
@@ -124,7 +159,7 @@
(labels ((walk (node)
(let* ((attlist
(compute-attributes node include-xmlns-attributes))
- (lname (rod (node-name node)))
+ (lname (rod (maybe-stringify (node-name node))))
(ns (rod (node-ns node)))
(qname (concatenate 'rod ns (rod ":") lname)))
;; fixme: namespaces
@@ -141,6 +176,7 @@
(remove nil
(mapcar (lambda (a)
(destructuring-bind (name value) a
+ (setf name (maybe-stringify name))
(if (or xmlnsp (not (cxml::xmlns-attr-p (rod name))))
(sax:make-attribute :qname (rod name)
:value (rod value)
<!-- $Id: catalog.dtd,v 1.10 2002/10/18 23:54:58 ndw Exp $ -->
<!ENTITY % pubIdChars "CDATA">
<!ENTITY % publicIdentifier "%pubIdChars;">
<!ENTITY % partialPublicIdentifier "%pubIdChars;">
<!ENTITY % uriReference "CDATA">
<!ENTITY % string "CDATA">
<!ENTITY % systemOrPublic "(system|public)">
<!ENTITY % p "">
<!ENTITY % s "">
<!ENTITY % nsdecl "xmlns%s;">
<!ENTITY % catalog "%p;catalog">
<!ENTITY % public "%p;public">
<!ENTITY % system "%p;system">
<!ENTITY % uri "%p;uri">
<!ENTITY % rewriteSystem "%p;rewriteSystem">
<!ENTITY % rewriteURI "%p;rewriteURI">
<!ENTITY % delegatePublic "%p;delegatePublic">
<!ENTITY % delegateSystem "%p;delegateSystem">
<!ENTITY % delegateURI "%p;delegateURI">
<!ENTITY % nextCatalog "%p;nextCatalog">
<!ENTITY % group "%p;group">
<!ENTITY % local.catalog.mix "">
<!ENTITY % local.catalog.attribs "">
<!ELEMENT %catalog; (%public;|%system;|%uri;
|%rewriteSystem;|%rewriteURI;
|%delegatePublic;|%delegateSystem;|%delegateURI;
|%nextCatalog;|%group; %local.catalog.mix;)+>
<!ATTLIST %catalog;
%nsdecl; %uriReference; #FIXED
'urn:oasis:names:tc:entity:xmlns:xml:catalog'
prefer %systemOrPublic; #IMPLIED
xml:base %uriReference; #IMPLIED
%local.catalog.attribs;
>
<!ENTITY % local.public.attribs "">
<!ELEMENT %public; EMPTY>
<!ATTLIST %public;
id ID #IMPLIED
publicId %publicIdentifier; #REQUIRED
uri %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.public.attribs;
>
<!ENTITY % local.system.attribs "">
<!ELEMENT %system; EMPTY>
<!ATTLIST %system;
id ID #IMPLIED
systemId %string; #REQUIRED
uri %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.system.attribs;
>
<!ENTITY % local.uri.attribs "">
<!ELEMENT %uri; EMPTY>
<!ATTLIST %uri;
id ID #IMPLIED
name %string; #REQUIRED
uri %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.uri.attribs;
>
<!ENTITY % local.rewriteSystem.attribs "">
<!ELEMENT %rewriteSystem; EMPTY>
<!ATTLIST %rewriteSystem;
id ID #IMPLIED
systemIdStartString %string; #REQUIRED
rewritePrefix %string; #REQUIRED
%local.rewriteSystem.attribs;
>
<!ENTITY % local.rewriteURI.attribs "">
<!ELEMENT %rewriteURI; EMPTY>
<!ATTLIST %rewriteURI;
id ID #IMPLIED
uriStartString %string; #REQUIRED
rewritePrefix %string; #REQUIRED
%local.rewriteURI.attribs;
>
<!ENTITY % local.delegatePublic.attribs "">
<!ELEMENT %delegatePublic; EMPTY>
<!ATTLIST %delegatePublic;
id ID #IMPLIED
publicIdStartString %partialPublicIdentifier; #REQUIRED
catalog %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.delegatePublic.attribs;
>
<!ENTITY % local.delegateSystem.attribs "">
<!ELEMENT %delegateSystem; EMPTY>
<!ATTLIST %delegateSystem;
id ID #IMPLIED
systemIdStartString %string; #REQUIRED
catalog %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.delegateSystem.attribs;
>
<!ENTITY % local.delegateURI.attribs "">
<!ELEMENT %delegateURI; EMPTY>
<!ATTLIST %delegateURI;
id ID #IMPLIED
uriStartString %string; #REQUIRED
catalog %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.delegateURI.attribs;
>
<!ENTITY % local.nextCatalog.attribs "">
<!ELEMENT %nextCatalog; EMPTY>
<!ATTLIST %nextCatalog;
id ID #IMPLIED
catalog %uriReference; #REQUIRED
xml:base %uriReference; #IMPLIED
%local.nextCatalog.attribs;
>
<!ENTITY % local.group.mix "">
<!ENTITY % local.group.attribs "">
<!ELEMENT %group; (%public;|%system;|%uri;
|%rewriteSystem;|%rewriteURI;
|%delegatePublic;|%delegateSystem;|%delegateURI;
|%nextCatalog; %local.group.mix;)+>
<!ATTLIST %group;
id ID #IMPLIED
prefer %systemOrPublic; #IMPLIED
xml:base %uriReference; #IMPLIED
%local.group.attribs;
>
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
;;; copyright (c) 2004 knowledgeTools Int. GmbH
;;; Author of this version: David Lichteblau <david@knowledgetools.de>
;;;
;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann
;;;
;;; License: LLGPL (See file COPYING for details).
;;;
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(in-package :glisp)
(deftype rune () 'base-char)
(deftype rod () 'base-string)
(deftype simple-rod () 'simple-string)
(defsubst rune (rod index)
(char rod index))
(defun (setf rune) (new rod index)
(setf (char rod index) new))
(defsubst %rune (rod index)
(aref (the simple-string rod) (the fixnum index)))
(defsubst (setf %rune) (new rod index)
(setf (aref (the simple-string rod) (the fixnum index)) new))
(defun rod-capitalize (rod)
(string-upcase rod))
(defsubst code-rune (x) (code-char x))
(defsubst rune-code (x) (char-code x))
(defsubst rune= (x y)
(char= x y))
(defun rune-downcase (rune)
(char-downcase rune))
(defsubst rune-upcase (rune)
(char-upcase rune))
(defun rune-upper-case-letter-p (rune)
(upper-case-p rune))
(defun rune-lower-case-letter-p (rune)
(lower-case-p rune))
(defun rune-equal (x y)
(char-equal x y))
(defun rod-downcase (rod)
(string-downcase rod))
(defun rod-upcase (rod)
(string-upcase rod))
(defsubst white-space-rune-p (char)
(or (char= char #\tab)
(char= char #.(code-char 10)) ;Linefeed
(char= char #.(code-char 13)) ;Carriage Return
(char= char #\space)))
(defsubst digit-rune-p (char &optional (radix 10))
(digit-char-p char radix))
(defun rod (x)
(cond
((stringp x) x)
((symbolp x) (string x))
((characterp x) (string x))
((vectorp x) (coerce x 'string))
((integerp x) (string (code-char x)))
(t (error "Cannot convert ~S to a ~S" x 'rod))))
(defun runep (x)
(characterp x))
(defun sloopy-rod-p (x)
(stringp x))
(defun rod= (x y)
(string= x y))
(defun rod-equal (x y)
(string-equal x y))
(defsubst make-rod (size)
(make-string size))
(defun char-rune (char)
char)
(defun rune-char (rune &optional default)
(declare (ignore default))
rune)
(defun rod-string (rod &optional (default-char #\?))
(declare (ignore default-char))
rod)
(defun string-rod (string)
string)
;;;;
(defun rune<= (rune &rest more-runes)
(loop
for (a b) on (cons rune more-runes)
while b
always (char<= a b)))
(defun rune>= (rune &rest more-runes)
(loop
for (a b) on (cons rune more-runes)
while b
always (char>= a b)))
(defun rodp (object)
(stringp object))
(defun really-rod-p (object)
(stringp object))
(defun rod-subseq (source start &optional (end (length source)))
(unless (stringp source)
(error "~S is not of type ~S." source 'rod))
(subseq source start end))
(defun rod-subseq* (source start &optional (end (length source)))
(rod-subseq source start end))
(defun rod< (rod1 rod2)
(string< rod1 rod2))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: GLISP; -*-
;;; ---------------------------------------------------------------------------
;;; Title: ACL-4.3 dependent stuff + fixups
;;; Created: 1999-05-25 22:33
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1998,1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;; ACL is incapable to define compiler macros on (setf foo)
;; Unfortunately it is also incapable to declaim such functions inline.
;; So we revoke the DEFUN hack from dep-gcl here.
(defmacro glisp::defsubst (fun args &body body)
(if (and (consp fun) (eq (car fun) 'setf))
(let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
(symbol-package (cadr fun)))))
`(progn
(defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
(glisp::defsubst ,fnam ,args .,body)))
`(progn
(defun ,fun ,args .,body)
(define-compiler-macro ,fun (&rest .args.)
(cons '(lambda ,args .,body)
.args.)))))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; Encoding: utf-8; -*-
;;; ---------------------------------------------------------------------------
;;; Title: ACL-5.0 dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1998,1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Changes
;;; =======
;;; When Who What
;;; ---------------------------------------------------------------------------
;;; 2002-01-04 GB spend BLOCK for DEFSUBST
;;; 1999-08-31 SES Stig Erik Sandø <stig@ii.uib.no>
;;;
;;; Changed #+allegro-v5.0 to
;;; #+(and allegro-version>= (version>= 5))
;;;
;; ACL is incapable to define compiler macros on (setf foo)
;; Unfortunately it is also incapable to declaim such functions inline.
;; So we revoke the DEFUN hack from dep-gcl here.
(defmacro glisp::defsubst (fun args &body body)
(if (and (consp fun) (eq (car fun) 'setf))
(let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
(symbol-package (cadr fun)))))
`(progn
(defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
(glisp::defsubst ,fnam ,args .,body)))
(labels ((declp (x)
(and (consp x) (eq (car x) 'declare))))
`(progn
(defun ,fun ,args .,body)
(define-compiler-macro ,fun (&rest .args.)
(cons '(lambda ,args
,@(remove-if-not #'declp body)
(block ,fun
,@(remove-if #'declp body)))
.args.))))))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CLISP dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(in-package :CL-USER)
(eval-when (compile load eval)
(if (fboundp 'cl::define-compiler-macro)
(pushnew 'define-compiler-macro *features*)))
(setq lisp:*load-paths* '(#P"./"))
#+DEFINE-COMPILER-MACRO
(cl:define-compiler-macro ldb (bytespec value &whole whole)
(let (pos size)
(cond ((and (consp bytespec)
(= (length bytespec) 3)
(eq (car bytespec) 'byte)
(constantp (setq size (second bytespec)))
(constantp (setq pos (third bytespec))))
`(logand ,(if (eql pos 0) value `(ash ,value (- ,pos)))
(1- (ash 1 ,size))))
(t
whole))))
#-DEFINE-COMPILER-MACRO
(progn
(export 'glisp::define-compiler-macro :glisp)
(defmacro glisp::define-compiler-macro (name args &body body)
(declare (ignore args body))
`(progn
',name)))
(defmacro glisp::defsubst (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CMUCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(defmacro glisp::defsubst (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: CMUCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(defmacro glisp::defsubst (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: GLISP; -*-
;;; ---------------------------------------------------------------------------
;;; Title: Second part of GCL dependent stuff
;;; Created: 1999-05-25 22:31
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: GPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(in-package :GLISP)
This diff is collapsed.
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: SBCL dependent stuff + fixups
;;; Created: 1999-05-25 22:32
;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
;;; License: LLGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; This code is free software; you can redistribute it and/or modify it
;;; under the terms of the version 2.1 of the GNU Lesser General Public
;;; License as published by the Free Software Foundation, as clarified
;;; by the "Preamble to the Gnu Lesser General Public License" found in
;;; the file COPYING.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; Version 2.1 of the GNU Lesser General Public License is in the file
;;; COPYING that was distributed with this file. If it is not present,
;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
;;; superseded by a newer version) or write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
(defmacro glisp::defsubst (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))