[quiz] Enhanced Strings in CL ?

[Laurent PETIT]

Hello,

I've modified the code as follows (also not yet corrected the tilde bug) :
What you can see is that insted of restoring the full initial readtable, I
only restore the #\" macro character previous function (the one I have
overriden with (start). This way, I do not reset other -possible-
personalized macro character functions.
I also provide a (stop) method which restores the previous #\" macro
character.

I also twiked the main function in order to let the initial string unchanged
in case no ${} is used (usefull for a lot of macros that only accept raw
strings, such as defpackage, ...).

Please let me know if you think this would not work in a case I haven't
seen.

The code follows :

(defpackage "ENHANCED-STRINGS"
 (:USE "COMMON-LISP")
 (:EXPORT "START")
 (:EXPORT "STOP"))

(in-package  "ENHANCED-STRINGS")

(defun parse-enhanced-string (string)
  (loop
   :with chunks = '()
   :with args = '()
   :with start = 0
   :for pos = (search "${" string :start2 start)
   :for end = (and pos (search "}" string :start2 pos))
   :while end
   :do (progn
     (push (subseq string start pos) chunks)
     (multiple-value-bind (form next)
         (read-from-string string t nil :start (+ 2 pos) :end end)
       (loop :while (and (< next end)
                 (member (aref string next) '(#\space #\newline)))
         :do (incf next))
       (unless (= next end)
         (error "Junk in ~S" (subseq string pos end)))
       (push form args))
     (setf start (1+ end)))
   :finally (progn
          (push (subseq string start) chunks)
          (if (rest chunks)
          (return `(format nil ,(format nil "~{~A~^~~A~}" (nreverse chunks))
                ,@(nreverse args))))
          (return string))))

(defun reader-macro--enhanced-string (stream dblquote)
  (let ((*readtable* (copy-readtable)))
    (set-macro-character #\" (get-old-macro-character))
    (unread-char dblquote stream)
    (parse-enhanced-string (read stream t nil t))))

(let ((old-macro-character nil))
  (defun start ()
    (unless old-macro-character
      (setf old-macro-character (get-macro-character #\"))
      (set-macro-character #\" #'reader-macro--enhanced-string)))
  (defun stop ()
    (when old-macro-character
      (set-macro-character #\" old-macro-character)
      (setf old-macro-character nil)))
  (defun get-old-macro-character ()
    old-macro-character))
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/quiz/attachments/20061129/50b4c725/attachment.html>