Commit fbf58a90 authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler

Minor cleanup of cruft.lisp; introduce DEFINE-INLINE-FUNCTION macro.

darcs-hash:20090424123010-f5546-a54b7ddaf410e2680fa4260499d4cff5bebc89a0.gz
parent c7360ff7
...@@ -6,22 +6,22 @@ ...@@ -6,22 +6,22 @@
(warn "~A hasn't been ported to ~A; you're likely to get a compiler error" (warn "~A hasn't been ported to ~A; you're likely to get a compiler error"
(package-name *package*) (lisp-implementation-type))) (package-name *package*) (lisp-implementation-type)))
(defmacro define-inline-function (name lambda-list &body body)
`(progn (declaim (inline ,name))
(defun ,name ,lambda-list ,@body)))
(defvar *readtable-names* (make-hash-table :test 'eq)) (defvar *readtable-names* (make-hash-table :test 'eq))
(declaim (inline %register-readtable-name)) (define-inline-function %register-readtable-name (name read-table)
(defun %register-readtable-name (name read-table)
(setf (gethash read-table *readtable-names*) name)) (setf (gethash read-table *readtable-names*) name))
(declaim (inline %unregister-readtable-name)) (define-inline-function %unregister-readtable-name (read-table)
(defun %unregister-readtable-name (read-table)
(remhash read-table *readtable-names*)) (remhash read-table *readtable-names*))
(declaim (inline %readtable-name)) (define-inline-function %readtable-name (read-table)
(defun %readtable-name (read-table)
(values (gethash read-table *readtable-names*))) (values (gethash read-table *readtable-names*)))
(declaim (inline %list-all-readtable-names)) (define-inline-function %list-all-readtable-names ()
(defun %list-all-readtable-names ()
(list* :standard :current (list* :standard :current
(loop for name being each hash-value of *readtable-names* (loop for name being each hash-value of *readtable-names*
collect name))) collect name)))
...@@ -32,8 +32,7 @@ ...@@ -32,8 +32,7 @@
(when (find-package "SB-READER") (when (find-package "SB-READER")
(push :sbcl+sb-reader *features*))) (push :sbcl+sb-reader *features*)))
(declaim (inline %standard-readtable)) (define-inline-function %standard-readtable ()
(defun %standard-readtable ()
#+sbcl+sb-reader sb-reader:*standard-readtable* #+sbcl+sb-reader sb-reader:*standard-readtable*
#-sbcl+sb-reader (copy-readtable nil)) #-sbcl+sb-reader (copy-readtable nil))
...@@ -103,16 +102,13 @@ ...@@ -103,16 +102,13 @@
(progn (progn
(defvar *named-readtables* (make-hash-table :test 'eq)) (defvar *named-readtables* (make-hash-table :test 'eq))
(declaim (inline %register-readtable)) (define-inline-function %register-readtable (name read-table)
(defun %register-readtable (name read-table)
(setf (gethash name *named-readtables*) read-table)) (setf (gethash name *named-readtables*) read-table))
(declaim (inline %unregister-readtable)) (define-inline-function %unregister-readtable (name)
(defun %unregister-readtable (name)
(remhash name *named-readtables*)) (remhash name *named-readtables*))
(declaim (inline %find-readtable-from-name)) (define-inline-function %find-readtable-from-name (name)
(defun %find-readtable-from-name (name)
(values (gethash name *named-readtables* nil)))) (values (gethash name *named-readtables* nil))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment