我正在尝试使用下划线 (_) 创建 lambda 的简写,per:
(defmacro _ (&rest body)
`(lambda (&rest _) ,@(expand_s body)))
(defun expand_s (s)
(cond ((null s) nil)
((atom s)
(if (eq '_ s) '(nth 0 _)
(let ((s_string (format nil "~a" s)))
(if (char-equal #\_ (aref s_string 0))
`(nth ,(1- (parse-integer (subseq s_string 1))) _)
s))))
(t (cons (expand_s (car s)) (expand_s (cdr s))))))
(print (macroexpand '(_ (+ _1 _2))))
(print (mapcar (_ (+ (* _1 _2) (expt _2 _1))) '(1 2 3) '(10 20 30)))
虽然丑陋,但在 SBCL 中编译却可以正常工作:
* (load "shlambda.fasl")
#'(LAMBDA (&REST _) (+ (NTH 0 _) (NTH 1 _)))
(20 440 27090)
但是 SBCL 编译器真的不喜欢它:
; compiling (PRINT (MAPCAR # ...))
; file: shlambda.lisp
; in:
; PRINT (MAPCAR (_ (+ (* |_1| |_2|) (EXPT |_2| |_1|))) '(1 2 3) '(10 20 30))
; (_ (+ (* |_1| |_2|) (EXPT |_2| |_1|)))
; --> FUNCTION + * NTH SB-C::%REST-REF AND IF
; ==>
; NIL
;
; caught STYLE-WARNING:
; This is not a NUMBER:
; NIL
; See also:
; The SBCL Manual, Node "Handling of Types"
;
; caught STYLE-WARNING:
; This is not a NUMBER:
; NIL
; See also:
; The SBCL Manual, Node "Handling of Types"
; --> FUNCTION + EXPT NTH SB-C::%REST-REF AND IF
; ==>
; NIL
;
; caught STYLE-WARNING:
; This is not a NUMBER:
; NIL
; See also:
; The SBCL Manual, Node "Handling of Types"
;
; caught STYLE-WARNING:
; This is not a NUMBER:
; NIL
; See also:
; The SBCL Manual, Node "Handling of Types"
;
; compilation unit finished
; caught 4 STYLE-WARNING conditions
我猜类型推断无法弄清楚 lambda 中的 &rest 的类型(我承认,我很惊讶它甚至接受 lambda 中的 &rest!)但是你几乎永远无法弄清楚 lambda 中的类型一个&休息,所以...???
提前感谢您的指导。
以下内容在冷的 SBCL 2.2.7 中完全默默地为我编译:
(defmacro _ (&rest body) ;should be &body
`(lambda (&rest _) ,@(expand_s body)))
(eval-when (:load-toplevel :compile-toplevel :execute)
;; needed on voyage
(defun expand_s (s)
(cond ((null s) nil)
((atom s)
(if (eq '_ s) '(nth 0 _)
(let ((s_string (format nil "~a" s)))
(if (char-equal #\_ (aref s_string 0))
`(nth ,(1- (parse-integer (subseq s_string 1))) _)
s))))
(t (cons (expand_s (car s)) (expand_s (cdr s)))))))
(print (macroexpand '(_ (+ _1 _2))))
(print (mapcar (_ (+ (* _1 _2) (expt _2 _1))) '(1 2 3) '(10 20 30)))
我不明白为什么不应该这样做。 Barmar 是对的,宏中的
&rest
可能应该是 &body
,但这是风格上的。
我的猜测是,您可能没有足够早地定义
expand_s
(请参阅我的eval-when
),但实际上我不知道。
因此,基于上述内容,我改进了代码,以防有人真正关心。您可以使用 _* 访问整个 &rest 列表,这可以让您创建一个非常简洁的“类似 zip 的”表达式。
(defmacro _ (&body body) ;should be &body
`(lambda (&rest _) ,@(expand_s body)))
(eval-when (:load-toplevel :compile-toplevel :execute)
;; needed on voyage
(defun expand_s (s)
(cond ((null s) nil)
((atom s)
(if (eq '_* s) '_
(if (eq '_ s) '(nth 0 _)
(let ((s_string (format nil "~a" s)))
(if (char-equal #\_ (aref s_string 0))
`(nth ,(1- (parse-integer (subseq s_string 1))) _)
s)))))
(t (cons (expand_s (car s)) (expand_s (cdr s)))))))
(defun macroexpand* (form)
(cond ((atom form) form)
(t (let ((mx (macroexpand form)))
(if (not (equal form mx)) mx
(cons (macroexpand* (car form))
(macroexpand* (cdr form))))))))
(defmacro xchecker (form expected-result)
`(progn
(let ((mex (ignore-errors (macroexpand* ',form))))
(format t "~%*** Testing: ~s~%Macroexpand: ~s~%"
',form (or mex "***FAILED***"))
(when mex
(let ((result (ignore-errors ,form)))
(format t "Expected: ~s~%Returned: ~s~%~a~%~%"
',expected-result
result
(if (equal ',expected-result result) "+++ Correct +++" "*** FAILED ***")))))))
(xchecker (mapcar (_ (+ (* _1 _2) (expt _2 _1))) '(1 2 3) '(10 20 30)) (20 440 27090))
(xchecker (funcall (_ (* _1 _2)) 3 4) 12)
(xchecker (funcall (_ (reverse _)) '(1 2 3)) (3 2 1))
(xchecker (funcall (_ (car (reverse _))) '(1 2 3)) 3)
(xchecker (funcall (_ (car _)) '(1 2 3)) 1)
(xchecker (funcall (_ (reverse _*)) 1 2 3) (3 2 1))
(xchecker (mapcar (_ _*) '(1 2 3) '(10 20 30)) ((1 10) (2 20) (3 30))) ;; This is like ZIP in some languages