3 (set-dispatch-macro-character #\
# #\
[ ; Dispatch on the sequence #[ or #arg[
4 #'(lambda (stream subchar arg
) ; Anonymous function to read/parse it
5 (declare (ignore subchar
)) ; We already know it is [
6 (let ((list (read-delimited-list #\
] stream t
)) ; Read in the rest of the list, up to ]
7 (keys '()) ; Empty list, filled below
8 (values '()) ; Empty list, filled below
9 (hashtab (gensym))) ; Gensym name for the hashtab so the values can't clobber it
11 (do ((key list
(cddr key
)) ; Loop for keys being sublists, skipping 2 ahead each time
12 (value (cdr list
) (cddr value
))) ; ...and for values being sublists, skipping 2 ahead
13 ((null key
)) ; Terminate loop when out of keys
14 (push (car key
) keys
) ; Assemble the keys in reverse order
15 (push (car value
) values
)) ; Assemble value forms in reverse order
16 (setf keys
(nreverse keys
)) ; Reverse the keys - push/nreverse is the fast way to do this
17 (setf values
(nreverse values
)) ; Reverse the value forms
19 ;;; The next 8 lines are the code template
20 `(let ((,hashtab
,(if arg
; If there is an argument given, make the hash-table that size
21 `(make-hash-table :test
#'equalp
:size
,arg
)
22 '(make-hash-table :test
#'equalp
)))) ; Otherwise use the default size
23 ,@(mapcar #'(lambda (key value
) ; Map this function across keys/values
24 `(setf (gethash ',key
,hashtab
) ,value
)) ; Add the item to the hash
27 ,hashtab
)))) ; Return the generated hashtab
29 (set-macro-character #\
[ ; Dispatch on [
30 #'(lambda (stream char
) ; Anonymous function to read/parse
31 (declare (ignore char
)) ; We already know that it's [
32 (let ((list (read-delimited-list #\
] stream t
))) ; Read up through ]
33 (when (/= (length list
) 2) ; Make sure that we have two elements
34 (error "Invalid number of arguments to []"))
35 (when (not (symbolp (cadr list
))) ; Make sure that the key is a symbol
36 (error "Key must be a symbol"))
37 `(gethash ',(cadr list
) ,(car list
))))) ; The actual code template
39 (set-macro-character #\
] (get-macro-character #\
))) ; This is a helper for read-delimited-list
