Com S 342 meeting -*- Outline -*-

* Aspect-Oriented Programming in the defined language

   The goal is to describe the key semantic idea of around advice and proceed.

   We'll focus on get at first.

** Desugaring before and after into around

------------------------------------------
        BEFORE AND AFTER ARE SUGARS

before get X do E
    ==> around get X do E; proceed

after get X do E
    ==> around get X do let r = proceed
                        in begin E; r end
           (where r is not free in E)
------------------------------------------

        The key idea is therefore to understand those around advice,
        which replaces an expression, and proceed.

** syntax

   Because we don't have close association between procedure names and
   procedures, we're going to focus on just get and set advice

------------------------------------------
         CONCRETE SYNTAX

<program> ::=
     {<advice>}*   "a-program (advice-defs
     run <expression>          exp)"           

<advice> ::= 
     around <pcd>      "around-adv (pcd
     do <expression>                body)"

<pcd> ::=
       get <idpattern>  "get-pcd (id-pat)"

<idpattern> ::=
       <identifier>     "id-pat (id)"
     | *                "wild-pat ()"

<expression> ::= ...
     | proceed          "proceed-exp ()"

------------------------------------------

       This is a vast simplification from AspectJ, as we only have one
       kind of advice, and very simple patterns.
       We're also omitting such features as context exposure in AspectJ.

** examples
*** get advice
------------------------------------------
        EXAMPLES OF GET ADVICE

around get x do 0
run let x = 3 in x

around get y do add1(proceed)
run let y = 10 in +(y, y)

around get z do add1(proceed)
run let y = 10 in +(y, y)

around get y do begin
                  set y = add1(proceed);
                  proceed
                end
run let y = 10 in +(y, y)

around get * do add1(proceed)
run let y = 10
        z = 5
   in +(y, z)
------------------------------------------
              ... ==> 0
              ... ==> 22
              ... ==> 20
              ... ==> 23
              ... ==> 17

** informal semantics, examples
------------------------------------------
       INFORMAL SEMANTICS

Assuming: one piece of advice, and
         the idpattern doesn't occur
         in the advice

  around get X do A run E[[X]]
==> 
  E[[let proceed$c = proc() X in A]]

  proceed
==>
  (proceed$c)

Example (1):

  around get y do add1(proceed)
  run let y = 10
      in +(y, y)
==>
  let y = 10
  in +(let proceed$c = proc() y
       in add1((proceed$c)),
       let proceed$c = proc() y
       in add1((proceed$c)))

Example (2):

  around get y do begin
                    set y = add1(proceed);
                    proceed
                  end
  run let y = 10
  in +(y, y)
==>
  let y = 10
  in +(let proceed$c = proc() y
       in begin 
           set y = add1((proceed$c));
               (proceed$c)
           end,
       let proceed$c = proc() y
       in begin 
           set y = add1((proceed$c));
               (proceed$c)
           end)
------------------------------------------

    So around:
      - replaces expressions matched by the pointcut description
        with the expression, and
      - remembers other advice and the
        original expression in a binding for "proceed$c"

** implementation

*** abstract syntax

    part of it... we omit details for advising set expressions

------------------------------------------
          ABSTRACT SYNTAX

(define-datatype program program?
  (a-program
   (advice-defs (list-of advice?))
   (exp expression?)))

(define-datatype advice advice?
  (around-adv (pcd pcd?)
	      (body expression?)))

(define-datatype pcd pcd?
  (get-pcd (id-pat idpattern?)))

(define-datatype idpattern idpattern?
  (id-pat (id symbol?))
  (wild-pat))

(define-datatype expression expression?
  ;...
  ;; visible to programmers
  (proceed-exp)
  ;; Not visible to programmers
  (unadvisable-var-exp (id symbol?))
  (continue-weave-get-exp
   (remaining-advice
                  (list-of expression?))
   (base-exp expression?)) )
------------------------------------------

*** The interpreter

**** Program and Advice table

     Need a global variable to contain the advice, because in our
     syntax advice is defined before the entire program.

     An alternative would be to bind advice in the global environment,
     but really want other operations on this, such as matching...
     so it doesn't fit well with the environment abstraction.

***** eval-program
------------------------------------------
       THE INTERPRETER'S CHANGES

;; Added to track advice
(deftype *advice-table* advice-table)
(define *advice-table*
   (empty-advice-table))

(deftype eval-program
   (-> (program) Expressed-Value))
(define eval-program 
  (lambda (pgm)
    (set! *advice-table*
          (empty-advice-table))
    (cases program pgm
      (a-program (advice-defs body)
	(begin
	  (for-each (lambda (adv)
                      (add-advice!
                        *advice-table*
                           adv))
		    advice-defs)
	  (eval-expression body
                          (init-env)))))))
------------------------------------------

        Q:  Why do we have to reset the table when eval-program is called?
            To prevent interference between runs

***** advice table datatype
------------------------------------------
         ADVICE TABLE DATATYPE

(deftype empty-advice-table
   (-> () advice-table))
(deftype add-advice!
   (-> (advice-table advice) void))
(deftype around-advice-for-get
   (-> (advice-table symbol)
       (list-of expression)))
;; ...
------------------------------------------

        Q:  What would be a good implementation of the advice table?
            Hashing might be good.  See $PUB/lib342/aop-3-7.scm

**** eval-expression

------------------------------------------
      CHANGES TO EVAL-EXPRESSION

(deftype eval-expression
   (-> (expression environment)
       Expressed-Value))
(define eval-expression 
  (lambda (exp env)
    (cases expression exp
      ; ...
      (var-exp (id)
	(let ((applicable-around-advice
	       (around-advice-for-get
                *advice-table* id)))
	  (dynamically-weave-around-get
           applicable-around-advice
           (unadvisable-var-exp id)
     	   env)))
      (unadvisable-var-exp (id)
	(apply-env env id))
      (proceed-exp ()
	(if (defined-in-env? env 'proceed)
	    (let ((proceed-closure
		   (expressed->procval
                     (apply-env
                       env
                       'proceed))))
	      (apply-procval
                proceed-closure '()))
	    (eopl:error
              'eval-expression
	      (string-append
                "proceed may only be used"
                " from within around"
                " advice"))))
      (continue-weave-get-exp
              (remaining-advice base-exp)
        (dynamically-weave-around-get
          remaining-advice base-exp env))
      )))
------------------------------------------

        Q:  What happens if you use a varref-exp instead of a
        unadvisable-varref-exp?
            You get an infinite loop.

        Q: So what happens to
              advise get x do 0 run let x = 3 in x ?

        To understand proceed, we have to understand
        dynamically-weave-around-get...

------------------------------------------

(deftype dynamically-weave-around-get
  (-> ((list-of expression) expression
        environment)
       Expressed-Value))
(define dynamically-weave-around-get
  (lambda (advice-exps base-exp env)
    (if (null? advice-exps)
	(eval-expression base-exp env)
	(eval-expression
	 (car advice-exps)
	 (extend-env
	  '(proceed)
	  (list (procval->expressed
		 (closure 
                   '()
	           (continue-weave-get-exp
		     (cdr advice-exps)
		     base-exp)
	             env)))
	  env)))))
------------------------------------------

** discussion

   Q:  What kind of scoping is given to the patterns?
       It's essentially dynamic!
   Q:  Does that allow static type checking?
       No, but in AspectJ the patterns involve the types...
        (through the context exposure mechanism)

   Q:  How would we add more patterns?

   Q:  What happens if there is more than one piece of advice?

** handling set advice

*** concrete syntax
------------------------------------------
       CONCRETE SYNTAX FOR SET ADVICE

<pcd> ::=
     | set <idpattern>  "set-pcd (id-pat)"

<expression> ::= ...
     | LHS              "varassign-LHS-exp
        = <expression>      (rhs-exp)"
     | RHS              "RHS-exp ()"
------------------------------------------

*** abstract syntax

------------------------------------------

(define-datatype pcd pcd?
  (get-pcd (id-pat idpattern?))
  (set-pcd (id-pat idpattern?)))

(define-datatype expression expression?
  ;...
  ;; visible to programmers
  (varassign-LHS-exp
   (rhs-exp expression?))
  (RHS-exp)
  ;; not visible to programmers
  (unadvisable-varassign-exp
   (id symbol?)
   (rhs-exp expression?))
  (continue-weave-set-exp
   (remaining-advice (list-of expression?))
   (base-exp expression?)
   (id symbol?)
   (rhs-exp expression?))
------------------------------------------

        Q:  Why are the unadvisable-varassign-exp's needed?

*** implementation of eval-expression
------------------------------------------
(define eval-expression 
  (lambda (exp env)
    (cases expression exp
      ; ...
      (continue-weave-set-exp (remaining-advice base-exp id rhs-exp)
        (dynamically-weave-around-set
          remaining-advice base-exp id rhs-exp env))
      (varassign-exp (id rhs-exp)
	(let ((applicable-around-advice
	       (around-advice-for-set *advice-table* id)))
	  (dynamically-weave-around-set
	   applicable-around-advice
	   (unadvisable-varassign-exp id rhs-exp)
	   id rhs-exp env)))
      (unadvisable-varassign-exp (id rhs-exp)
        (begin
          (setref! 
            (apply-env-ref env id)
            (eval-expression rhs-exp env))
          (number->expressed 1)))
      (varassign-LHS-exp (rhs-exp)
	(if (defined-in-env? env 'LHS)
	    (let ((action-closure (apply-env env 'LHS))
		  (rhs-val (eval-expression rhs-exp env)))
	      (apply-procval (expressed->procval action-closure)
			     (list rhs-val)))
	    (eopl:error
	     'eval-expression
	     "LHS = <expression> can only be used in advice on set")))
      (RHS-exp ()
	(if (defined-in-env? env 'RHS)
	    (apply-procval (expressed->procval (apply-env env 'RHS)) '())
	    (eopl:error
	     'eval-expression
	     "RHS can only be used in advice on set")))
      )))
------------------------------------------

------------------------------------------
(deftype dynamically-weave-around-set
  (-> ((list-of expression) expression symbol expression environment)
      Expressed-Value))
(define dynamically-weave-around-set
  (lambda (advice-exps base-exp id rhs-exp env)
    (if (null? advice-exps)
	(eval-expression base-exp env)
	(eval-expression
	 (car advice-exps)
	 (extend-env
	  '(proceed LHS RHS)
	  (list
	   ;; Binding for proceed below.  When set advice proceeds,
	   ;; the interpreter find the closure bound to proceed, and
	   ;; runs it, which runs the next advice or the base expression.
	   (procval->expressed
		 (closure '()
			  (continue-weave-set-exp
			   (cdr advice-exps) base-exp
			   id rhs-exp)
			  env))
	   ;; Binding for LHS below.  When an expression of the form
	   ;;    set LHS = <expression>
	   ;; is encountered, we find the closure below, and call it,
	   ;; passing it the value of the given <expression>.
	   ;; The closure below will assign that value to the saved LHS name.
	   (procval->expressed
	    (closure (list '$rhs)
		     (unadvisable-varassign-exp id (unadvisable-var-exp '$rhs))
		     env))
	   ;; Binding for RHS below.  When an expression of the form
	   ;;    RHS
	   ;; is encountered, we find the closure below, and call it
	   ;; to obtain the value of the saved rhs-exp.
	   (procval->expressed
	    (closure '()
		     rhs-exp
		     env)))
	  env)))))

------------------------------------------