Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
N
named-readtables
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Raymond Toy
named-readtables
Commits
8dc02af1
Commit
8dc02af1
authored
Sep 05, 2009
by
Tobias C. Rittweiler
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add :EMPTY readtables.
darcs-hash:20090905182312-f5546-8ef69cab7c36af5c35fc58a70294d1cead3641b7.gz
parent
6edecc9d
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
68 additions
and
48 deletions
+68
-48
named-readtables/cruft.lisp
named-readtables/cruft.lisp
+25
-5
named-readtables/named-readtables.asd
named-readtables/named-readtables.asd
+1
-1
named-readtables/named-readtables.lisp
named-readtables/named-readtables.lisp
+29
-35
named-readtables/package.lisp
named-readtables/package.lisp
+13
-7
No files found.
named-readtables/cruft.lisp
View file @
8dc02af1
...
@@ -20,7 +20,7 @@
...
@@ -20,7 +20,7 @@
(
find-package
"SB-IMPL"
))
(
find-package
"SB-IMPL"
))
(
pushnew
:sbcl+safe-standard-readtable
*features*
)))
(
pushnew
:sbcl+safe-standard-readtable
*features*
)))
;;;;; Implementation-dependent cruft
;;;;; Implementation-dependent cruft
...
@@ -33,7 +33,7 @@
...
@@ -33,7 +33,7 @@
#+
:sbcl+safe-standard-readtable
sb-impl::*standard-readtable*
#+
:sbcl+safe-standard-readtable
sb-impl::*standard-readtable*
#+
:common-lisp
(
copy-readtable
nil
))
#+
:common-lisp
(
copy-readtable
nil
))
;;;; Mapping between a readtable object and its readtable-name.
;;;; Mapping between a readtable object and its readtable-name.
(
defvar
*readtable-names*
(
make-hash-table
:test
'eq
))
(
defvar
*readtable-names*
(
make-hash-table
:test
'eq
))
...
@@ -57,7 +57,7 @@
...
@@ -57,7 +57,7 @@
(
loop
for
name
being
each
hash-value
of
*readtable-names*
(
loop
for
name
being
each
hash-value
of
*readtable-names*
collect
name
)))
collect
name
)))
;;;; Mapping between a readtable-name and the actual readtable object.
;;;; Mapping between a readtable-name and the actual readtable object.
;;; On Allegro we reuse their named-readtable support so we work
;;; On Allegro we reuse their named-readtable support so we work
...
@@ -99,7 +99,7 @@
...
@@ -99,7 +99,7 @@
#+
:allegro
(
excl:named-readtable
(
readtable-name-for-allegro
name
))
#+
:allegro
(
excl:named-readtable
(
readtable-name-for-allegro
name
))
#+
:common-lisp
(
values
(
gethash
name
*named-readtables*
nil
)))
#+
:common-lisp
(
values
(
gethash
name
*named-readtables*
nil
)))
;;;; Readtables Iterators
;;;; Readtables Iterators
(
defmacro
with-readtable-iterator
((
name
readtable
)
&body
body
)
(
defmacro
with-readtable-iterator
((
name
readtable
)
&body
body
)
...
@@ -223,7 +223,27 @@
...
@@ -223,7 +223,27 @@
(
error
()
nil
))
(
error
()
nil
))
(
return
(
values
t
char
fn
disp?
alist
)))))))))
(
return
(
values
t
char
fn
disp?
alist
)))))))))
(
defmacro
do-readtable
((
entry-designator
readtable
&optional
result
)
&body
body
)
"Iterate through a readtable's macro characters, and dispatch macro characters."
(
destructuring-bind
(
char
&optional
reader-fn
disp?
table
)
(
if
(
symbolp
entry-designator
)
(
list
entry-designator
)
entry-designator
)
(
let
((
iter
(
gensym
"ITER+"
))
(
more?
(
gensym
"MORE?+"
)))
`
(
with-readtable-iterator
(
,
iter
,
readtable
)
(
loop
(
multiple-value-bind
(
,
more?
,
char
,@
(
when
reader-fn
(
list
reader-fn
))
,@
(
when
disp?
(
list
disp?
))
,@
(
when
table
(
list
table
)))
(
,
iter
)
(
unless
,
more?
(
return
,
result
))
,@
body
))))))
;;;; Specialized PRINT-OBJECT for named readtables.
;;;; Specialized PRINT-OBJECT for named readtables.
;;; 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
...
...
named-readtables/named-readtables.asd
View file @
8dc02af1
(
defsystem
:named-readtables
(
asdf:
defsystem
:named-readtables
:description
"Library that creates a namespace for named readtable akin to the namespace of packages."
:description
"Library that creates a namespace for named readtable akin to the namespace of packages."
:author
"Tobias C. Rittweiler <trittweiler@common-lisp.net>"
:author
"Tobias C. Rittweiler <trittweiler@common-lisp.net>"
:version
"1.0 (unpublished so far)"
:version
"1.0 (unpublished so far)"
...
...
named-readtables/named-readtables.lisp
View file @
8dc02af1
...
@@ -43,14 +43,8 @@ The readtable can be populated using the following `options':
...
@@ -43,14 +43,8 @@ The readtable can be populated using the following `options':
(:MERGE `readtable-designators'+)
(:MERGE `readtable-designators'+)
Merge the readtables designated into the new readtable, using
Merge the readtables designated into the new readtable, using
MERGE-READTABLES-INTO. It is mandatory to supply at least one :MERGE
MERGE-READTABLES-INTO.
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.
Note that the process of merging readtables is _not_ commutative, so
Note that the process of merging readtables is _not_ commutative, so
that reader macros in earlier entries will be overwritten by later
that reader macros in earlier entries will be overwritten by later
ones.
ones.
...
@@ -90,7 +84,8 @@ Notes:
...
@@ -90,7 +84,8 @@ Notes:
its definition -- you have to wrap the DEFREADTABLE form in an explicit
its definition -- you have to wrap the DEFREADTABLE form in an explicit
EVAL-WHEN.
EVAL-WHEN.
NIL, :STANDARD, and :CURRENT are preregistered readtable names.
NIL, :STANDARD, :EMPTY, and :CURRENT are preregistered readtable
names.
"
"
(
check-type
name
symbol
)
(
check-type
name
symbol
)
(
when
(
reserved-readtable-name-p
name
)
(
when
(
reserved-readtable-name-p
name
)
...
@@ -127,10 +122,8 @@ Notes:
...
@@ -127,10 +122,8 @@ Notes:
(
append
merge-clauses
case-clauses
(
append
merge-clauses
case-clauses
macro-clauses
syntax-clauses
))))
macro-clauses
syntax-clauses
))))
(
cond
(
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: ~
/PPRINT-LINEAR/
"
other-clauses
))
(
t
(
t
`
(
eval-when
(
:load-toplevel
:execute
)
`
(
eval-when
(
:load-toplevel
:execute
)
(
handler-bind
((
readtable-does-already-exist
(
handler-bind
((
readtable-does-already-exist
...
@@ -141,15 +134,8 @@ Notes:
...
@@ -141,15 +134,8 @@ Notes:
(
continue
c
))))
(
continue
c
))))
;; The (FIND-READTABLE ...) is important for proper redefinition
;; The (FIND-READTABLE ...) is important for proper redefinition
;; semantics.
;; semantics.
(
let
((
readtable
(
find-readtable
',name
)))
(
let
((
readtable
(
or
(
find-readtable
',name
)
(
setq
readtable
(
make-readtable
',name
))))
(
make-readtable
',name
;; We have to provide an explicit :MERGE
;; argument, because otherwise the
;; :STANDARD readtable would be used which
;; is not necessarily what we want.
:merge
',
(
rest
(
first
merge-clauses
))))
;; We have to grovel all MERGE-CLAUSES for the redefinition case.
,@
(
loop
for
option
in
merge-clauses
,@
(
loop
for
option
in
merge-clauses
collect
(
process-option
option
'readtable
))
collect
(
process-option
option
'readtable
))
,@
(
loop
for
option
in
case-clauses
,@
(
loop
for
option
in
case-clauses
...
@@ -190,10 +176,10 @@ Notes:
...
@@ -190,10 +176,10 @@ Notes:
"Creates and returns a new readtable under the specified `name'.
"Creates and returns a new readtable under the specified `name'.
`merge' takes a list of NAMED-READTABLE-DESIGNATORS and specifies the
`merge' takes a list of NAMED-READTABLE-DESIGNATORS and specifies the
readtables the new readtable is created from. (See the :MERGE clause
s
of
readtables the new readtable is created from. (See the :MERGE clause of
DEFREADTABLE for details.) If
:MERGE wasn't given (or NIL), the :STANDARD
DEFREADTABLE for details.) If
`merge' wasn't given (or NIL), the :EMPTY
readtable is used instead."
readtable is used instead."
(
let
((
merge-list
(
or
merge
'
(
:
standard
))))
(
let
((
merge-list
(
or
merge
'
(
:
empty
))))
(
check-type
merge-list
list
)
(
check-type
merge-list
list
)
(
cond
((
reserved-readtable-name-p
name
)
(
cond
((
reserved-readtable-name-p
name
)
(
error
"~A is the designator for a predefined readtable. ~
(
error
"~A is the designator for a predefined readtable. ~
...
@@ -235,17 +221,14 @@ definitions in readtables appearing later in the list will overwrite
...
@@ -235,17 +221,14 @@ definitions in readtables appearing later in the list will overwrite
reader-macros appearing earlier. Notice that the /readtable case/ is also
reader-macros appearing earlier. Notice that the /readtable case/ is also
subject of the merge operation."
subject of the merge operation."
(
flet
((
merge-into
(
rt1
rt2
)
(
flet
((
merge-into
(
rt1
rt2
)
(
with-readtable-iterator
(
rt2-iter
rt2
)
(
do-readtable
((
char
reader-fn
disp?
table
)
rt2
)
(
loop
(
unless
(
standard-macro-char-p
char
rt2
)
(
multiple-value-bind
(
more?
char
reader-fn
disp?
table
)
(
rt2-iter
)
(
let
((
non-terminating-p
(
nth-value
1
(
get-macro-character
char
rt2
))))
(
unless
more?
(
return
))
(
set-macro-character
char
reader-fn
non-terminating-p
rt1
)))
(
unless
(
standard-macro-char-p
char
rt2
)
(
when
disp?
(
let
((
non-terminating-p
(
nth-value
1
(
get-macro-character
char
rt2
))))
(
loop
for
(
subchar
.
subfn
)
in
table
do
(
set-macro-character
char
reader-fn
non-terminating-p
rt1
)))
(
unless
(
standard-dispatch-macro-char-p
char
subchar
rt2
)
(
when
disp?
(
set-dispatch-macro-character
char
subchar
subfn
rt1
)))))
(
loop
for
(
subchar
.
subfn
)
in
table
do
(
unless
(
standard-dispatch-macro-char-p
char
subchar
rt2
)
(
set-dispatch-macro-character
char
subchar
subfn
rt1
)))))))
rt1
))
rt1
))
(
setf
result-table
(
ensure-readtable
result-table
))
(
setf
result-table
(
ensure-readtable
result-table
))
(
dolist
(
table
(
mapcar
#'
ensure-readtable
named-readtable-designators
))
(
dolist
(
table
(
mapcar
#'
ensure-readtable
named-readtable-designators
))
...
@@ -308,6 +291,15 @@ guaranteed to be fresh, but may contain duplicates."
...
@@ -308,6 +291,15 @@ guaranteed to be fresh, but may contain duplicates."
;;;
;;;
(
defvar
*standard-readtable*
(
%standard-readtable
))
(
defvar
*standard-readtable*
(
%standard-readtable
))
(
defvar
*empty-readtable*
(
let
((
readtable
(
copy-readtable
nil
)))
(
do-readtable
(
char
readtable
)
(
set-syntax-from-char
char
#\A
readtable
(
%standard-readtable
)))
;; Alas, on SBCL, SET-SYNTAX-FROM-CHAR does not get rid of a
;; readtable's dispatch table properly.
#+
sbcl
(
setf
(
sb-impl::dispatch-tables
readtable
)
nil
)
readtable
))
(
defun
standard-macro-char-p
(
char
rt
)
(
defun
standard-macro-char-p
(
char
rt
)
(
multiple-value-bind
(
rt-fn
rt-flag
)
(
get-macro-character
char
rt
)
(
multiple-value-bind
(
rt-fn
rt-flag
)
(
get-macro-character
char
rt
)
(
multiple-value-bind
(
std-fn
std-flag
)
(
get-macro-character
char
*standard-readtable*
)
(
multiple-value-bind
(
std-fn
std-flag
)
(
get-macro-character
char
*standard-readtable*
)
...
@@ -321,7 +313,7 @@ guaranteed to be fresh, but may contain duplicates."
...
@@ -321,7 +313,7 @@ guaranteed to be fresh, but may contain duplicates."
(
eq
(
get-dispatch-macro-character
disp-char
sub-char
rt
)
(
eq
(
get-dispatch-macro-character
disp-char
sub-char
rt
)
(
get-dispatch-macro-character
disp-char
sub-char
*standard-readtable*
)))))
(
get-dispatch-macro-character
disp-char
sub-char
*standard-readtable*
)))))
(
defparameter
*reserved-readtable-names*
'
(
nil
:standard
:current
))
(
defparameter
*reserved-readtable-names*
'
(
nil
:standard
:current
:empty
))
(
defun
reserved-readtable-name-p
(
name
)
(
defun
reserved-readtable-name-p
(
name
)
(
and
(
member
name
*reserved-readtable-names*
)
t
))
(
and
(
member
name
*reserved-readtable-names*
)
t
))
...
@@ -333,6 +325,7 @@ guaranteed to be fresh, but may contain duplicates."
...
@@ -333,6 +325,7 @@ guaranteed to be fresh, but may contain duplicates."
(
defun
find-reserved-readtable
(
reserved-name
)
(
defun
find-reserved-readtable
(
reserved-name
)
(
cond
((
eq
reserved-name
nil
)
*standard-readtable*
)
(
cond
((
eq
reserved-name
nil
)
*standard-readtable*
)
((
eq
reserved-name
:standard
)
*standard-readtable*
)
((
eq
reserved-name
:standard
)
*standard-readtable*
)
((
eq
reserved-name
:empty
)
*empty-readtable*
)
((
eq
reserved-name
:current
)
*readtable*
)
((
eq
reserved-name
:current
)
*readtable*
)
(
t
(
error
"Bug: no such reserved readtable: ~S"
reserved-name
))))
(
t
(
error
"Bug: no such reserved readtable: ~S"
reserved-name
))))
...
@@ -393,6 +386,7 @@ successfull, NIL otherwise."
...
@@ -393,6 +386,7 @@ successfull, NIL otherwise."
(
cond
((
%readtable-name
read-table
))
(
cond
((
%readtable-name
read-table
))
((
eq
read-table
*readtable*
)
:current
)
((
eq
read-table
*readtable*
)
:current
)
((
eq
read-table
*standard-readtable*
)
:standard
)
((
eq
read-table
*standard-readtable*
)
:standard
)
((
eq
read-table
*empty-readtable*
)
:empty
)
(
t
nil
))))
(
t
nil
))))
...
...
named-readtables/package.lisp
View file @
8dc02af1
...
@@ -31,7 +31,7 @@
...
@@ -31,7 +31,7 @@
particular:
particular:
* you can associate readtables with names, and retrieve
* you can associate readtables with names, and retrieve
readtables
from their
names;
readtables
by
names;
* you can associate source files with readtable names, and be
* you can associate source files with readtable names, and be
sure that the right readtable is active when compiling/loading
sure that the right readtable is active when compiling/loading
...
@@ -39,7 +39,8 @@
...
@@ -39,7 +39,8 @@
* similiarly, your development environment now has a chance to
* similiarly, your development environment now has a chance to
automatically determine what readtable should be active while
automatically determine what readtable should be active while
processing source forms on interactive commands.
processing source forms on interactive commands. (E.g. think of
`C-c C-c' in Slime [yet to be done])
It follows that Named-Readtables is a facility for using readtables in
It follows that Named-Readtables is a facility for using readtables in
a localized way.
a localized way.
...
@@ -47,17 +48,17 @@
...
@@ -47,17 +48,17 @@
Additionally, it also attempts to become a facility for using
Additionally, it also attempts to become a facility for using
readtables in a /modular/ way. In particular:
readtables in a /modular/ way. In particular:
* it provides a
convenience macro to specify the whole content of
* it provides a
macro to specify the content of a readtable at a
a readtable at one sight.
glance;
* it
supports multiple inheritance
.
* it
makes it possible to use multiple inheritance between readtables
.
* Notes on the API
* Notes on the API
The API heavily imitates the API of packages. This has the nice
The API heavily imitates the API of packages. This has the nice
property that any experienced Common Lisper will take it up
totally
property that any experienced Common Lisper will take it up
without
effort
less
.
effort.
DEFREADTABLE - DEFPACKAGE
DEFREADTABLE - DEFPACKAGE
...
@@ -151,6 +152,11 @@
...
@@ -151,6 +152,11 @@
- :CURRENT designates the /current readtable/.
- :CURRENT designates the /current readtable/.
- :EMPTY designates an empty readtable. That is a readtable where
the character syntax of each character is like in the /standard
readtable/ except that each standard macro character has been
made a constituent.
* Examples
* Examples
> (defreadtable elisp:syntax
> (defreadtable elisp:syntax
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment