Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(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
"))
;; 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.