diff options
| -rw-r--r-- | Lisp/internal-reader-syntax.lisp | 91 | ||||
| -rw-r--r-- | Lisp/reader-syntax.lisp | 13 | ||||
| -rw-r--r-- | objective-cl.asd | 4 |
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" |