Advanced Methods in Programming Languages (201-2-4411-01)
Notes Week 11 - Michael Elhadad
previous class main page next class

Information gathered by the type checker on the OO language, can be used to optimize programs. Three optimizations are considered here:

  1. Method lookups are replaced by direct access to a method slot (similar to the vtable mechanism in C++)
  2. Calls to instanceof whose result is predictable are replaced by boolean literals
  3. Casts that are guaranteed to succeed are eliminated.
Method lookups can be replaced because if we know the type of an object, we can predict where each method can be found in the object's method vector. This is the reason why we maintained methods in ordered position when merging them in the OO interpreter. To represent the result of the optimization, we introduce a new expression in the optimized language:
<exp> ::= apply-method-indexed <exp> <num> ({<exp>}*)
This construct is a sort of "byte-code" that should only be introduced by the optimizing transformation and not in source code.

Source to Source Transformation

(define translation-of-program
  (lambda (pgm)
    (let ((pgm-type (type-of-program pgm)))
      (cases program pgm
        (a-program (c-decls exp)
          (a-program (translation-of-class-decls c-decls)
                     (translation-of-expression exp (empty-tenv)))))))
translation-of-expression is a typical "program walker" - it recurses through the abstract syntax of the expression, passing along a type environment. In most cases, it copies recursively the expression. Whenever a binding construction is met, it recurses by extending the environment the same way the type checker would extend it. In nodes where one of the optimizable expressions are met, a special optimizer handler is used.
(define translation-of-expression
  (lambda (exp tenv)
    (cases expression exp
      (lit-exp (number) exp)
      (true-exp () exp)
      (false-exp () exp)
      (var-exp (id) exp)
      (primapp-exp (prim rands)
        (primapp-exp prim (translation-of-expressions rands tenv)))
      (if-exp (test-exp true-exp false-exp)
        (if-exp (translation-of-expression test-exp tenv)
                (translation-of-expression true-exp tenv)
                (translation-of-expression false-exp tenv)))
      (app-exp (rator rands)
        (app-exp (translation-of-expression rator tenv)
                 (translation-of-expressions rands tenv)))
      (let-exp (ids rands body)
        (translation-of-let-exp ids rands body tenv))
      (proc-exp (id-texps ids body)
        (translation-of-proc-exp id-texps ids body tenv))
      (letrec-exp (result-texps proc-names id-texpss idss bodies letrec-body)
        (translation-of-letrec-exp
          result-texps proc-names id-texpss idss bodies letrec-body tenv))
      (new-object-exp (class-name rands)
        (new-object-exp class-name
          (translation-of-expressions rands tenv)))
      (super-call-exp (msg rands)
        (super-call-exp msg (translation-of-expressions rands tenv)))
      (method-app-exp (obj-exp msg rands)
        (translation-of-method-app-exp obj-exp msg rands tenv))
      (instanceof-exp (obj-exp name)
        (translation-of-instanceof-exp obj-exp name tenv))
      (cast-exp (obj-exp name)
        (translation-of-cast-exp obj-exp name tenv))
      )))

(define translation-of-expressions
  (lambda (exps tenv)
    (map (lambda (exp) (translation-of-expression exp tenv)) exps)))
    
(define translation-of-proc-exp
  (lambda (id-texps ids body tenv)
    (let ((id-types (expand-type-expressions id-texps)))
      (proc-exp id-texps ids
                (translation-of-expression body
                  (extend-tenv ids id-types tenv))))))

(define translation-of-let-exp
  (lambda (ids rands body tenv)
    (let ((tenv-for-body (extend-tenv ids (types-of-expressions rands) tenv)))
      (let-exp ids
               (translation-of-expressions rands tenv)
               (translation-of-expression body tenv-for-body)))))

(define translation-of-letrec-exp
  (lambda (result-texps proc-names id-tepxss idss bodies letrec-body tenv)
    (let ((id-typess (map expand-type-expressions id-texpss))
          (result-types (expand-type-expressions result-texps)))
      (let ((the-proc-types (map proc-type id-typess result-types)))
        (let ((tenv-for-body (extend-tenv proc-names the-proc-types tenv)))
          (letrec-exp result-texps proc-names id-texpss idss
            (map (lambda (id-types ids body)
                   (translation-of-expression body
                     (extend-tenv ids id-types tenv-for-body)))
                 id-typess idss bodies)
            (translation-of-expression letrec-body tenv-for-body)))))))

The optimizations are performed as follows:
(define translation-of-method-app-exp
  (lambda (obj-exp msg rands tenv)
    (let ((obj-type (type-of-expression obj-exp tenv)))
      (cases type obj-type
        (class-type (class-name)
          (let ((class (statically-lookup-class class-name)))
            (let ((pos (list-index (lambda (method)
                                     (eqv? msg (static-method->method-name method)))
                                   (static-class->methods class))))
              (if (number? pos)
                (apply-method-indexed-exp
                  (translation-of-expression obj-exp tenv)
                  pos
                  (translation-of-expressions rands tenv))
                (error "Should not happen.")))))
        (else (error "Should not happen."))))))
For an instance-of expression, we compare the type of the object with the target class. If the type of the object is a subclass of the target class, then instance-of will always succeed. We would like to replace the whole expression by true - but we cannot because the expression could include a side-effect.
(define translation-of-instanceof-exp
  (lambda (obj-exp name tenv)
    (let ((obj-type (type-of-expression obj-exp tenv)))
      (if (is-subtype? obj-type (class-type name))
        (begin-exp (list (translation-of-expression obj-exp tenv)
                         true-exp))
        (instanceof-exp (translation-of-expression obj-exp)
                        name tenv)))))
How could we do better? Could we determine statically whether an expression includes a side effect?

For a cast expression, we compare the type of expression with the target type. If the object is known to be a subclass of the target type, then this is an upcast which always succeeds. If the target is a subclass of the object type, we must keep the cast. If the types are not comparable, it is an error.

(define translation-of-cast-exp
  (lambda (obj-exp name tenv)
    (let ((obj-type (type-of-expression obj-exp tenv))
          (obj-code (translation-of-expression obj-exp tenv)))
      (cases type obj-type
        (class-type (obj-class-name)
          (cond ((statically-is-subtype? obj-class-name name) obj-code)
                ((statically-is-subtype? name obj-class-name) (cast-exp obj-code name))
                (else (error "Should not happen."))))
        (else (error "Should not happen."))))))
The last part of the transformation consists of examining class declarations. This is mostly recursive copying.
(define translation-of-class-decls
  (lambda (c-decls)
    (map translation-of-class-decl c-decls)))

(define translation-of-class-decl
  (lambda (c-decl)
    (cases class-decl c-decl
      (a-class-decl (specifier class-name super-name
                     local-field-texps local-field-ids m-decls)
        (a-class-decl specifier class-name super-name
          local-field-texps local-field-ids
          (map (lambda (m-decl)
                 (translation-of-method-decl m-decl class-name))
               m-decls))))))

(define translation-of-method-decl
  (lambda (m-decl class-name)
    (let ((class (statically-lookup-class class-name)))
      (let ((super-name  (static-class->super-name class))
            (field-ids   (static-class->field-ids class))
            (field-types (static-class->field-types class)))
        (cases method-decl m-decl
          (a-method-decl (result-texp name id-texps ids body)
            (let ((id-types (expand-type-expressions id-texps)))
              (let ((tenv (extend-tenv (cons '%super (cons 'self ids))
                                       (cons (class-type super-name)
                                         (cons (class-type class-name)
                                           id-types))
                                       (extend-tenv field-ids field-types
                                         (empty-tenv)))))
                (a-method-decl
                  result-texp name id-texps ids
                  (translation-of-expression body tenv)))))
          (an-abstract-method-decl (result-texp name id-texps ids)
            m-decl))))))
            

Last modified June 8th, 2003 Michael Elhadad