PL: Lecture #8  Tuesday, October 2nd
(text file)

Side-note: “Point-Free” combinators

Forming functions without using lambda (or an implicit lambda using a define syntactic sugar) is called point-free style. It’s especially popular in Haskell, where it is easier to form functions this way because of implicit currying and a large number of higher level function combinators. If used too much, it can easily lead to obfuscated code.


This is not Runtime Code Generation

All of this is similar to run-time code generation, but not really. The only thing that fderiv does is take a function and store it somewhere in the returned function, then when that function receives a number, it uses the stored function and send it to deriv with the number. We could simply write deriv as what fderiv is — which is the real derivative function:

(define (deriv f)
  (lambda (x)
    (/ (- (f (+ x dx)) (f x)) dx)))

but again, this is not faster or slower than the plain deriv. However, there are some situations where we can do some of the computation on the first-stage argument, saving work from the second stage. Here is a cooked-to-exaggeration example — we want a function that receives two inputs x, y and returns fib(x)*y, but we must use a stupid fib:

(define (fib n)
  (if (<= n 1)
    n
    (+ (fib (- n 1)) (fib (- n 2)))))

The function we want is:

(define (bogus x y)
  (* (fib x) y))

If we currify it as usual (or just use currify), we get:

(define (bogus x)
  (lambda (y)
    (* (fib x) y)))

And try this several times:

(define bogus24 (bogus 24))
(map bogus24 '(1 2 3 4 5))

But in the definition of bogus, notice that (fib x) does not depend on y — so we can rewrite it a little differently:

(define (bogus x)
  (let ([fibx (fib x)])
    (lambda (y)
      (* fibx y))))

and trying the above again is much faster now:

(define bogus24 (bogus 24))
(map bogus24 '(1 2 3 4 5))

This is therefore not doing any kind of runtime code generation, but it enables doing similar optimizations in our code. A proper RTCG facility would recompile the curried function for a given first input, and (hopefully) automatically achieve the optimization that we did in a manual way.

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 cache at that point.

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(Ef,extend(x,eval(E2,sc),sc))
                          if eval(E1,sc) = {fun {x} Ef}
        = 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)
    (let ([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 expr1 expr2)
  (Num (op (Num->number expr1) (Num->number expr2))))

(: 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)
    (let ([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)