diff --git a/meta-src.lisp b/meta-src.lisp index 4bb834c4dd0c57dfef04328d6d6084672bf49604..fda02366a9a536d017c110b640677dbd9ec9a6c8 100644 --- a/meta-src.lisp +++ b/meta-src.lisp @@ -18,21 +18,21 @@ ;;;; notice, this list of conditions and the following disclaimer in the ;;;; documentation and/or other materials provided with the distribution. ;;;; -;;;; THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER -;;;; EXPRESSED NOR IMPLIED WARRANTIES - THIS INCLUDES, BUT +;;;; THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER +;;;; EXPRESSED NOR IMPLIED WARRANTIES - THIS INCLUDES, BUT ;;;; IS NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY -;;;; AND FITNESS FOR A PARTICULAR PURPOSE.IN NO WAY ARE THE +;;;; AND FITNESS FOR A PARTICULAR PURPOSE. IN NO WAY ARE THE ;;;; AUTHORS LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;;;; SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; -;;;; LOSS OF USE, DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) -;;;; +;;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES, +;;;; LOSS OF USE, DATA, OR PROFITS OR BUSINESS INTERRUPTION) +;;;; ;;;; For further details contact the authors of this software. ;;;; -;;;; Jochen Schmidt -;;;; Zuckmantelstr. 11 -;;;; 91616 Neusitz -;;;; GERMANY +;;;; Jochen Schmidt +;;;; Zuckmantelstr. 11 +;;;; 91616 Neusitz +;;;; GERMANY ;;;; ;;;; ;;;; NOTE: @@ -49,7 +49,6 @@ ;;;; ;;;; Nuernberg, 01.Jul.2001 Jochen Schmidt - #+xcvb (module (:depends-on ("package"))) (in-package :meta) @@ -113,40 +112,38 @@ form) (defmethod make-load-form ((m meta) &optional environment) + (declare (ignore environment)) `(make-meta :char ,(meta-char m) :form ',(meta-form m))) (defun compileit (x &key meta-parser-type source-symbol) - (typecase x - (meta - (ecase (meta-char x) - (#\! (meta-form x)) - (#\[ `(and ,@(mapcar #'(lambda (f) (compileit f - :meta-parser-type meta-parser-type - :source-symbol source-symbol)) - (meta-form x)))) - (#\{ `(or ,@(mapcar #'(lambda (f) (compileit f - :meta-parser-type meta-parser-type - :source-symbol source-symbol)) - (meta-form x)))) - (#\$ `(not (do () ((not ,(compileit (meta-form x) + (typecase x + (meta + (ecase (meta-char x) + (#\! (meta-form x)) + (#\[ `(and ,@(mapcar #'(lambda (f) (compileit f + :meta-parser-type meta-parser-type + :source-symbol source-symbol)) + (meta-form x)))) + (#\{ `(or ,@(mapcar #'(lambda (f) (compileit f :meta-parser-type meta-parser-type - :source-symbol source-symbol)))))) - (#\@ (let ((f (meta-form x))) (list (ecase meta-parser-type - (:list 'list-match-type) - (:string 'string-match-type) - (:stream 'stream-match-type)) - (car f) (cadr f) - :source-symbol source-symbol - ))))) - (t (list (ecase meta-parser-type - (:list 'list-match) - (:string 'string-match) - (:stream 'stream-match)) - x - :source-symbol source-symbol - )))) - + :source-symbol source-symbol)) + (meta-form x)))) + (#\$ `(not (do () ((not ,(compileit (meta-form x) + :meta-parser-type meta-parser-type + :source-symbol source-symbol)))))) + (#\@ (let ((f (meta-form x))) (list (ecase meta-parser-type + (:list 'list-match-type) + (:string 'string-match-type) + (:stream 'stream-match-type)) + (car f) (cadr f) + :source-symbol source-symbol))))) + (t (list (ecase meta-parser-type + (:list 'list-match) + (:string 'string-match) + (:stream 'stream-match)) + x + :source-symbol source-symbol)))) (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *saved-readtable* (copy-readtable)) @@ -158,21 +155,20 @@ (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*) + #'(lambda (s c) (make-meta :char c :form (read-delimited-list #\} s t))) nil *meta-readtable*) (set-macro-character #\[ - #'(lambda (s c) (make-meta :char c :form (read-delimited-list #\] s t))) nil *meta-readtable*) + #'(lambda (s c) (make-meta :char c :form (read-delimited-list #\] s t))) nil *meta-readtable*) (mapc #'(lambda (c) (set-macro-character c (get-macro-character #\)) nil *meta-readtable*)) - '(#\] #\})) -) + '(#\] #\}))) (defmacro with-stream-meta ((source-symbol stream) &body body) `(let ((,source-symbol ,stream)) (macrolet ((match (x) - (compileit x - :meta-parser-type :stream - :source-symbol ',source-symbol))) + (compileit x + :meta-parser-type :stream + :source-symbol ',source-symbol))) ,@body))) (defmacro with-string-meta ((source-symbol string-buffer &key (start 0) end) &body body) @@ -182,18 +178,18 @@ (declare (fixnum index end) (type simple-base-string ,source-symbol)) (macrolet ((match (x) - (compileit x - :meta-parser-type :string - :source-symbol ',source-symbol))) - ,@body))) + (compileit x + :meta-parser-type :string + :source-symbol ',source-symbol))) + ,@body))) (defmacro with-list-meta ((source-symbol list) &body body) `(let ((,source-symbol ,list)) (macrolet ((match (x) - (compileit x - :meta-parser-type :list - :source-symbol ',source-symbol))) + (compileit x + :meta-parser-type :list + :source-symbol ',source-symbol))) ,@body))) (defun enable-meta-syntax () @@ -215,10 +211,8 @@ (defun ctoi (d) (- (char-code d) #.(char-code #\0))) ) -(eval-when (:compile-toplevel :load-toplevel :execute) - (enable-meta-syntax) -) - +(eval-when (:compile-toplevel :execute) + (enable-meta-syntax)) (defun parse-int (string &aux (s +1) d (n 0)) (with-string-meta (buffer string) @@ -229,8 +223,7 @@ $[@(digit d) !(setq n (+ (* n 10) (ctoi d)))]]) (* s n)))) -(eval-when (:compile-toplevel :load-toplevel :execute) -(disable-meta-syntax) -) +(eval-when (:compile-toplevel :execute) + (disable-meta-syntax)) |#