Lecture #9, Tuesday, February 4th
=================================

- Substitution Caches
- Implementation of Cache Functionality
- Formal Rules for Cached Substitutions
- Evaluating with Substitution Caches

------------------------------------------------------------------------
# Substitution Caches

> [PLAI §5] (called "deferred substitutions" there)

Evaluating using substitutions is very inefficient --- at each scope, we
copy a piece of the program AST. This includes all function calls which
implies an impractical cost (function calls should be *cheap*!).

To get over this, we want to use a cache of substitutions.

Basic idea: we begin evaluating with no cached substitutions, then
collect them as we encounter bindings.

[Implies another change for our evaluator: we don't really substitute
identifiers until we get to them; when we reach an identifier, it is no
longer an error --- we must consult the substitution cache.]


------------------------------------------------------------------------
# Implementation of Cache Functionality

First, we need a type for a substitution cache. For this we will use a
list of lists of two elements each --- a name and its value FLANG:

    ;; a type for substitution caches:
    (define-type SubstCache = (Listof (List Symbol FLANG)))

We need to have an empty substitution cache, a way to extend it, and a
way to look things up:

    (: empty-subst : SubstCache)
    (define empty-subst null)

    (: extend : Symbol FLANG SubstCache -> SubstCache)
    ;; extend a given substitution cache with a new mapping
    (define (extend id expr sc)
      (cons (list id expr) sc))

    (: lookup : Symbol SubstCache -> FLANG)
    ;; lookup a symbol in a substitution cache, return the value it is
    ;; bound to (or throw an error if it isn't bound)
    (define (lookup name sc)
      (cond [(null? sc) (error 'lookup "no binding for ~s" name)]
            [(eq? name (first (first sc))) (second (first sc))]
            [else (lookup name (rest sc))]))

Actually, the reason to use such list of lists is that Racket has a
built-in function called `assq` that will do this kind of search (`assq`
is a search in an association list using `eq?` for the key comparison).
This is a version of `lookup` that uses `assq`:

    (define (lookup name sc)
      (let ([cell (assq name sc)])
        (if cell
          (second cell)
          (error 'lookup "no binding for ~s" name))))


------------------------------------------------------------------------
# Formal Rules for Cached Substitutions

The formal evaluation rules are now different. Evaluation carries along
a *substitution cache* that begins its life as empty: so `eval` needs an
extra argument. We begin by writing the rules that deal with the cache,
and use the above function names for simplicity --- the behavior of the
three definitions can be summed up in a single rule for `lookup`:

    lookup(x,empty-subst)     = error!
    lookup(x,extend(x,E,sc))  = E
    lookup(x,extend(y,E,sc))  = lookup(x,sc)  if `x` is not `y`

And now we can write the new rules for `eval`

    eval(N,sc)                = N
    eval({+ E1 E2},sc)        = eval(E1,sc) + eval(E2,sc)
    eval({- E1 E2},sc)        = eval(E1,sc) - eval(E2,sc)
    eval({* E1 E2},sc)        = eval(E1,sc) * eval(E2,sc)
    eval({/ E1 E2},sc)        = eval(E1,sc) / eval(E2,sc)
    eval(x,sc)                = lookup(x,sc)
    eval({with {x E1} E2},sc) = eval(E2,extend(x,eval(E1,sc),sc))
    eval({fun {x} E},sc)      = {fun {x} E}
    eval({call E1 E2},sc)     = eval(B,extend(x,eval(E2,sc),sc))
                                  if eval(E1,sc) = {fun {x} B}
                              = error!  otherwise

Note that there is no mention of `subst` --- the whole point is that we
don't really do substitution, but use the cache instead. The `lookup`
rules, and the places where `extend` is used replaces `subst`, and
therefore specifies our scoping rules.

Also note that the rule for `call` is still very similar to the rule for
`with`, but it looks like we have lost something --- the interesting bit
with substituting into `fun` expressions.


------------------------------------------------------------------------
# Evaluating with Substitution Caches

Implementing the new `eval` is easy now --- it is extended in the same
way that the formal `eval` rule is extended:

    (: eval : FLANG SubstCache -> FLANG)
    ;; evaluates FLANG expressions by reducing them to expressions
    (define (eval expr sc)
      (cases expr
        [(Num n) expr]
        [(Add l r) (arith-op + (eval l sc) (eval r sc))]
        [(Sub l r) (arith-op - (eval l sc) (eval r sc))]
        [(Mul l r) (arith-op * (eval l sc) (eval r sc))]
        [(Div l r) (arith-op / (eval l sc) (eval r sc))]
        [(With bound-id named-expr bound-body)
         (eval bound-body
               (extend bound-id (eval named-expr sc) sc))]
        [(Id name) (lookup name sc)]
        [(Fun bound-id bound-body) expr]
        [(Call fun-expr arg-expr)
         (define fval (eval fun-expr sc))
         (cases fval
           [(Fun bound-id bound-body)
            (eval bound-body (extend bound-id (eval arg-expr sc) sc))]
           [else (error 'eval "`call' expects a function, got: ~s"
                        fval)])]))

Again, note that we don't need `subst` anymore, but the rest of the code
(the data type definition, parsing, and `arith-op`) is exactly the same.

Finally, we need to make sure that `eval` is initially called with an
empty cache. This is easy to change in our main `run` entry point:

    (: run : String -> Number)
    ;; evaluate a FLANG program contained in a string
    (define (run str)
      (let ([result (eval (parse str) empty-subst)])
        (cases result
          [(Num n) n]
          [else (error 'run "evaluation returned a non-number: ~s"
                       result)])))

The full code (including the same tests, but not including formal rules
for now) follows. Note that one test does not pass.

    #lang pl

    (define-type FLANG
      [Num  Number]
      [Add  FLANG FLANG]
      [Sub  FLANG FLANG]
      [Mul  FLANG FLANG]
      [Div  FLANG FLANG]
      [Id   Symbol]
      [With Symbol FLANG FLANG]
      [Fun  Symbol FLANG]
      [Call FLANG FLANG])

    (: parse-sexpr : Sexpr -> FLANG)
    ;; parses s-expressions into FLANGs
    (define (parse-sexpr sexpr)
      (match sexpr
        [(number: n)    (Num n)]
        [(symbol: name) (Id name)]
        [(cons 'with more)
         (match sexpr
           [(list 'with (list (symbol: name) named) body)
            (With name (parse-sexpr named) (parse-sexpr body))]
           [else (error 'parse-sexpr "bad `with' syntax in ~s" sexpr)])]
        [(cons 'fun more)
         (match sexpr
           [(list 'fun (list (symbol: name)) body)
            (Fun name (parse-sexpr body))]
           [else (error 'parse-sexpr "bad `fun' syntax in ~s" sexpr)])]
        [(list '+ lhs rhs) (Add (parse-sexpr lhs) (parse-sexpr rhs))]
        [(list '- lhs rhs) (Sub (parse-sexpr lhs) (parse-sexpr rhs))]
        [(list '* lhs rhs) (Mul (parse-sexpr lhs) (parse-sexpr rhs))]
        [(list '/ lhs rhs) (Div (parse-sexpr lhs) (parse-sexpr rhs))]
        [(list 'call fun arg)
                           (Call (parse-sexpr fun) (parse-sexpr arg))]
        [else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))

    (: parse : String -> FLANG)
    ;; parses a string containing a FLANG expression to a FLANG AST
    (define (parse str)
      (parse-sexpr (string->sexpr str)))

    ;; a type for substitution caches:
    (define-type SubstCache = (Listof (List Symbol FLANG)))

    (: empty-subst : SubstCache)
    (define empty-subst null)

    (: extend : Symbol FLANG SubstCache -> SubstCache)
    ;; extend a given substitution cache with a new mapping
    (define (extend name val sc)
      (cons (list name val) sc))

    (: lookup : Symbol SubstCache -> FLANG)
    ;; lookup a symbol in a substitution cache, return the value it is
    ;; bound to (or throw an error if it isn't bound)
    (define (lookup name sc)
      (let ([cell (assq name sc)])
        (if cell
          (second cell)
          (error 'lookup "no binding for ~s" name))))

    (: Num->number : FLANG -> Number)
    ;; convert a FLANG number to a Racket one
    (define (Num->number e)
      (cases e
        [(Num n) n]
        [else (error 'arith-op "expected a number, got: ~s" e)]))

    (: arith-op : (Number Number -> Number) FLANG FLANG -> FLANG)
    ;; gets a Racket numeric binary operator, and uses it within a FLANG
    ;; `Num' wrapper
    (define (arith-op op val1 val2)
      (Num (op (Num->number val1) (Num->number val2))))

    (: eval : FLANG SubstCache -> FLANG)
    ;; evaluates FLANG expressions by reducing them to expressions
    (define (eval expr sc)
      (cases expr
        [(Num n) expr]
        [(Add l r) (arith-op + (eval l sc) (eval r sc))]
        [(Sub l r) (arith-op - (eval l sc) (eval r sc))]
        [(Mul l r) (arith-op * (eval l sc) (eval r sc))]
        [(Div l r) (arith-op / (eval l sc) (eval r sc))]
        [(With bound-id named-expr bound-body)
         (eval bound-body
               (extend bound-id (eval named-expr sc) sc))]
        [(Id name) (lookup name sc)]
        [(Fun bound-id bound-body) expr]
        [(Call fun-expr arg-expr)
         (define fval (eval fun-expr sc))
         (cases fval
           [(Fun bound-id bound-body)
            (eval bound-body (extend bound-id (eval arg-expr sc) sc))]
           [else (error 'eval "`call' expects a function, got: ~s"
                        fval)])]))

    (: run : String -> Number)
    ;; evaluate a FLANG program contained in a string
    (define (run str)
      (let ([result (eval (parse str) empty-subst)])
        (cases result
          [(Num n) n]
          [else (error 'run "evaluation returned a non-number: ~s"
                       result)])))

    ;; tests
    (test (run "{call {fun {x} {+ x 1}} 4}")
          => 5)
    (test (run "{with {add3 {fun {x} {+ x 3}}}
                  {call add3 1}}")
          => 4)
    (test (run "{with {add3 {fun {x} {+ x 3}}}
                  {with {add1 {fun {x} {+ x 1}}}
                    {with {x 3}
                      {call add1 {call add3 x}}}}}")
          => 7)
    (test (run "{with {identity {fun {x} x}}
                  {with {foo {fun {x} {+ x 1}}}
                    {call {call identity foo} 123}}}")
          => 124)
    (test (run "{call {with {x 3}
                        {fun {y} {+ x y}}}
                      4}")
          => 7)
    (test (run "{with {f {with {x 3} {fun {y} {+ x y}}}}
                  {with {x 100}
                    {call f 4}}}")
          => 7)
    (test (run "{with {x 3}
                  {with {f {fun {y} {+ x y}}}
                    {with {x 5}
                      {call f 4}}}}")
          => "???")
    (test (run "{call {call {fun {x} {call x 1}}
                            {fun {x} {fun {y} {+ x y}}}}
                      123}")
          => 124)