summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-13 14:16:07 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-13 14:16:07 +0100
commit9bcf5f61465b954837dea6472c7bdd6972d81f8b (patch)
treededa839153bf68ae02b912fd4e572abef8d84efb
parent507c9bd8238f634f4131620909125948b4f3693e (diff)
Add an internal reader macro for more readable type declarations.
darcs-hash:362e46ca84f20400936f066b7c7335417dcffa82
-rw-r--r--Lisp/internal-reader-syntax.lisp91
-rw-r--r--Lisp/reader-syntax.lisp13
-rw-r--r--objective-cl.asd4
3 files changed, 94 insertions, 14 deletions
diff --git a/Lisp/internal-reader-syntax.lisp b/Lisp/internal-reader-syntax.lisp
new file mode 100644
index 0000000..e7bade8
--- /dev/null
+++ b/Lisp/internal-reader-syntax.lisp
@@ -0,0 +1,91 @@
+;;;; Objective-CL, an Objective-C bridge for Common Lisp.
+;;;; Copyright (C) 2007, 2008 Matthias Andreas Benkard.
+;;;;
+;;;; This program is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public License
+;;;; as published by the Free Software Foundation, either version 3 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this program. If not, see
+;;;; <http://www.gnu.org/licenses/>.
+
+(in-package #:mulk.objective-cl)
+
+
+(defvar *readtable-stack* (list))
+
+
+(defun restore-readtable ()
+ (when *readtable-stack*
+ (setq *readtable* (pop *readtable-stack*)))
+ (values))
+
+
+(defun save-readtable ()
+ (push *readtable* *readtable-stack*)
+ (setq *readtable* (copy-readtable *readtable*))
+ (values))
+
+
+(defun enable-type-declaration-syntax ()
+ (save-readtable)
+ (set-dispatch-macro-character #\# #\? #'read-type-declaration))
+
+
+(defun disable-type-declaration-syntax ()
+ (restore-readtable))
+
+
+(defun read-type-declaration (stream subchar argument)
+ (declare (ignore argument))
+ (let (defun-form typedecl-string)
+ (loop with finished-p = nil
+ with next-char = nil
+ with next-subchar = nil
+ until finished-p
+ for char = (read-char stream nil nil t)
+ while char
+ if (char= char #\Newline)
+ if (and (setq next-char (read-char stream nil nil t))
+ (char= next-char #\#))
+ if (and (setq next-subchar (read-char stream nil nil t))
+ (char= next-subchar subchar))
+ do (progn)
+ else do (progn
+ (cerror "Ignore the current line."
+ "Unknown macro subcharacter ~S found while ~
+ reading type declaration."
+ next-subchar)
+ (read-line stream t nil t)
+ (unread-char #\Newline stream))
+ else do (progn
+ (unread-char next-char stream)
+ (setq defun-form (read stream t nil t))
+ (setq finished-p t))
+ else
+ collect char into collected-chars
+ finally
+ (setq typedecl-string (coerce collected-chars 'string)))
+ (let* ((eof-value (gensym))
+ (typedecl (with-input-from-string (in typedecl-string)
+ (loop for x = (read in nil eof-value nil)
+ until (eq x eof-value)
+ collect x)))
+ (typedecl-parts (split-sequence:split-sequence '->
+ typedecl
+ :test
+ #'eq
+ :count 2))
+ (function-name (cadr defun-form))
+ (arg-types (first typedecl-parts))
+ (return-types (second typedecl-parts)))
+ `(progn
+ (declaim (ftype ,function-name
+ (function (,@arg-types) (values ,@return-types))))
+ ,defun-form))))
diff --git a/Lisp/reader-syntax.lisp b/Lisp/reader-syntax.lisp
index a8a4978..18174d2 100644
--- a/Lisp/reader-syntax.lisp
+++ b/Lisp/reader-syntax.lisp
@@ -20,19 +20,6 @@
(defvar *method-syntax-macro-chars* (list))
(defvar *bracket-syntax-macro-chars* (list))
-(defvar *readtable-stack* (list))
-
-
-(defun restore-readtable ()
- (when *readtable-stack*
- (setq *readtable* (pop *readtable-stack*)))
- (values))
-
-
-(defun save-readtable ()
- (push *readtable* *readtable-stack*)
- (setq *readtable* (copy-readtable *readtable*))
- (values))
(defun enable-method-syntax ()
diff --git a/objective-cl.asd b/objective-cl.asd
index 96d94f6..dbc056e 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -102,7 +102,9 @@
"conditions"
"memory-management"))
(:file "reader-syntax" :depends-on ("defpackage"
- "method-invocation"))
+ "method-invocation"
+ "internal-reader-syntax"))
+ (:file "internal-reader-syntax" :depends-on ("defpackage"))
(:file "utilities" :depends-on ("init"
"defpackage"
"method-invocation"