Skip to content

Instantly share code, notes, and snippets.

@shirok
Created Oct 5, 2021
Embed
What would you like to do?
(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)))))))
(let* ((nam (coerce `(#\c ,@ads #\r) 'string))
(sym (intern (ecase (readtable-case *cxr-readtable*)
((:upcase) (string-upcase nam))
((:downcase) (string-downcase nam))
((:invert) (map 'string
(lambda (c)
(cond
((upper-case-p c) (char-downcase c))
((lower-case-p c) (char-upcase c))
(t c)))
nam))
((:preserve) nam)))))
(unless (fboundp sym)
(setf (fdefinition sym)
(eval `(cl:lambda (x) ,(expand ads)))))
sym)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment