commit c5304a3725fbdcb1e917f3b48ac5e8603fcb793e
jose <jose@linux-q5ep.lan>
2018-11-17 19:08:49 -0800
Select terminating character with enclosing support {} [] () <>.
macrog.lisp | 24 ++++++++++++++----------
1 file changed, 14 insertions(+), 10 deletions(-)
diff --git a/macrog.lisp b/macrog.lisp
index 4db1d41..9010944 100644
--- a/macrog.lisp
+++ b/macrog.lisp
@@ -12,6 +12,14 @@
:end1 3))))
(defun prepare (str)
(concatenate 'string (string #\() str (string #\))))
+(defun enclose (char)
+ (cond ((char= char #\{) #\})
+ ((char= char #\[) #\[)
+ ((char= char #\() #\))
+ ((char= char #\<) #\>)
+ (t char)))
+(defun termp (opening tester)
+ (char= (enclose opening) tester))
(defun backquote-kludge (str)
(remove #\` str))
(defmacro with-macro-fn (char new-fn &body body)
@@ -23,18 +31,14 @@
(defun read-atoms (str)
(with-macro-fn #\, nil
(flatten (read-from-string (backquote-kludge (prepare str)) nil nil))))
-(defun read-to-string (stream &optional (acc (make-stack)) (parens 0))
- (aif (and (not (= -1 parens)) (read-char stream nil nil))
- (read-to-string stream (push-on it acc) (case it
- (#\) (1- parens))
- (#\( (1+ parens))
- (t parens)))
- (concatenate 'string (subseq acc 0 (1- (length acc))))))
+(defun read-to-string (stream terminating-char &optional (acc (make-stack)))
+ (let ((ch (read-char stream nil nil)))
+ (if (and ch (not (termp terminating-char ch)))
+ (read-to-string stream terminating-char (push-on ch acc))
+ (concatenate 'string acc))))
(defun gbang (stream no nope)
(declare (ignore no nope))
- (let* ((str1 (read-to-string stream))
- (term (aref str1 0))
- (str (prepare str1))
+ (let* ((str (prepare (read-to-string stream (read-char stream))))
(code (read-from-string str nil))
(syms (remove-duplicates (mapcar #'(lambda (x) (intern (remove #\, (symbol-name x))))
(remove-if-not #'g!-symbol-p (read-atoms str)))