Welcome to the CHICKEN Scheme pasting service

(use srfi-1)
(define-syntax define-ir-syntax
  (ir-macro-transformer
   (lambda (e i c)
     (let* [(l (second e))
	    (name (first l))
	    (ee (second l))
	    (ii (third l))
	    (cc (fourth l))
	    (arglist (drop l 4))
	    (body (drop e 2))]
       `(define-syntax ,name
	  (ir-macro-transformer
	   (lambda (,ee ,ii ,cc)
	     (apply (lambda ,arglist
		      ,@body)
		    (drop ,ee 1)))))))))


;; (pp (expand '(define-syntax foo
;; 	       (ir-macro-transformer
;; 		(lambda (e i c)
;; 		  (let [(arg (second e))]
;; 		   `(print ,arg)))))))

;; (pp (expand '(define-ir-syntax (foo e i c arg)
;; 	       `(print ,arg))))

(define-ir-syntax (while e i c pred #!rest body)
  `(call/cc (lambda (,(i 'return))
	      (let loop ()
		(when ,pred
		  ,@body (loop))))))

(define x 5)
(while (positive? x)
       (display x)
       (set! x (- x 1))
       (if (= x 2) (return #t)))