Commit 9772a91f authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler

Add :SYNTAX-FROM clause to DEFREADTABLE.

darcs-hash:20090828195357-f5546-1ae62e15f38ced823be394c213a4402b3c19fdbf.gz
parent 4fde8940
...@@ -228,11 +228,13 @@ ...@@ -228,11 +228,13 @@
;;; As per #19 in CLHS 11.1.2.1.2 defining a method for PRINT-OBJECT ;;; As per #19 in CLHS 11.1.2.1.2 defining a method for PRINT-OBJECT
;;; that specializes on READTABLE is actually forbidden. It's quite ;;; that specializes on READTABLE is actually forbidden. It's quite
;;; likely to work on most implementations, though. ;;; likely to work (modulo package-locks) on most implementations,
;;; though.
;;; We don't need this on Allegro CL's as we hook into their ;;; We don't need this on Allegro CL's as we hook into their
;;; named-readtable facility, and they provide such a method already. ;;; named-readtable facility, and they provide such a method already.
;; FIXME: This may violate package locks.
#-allegro #-allegro
(defmethod print-object :around ((rt readtable) stream) (defmethod print-object :around ((rt readtable) stream)
(let ((name (readtable-name rt))) (let ((name (readtable-name rt)))
......
...@@ -35,37 +35,55 @@ ...@@ -35,37 +35,55 @@
(defmacro defreadtable (name &body options) (defmacro defreadtable (name &body options)
"Define a new named readtable, whose name is given by the symbol NAME. "Define a new named readtable, whose name is given by the symbol NAME.
Or, if a readtable is already registered under that name, redefines that one. Or, if a readtable is already registered under that name, redefine that one.
The readtable can be populated using the OPTIONS &rest argument, as follows: The readtable can be populated using the following OPTIONS:
(:MERGE &REST READTABLE-DESIGNATORS) -- merge the readtables designated into (:MERGE &REST READTABLE-DESIGNATORS)
the new readtable, using MERGE-READTABLES-INTO. It is mandatory to supply
at least one :MERGE option naming a readtable to incorporate.
DEFREADTABLE accepts some special readtable designators, including Merge the readtables designated into the new readtable, using
NIL or :STANDARD for the standard readtable and :CURRENT for the current `merge-readtables-into'. It is mandatory to supply at least one :MERGE
clause.
DEFREADTABLE accepts some special readtable designators, including NIL
or :STANDARD for the standard readtable and :CURRENT for the current
readtable, as well as the names of programmer-defined readtables. readtable, as well as the names of programmer-defined readtables.
Note that the process of merging readtables is _not_ commutative, so that Note that the process of merging readtables is _not_ commutative, so that
macros in later entries will overwrite earlier ones, left to right in a single macros in later entries will overwrite earlier ones.
:MERGE directive, and one after another across multiple :MERGE directives.
(:DISPATCH-MACRO-CHAR MACRO-CHAR SUB-CHAR FUNCTION)
Define a new sub character SUB-CHAR for the dispatching macro character
MACRO-CHAR, per `set-dispatch-macro-character'. You probably have to
define MACRO-CHAR as a dispatching macro character by the following option
first.
(:MACRO-CHAR MACRO-CHAR FUNCTION &OPTIONAL NON-TERMINATING-P)
Define a new macro character in the readtable, per `set-macro-character'.
If FUNCTION is the keyword :DISPATCH, MACRO-CHAR is made a dispatching
macro character, per `make-dispatch-macro-character'.
(:SYNTAX-FROM FROM-READTABLE-DESIGNATOR FROM-CHAR TO-CHAR)
Set the character syntax of TO-CHAR in the readtable being defined to the
same syntax as FROM-CHAR in FROM-READTABLE-DESIGNATOR as per
`set-syntax-from-char'.
(:DISPATCH-MACRO-CHAR MACRO-CHAR SUB-CHAR FUNCTION) -- define a new (:CASE CASE-MODE)
dispatch macro character in the readtable, per SET-DISPATCH-MACRO-CHARACTER.
(:MACRO-CHAR MACRO-CHAR FUNCTION &OPTIONAL NON-TERMINATING-P) -- define a Defines the /case sensititivy mode/ of the resulting readtable.
new macro character in the readtable, per SET-MACRO-CHARACTER. If FUNCTION
is the keyword :DISPATCH, MACRO-CHAR is made a dispatching macro character,
per MAKE-DISPATCH-MACRO-CHARACTER.
(:CASE CASE-MODE) -- defines the /case sensititivy mode/ of the resulting Any number of option clauses may appear. The options are grouped by their
readtable. type, but in each group the textual order the options appeared is preserved.
The following groups exist and are executed in this order: :MERGE, :CASE,
:MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group), finally :SYNTAX-FROM.
Any number of option clauses may appear. The :merge directives are evaluated first, The readtable is defined at load-time. If you want to have it available at
then the :case directives are evaluated in the order they appear. At last the local compilation time -- say to use its reader-macros in the same file as its
macro definitions in :dispatch-macro-char and :macro-char are evaluated in the order definition -- you have to wrap the DEFREADTABLE form in an explicit EVAL-WHEN.
they appear." "
(check-type name symbol) (check-type name symbol)
(when (reserved-readtable-name-p name) (when (reserved-readtable-name-p name)
(error "~A is the designator for a predefined readtable. ~ (error "~A is the designator for a predefined readtable. ~
...@@ -83,34 +101,45 @@ they appear." ...@@ -83,34 +101,45 @@ they appear."
;; an appropriate patch upstream. ;; an appropriate patch upstream.
`(make-dispatch-macro-character ,char ,non-terminating-p ,var) `(make-dispatch-macro-character ,char ,non-terminating-p ,var)
`(set-macro-character ,char ,function ,non-terminating-p ,var))) `(set-macro-character ,char ,function ,non-terminating-p ,var)))
((:syntax-from from-rt-designator from-char to-char)
`(set-syntax-from-char ,to-char ,from-char
,var (find-readtable ,from-rt-designator)))
((:case mode) ((:case mode)
`(setf (readtable-case ,var) ,mode)))) `(setf (readtable-case ,var) ,mode))))
(member-of (&rest rest) #'(lambda (x) (member x rest)))) (remove-clauses (clauses options)
(let* ((merge-clauses (remove-if-not (member-of :merge) options :key #'first)) (setq clauses (if (listp clauses) clauses (list clauses)))
(case-clauses (remove-if-not (member-of :case) options :key #'first)) (remove-if-not #'(lambda (x) (member x clauses))
(macro-clauses (remove-if-not (member-of :macro-char options :key #'first)))
:dispatch-macro-char) options (let* ((merge-clauses (remove-clauses :merge options))
:key #'first)) (case-clauses (remove-clauses :case options))
(other-clauses (set-difference options (append merge-clauses case-clauses macro-clauses)))) (macro-clauses (remove-clauses '(:macro-char :dispatch-macro-char)
(cond ((null merge-clauses) options))
(error "Not at least one (:merge ...) clause given in DEFREADTABLE form.")) (syntax-clauses (remove-clauses :syntax-from options))
(other-clauses (set-difference options
(append merge-clauses case-clauses
macro-clauses syntax-clauses))))
(cond
((null merge-clauses)
(error "You must specify at least one :MERGE clause in DEFREADTABLE."))
((not (null other-clauses)) ((not (null other-clauses))
(error "Bogus DEFREADTABLE clauses: ~{~A~^, ~}" other-clauses)) (error "Bogus DEFREADTABLE clauses: ~{~A~^, ~}" other-clauses))
(t (t
`(eval-when (:load-toplevel :execute) `(eval-when (:load-toplevel :execute)
;; The (FIND-READTABLE ...) is important for proper redefinition semantics.
(handler-bind ((readtable-does-already-exist (handler-bind ((readtable-does-already-exist
#'(lambda (c) #'(lambda (c)
(simple-style-warn (simple-style-warn
"Overwriting previously existing readtable ~S." "Overwriting previously existing readtable ~S."
(existing-readtable-name c)) (existing-readtable-name c))
(continue c)))) (continue c))))
;; The (FIND-READTABLE ...) is important for proper redefinition
;; semantics.
(let ((readtable (find-readtable ',name))) (let ((readtable (find-readtable ',name)))
(setq readtable (setq readtable
(make-readtable ',name (make-readtable ',name
;; We have to provide an explicit :MERGE argument, ;; We have to provide an explicit :MERGE
;; because otherwise the :STANDARD readtable would ;; argument, because otherwise the
;; be used which is not necessarily what we want. ;; :STANDARD readtable would be used which
;; is not necessarily what we want.
:merge ',(rest (first merge-clauses)))) :merge ',(rest (first merge-clauses))))
;; We have to grovel all MERGE-CLAUSES for the redefinition case. ;; We have to grovel all MERGE-CLAUSES for the redefinition case.
,@(loop for option in merge-clauses ,@(loop for option in merge-clauses
...@@ -119,8 +148,20 @@ they appear." ...@@ -119,8 +148,20 @@ they appear."
collect (process-option option 'readtable)) collect (process-option option 'readtable))
,@(loop for option in macro-clauses ,@(loop for option in macro-clauses
collect (process-option option 'readtable)) collect (process-option option 'readtable))
,@(loop for option in syntax-clauses
collect (process-option option 'readtable))
readtable)))))))) readtable))))))))
(defmacro in-readtable (name)
"Bind the *readtable* to the readtable referred to by NAME, raising
an error if no such readtable can be found."
(check-type name symbol)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (ensure-readtable ',name))
(when (find-package :swank)
(%frob-swank-readtable-alist *package* *readtable*))
))
;;; KLUDGE: ;;; KLUDGE:
;;; We need support for this in Slime itself, because we want IN-READTABLE ;;; We need support for this in Slime itself, because we want IN-READTABLE
;;; to work on a per-file basis, and not on a per-package basis. ;;; to work on a per-file basis, and not on a per-package basis.
...@@ -137,15 +178,6 @@ they appear." ...@@ -137,15 +178,6 @@ they appear."
(and (string= pkg-name1 pkg-name2) (and (string= pkg-name1 pkg-name2)
(eq rt1 rt2))))))))) (eq rt1 rt2)))))))))
(defmacro in-readtable (name)
"Bind the *readtable* to the readtable referred to by NAME, raising
an error if no such readtable can be found."
(check-type name symbol)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (ensure-readtable ',name))
(when (find-package :swank)
(%frob-swank-readtable-alist *package* *readtable*))
))
(defun make-readtable (name &key merge) (defun make-readtable (name &key merge)
"Makes and returns a new readtable under the specified NAME. The "Makes and returns a new readtable under the specified NAME. The
......
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