Ticket #1362: foo.scm

(use srfi-1)
(begin-for-syntax (import extras))

(define-syntax bind-pair
  (ir-macro-transformer
   (lambda (e i c)
     (let* ((b (second e))
            (exp (third e))
            (body (drop e 3)))
       `(let* ((x ,exp)
               (,(first b) (car x))
               (,(second b) (cdr x)))
          ,@body)))))

(define-syntax foo
  (ir-macro-transformer
   (lambda (e i c)
     `(bind-pair (x y) (cons 'foo-car 'b) (print y)))))

(bind-pair (x y) (cons 1 2)
           (print y))

(pp (expand '(foo)))

(foo)

;; $ csi -qbn foo.scm
;; 2
;; (##core#let
;;   ((x40 (cons42 (quote43 foo-car44) (quote43 b45))))
;;   (##core#let
;;     ((x40 (car48 x40)))
;;     (##core#let ((y41 (cdr49 x40))) (##core#let () (print46 y41)))))
;; 
;; Error: (cdr) bad argument type: foo-car
;; 
;;      Call history:
;; 
;;      <syntax>          (##core#begin (##core#let ((y53 (cdr61 x52))) (##core#let () (print58 y53))))
;;      <syntax>          (##core#let ((y53 (cdr61 x52))) (##core#let () (print58 y53)))
;;      <syntax>          (##core#begin (##core#let () (print58 y53)))
;;      <syntax>          (##core#let () (print58 y53))
;;      <syntax>          (##core#begin (print58 y53))
;;      <syntax>          (print58 y53)
;;      <syntax>          (cdr61 x52)
;;      <syntax>          (car60 x52)
;;      <syntax>          (cons54 (quote55 foo-car56) (quote55 b57))
;;      <syntax>          (quote55 foo-car56)
;;      <syntax>          (##core#quote foo-car56)
;;      <syntax>          (quote55 b57)
;;      <syntax>          (##core#quote b57)
;;      <eval>    (cons54 (quote55 foo-car56) (quote55 b57))
;;      <eval>    (car60 x52)
;;      <eval>    (cdr61 x52)   <--