特性
!let
let改, Elisp let 扩展，支持直接将变量作为函数调用，省略 funcall. 即支持如下的语法：
T:!let
(! deftest (!let)
;; 测试用例摆放在较前位置以说明 !let 用法。
`("let lisp1/lisp2"
(equal
(!let ((list 0)) (list list 1))
'(0 1))
"letf"
(equal
(!let ((+ 'concat)(a "a")(b "b"))
(+ a b "c"))
"abc")))
核心框架实现：
!let
(defalias (fmakunbound '!let)
(! package (!"bindings &rest body"
"!let
ARGS: (BINDINGS BODY)"
(declare((! indent)(!let indent)))
(cond*
((bind* parse post))
((null bindings)
(setq body (macroexp-progn body)
post (eval '(!let post) t))
(if post (funcall post body) body))
((bind* B S vars vals prelude epilogue ap aps))
((listp bindings)
(when (setq parse (!let parse-bindings))
(setq B (apply parse bindings)
ap (cdr (assq t (nth 5 B)))))
(when (setq parse (!let parse-body))
(setq S (funcall parse body)
body (if S (car (last S)) body)
S (if S (nth 0 S))))
(setq post (!let post))
(mapcar
#'(lambda (s)
(let ((d (assq s (nth 1 B)))
(i (assq s (nth 2 B)))
(a (assq s (nth 5 B))))
(push s vars)
(push (if d (nth 1 d)) vals)
(if i (push (cons 'setq i) prelude))
(push (if a `(,@(cdr a) ,s) s) aps)))
(seq-uniq (append (car B) S)))
(setq
vars (nreverse vars) vals (nreverse vals)
prelude (nreverse prelude) epilogue (nth 4 B)
prelude (append prelude (nth 3 B))
body (macroexp-progn `(,@prelude ,@body))
body `(unwind-protect ,body ,@epilogue)
body `(!let using ,ap (,@aps) ,body)
;; 用 #' quote 住 lambda, 以免被 post 处理。
body `(funcall #'(lambda ,vars ,body) ,@vals))
(if post (funcall post body) body))
(t nil)))
:def '!def))
(!let def '(and (listp (car args)) default))
F:!let
<<@([[id:!let]])>>
<<@([[id:T:!let]])>>
using
!let using (!"APPLY VARS &rest BODY")
D:using
将 VARS 中的符号定义为局部宏，并使用 APPLY 调用。
APPLY 是 (unquoted) 符号或列表。如：
(using apply VARS BODY) 等价于
(using (apply) VARS BODY)
APPLY 可 nil, 默认为 (!let apply)
VARS 是 (unquoted) 列表，其元素为 SYM 或 APL, SYM 是
(unquoted) 符号, APL 是 (APPLY SYM). 如：
(a (apply b) (funcall c))
对于任意属于 VARS 的 v, BODY 中的所有关于 v 的函数调
用式 (v ...) 将被展开为 (,@APPLY v ...). 对于任意属
于 VARS 的 (a v), BODY 中的所有关于 v 的函数调用式
(v ...) 将被展开为 (a v ...), 即 APL 中的 APPLY 的
优先级高于 APPLY.
用例：
T:using
(! test defcase (!let)
"(!let using SYM ...)"
'(equal
(let ((a 'vector))
(!let using funcall (a)
(a 0 1 2)))
[0 1 2])
"(!let using LST ...)"
'(equal
(let ((a 'vector))
(!let using (funcall) (a)
(a 0 1 2)))
[0 1 2])
"(!let using _ (SYM APL1) ...)"
'(equal
(let ((a 'vector) (b 'list))
(!let using funcall (a (apply b))
`(,(a 0 1 2) ,(b '(a b c)))))
'([0 1 2] (a b c)))
"(!let using _ (SYM APL2) ...)"
'(equal
(let ((a 'vector) (b 'list))
(!let using funcall (a (apply 'funcall b))
`(,(a 0 1 2) ,(b '(a b c)))))
'([0 1 2] (a b c))))
F:using
(!let def 'using (!"APPLY VARS &rest BODY"
"!let using
<<@([[id:D:using]])>>"
(declare (!export t))
(setq VARS (seq-uniq VARS)
APPLY (or APPLY '(!let apply))
APPLY (if (listp APPLY) APPLY `(,APPLY)))
`(cl-macrolet
,(seq-mapn
#'(lambda (s &optional a)
(if (atom s) (setq a APPLY)
(setq a (take (1- (length s)) s)
s (car (last s))))
`(,s (&rest A) `(,@',a ,',s ,@A)))
VARS)
,@BODY)))
<<@([[id:T:using]])>>
apply1
默认 apply 函数，仅针对值为 function 的变量。
F:apply1
(!let def 'apply1 (!"FM &rest ARGS"
`(funcall
(or (and (functionp (ignore-errors ,FM)) ,FM) ',FM)
,@ARGS)))
(!let def 'apply (!let apply1))
parse-bindings
变量绑定解析框架。默认支持绑定式 SYM, (SYM), (SYM VAL); 支持语法扩展。
F:parse-bindings
(!let def 'parse-bindings (![binding &rest bindings]
(setq bindings `(,binding ,@bindings))
;; 解析 bindings, 并将其分为六个部分：
;; S: 所有符号; Bd: 直接绑定; Bi: 间接绑定;
;; P: prelude, E: epilogue, A: apply.
(let (B S Bd Bi P E A parse)
(setq parse (eval '(!let parse-binding) t))
(mapcar
#'(lambda (b)
(setq B (funcall parse b))
(unless B (error "Invalid binding: %S" b))
(setq
S `(,@S ,@(nth 0 B))
Bd `(,@Bd ,@(nth 1 B))
Bi `(,@Bi ,@(nth 2 B))
P `(,@P ,@(nth 3 B))
E `(,@E ,@(nth 4 B))
A `(,@A ,@(nth 5 B))))
bindings)
`(,S ,Bd ,Bi ,P ,E ,A))))
(!let def 'var? (![v]
(and v (symbolp v) (not (keywordp v)))))
(!let def 'parse-binding ; SYM
( `((,b) ((,b nil))))))
(!let def 'parse-binding ; (SYM VAL) or (SYM)
(let ((parse (!let parse-binding)))
(
(and b (listp b) (length< b 3)
(!let var? (car b))
`((,(car b)) (,b)))))))
parse-body1
默认解析 body 的工具。提供一个收集顶层符号的特性，即：
(!let nil
:collect-symbol !def (!def a 0))
等价于
(!let (a) (!def a 0))
F:parse-body1
(!let def 'parse-body1 (![BODY]
(cond*
((bind* S d s))
((eq :collect-symbol: (car-safe BODY))
(setq
d (cadr BODY) BODY (cddr BODY)
S (mapcar
#'(lambda(f)
(when (eq (car-safe f) d)
(setq s (cadr f))
(if (symbolp s) s)))
BODY)
S (seq-remove 'null S))
`(,S ,BODY)))))
(!let def 'parse-body (!let parse-body1))
rulext
绑定式扩展语法 (:RULE …), 默认支持 (:apply SYM APPLY-FORM).
扩展语法可通过 (defrule :KEYWORD (![…])) 定义，如：
T:rulext
(! test defcase (!let)
"let extend rule"
'(equal
(ignore-errors
(prog2
(!let defrule :test
(lambda (&rest syms)
`(,syms ,(seq-mapn
'list syms '(1 2)))))
(!let ((:test a b))
(+ a b))
(!let defrule :test nil)))
3))
F:rulext
(!let def 'parse-binding ; (:RULE ...)
(let ((parse (!let parse-binding)))
(![b]
(or
(funcall parse b)
(and
(keywordp (car-safe b))
(let* ((rules '(!let binding-rules)) B
(rules (eval rules t))
(rules (cdr (symbol-value rules)))
(rule (plist-get rules (car b)))
S Bd Bi P E)
(unless rule
(error "!let rule undefined: %S" (car b)))
(apply rule (cdr b))))))))
(!let def 'binding-rules '(binding-rules))
(!let def 'defrule ; 扩展绑定语法规则
(![rule func]
(setf (plist-get
(cdr (symbol-value (!let binding-rules)))
rule)
func)))
(!let defrule :apply
(![&rest args]
(cond
;; (:apply (X apply) SYMs...)
((listp (car args))
(setq args (mapcar #'(lambda (v)
`(,v ,@(car args)))
(cdr args))))
;; (:apply SYM X apply)
((setq args `(,args))))
`(nil nil nil nil nil ,args)))
<<@([[id:T:rulext]])>>
apply
全特性 apply. 支持调用 function, macro 变量; function 变量的 setf 及连续调用扩展。
macro 变量相关用例：
T:apply-macro
(! test defcase (!let)
"let macro"
'(and
(equal
(ignore-errors
(!let ((a '!let))
(a ((a 0)) 10)))
10)
(equal
(ignore-errors
(!let ((a '!let)(b 1))
(a ((a 0)) (+ 10 b))))
11)
(equal
(ignore-errors
(!let ((xlet '!let)
(b (lambda (a)
(+ a 10))))
(xlet ((a (let (a)
(lambda (&rest v)
(if v (setf a (car v))
a)))))
(setf (a) (b 1))
(a))))
11))
"let anonymous macro"
'(and
(equal
(!let ((m (!"&rest a"`(f ,@a)))
(f ()))
(m 1 2 3))
[1 2 3])
(equal
(ignore-errors
(!let ((d 2)(L 'list)
(o (!"&rest a" `(L ,@a))))
(o d 'a 0)))
'(2 a 0)))
"let apply"
'(and
(equal
(ignore-errors
(!let ((a (lambda(&rest r)(apply '+ r)))
(b 1)(c 2)(d 3)(e 4)(! 'lambda))
(!let apply
(!let apply ! (&rest x) (apply a b c x))
d e)))
10)))
function 变量相关用例：
T:apply-funext
(! test defcase (!let)
"let with setf"
'(equal
(ignore-errors
(!let ((a (let (a)
(lambda (&rest v)
(if v (setf a (car v))
a)))))
(setf (a) 10) (a)))
10)
"let continue apply"
'(and
(equal
(!let ((a (lambda (a)
(lambda (b) (+ a b)))))
(a 2 3))
5)
(equal
(!let ((a (lambda (a)
(lambda (b) (+ a b)))))
(funcall (funcall (a) 2) 3))
5)
(equal
(!let ((a (lambda (a)
(lambda (b) (+ a b)))))
(funcall (a 2) 3))
5))
"let Y combinator"
'(equal
(ignore-errors
(!let ((Y (lambda (f)
((lambda (g) (f g))
(lambda (g) (f g)))))
(G (lambda (g x)
(if (= x 0) 1
(* x (g g (- x 1)))))))
(Y G 4)))
24))
F:apply
(!let def 'defcase)
(!let def 'apply2
(!"FM &rest ARGS"
"FM 函数或宏. ARGS 是否求值取决于 FM."
(declare (!export t))
(let ((m (make-symbol "f"))
(cases (!let defcase))
(fn? (eval '(!let fn?) t)))
`(let ((,m (condition-case nil ,FM (error nil))))
(or (,fn? ,m) (setq ,m ',FM))
,(eval
`(backquote (cond ,@(symbol-value cases)))
`((FM . ,m) (ARGS . ,ARGS)))))))
(!let def 'apply (!let apply2))
(!let def 'defcase
(![pred &optional progs]
"为 !let apply 的展开结果添加新 cond clause.
PRED: cond clause first form;
PROGS: cond clause rest forms."
(cond
(progs
(setf (alist-get
pred (symbol-value (!let defcase))
nil nil 'equal)
progs))
(t
(setf
progs (symbol-value (!let defcase))
progs (assoc pred progs)
(symbol-value (!let defcase))
(assoc-delete-all
pred (symbol-value (!let defcase))))
(push progs (symbol-value (!let defcase)))))))
(set (!let defcase) nil)
(!let def 'rename
(! package
(!"qsym"
(declare (!export nil))
;; 为防止 !let 中使用的符号在宏展开时被干扰，此包将某些
;; 内置符号别名成 !let 内部符号。
`(!let rename def ,qsym
(symbol-function ,qsym)))))
(!let defcase 't '((funcall ,FM ,@ARGS)))
(!let def 'fn? 'functionp)
F:apply-macro
(!let rename 'macrop)
(!let defcase '(,(!let rename macrop) ,FM)
;; 由于 ! 是 global 符号，这里预先取其实现，以免
;; 被 global 符号干扰。
`((,(! apply macro) ,',FM ,',ARGS)))
(!let def 'fn?
(let ((fn? (!let fn?)))
( (macrop f)))))
<<@([[id:T:apply-macro]])>>
F:apply-funext
;; setf 特性; continue-apply 特性
(!let def 'call
(![fn env &optional arglist &rest args]
(declare
(gv-setter
(lambda (val)
`(apply (!let call)
,fn ,env ,arglist
,@args (list ,val)))))
(cond*
((bind* (args (append arglist args))
(arity (func-arity fn))
(amax (cdr arity)) (amin (car arity))
(areq (- amin (length args)))
(ares nil) (x nil)))
((and (null args) (> amin 0)) fn)
((eq amax 'many) (apply fn args))
;; 输入参数的数量多于 fn 入参
((> (setq ares (- (length args) amax)) 0)
;; 取一部分参数调用 fn, 并视其返回值是否为函数
;; 进一步 apply 剩余参数。
(setf
x (apply fn (take amax args))
ares (seq-subseq args amax)
x (cond
((functionp x)
(apply (eval '(!let call) t)
x env nil ares))
((cons x ares))
;; ((functionp (car ares)))
;; ((list x ...))
))
x)
;; 输入参数的数量足以调用 fn
((ignore (dotimes (_ areq) (push (gensym 'x) x))))
((null x) (apply fn args))
;; 输入参数的数量不足以调用 fn
(t (eval `(lambda ,x (!let apply ,fn ,@args ,@x))
env)))))
(!let rename 'list)
(!let defcase 't
'((,(!let call) ,FM t (,(!let rename list) ,@ARGS))))
<<@([[id:T:apply-funext]])>>
list-unpack
解绑 list 变量。
用例：
T:list-unpack
(! test defcase (!let)
"let (l0 l1 l2 ... LIST)"
'(ignore-errors
(and
(equal
(!let ((a b c d '(1 2 3 4)))
(+ a b c d))
10)
(equal
(let ((a '(1 2 3 4)))
(!let ((a b c d a))
(+ a b c d)))
10)
(equal
(!let ((a (lambda nil '(1 2 3 4))))
(!let ((a b c d (a)))
(+ a b c d)))
10))))
F:list-unpack
(!let def 'parse-binding ; (SYM1 SYM2 ... LIST)
(let ((parse (!let parse-binding)))
(![b]
(or
(funcall parse b)
(and
b (listp b) (all (!let var?) (butlast b))
(let ((s (gensym "s")) (V (butlast b))
(L (car (last b))) B)
`((,s ,@V)
((,s ,L)
,@(mapcar #'(lambda(v)`(,v nil)) V))
,(seq-map-indexed
#'(lambda(v i)`(,v (seq-elt ,s ,i)))
V))))))))
<<@([[id:T:list-unpack]])>>
exrules
常用扩展语法。
F:exrules
(!let defrule :alist
(![&rest args]
(let ((syms (butlast args))
(val (car (last args)))
(var (gensym "x")))
`((,var ,@syms)
((,var ,val)
,@(mapcar (lambda (s) `(,s nil)) syms))
,(mapcar
(lambda (s) `(,s (alist-get ',s ,var)))
syms)))))
(!let defrule :plist
(![&rest args]
(let ((syms (butlast args))
(val (car (last args)))
(var (gensym "x")))
`((,var ,@syms)
((,var ,val)
,@(mapcar (lambda (s) `(,s nil)) syms))
,(mapcar
(lambda (s)
`(,s (plist-get
,var ,(intern (format ":%s" s)))))
syms)))))
(!let defrule :dyn
(![&rest args]
(let ((sym (car args)) (val (cadr args))
(oldval (gensym "s")))
`((,oldval) ((,oldval ,sym)) nil
((setf ,sym ,val))
((setf ,sym ,oldval))))))
(!let defrule :symbolize
(![&rest args]
(let ((syms args)
(val (car (last args))))
`(,syms
,(mapcar
(lambda (s)
`(,s (make-symbol (symbol-name ',s))))
syms)))))
macros
T:macros
(! test defcase (!)
"! lambda 无参"
'(equal (![]a) (!let()(lambda()a)))
"! lambda 有参"
'(equal (![a]a) (!let()(lambda(a)a)))
"! lambda 多表达式体"
'(equal
(![a b]
"doc"(interactive)(declare(indent 1))
(setq a (1+ b))(+ a b))
(!let()
(lambda(a b)
"doc"(interactive)(declare(indent 1))
(setq a (1+ b))(+ a b))))
"! lambda 变量及函数捕获"
'(equal
(ignore-errors
(!let ((a 2)(b (lambda (a) (+ 5 a))))
(funcall (! [x] (+ (b a) x)) 1)))
8))
(! test all)
F:macros
;; 将 !let 中所有 lambda 的入参都套上宏以函数化
(!let def 'macros nil) ; !let 中的宏
(!let def 'defmacro
(![name expander]
(setf (alist-get name (symbol-value (!let macros)))
expander)))
(!let def 'post
(![body]
(let* ((lambda-expander
(eval '(!let lambda-expander) t))
(env macroexpand-all-environment)
;; 加入 !let 的 macros, unless 防止重复。
(env (unless (eq (alist-get 'lambda env)
lambda-expander)
(symbol-value (!let macros))))
(env (append
;; 这放前头，以便局部 macro 优先。
macroexpand-all-environment env)))
(macroexpand-all body env))))
(!let def 'lambda-expander
(![&optional args &rest body]
(let* ((body (macroexp-parse-body body))
(decl (car body)) (body (cdr body))
;; 用 !let 封 lambda 入参，以便能以 lisp1 的
;; 形式调用入参函数，同时参与 lexical 环境维护。
(V nil)
(_ (dolist (v args)
(unless (memq v '(&rest &optional))
(push (list v v) V))))
(body `(!let ,(nreverse V) ,@body))
(body `(,args ,@decl ,body))
(lambda (cons 'lambda body))
(lambda (list 'function lambda)))
lambda)))
(!let defmacro 'lambda ; !let 中 lambda 入参将函数化
(!let lambda-expander))
(! def 'lambda ; 基于 !let 扩展的 lambda
(!"args &rest body"
"匿名函数，可简写为 ([ARGS] BODY)."
(declare (!export t))
`(!let()(lambda ,args ,@body))))
<<@([[id:T:macros]])>>
DOC
DOC
(!let def 'indent
(![p s]
(save-excursion
(goto-char (nth 1 s))
(cond*
((bind* (a0 (nth 1 (sexp-at-point)))))
((and (listp a0) (= (current-column) 0)) 0)
((+ (current-column) 1))))))
(!def '!let '!let)
(! defdoc '!let
"用例见: " (! button (! test (!let))) "."
"\n\n"
"符号: " (! button
(seq-filter ()
(! export all '!let))))
!let*
F:!let-star
(defmacro !let* (bindings &rest body)
(declare
(indent
(lambda (p s)
(save-excursion
(goto-char (car (last (nth 9 s))))
(1+ (current-column))))))
(if (null bindings) `(progn ,@body)
(setq bindings (reverse bindings))
(while bindings
(setq body (list `(!let (,(pop bindings))
,@body))))
(car body)))
版本
x.1
.1, 无依赖，原始引用，一个可 buffer 执行的的自举用版本。
;;; !let -*- lexical-binding: t; -*-
<<2026-02-12-20-11>>
<<2026-02-12-19-57>>
<<2026-02-12-19-48>>
<<2026-02-12-20-00>>
<<2026-02-12-19-52>>
1.n
;;; !let -*- lexical-binding: t; -*-
<<@([[id:F:!let]])>>
<<@([[id:F:using]])>>
<<@([[id:F:apply1]])>>
<<@([[id:F:parse-bindings]])>>
<<@([[id:F:parse-body1]])>>
;;;; !let apply
<<@([[id:F:apply]])>>
;;;; !let macro
<<@([[id:F:apply-macro]])>>
;;;; !let function extend
<<@([[id:F:apply-funext]])>>
;;;; !let macros
<<@([[id:F:macros]])>>
;;;; !let bindings extend
<<@([[id:F:rulext]])>>
<<@([[id:F:exrules]])>>
<<@([[id:F:list-unpack]])>>
;;;; !let 符号属性
<<@([[id:DOC]])>>
(! test all (!let))
<<@([[id:F:!let-star]])>>
