;======================================================================================================
;tests for AspectScheme v.2
;Copyright (c) 2005, Christopher Dutchyn; all rights reserved.

(require aspect-scheme-2)

(define (open-file f)
  (print (list "open file" f))
  (newline))

(define (trace-adv s)
  (lambda (proceed)
    (lambda (c)
      (lambda (a)
        (print (list "advised" s c a))(newline)
        (app/prim proceed a)))))

(define (mmap f l)
  (if (null? l)
      '()
      (cons (f (car l)) (mmap f (cdr l)))))

(define trace-pc
  (&& (call open-file)
      args))

(around trace-pc (trace-adv 0)
  (open-file "boston"))

(around trace-pc (trace-adv "1a")
  (map open-file '("boston" "providence")))

(around trace-pc (trace-adv "1b")
  (mmap open-file '("boston" "providence")))

(map (around trace-pc (trace-adv 2)
       (lambda (f) (open-file f)))
     '("boston" "providence"))

(fluid-around trace-pc (trace-adv 3)
  (map open-file '("boston" "providence")))

(map (fluid-around trace-pc (trace-adv 4)
       (lambda (f) (open-file f)))
     '("boston" "providence"))

(around trace-pc (trace-adv "6a")
  (around trace-pc (trace-adv "5a")
    (open-file '"boston")))

(around trace-pc (trace-adv "6b")
  (around trace-pc (trace-adv "5b")
    (map open-file '("boston" "providence"))))

(around trace-pc (trace-adv "6c")
  (around trace-pc (trace-adv "5c")
    (mmap open-file '("boston" "providence"))))

(fluid-around trace-pc (trace-adv "12")
  (fluid-around trace-pc (trace-adv "11")
    (mmap open-file '("boston" "providence"))))

(around trace-pc (trace-adv 8)
  (fluid-around trace-pc (trace-adv 7)
    (open-file "boston")))

((fluid-around trace-pc (trace-adv 9)
 (around trace-pc (trace-adv 10)
   (lambda (f) (open-file f))))
 "boston")

(fluid-around trace-pc (trace-adv "12")
  (fluid-around trace-pc (trace-adv "11")
    (map open-file '("boston" "providence"))))

(fluid-around trace-pc (trace-adv "14")
  (fluid-around trace-pc (trace-adv "13")
    (mmap open-file '("boston" "providence"))))


(newline)

(define (fact n k)
  (if (= 0 n)
      k
      (fact (- n 1) (* k n))))

(print "Fact 1") (newline)
(around (&& args (call fact))
        (lambda (proceed)
          (lambda (ncall kcall)
            (lambda (nactual kactual)
              (print (list ncall kcall nactual kactual)) (newline)
              (proceed nactual kactual))))
  (fact 4 1))

(print "Fact 2") (newline)
(fluid-around (call fact) (lambda (proceed)
                            (lambda ()
                              (lambda (n k)
                                (print (list n k)) (newline)
                                (app/prim proceed n k))))
  (fact 4 1))

(define (foo) (fact 4 1))

(print "Fact 2a") (newline)
(fluid-around (call fact) (lambda (proceed)
                            (lambda ()
                              (lambda (n k)
                                (print (list n k)) (newline)
                                (app/prim proceed n k))))
  (foo))

(print "Fact 3") (newline)
(fluid-around (|| (call fact)
                  (call read-line))
              (lambda (proceed)
                (lambda ()
                  (lambda (n k)
                    (print (list n k)) (newline)
                    (app/prim proceed n k))))
  (foo))

(define marks #f)

(print "Fact 4") (newline)
(fluid-around (|| (call read-line)
                  (call fact))
              (lambda (proceed)
                (lambda ()
                  (lambda (n k)
                    (print (list n k)) (newline)
                    (set! marks (current-continuation-marks))
                    (app/prim proceed n k))))
  (foo))

(print "Fact 5") (newline)
(fluid-around (&& (call fact)
                  (call foo))
              (lambda (proceed)
                (lambda ()
                  (lambda (n k)
                    (print (list n k)) (newline)
                    (app/prim proceed n k))))
  (foo))

(print "Fact 6") (newline)
(fluid-around (|| (call fact)
                  (call foo))
              (lambda (proceed)
                (lambda ()
                  (lambda args
                    (print args) (newline)
                    (apply proceed args))))
  (foo))

(print "Fact 6a") (newline)
(fluid-around (&& (call fact)
                  (cflowbelow (exec foo)))
              (lambda (proceed)
                (lambda ()
                  (lambda args
                    (print args) (newline)
                    (apply proceed args))))
  (foo))

(print "Fact 7") (newline)
(fluid-around (&& (&& (call fact) args)
                  (&& (exec fact) args))
              (lambda (proceed)
                (lambda (nc kc nx kx)
                  (lambda (n k)
                    (print (list nc kc nx kx n k)) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))

(print "Fact 8") (newline)
(fluid-around (&& (&& (call fact) args)
                  (below (&& (exec fact) args)))
              (lambda (proceed)
                (lambda (nc kc nx kx)
                  (lambda (n k)
                    (print (list nc kc nx kx n k)) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))

(print "Fact 9a") (newline)
(fluid-around (&& (&& (call fact) args)
                  (cflowbelow (&& (&& (exec fact) args)
                                  (cflowbelow (&& (exec fact) args)))))
              (lambda (proceed)
                (lambda (nc kc nx1 kx1 nx2 kx2)
                  (lambda (n k)
                    (print (list nc kc nx1 kx1 nx2 kx2 n k)) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))

(print "Fact 9b") (newline)
(fluid-around (&& (&& (call fact) args)
                  (below (&& (&& (exec fact) args)
                             (below (&& (exec fact) args)))))
              (lambda (proceed)
                (lambda (nc kc nx1 kx1 nx2 kx2)
                  (lambda (n k)
                    (print (list nc kc nx1 kx1 nx2 kx2 n k)) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))

(print "Fact 9c1") (newline)
(fluid-around (&& (&& (call fact) args)
                  (cflowtop (&& (exec fact) args)))
              (lambda (proceed)
                (lambda (n k nt kt)
                  (lambda (n k)
                    (print (list n k nt kt)) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))

(print "Fact 9c2") (newline)
(fluid-around (letrec ([flowall (lambda (pc)
                                  (lambda (jp- jp jp+)
                                    ((|| (top pc)
                                         (&& pc
                                             (cflowbelow (flowall pc)))
                                         (below (flowall pc))) jp- jp jp+)))])
                (&& (&& (call fact) args)
                    (flowall (&& (exec fact) args))))
              (lambda (proceed)
                (lambda ctxt
                  (lambda (n k)
                    (print ctxt) (newline)
                    (app/prim proceed n k))))
  (fact 4 1))


(print "Fact 10") (newline)
(fluid-around (&& (call fact)
                  (cflowbelow (&& (exec fact)
                                  (! (cflowbelow (exec fact))))))
              (lambda (proceed)
                (lambda ()
                  (lambda (nc kc)
                    (print (list nc kc)) (newline)
                    (app/prim proceed nc kc))))
  (fact 4 1))