Skip to content

Instantly share code, notes, and snippets.

@r-moeritz

r-moeritz/pretty-literals.lisp

Created June 24, 2011 10:30
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save r-moeritz/1044553 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save r-moeritz/1044553 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Ralph Moritz revised this gist Jun 26, 2011. 1 changed file with 2 additions and 8 deletions.
    10 changes: 2 additions & 8 deletions pretty-literals.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -14,14 +14,8 @@
    (setf keep-going nil)))
    (let ((items (loop for value = (read str nil nil t)
    while keep-going
    collect value))
    (retn (gensym)))
    `(let ((,retn (make-array ,(length items) :fill-pointer 0)))
    ,@(mapcar
    (lambda (item)
    `(vector-push ,item ,retn))
    items)
    ,retn)))))
    collect value)))
    (coerce items 'vector)))))

    ;; hash-table literal syntax using braces
    (set-macro-character #\{
  2. Ralph Moritz created this gist Jun 24, 2011.
    45 changes: 45 additions & 0 deletions pretty-literals.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,45 @@
    ;;;; 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))
    (retn (gensym)))
    `(let ((,retn (make-array ,(length items) :fill-pointer 0)))
    ,@(mapcar
    (lambda (item)
    `(vector-push ,item ,retn))
    items)
    ,retn)))))

    ;; 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)))))