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. Merge the readtables designated into the new readtable, using
`merge-readtables-into'. It is mandatory to supply at least one :MERGE
clause.
DEFREADTABLE accepts some special readtable designators, including DEFREADTABLE accepts some special readtable designators, including NIL
NIL or :STANDARD for the standard readtable and :CURRENT for the current 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,43 +101,66 @@ they appear." ...@@ -83,43 +101,66 @@ 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))
((not (null other-clauses)) (other-clauses (set-difference options
(error "Bogus DEFREADTABLE clauses: ~{~A~^, ~}" other-clauses)) (append merge-clauses case-clauses
(t macro-clauses syntax-clauses))))
`(eval-when (:load-toplevel :execute) (cond
;; The (FIND-READTABLE ...) is important for proper redefinition semantics. ((null merge-clauses)
(handler-bind ((readtable-does-already-exist (error "You must specify at least one :MERGE clause in DEFREADTABLE."))
#'(lambda (c) ((not (null other-clauses))
(simple-style-warn (error "Bogus DEFREADTABLE clauses: ~{~A~^, ~}" other-clauses))
"Overwriting previously existing readtable ~S." (t
(existing-readtable-name c)) `(eval-when (:load-toplevel :execute)
(continue c)))) (handler-bind ((readtable-does-already-exist
(let ((readtable (find-readtable ',name))) #'(lambda (c)
(setq readtable (simple-style-warn
(make-readtable ',name "Overwriting previously existing readtable ~S."
;; We have to provide an explicit :MERGE argument, (existing-readtable-name c))
;; because otherwise the :STANDARD readtable would (continue c))))
;; be used which is not necessarily what we want. ;; The (FIND-READTABLE ...) is important for proper redefinition
:merge ',(rest (first merge-clauses)))) ;; semantics.
;; We have to grovel all MERGE-CLAUSES for the redefinition case. (let ((readtable (find-readtable ',name)))
,@(loop for option in merge-clauses (setq readtable
collect (process-option option 'readtable)) (make-readtable ',name
,@(loop for option in case-clauses ;; We have to provide an explicit :MERGE
collect (process-option option 'readtable)) ;; argument, because otherwise the
,@(loop for option in macro-clauses ;; :STANDARD readtable would be used which
collect (process-option option 'readtable)) ;; is not necessarily what we want.
readtable)))))))) :merge ',(rest (first merge-clauses))))
;; We have to grovel all MERGE-CLAUSES for the redefinition case.
,@(loop for option in merge-clauses
collect (process-option option 'readtable))
,@(loop for option in case-clauses
collect (process-option option 'readtable))
,@(loop for option in macro-clauses
collect (process-option option 'readtable))
,@(loop for option in syntax-clauses
collect (process-option option '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
...@@ -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