Skip to content

Instantly share code, notes, and snippets.

@shirok
Last active Oct 5, 2021
Embed
What would you like to do?
(defvar *original-readtable* *readtable*)
(defvar *cxr-readtable* (copy-readtable *original-readtable*))
(defconstant +constituents+
(remove-if #'get-macro-character
"!$%&0123456789<=>?[]^_{}~.+-*/@ABCDEFGHIJKLMNOPQRTSUVWXYZabcdefghijklmnopqrstuvwxyz"))
(defun cxr-reader (stream char)
(let* ((chars (loop with cs = `(,char)
for c = (peek-char nil stream nil nil t)
while (find c +constituents+)
do (push (read-char stream nil nil t) cs)
finally (return (reverse cs))))
(ads (butlast (cdr chars)))
(last (car (last chars))))
(if (and (equalp char #\c)
(> (length ads) 4)
(equalp last #\r)
(every (lambda (x) (member x '(#\a #\d) :test #'equalp)) ads))
(expand-cxr ads)
(let ((*readtable* *original-readtable*))
(read-from-string (coerce chars 'string))))))
(defun expand-cxr (ads)
(labels ((expand (ads)
(cond
((null ads) 'x)
((equalp (car ads) #\a) `(cl:car ,(expand (cdr ads))))
(t `(cl:cdr ,(expand (cdr ads)))))))
`(cl:lambda (x) ,(expand ads))))
(let ((*readtable* *cxr-readtable*))
(loop for c across +constituents+
do (set-macro-character c #'cxr-reader)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment