读者宏

文章 来源

示例

装饰器

cl-annot 库在 Common Lisp 中实现了装饰器模式（将它们称为“批注”）。

例如，你可以使用它来导出包定义外的符号并对其进行描述，例如：

(defpackage my-package
  (:use :cl :cl-annot.doc))
(in-package :my-package)
(annot:enable-annot-syntax)

@doc "Add two numbers."
@export
(defun add (x y)
  (+ x y))

请注意，你必须在使用批注的任何文件的开头放置 (annot:enable-annot-syntax)。

哈希表字面量

摘自 此处。

(defun read-separator (str)
 (let
  ((*readtable* (copy-readtable *readtable* nil)))
  (set-macro-character #\, (lambda (stream char)
                            (declare (ignore char) (ignore stream))
                            'break))
  (read str nil)))

(set-macro-character #\{
 (lambda (str char)
  (declare (ignore char))
  (let
   ((*readtable* (copy-readtable *readtable* nil)))
   (set-macro-character #\} (lambda (stream char)
                             (declare (ignore char) (ignore stream))
                             'end))

   (let
    ((pairs (loop for key = (read str nil nil t)
                  for sep = (read str nil nil t)
                  for value = (read str nil nil t)
                  for end? = (read-separator str)
                  do (when (not (eql '=> sep)) (error "Expected =>, did not get"))
                  do (when (not (or (eql 'end end?) (eql 'break end?))) (error "Expected , or }"))
                  collect (list key value)
                  while (not (eql 'end end?))))
     (retn (gensym)))
    `(let
      ((,retn (make-hash-table :test #'equal)))
      ,@(mapcar
         (lambda (pair)
          `(setf (gethash ,(car pair) ,retn) ,(cadr pair)))
         pairs)
      ,retn)))))

列表理解

摘自 此处。

(defun read-listcomp (stream char)
  (declare (ignore char))
  (let (rezs srcs conds state)
    (dolist (item (read-delimited-list #\} stream))
      (if (eql '|| item)
          (setf state (if state :cond :src))
          (case state
            (:src (push item srcs))
            (:cond (push item conds))
            (otherwise (push item rezs)))))
    (setf rezs (reverse rezs)
          srcs (reverse srcs)
          conds (reverse conds))
    (let ((binds (mapcar (lambda (group) (cons (first group) (third group)))
                         (group 3 srcs))))
      `(mapcan (lambda ,(mapcar #'car binds)
                 (when (and ,@conds)
                   (list ,(if (rest rezs)
                              (cons 'list rezs)
                              (first rezs)))))
               ,@(mapcar #'cdr binds)))))

(set-macro-character #\{ #'read-listcomp)
(set-macro-character #\} (get-macro-character #\)))

这使用了保罗·格雷厄姆的《Lisp 编程艺术》中定义的 group 实用程序函数。

(defun group (n list)
  "Split LIST into a list of lists of length N."
  (declare (integer n))
  (when (zerop n)
    (error "Group length N shouldn't be zero."))
  (labels ((rec (src acc)
             (let ((rest (nthcdr n src)))
               (if (consp rest)
                   (rec rest (cons (subseq src 0 n) acc))
                   (nreverse (cons src acc))))))
    (when list
      (rec list nil))))

另请参阅