Created
June 24, 2011 10:30
-
-
Save r-moeritz/1044553 to your computer and use it in GitHub Desktop.
pretty hash table & vector literal syntax for common lisp
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;;; pretty-literals.lisp - pretty hash table & vector literal syntax | |
;;;; inspired by and uses code from http://frank.kank.net/essays/hash.html | |
(in-package #:pretty-literals) | |
;; vector literal syntax using brackets | |
(set-macro-character #\[ | |
(lambda (str char) | |
(declare (ignore char)) | |
(let ((*readtable* (copy-readtable *readtable* nil)) | |
(keep-going t)) | |
(set-macro-character #\] (lambda (stream char) | |
(declare (ignore char) (ignore stream)) | |
(setf keep-going nil))) | |
(let ((items (loop for value = (read str nil nil t) | |
while keep-going | |
collect value))) | |
(coerce items 'vector))))) | |
;; hash-table literal syntax using braces | |
(set-macro-character #\{ | |
(lambda (str char) | |
(declare (ignore char)) | |
(let ((*readtable* (copy-readtable *readtable* nil)) | |
(keep-going t)) | |
(set-macro-character #\} (lambda (stream char) | |
(declare (ignore char) (ignore stream)) | |
(setf keep-going nil))) | |
(let ((pairs (loop for key = (read str nil nil t) | |
while keep-going | |
for value = (read str nil nil t) | |
collect (list key value))) | |
(retn (gensym))) | |
`(let ((,retn (make-hash-table :test #'equal))) | |
,@(mapcar | |
(lambda (pair) | |
`(setf (gethash ,(car pair) ,retn) ,(cadr pair))) | |
pairs) | |
,retn))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment