;; TODO put in module system
;; gauche.aspect (basic aspect functionality)
;; gauche.aspect.logger (useful sample usages)

;; just return a new function from aspect-wrap and assign it at
;; toplevel
;; OLD without dynamic-wind, passes result to post-closure
;; (define (aspect-wrap fn pre post)
;;   (let1 fn-closure (symbol-value fn)
;;     (lambda args
;;       (apply pre fn args)
;;       (let1 result (apply fn-closure args)
;;         ;; FIXME result and args are reversed: otherwise we pass an
;;         ;; improper list?
;;         (apply post fn result args)
;;         result))))
;; ----
;; doesn't need symbol-value: works fine but can't print the function
;; name...
;; (define (aspect-wrap/no-eval fn pre post)
;;   (lambda args
;;     (apply pre fn args)
;;     (let ((result (apply fn args)))
;;       (apply post fn result args)
;;       result)))
;; usage:
;; (define fibonacci (aspect-wrap fibonacci logger-enter logger-leave))
;; ----
;; (define (symbol-value . args)
;;   (let-optionals* args (name (module (current-module)))
;;       (eval name module)))
;;
;; (define (aspect-wrap/sym fn pre post)
;;   (let ((fn-closure (symbol-value fn)))
;;     (lambda args
;;       (dynamic-wind
;;           (lambda ()
;;             (apply pre fn args))
;;           (lambda ()
;;             (apply fn-closure args))
;;           (lambda ()
;;             (apply post fn args))))))

;; using aux function
;; (define (aspect-wrap-aux fn fn-name pre post)
;;   (lambda args
;;     (dynamic-wind
;;         (lambda ()
;;           (apply pre fn-name args))
;;         (lambda ()
;;           (apply fn args))
;;         (lambda ()
;;           (apply post fn-name args)))))
;;
;; (define-macro (aspect-wrap fn pre post)
;;   `(define ,fn (aspect-wrap-aux ,fn ',fn ,pre ,post)))

;; (define-macro (aspect-wrap fn pre post)
;;   `(define ,fn
;;      (let ((orig ,fn))
;;        (lambda args
;;          (dynamic-wind
;;              (lambda ()
;;                (apply ,pre ',fn args))
;;              (lambda ()
;;                (apply orig args))
;;              (lambda ()
;;                (apply ,post ',fn args)))))))

(define-syntax aspect-wrap
  (syntax-rules ()
    ((_ fn pre post)
     (define fn
       (let ((original-fn fn))
         (lambda args
           (dynamic-wind
               (lambda ()
                 (apply pre 'fn args))
               (lambda ()
                 (apply original-fn args))
               (lambda ()
                 (apply post 'fn args)))))))))

;; -----------------------------------------------------------------
;; define aspects, e.g. a logger
(define logger-indent 0)
(define (logger-indent-string)
  (with-output-to-string
    (lambda ()
      (dotimes (i logger-indent)
        (display "| ")))))

(define (logger-enter fn . args)
  (format #t "~a(~s ~s) ->\n" (logger-indent-string) fn args)
  (inc! logger-indent))

(define (logger-leave fn . args)
  (dec! logger-indent)
  (format #t "~a(~s ~s) <-\n" (logger-indent-string) fn args))

;; -----------------------------------------------------------------
;; tests
;; no args
(define (f)
  (print 'f))
(aspect-wrap f logger-enter logger-leave)
(f)

;; 1 arg
(define (fibonacci n)
  (cond
   ((< n 3) 1)
   (else (+ (fibonacci (- n 1))
            (fibonacci (- n 2))))))
(aspect-wrap fibonacci logger-enter logger-leave)
(fibonacci 5)

(define (lucas n)
  (cond
   ((<= n 1) 1)
   ((= n 2) 3)
   (else (+ (lucas (- n 1))
            (lucas (- n 2))))))
(aspect-wrap lucas logger-enter logger-leave)
(lucas 5)

;; >1 args
(define (ackermann m n)
  (cond ((= m 0) (+ n 1))
        ((= n 0) (ackermann (- m 1) 1))
        (else (ackermann (- m 1) (ackermann m (- n 1))))))

(aspect-wrap ackermann logger-enter logger-leave)
(ackermann 2 1)