SBCL Type Inference problem in a somewhat weird macro

Question

I'm trying to create a shorthand for lambda using underbar (_), 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)))   

Ugly as it is, it works fine compiled in SBCL:

* (load "shlambda.fasl")                                                                                                                                        
                                                                                                                                                                
#'(LAMBDA (&REST _) (+ (NTH 0 _) (NTH 1 _)))                                                                                                                    
(20 440 27090)                                                                                                                                                                                                                                                                                                                

But the SBCL compiler really doesn't like it:

; 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       

I guess type inference can't figure out the types of an &rest in a lambda (which, I admit, I'm amazed that it even accepts an &rest in a lambda!) But you can pretty much never figure out the types in an &rest, so ... ???

Thanks in advance for your guidance.

Answer 1

The following compiles entirely silently for me, in a cold 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)))

And I can't see why it should not. Barmar is right that the &rest in the macro should probably be &body but that's stylistic.

My guess is that you might not be defining expand_s early enough (see my eval-when), but actually I have no idea.

Answer 2

So, based on the above, I've improved the code, in case anyone actually cares. You can use _* to access the whole &rest list, which lets you create a really succinct "zip-like" expr.

(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