Add named-readtables support.
authorFrancois-Rene Rideau <fare@tunes.org>
Tue, 19 Jun 2012 05:29:43 +0000 (01:29 -0400)
committerFrancois-Rene Rideau <fare@tunes.org>
Tue, 19 Jun 2012 05:29:43 +0000 (01:29 -0400)
meta-src.lisp
meta.asd
package.lisp

index db5d73f..ae14415 100644 (file)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *saved-readtable* (copy-readtable))
-(defparameter *meta-readtable* (copy-readtable))
-
-(defun meta-reader (s c) (make-meta :char c :form (read s)))
+(defparameter *meta-readtable* (copy-readtable)))
 
+(defun meta-reader (s c)
+  (make-meta :char c :form (read s)))
+(defun meta-curly-bracket (s c)
+  (make-meta :char c :form (read-delimited-list #\} s t)))
+(defun meta-square-bracket (s c)
+  (make-meta :char c :form (read-delimited-list #\] s t)))
 
 (mapc #'(lambda (c) (set-macro-character c #'meta-reader nil *meta-readtable*)) '(#\@ #\$ #\!))
 
-(set-macro-character #\{
-  #'(lambda (s c) (make-meta :char c :form (read-delimited-list #\} s t))) nil *meta-readtable*)
+(set-macro-character #\{ #'meta-curly-bracket nil *meta-readtable*)
+(set-macro-character #\[ #'meta-square-bracket nil *meta-readtable*)
+(mapc #'(lambda (c) (set-macro-character c (get-macro-character #\)) nil *meta-readtable*))
+  '(#\] #\}))
 
-(set-macro-character #\[
-  #'(lambda (s c) (make-meta :char c :form (read-delimited-list #\] s t))) nil *meta-readtable*)
+(defreadtable :meta-mixin
+  (:macro-char #\[ #'meta-square-bracket)
+  (:syntax-from :standard #\) #\])
+  (:macro-char #\[ #'meta-curly-bracket)
+  (:syntax-from :standard #\) #\})
+  (:macro-char #\@ #'meta-reader)
+  (:macro-char #\$ #'meta-reader)
+  (:macro-char #\! #'meta-reader))
 
-(mapc #'(lambda (c) (set-macro-character c (get-macro-character #\))  nil *meta-readtable*))
-  '(#\] #\})))
+(defreadtable :meta
+  (:fuze :standard :meta))
 
 (defmacro with-stream-meta ((source-symbol stream) &body body)
   `(let ((,source-symbol ,stream))
        ,@body)))
 
 (defun enable-meta-syntax ()
-       (copy-readtable *meta-readtable* *readtable*))
+  (setf *readtable* *meta-readtable*))
 
 (defun disable-meta-syntax()
-       (copy-readtable *saved-readtable* *readtable*))
+  (setf *readtable* *saved-readtable*))
 
 
 (provide 'meta)
index fa0066e..749a1a0 100644 (file)
--- a/meta.asd
+++ b/meta.asd
@@ -3,5 +3,6 @@
 (defsystem :meta
   :description "META syntax to easily write parsers"
   :long-description "META syntax to easily write parsers, as per Henry G. Baker's Prag-Parse article"
+  :depends-on (:named-readtables)
   :components ((:file "package")
               (:file "meta-src" :depends-on ("package"))))
index f735085..6c26009 100644 (file)
@@ -5,7 +5,7 @@
 (in-package :cl-user)
 
 (defpackage :meta
-  (:use #:common-lisp)
+  (:use #:common-lisp #:named-readtables)
   (:export #:with-string-meta
           #:with-list-meta
           #:with-stream-meta