avoid name conflicts with functions from "glisp" of the same name. - Renamed defsubst to definline for the same reason. (This is a commit to the cxml repository, not the main closure repository. If you don't want cxml commit messages on the closure list, please complain to me and I'll change it.)
60 lines
2.7 KiB
Common Lisp
60 lines
2.7 KiB
Common Lisp
;;; -*- 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 runes::definline (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))
|
|
(runes::definline ,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.))))))
|