Common Lisp如何扩展内置运算符支持离散概率分布类型

首先明确核心红线：绝对不要直接全局重定义COMMON-LISP包下的内置运算符。ANSI Common Lisp标准明确规定修改CL包内置符号的函数绑定属于未定义行为，多数实现对内置算术、比较运算符做了底层编译优化，全局改动很容易破坏标准库、第三方库甚至REPL本身的正常逻辑。

最符合Lisp可编程特性、零侵入、不破坏原有功能的实现方案是：包级符号遮蔽 + CLOS泛型多分派，所有改动仅在你自己的DSL包内生效，包外的原有运算符行为完全不受影响，包内原有实数运算的逻辑也和标准CL完全一致，仅当参数传入自定义分布类型时才触发扩展逻辑。

具体实现步骤 #

1. 先定义独立的离散分布类型 #

不要直接用裸哈希表代表分布，单独定义类型可以让泛型分派精准命中，不会误把普通哈希表识别为分布：

(defstruct (dist (:constructor %make-dist))
  "离散概率分布类型，内部存储取值到对应概率的映射哈希表"
  table)

(defun d (n)
  "构造n面均匀骰子的离散分布，对应示例里的(d 4)用法"
  (let ((table (make-hash-table :test 'eql)))
    (loop for i from 1 to n
          do (setf (gethash i table) (/ 1 n)))
    (%make-dist :table table)))

2. 搭建DSL专属包，做符号遮蔽 #

创建独立的DSL包，把需要扩展的运算符从CL包做遮蔽导入，后续所有运算符扩展都在这个包内完成，完全不触碰CL包的原始定义：

(defpackage #:prob-dsl
  (:use #:cl)
  ;; 遮蔽导入需要扩展的运算符，包内调用这些符号时不会走CL原始全局定义
  (:shadowing-import-from #:cl < <= = >= > + - * /))

(in-package #:prob-dsl)

3. 将运算符定义为泛型函数，保留原有实数运算逻辑 #

把需要扩展的运算符定义为CLOS泛型函数，首先为实数类型添加方法，完全复刻CL原有运算逻辑，保证常规使用和标准行为完全一致：

;; 批量定义比较运算符泛型，保留原有实数比较逻辑
(macrolet ((define-compare-op (name cl-fn)
             `(progn
                (defgeneric ,name (a b))
                (defmethod ,name ((a real) (b real))
                  (funcall ,cl-fn a b)))))
  (define-compare-op < #'cl:<)
  (define-compare-op <= #'cl:<=)
  (define-compare-op = #'cl:=)
  (define-compare-op >= #'cl:>=)
  (define-compare-op > #'cl:>))

;; 批量定义算术运算符泛型，保留原有实数算术逻辑
(macrolet ((define-arith-op (name cl-fn)
             `(progn
                (defgeneric ,name (a b))
                (defmethod ,name ((a real) (b real))
                  (funcall ,cl-fn a b)))))
  (define-arith-op + #'cl:+)
  (define-arith-op - #'cl:-)
  (define-arith-op * #'cl:*)
  (define-arith-op / #'cl:/))

4. 实现分布运算的通用逻辑 #

独立分布的运算本质是概率卷积：遍历两个运算对象的所有取值组合，对取值做目标运算，组合概率为两个取值概率的乘积，相同运算结果的概率累加。写一个通用工具函数覆盖「分布+实数」「实数+分布」「分布+分布」三种场景：

(defun hash-table->alist (ht)
  (let (res)
    (maphash (lambda (k v) (push (cons k v) res)) ht)
    res))

(defun dist-apply (op a b)
  "对两个运算对象（实数或分布）应用二元运算OP，返回结果分布"
  (let ((res-table (make-hash-table :test 'eql))
        (a-pairs (typecase a
                   (dist (hash-table->alist (dist-table a)))
                   (real (list (cons a 1)))))
        (b-pairs (typecase b
                   (dist (hash-table->alist (dist-table b)))
                   (real (list (cons b 1))))))
    (loop for (va . pa) in a-pairs
          do (loop for (vb . pb) in b-pairs
                   for rv = (funcall op va vb)
                   for rp = (* pa pb)
                   do (incf (gethash rv res-table 0) rp)))
    (%make-dist :table res-table)))

5. 为运算符追加分布类型的处理方法 #

批量给所有运算符添加针对dist类型的方法，比较运算的布尔结果统一转成1（真）、0（假），和预期返回格式对齐：

;; 批量给比较运算符加分布支持
(macrolet ((define-dist-compare (name)
             `(progn
                (defmethod ,name ((a dist) (b real))
                  (dist-apply (lambda (x y) (if (,name x y) 1 0)) a b))
                (defmethod ,name ((a real) (b dist))
                  (dist-apply (lambda (x y) (if (,name x y) 1 0)) a b))
                (defmethod ,name ((a dist) (b dist))
                  (dist-apply (lambda (x y) (if (,name x y) 1 0)) a b)))))
  (define-dist-compare <)
  (define-dist-compare <=)
  (define-dist-compare =)
  (define-dist-compare >=)
  (define-dist-compare >))

;; 批量给算术运算符加分布支持
(macrolet ((define-dist-arith (name)
             `(progn
                (defmethod ,name ((a dist) (b real))
                  (dist-apply #',name a b))
                (defmethod ,name ((a real) (b dist))
                  (dist-apply #',name a b))
                (defmethod ,name ((a dist) (b dist))
                  (dist-apply #',name a b)))))
  (define-dist-arith +)
  (define-dist-arith -)
  (define-dist-arith *)
  (define-dist-arith /))

效果验证 #

在prob-dsl包内执行示例(< (d 4) 3)，返回的dist对象内部哈希表正好是预期结果：取值1对应概率1/2（比较为真）、取值0对应概率1/2（比较为假），和要求的((0 . 1/2) (1 . 1/2))格式完全一致。

同时原有功能完全不受影响：

• 包外调用cl:<、cl:+等运算符，行为和标准CL完全一致
• 包内调用实数运算，比如(< 1 3)仍返回t，(+ 2 5)仍返回7，没有任何行为变化
• 后续要扩展其他自定义类型的运算支持，只要给对应泛型函数添加新方法即可，不需要修改原有代码。

内容的提问来源于stack exchange，提问作者brubsby