block reader.lisp

(in-package :cl-user)

(defpackage :testread
  (:use cl))
(in-package :testread)

(defparameter *old-readtable* (copy-readtable) "")
(defparameter *new-readtable* (copy-readtable) "")
(defparameter *syms* (make-hash-table))

(defmethod string+ ((s1 string) (s2 string))
  (concatenate 'string s1 s2))

(defun register-sym (sym &rest handler)
  (setf (gethash sym *syms*) (cons (gensym) handler)))

(defun enable-readtable nil
  (setf *old-readtable* (copy-readtable *readtable*))
  (setf *readtable* *new-readtable*))

(defun disable-readtable nil
  (setf *readtable* *old-readtable*))

(register-sym 'a
              `(print "Hello World"))

(make-dispatch-macro-character #\@)
(set-dispatch-macro-character #\@ #\s
                              (lambda (s ch1 ch2)
                                (declare (ignore ch1 ch2))
                                (let ((tart (read s))
                                      tag handler
                                      (bodys '((print "body"))))
                                  (if (eq 'tart tart)
                                      (progn
                                        (print "==start==")
                                        (setf tag (read s))
                                        (unless (eq tag 'end)
                                          (setf handler (cdr (gethash tag *syms*))))
                                        (do ((body (read s)))
                                            ((eq 'end body) 'end)
                                          (setf (cdr (last bodys)) (list body)
                                                body (read s)))
                                        `(progn
                                           ;; [TODO]: Copy readtable, make accept @end.
                                           ,@handler
                                           ,@bodys))
                                      (print "==exit==")))))
(print (read-from-string
        "@start  a
(print (+ 1 2 3))
end
"))

new-at-symbol-macro.lisp

;; create @ symbol-macro like @hello which print "Hello"

(defmacro new-at-symbol-macro (sym body)
  (let ((s (string+ "@" (symbol-name sym))))
    `(define-symbol-macro  ,(intern s) ,body)))
    
;; use (new-at-symbol-macro symbol body)
;; example use
(new-at-symbol-macro hello (print "Hello"))
@hello