;;;; File: anaphora.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Jul 27, 2008
;;;;       May 25, 2009
;;;;       Nov 24, 2009
;;;;       Dec  4, 2009
;;;;       Jan 21, 2010
;;;;       May 25, 2010
;;;;       Nov 08, 2010
;;;;       Feb 21, 2011
;;;;       Jun 21, 2011
;;;;       Jul 10, 2011
;;;;       Sep 08, 2011


;Inspired by Paul Graham's classic "On Lisp" this module introduces
;anaphoric macros, which are unhygienic by design. Hence they can not
;implemented with syntax-rules! In fact, they introduce new identifiers
;behind the scene, mostly named it, which can be referenced in the body
;without being declared. Please note, that this identifier is not
;renamed! 
;
;We implement all anaphoric macros with ir-macro-transformer.

(module anaphora *

(import scheme (only chicken case-lambda print))

;;; (aif test? consequent [alternative])
;;; ------------------------------------
;;; anaphoric if, where consequent and alternative can refer to result
;;; of test? named it
(define-syntax aif
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((it (inject 'it)))
        (let (
          (test? (cadr form))
          (consequent (caddr form))
          (alternative (cdddr form))
          )
          (if (null? alternative)
            `(let ((,it ,test?))
               (if ,it ,consequent))
            `(let ((,it ,test?))
               (if ,it ,consequent ,(car alternative)))))))))

;;; (awhen test? xpr . xprs)
;;; ------------------------
;;; anaphoric when, where xpr ... can refer to result of test?
;;; named it
(define-syntax awhen
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((it (inject 'it)))
        (let (
          (test? (cadr form))
          (xpr (caddr form))
          (xprs (cdddr form))
          )
          `(let ((,it ,test?))
             (if ,it (begin ,xpr ,@xprs))))))))

;;; (acond . clauses)
;;; -----------------
;;; anaphoric cond, where each clause is a list (test? xpr ...) in which
;;; each xpr can refer to result of test? named it.
;;; The last clause can start with else which evaluates to #t.
(define-syntax acond
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((it (inject 'it)))
        (let ((clauses (cdr form)))
          (let loop ((clauses clauses))
            (if (null? clauses)
              #f
              (let* (
                (clause (car clauses))
                (cnd (car clause))
                )
                `(let ((sym ,(if (compare? cnd 'else) #t cnd)))
                   (if sym
                     (let ((,it sym))
                       ,@(cdr clause))
                     ,(loop (cdr clauses))))))))))))

;;; (awhile test? xpr . xprs)
;;; -------------------------
;;; anaphoric while, where each xpr ... can refer to the result of
;;; the successive test?, named it
(define-syntax awhile
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((it (inject 'it)))
        (let (
          (test? (cadr form))
          (xpr (caddr form))
          (xprs (cdddr form))
          )
          `(let loop ((,it ,test?))
             (when ,it
               ,xpr ,@xprs
               (loop ,test?))))))))

;;; (aand . args)
;;; -------------
;;; anaphoric and, where each successive argument can refer to the
;;; result of the previous argument, named it.
(define-syntax aand
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((it (inject 'it)))
        (let ((args (cdr form)))
          (let loop ((args args))
            (cond 
              ((null? args) #t)
              ((null? (cdr args)) (car args))
              (else 
                `(let ((,it ,(car args)))
                   (if ,it
                     ,(loop (cdr args))))))))))))

;;; (alambda args xpr . xprs)
;;; -------------------------
;;; anaphoric lambda, where the body xpr ... can refer to self, so that
;;; recursion is possible
(define-syntax alambda
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((self (inject 'self)))
        (let ((args (cadr form)) (body (cddr form)))
          `(letrec ((,self (lambda ,args ,@body)))
             ,self))))))

;;; documentation dispatcher

(define anaphora
  (let (
    (alist '(
      (aif
        (aif test? consequent [alternative])
        "anaphoric if, consequent and alternative can refer to result it
of test?")
      (awhen
         (awhen test? xpr . xprs)
         "anaphoric when, where xpr ... can refer to result of test?
named it")
      (acond
        (acond . clauses)
        "anaphoric cond, where each clause is a list (test? xpr ...) in which
each xpr can refer to result of test? named it.
The last clause can start with else which evaluates to #t.")
      (awhile
        (awhile test? xpr . xprs)
        "anaphoric while, where each xpr ... can refer to the result of
the successive test?, named it")
      (aand
        (aand . args)
        "anaporic and, each arg can refer to the previous arg with it")
      (alambda
        (alambda args . body)
        "anaphoric lambda, where body can refer to self")
      )))
    (case-lambda
      (() (map car alist))
      ((sym)
       (let ((pair (assq sym alist)))
         (if pair
           (cdr pair)
           (print "Choose one of " (map car alist))))))))

) ; module anaphora