;;;; 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


;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. To
;facilitate destructuring we could use match from the matchable package
;or one of the bindings macros from the bindings package. But that's too
;much noise, so we use a flat variant of bind which we must define in a
;helper module, so that we can use import-for-syntax. To facilitate
;destructuring we could use match from the matchable package or one of
;the bindings macros from the bindings package. But that's too much
;noise, so we use a flat variant of bind which we must define in a
;helper module, so that we can import it for syntax. Remember, that
;destructuring must happen within the macro-transformer, hence at
;compile time.

(module anaphora-helper *
  (import scheme)
;;; flat list variant of bind
;;; (bind llst xpr . body)
;;; ->
;;; (apply (lambda llst . body) xpr)
(define-syntax bind
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let (
        (lst (cadr form))
        (xpr (caddr form))
        (body (cdddr form))
        )
        `(apply (lambda ,lst ,@body) ,xpr)))))
) ; anaphora-helper

(module anaphora *

(import scheme)
(import-for-syntax anaphora-helper)

;;; (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)))
        (bind (_ test? consequent . alternative) 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)))
        (bind (_ test? xpr . xprs) 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)))
        (bind (_ . clauses) 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)))
        (bind (_ test? xpr . xprs) 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)))
        (bind (_ . args) 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)))
        (bind (_ args . body) form
          `(letrec ((,self (lambda ,args ,@body)))
             ,self))))))

) ; module anaphora