2010-02-02
- The FLANG Language (contd.)
- Introducing Scheme's `lambda'
- Using Functions as Objects
- Currying

========================================================================
There is still a problem with this version.  First a question -- if
`call' is similar to arithmetic operations (and to `with' in what it
actually does), then how come the code is different enough that it
doesn't even need an auxiliary function?

Second question: what *should* happen if we evaluate this:

  (run "{with {identity {fun {x} x}}
          {with {foo {fun {x} {+ x 1}}}
            {call {call identity foo} 123}}}")
  (run "{call {call {fun {x} {call x 1}}
                    {fun {x} {fun {y} {+ x y}}}}
              123}")

Third question, what *will* happen if we do the above?

The following simple fix takes care of this:

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

The complete code is:

  ---<<<FLANG>>>--------------------------------------------------------
  ;; The Flang interpreter

  #lang pl

  #|
  The grammar:
    <FLANG> ::= <num>
              | { + <FLANG> <FLANG> }
              | { - <FLANG> <FLANG> }
              | { * <FLANG> <FLANG> }
              | { / <FLANG> <FLANG> }
              | { with { <id> <FLANG> } <FLANG> }
              | <id>
              | { fun { <id> } <FLANG> }
              | { call <FLANG> <FLANG> }

  Evaluation rules:

    subst:
      N[v/x]                = N
      {+ E1 E2}[v/x]        = {+ E1[v/x] E2[v/x]}
      {- E1 E2}[v/x]        = {- E1[v/x] E2[v/x]}
      {* E1 E2}[v/x]        = {* E1[v/x] E2[v/x]}
      {/ E1 E2}[v/x]        = {/ E1[v/x] E2[v/x]}
      y[v/x]                = y
      x[v/x]                = v
      {with {y E1} E2}[v/x] = {with {y E1[v/x]} E2[v/x]} ; if y =/= x
      {with {x E1} E2}[v/x] = {with {x E1[v/x]} E2}
      {call E1 E2}[v/x]     = {call E1[v/x] E2[v/x]}
      {fun {y} E}[v/x]      = {fun {y} E[v/x]}           ; if y =/= x
      {fun {x} E}[v/x]      = {fun {x} E}

    eval:
      eval(N)            = N
      eval({+ E1 E2})    = eval(E1) + eval(E2)  \ if both E1 and E2
      eval({- E1 E2})    = eval(E1) - eval(E2)   \ evaluate to numbers
      eval({* E1 E2})    = eval(E1) * eval(E2)   / otherwise error!
      eval({/ E1 E2})    = eval(E1) / eval(E2)  /
      eval(id)           = error!
      eval({with {x E1} E2}) = eval(E2[eval(E1)/x])
      eval(FUN)          = FUN ; assuming FUN is a function expression
      eval({call E1 E2}) = eval(Ef[eval(E2)/x]) if eval(E1)={fun {x} Ef}
                         = error!               otherwise
  |#

  (define-type FLANG
    [Num  (n Number)]
    [Add  (lhs FLANG) (rhs FLANG)]
    [Sub  (lhs FLANG) (rhs FLANG)]
    [Mul  (lhs FLANG) (rhs FLANG)]
    [Div  (lhs FLANG) (rhs FLANG)]
    [Id   (name Symbol)]
    [With (name Symbol) (named FLANG) (body FLANG)]
    [Fun  (name Symbol) (body FLANG)]
    [Call (fun-expr FLANG) (arg-expr FLANG)])

  (: parse-sexpr : Sexpr -> FLANG)
  ;; to convert 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)))

  (: subst : FLANG Symbol FLANG -> FLANG)
  ;; substitutes the second argument with the third argument in the
  ;; first argument, as per the rules of substitution; the resulting
  ;; expression contains no free instances of the second argument
  (define (subst expr from to)
    (cases expr
      [(Num n) expr]
      [(Add l r) (Add (subst l from to) (subst r from to))]
      [(Sub l r) (Sub (subst l from to) (subst r from to))]
      [(Mul l r) (Mul (subst l from to) (subst r from to))]
      [(Div l r) (Div (subst l from to) (subst r from to))]
      [(Id name) (if (eq? name from) to expr)]
      [(With bound-id named-expr bound-body)
       (With bound-id
             (subst named-expr from to)
             (if (eq? bound-id from)
               bound-body
               (subst bound-body from to)))]
      [(Call l r) (Call (subst l from to) (subst r from to))]
      [(Fun bound-id bound-body)
       (if (eq? bound-id from)
         expr
         (Fun bound-id (subst bound-body from to)))]))

  (: arith-op : (Number Number -> Number) FLANG FLANG -> FLANG)
  ;; gets a Scheme numeric binary operator, and uses it within a FLANG
  ;; `Num' wrapper
  (define (arith-op op expr1 expr2)
    (: Num->number : FLANG -> Number)
    (define (Num->number e)
      (cases e
        [(Num n) n]
        [else (error 'arith-op "expects a number, got: ~s" e)]))
    (Num (op (Num->number expr1) (Num->number expr2))))

  (: eval : FLANG -> FLANG)
  ;; evaluates FLANG expressions by reducing them to *expressions*
  (define (eval expr)
    (cases expr
      [(Num n) expr]
      [(Add l r) (arith-op + (eval l) (eval r))]
      [(Sub l r) (arith-op - (eval l) (eval r))]
      [(Mul l r) (arith-op * (eval l) (eval r))]
      [(Div l r) (arith-op / (eval l) (eval r))]
      [(With bound-id named-expr bound-body)
       (eval (subst bound-body
                    bound-id
                    (eval named-expr)))]
      [(Id name) (error 'eval "free identifier: ~s" name)]
      [(Fun bound-id bound-body) expr]
      [(Call fun-expr arg-expr)
       (let ([fval (eval fun-expr)])
         (cases fval
           [(Fun bound-id bound-body)
            (eval (subst bound-body
                         bound-id
                         (eval arg-expr)))]
           [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))])
      (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 {call {fun {x} {call x 1}}
                          {fun {x} {fun {y} {+ x y}}}}
                    123}")
        => 124)
  ----------------------------------------------------------------------

========================================================================
>>> Introducing Scheme's `lambda'

fun & lambda
difference between lambda and simple values
scheme puzzle -- (+ ((?)) 3)
not being able to do recursive functions with `let'
let* as a derived form
let with lambda in scheme --> can be a derived form
how `if' can be used to implement `and' `or' as derived forms

Newtonian syntax vs. a lambda expression.

Don't be fooled into making a bogus connection between Scheme's syntax,
and its `unique' powers...  The fact is that it is not the only language
that has this capability.  For example, this:

  (define (f g) (g 2 3))
  (f +) ==> 5
  (f *) ==> 6
  (f (lambda (x y) (+ (square x) (square y)))) ==> 13

Can be written in JavaScript like this:

  function f(g) { return g(2,3); }
  function square(x) { return x*x; }
  window.alert(f(function (x,y) { return square(x) + square(y); }))

In Perl:

  sub f { my ($g) = @_; return $g->(2,3); }
  sub square { my ($x) = @_; return $x * $x; }
  print f(sub { my ($x, $y) = @_; return square($x) + square($y); });

In Ruby:

  def f(g) g.call(2,3) end
  def square(x) x*x end
  puts f(lambda{|x,y| square(x) + square(y)});

etc.

========================================================================
>>> Using Functions as Objects

A very important aspect of Scheme -- using "higher order" functions --
functions that get and return functions.  Here is a very simple example:

  (define (f x) (lambda () x))
  (define a (f 2))
  (a)  -->  2
  (define b (f 3))
  (b)  -->  3

Note - what we get is actually an object that remembers (by the
substitution we're doing) a number.
How about:

  (define aa (f a))
  (aa)    -->  #<procedure> (this is a)
  ((aa))  -->  2

Take this idea to the next level:

  (define (kons x y)
    (lambda (b)
      (if b x y)))
  (define (kar x) (x #t))
  (define (kdr x) (x #f))
  (define a (kons 1 2))
  (define b (kons 3 4))
  (list (kar a) (kdr a))
  (list (kar b) (kdr b))

Or, with types:

  (: kons : (All (A B) (A B -> (Boolean -> (U A B)))))
  (define (kons x y)
    (lambda (b)
      (if b x y)))
  (: kar : (All (T) ((Boolean -> T) -> T)))
  (define (kar x) (x #t))
  (: kdr : (All (T) ((Boolean -> T) -> T)))
  (define (kdr x) (x #f))
  (define a (kons 1 2))
  (define b (kons 3 4))
  (list (kar a) (kdr a))
  (list (kar b) (kdr b))

Even more -- why should the internal function expect a boolean and
choose what to return?  We can simply expect a function that will take
the two values and return one:

  (define (kons x y)
    (lambda (s)
      (s x y)))
  (define (kar x) (x (lambda (x y) x)))
  (define (kdr x) (x (lambda (x y) y)))
  (define a (kons 1 2))
  (define b (kons 3 4))
  (list (kar a) (kdr a))
  (list (kar b) (kdr b))

And a typed version, using our own constructor to make it a little less
painful:

  (define-type (Kons A B) = ((A B -> (U A B)) -> (U A B)))

  (: kons : (All (A B) (A B -> (Kons A B))))
  (define (kons x y)
    (lambda (s)
      (s x y)))
  (: kar : (All (A B) ((Kons A B) -> (U A B))))
  (define (kar x) (x (lambda: ([x : A] [y : B]) x)))
  (: kdr : (All (A B) ((Kons A B) -> (U A B))))
  (define (kdr x) (x (lambda: ([x : A] [y : B]) y)))
  (define a (kons 1 2))
  (define b (kons 3 4))
  (list (kar a) (kdr a))
  (list (kar b) (kdr b))

Note that the `Kons' type definition is the same as:

  (define-type Kons = (All (A B) ((A B -> (U A B)) -> (U A B))))

so `All' is to polymorphic type definitions what `lambda' is for
function definitions.

Note also that we use the `lambda:' form, which is like `lambda' except
that its arguments are decorated with types.

Finally in JavaScript:

  function kons(x,y) {
    return function(s) { return s(x, y); }
  }
  function kar(x) { return x(function(x,y){ return x; }); }
  function kdr(x) { return x(function(x,y){ return y; }); }
  a = kons(1,2);
  b = kons(3,4);
  window.alert('a = <' + kar(a) + ',' + kdr(a) + '>' );
  window.alert('b = <' + kar(b) + ',' + kdr(b) + '>' );

========================================================================
>>> Currying

How is this done?

Functions for translating between normal and curried versions.

  (define (currify f)
    (lambda (x)
      (lambda (y)
        (f x y))))

Typed, with examples:

  (: currify : (All (A B C) ((A B -> C) -> (A -> (B -> C)))))
  ;; convert a double-argument function to a curried one
  (define (currify f)
    (lambda (x) (lambda (y) (f x y))))

  (: add : Number Number -> Number)
  (define (add x y) (+ x y))

  (: plus : Number -> (Number -> Number))
  (define plus (currify add))

  (test ((plus 1) 2) => 3)
  (test (((currify add) 1) 2) => 3)
  (test (map (plus 1) '(1 2 3)) => '(2 3 4))
  (test (map ((currify add) 1) '(1 2 3)) => '(2 3 4))

Usages -- common with H.O. functions like map, where we want to `fix'
one argument.

When dealing with such higher-order code, the types are very helpful,
since every arrow corresponds to a function:

  (: currify : (All (A B C) ((A B -> C) -> (A -> (B -> C)))))

It is common to make a function `->' type associate to the right (but
not in Typed Scheme), so you can find this type written as:

  currify : (A B -> C) -> (A -> B -> C)

or even as

  currify : (A B -> C) -> A -> B -> C

but that's a little confusing...  In any case, typed-scheme requires the
properly parenthesized form.

========================================================================