2008-02-15 Closures, Implementing Lexical Scope, Using Scheme Closures ======================================================================== >>> Implementing Lexical Scope: Closures and Environments So how do we fix this? Lets go back to the root of the problem: the new evaluator does not behave in the same way as the substituting evaluator. In the old evaluator, it was easy to see how functions can behave as objects that remember values. For example, when we do this: {with {x 1} {fun {y} {+ x y}}} the result was a function value, which actually was the syntax object for this: {fun {y} {+ 1 y}} Now if we call this function from someplace else like: {with {f {with {x 1} {fun {y} {+ x y}}}} {with {x 2} {call f 3}}} it is clear what the result will be: f is bound to a function that adds 1 to its input, so in the above the later binding for `x' has no effect at all. But with the caching evaluator, the value of {with {x 1} {fun {y} {+ x y}}} is simply: {fun {y} {+ x y}} and there is no place where we save the 1 -- *that's* the root of our problem. (That's also what makes people suspect that using `lambda' in Scheme involves some inefficient code-recompiling magic.) In fact, we can verify that by inspecting the returned value, and see that it does contain a free identifier. Clearly, we need to create an object that contains the body and the argument list, like the function syntax object -- but we don't do any substitution, so in addition to the body an argument name(s) we need to remember that we still need to substitute x by 1. This means that the pieces of information we need to know are: - formal argument(s): {y} - body: {+ x y} - substitutions we owe: [1/x] and that last bit has the missing 1. The resulting object is called a `closure' because it closes the function body over the substitutions that are still pending (its environment). So, the first change is in the value of functions which now need all these pieces, unlike the `Fun' case for the syntax object. A second place that needs changing is the when functions are called. When we're done evaluating the `call' arguments (the function value and the argument value) but before we apply the function we have two *values* -- there is no more use for the current substitution cache at this point: we have finished dealing with all substitutions that were necessary over the current expression -- we now continue with evaluating the body of the function, with the new substitutions for the formal arguments and actual values given. But the body itself is the same one we had before -- which is the previous body with its suspended substitutions that we *still* did not do. Rewrite the evaluation rules -- all are the same except for evaluating a `fun' form and a `call' form: 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},sc> eval({call E1 E2},sc1) = eval(Ef,extend(x,eval(E2,sc1),sc2)) if eval(E1,sc1)=<{fun {x} Ef},sc2> = error! otherwise (The algorithm for evaluating a `call' is: 1. f := evaluate E1 in sc1 2. if f is not a <{fun ...},...> closure then error! 3. a := evaluate E2 in sc1 4. new_sc := extend sc_of(f) by mapping arg_of(f) to a 5. evaluate (and return) body_of(f) in new_sc ) Note how the scoping rules that are implied by this definition match the scoping rules that were implied by the substitution-based rules. (It should be possible to prove that they are the same.) The changes to the code are almost trivial, except that we need a way to represent <{fun {x} Ef},sc> pairs. ======================================================================== The implication of this change is that we now cannot use the same type for function syntax and function values since function values have more than just syntax. There is a simple solution to this -- we never do any substitutions now, so we don't need to translate values into expressions -- we can come up with a new type for values, separate from the type of abstract syntax trees. When we do this, we will also fix our hack of using FLANG as the type of values: this was merely a convenience since the AST type had cases for all kinds of values that we needed. (In fact, you should have noticed that Scheme does this too: numbers, strings, booleans, etc are all used by both programs, and in syntax representation (s-expressions) -- but note that procedure values are *not* used in syntax.) We will now implement a separate `VAL' type for runtime values. As a side note, these substitution caches are a little more than just a cache now -- they actually hold an "environment" of substitutions in which the expression should be evaluated. So the usual name used for them is an environment, we will use this name. First, we need now a type for such environments -- we can use `Listof' for this: ;; a type for environments: (define-type ENV = (Listof (List Symbol VAL))) but we can just as well define a new type for environment values: (define-type ENV [EmptyEnv] [Extend (id Symbol) (v VAL) (rest-env ENV)]) Reimplementing `lookup' is now simple: (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (cases env [(EmptyEnv) (error 'lookup "no binding for ~s" name)] [(Extend id val rest-env) (if (eq? id name) val (lookup name rest-env))])) ... we don't need `extend' because we get `Extend' from the type definition, and we also get `(EmptyEnv)' instead of `empty-subst'. We now use this with the new type for values -- two variants of these: (define-type VAL [NumV (n Number)] [FunV (name Symbol) (body FLANG) (env ENV)]) And now the new implementation of `eval' which uses the new type and implements lexical scope: (: eval : (FLANG ENV -> VAL)) ;; evaluates FLANG expressions by reducing them to values (define (eval expr env) (cases expr [(Num n) (NumV n)] [(Add l r) (arith-op + (eval l env) (eval r env))] [(Sub l r) (arith-op - (eval l env) (eval r env))] [(Mul l r) (arith-op * (eval l env) (eval r env))] [(Div l r) (arith-op / (eval l env) (eval r env))] [(With bound-id named-expr bound-body) (eval bound-body (Extend bound-id (eval named-expr env) env))] [(Id name) (lookup name env)] [(Fun bound-id bound-body) (FunV bound-id bound-body env)] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV bound-id bound-body f-env) (eval bound-body (Extend bound-id (eval arg-expr env) f-env))] [else (error 'eval "`call' expects a function, got: ~s" fval)]))])) We also need to update `arith-op' to use VAL objects. The full code follows -- it now passes all tests, including the example that we used to find the problem. ---------------------------------------------------------------------- #| The grammar: ::= | { + } | { - } | { * } | { / } | { with { } } | | { fun { } } | { call } Evaluation rules: eval(N,env) = N eval({+ E1 E2},env) = eval(E1,env) + eval(E2,env) eval({- E1 E2},env) = eval(E1,env) - eval(E2,env) eval({* E1 E2},env) = eval(E1,env) * eval(E2,env) eval({/ E1 E2},env) = eval(E1,env) / eval(E2,env) eval(x,env) = lookup(x,env) eval({with {x E1} E2},env) = eval(E2,extend(x,eval(E1,env),env)) eval({fun {x} E},env) = <{fun {x} E},env> eval({call E1 E2},env1) = eval(Ef,extend(x,eval(E2,env1),env2)) if eval(E1,env1)=<{fun {x} Ef},env2> = 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 op left right) (let ([make-node (match op ['+ Add] ['- Sub] ['* Mul] ['/ Div] ['call Call] [else (error 'parse-sexpr "don't know about ~s" op)])]) (make-node (parse-sexpr left) (parse-sexpr right)))] [else (error 'parse-sexpr "bad syntax in ~s" sexpr)])) (: parse : (String -> FLANG)) ;; parses a string containing an FLANG expression to a FLANG AST (define (parse str) (parse-sexpr (string->sexpr str))) ;; Types for environments, values, and a lookup function (define-type ENV [EmptyEnv] [Extend (id Symbol) (v VAL) (rest-env ENV)]) (define-type VAL [NumV (n Number)] [FunV (name Symbol) (body FLANG) (env ENV)]) (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (cases env [(EmptyEnv) (error 'lookup "no binding for ~s" name)] [(Extend id val rest-env) (if (eq? id name) val (lookup name rest-env))])) (: arith-op : ((Number Number -> Number) VAL VAL -> VAL)) ;; gets a Scheme numeric binary operator, and uses it within a NumV ;; wrapper (define (arith-op op val1 val2) (define: (NumV->number [v : VAL]) : Number (cases v [(NumV n) n] [else (error 'arith-op "expects a number, got: ~s" v)])) (NumV (op (NumV->number val1) (NumV->number val2)))) (: eval : (FLANG ENV -> VAL)) ;; evaluates FLANG expressions by reducing them to values (define (eval expr env) (cases expr [(Num n) (NumV n)] [(Add l r) (arith-op + (eval l env) (eval r env))] [(Sub l r) (arith-op - (eval l env) (eval r env))] [(Mul l r) (arith-op * (eval l env) (eval r env))] [(Div l r) (arith-op / (eval l env) (eval r env))] [(With bound-id named-expr bound-body) (eval bound-body (Extend bound-id (eval named-expr env) env))] [(Id name) (lookup name env)] [(Fun bound-id bound-body) (FunV bound-id bound-body env)] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV bound-id bound-body f-env) (eval bound-body (Extend bound-id (eval arg-expr env) f-env))] [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) (EmptyEnv))]) (cases result [(NumV 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 "{with {x 3} {with {f {fun {y} {+ x y}}} {with {x 5} {call f 4}}}}") => 7) (test (run "{call {call {fun {x} {call x 1}} {fun {x} {fun {y} {+ x y}}}} 123}") => 124) ---------------------------------------------------------------------- ======================================================================== >>> Implementing Lexical Scope using Scheme Closures and Environments An alternative representation for an environment We've already seen how first-class functions can be used to implement "objects" that contain some information. We can use the same idea to represent an environment. The basic intuition is -- an environment is a *mapping* (a function) between an identifier and some value. For example, we can represent the environment that maps 'a to 1 and 'b to 2 (using just Scheme numbers for simplicity) using this function: (: my-map : (Symbol -> Number)) (define (my-map id) (cond [(eq? 'a id) 1] [(eq? 'b id) 2] [else (error ...)])) An empty mapping that is implemented in this way has the same type: (: my-map : (Symbol -> Number)) (define (empty-mapping id) (error ...)) We can use this idea to implement our environments: we only need to define three things -- `EmptyEnv', `Extend', and `lookup'. If we manage to keep the contract to these functions intact, we will be able to simply plug it into the same evaluator code with no other changes. It will also be more convenient to define `ENV' as the appropriate function type for use in the VAL type definition instead of using the actual type: ;; Define a type for functional environments (define-type ENV = (Symbol -> VAL)) Now we get to `EmptyEnv' -- this is expected to be a procedure that expects no arguments and creates an empty environment, one that behaves like the `empty-mapping' procedure defined above. We could define it like this (changing the `empty-mapping' type to return a VAL): (define (EmptyEnv) empty-mapping) but we can skip the need for an extra definition and simply return an empty mapping procedure: (: EmptyEnv : (-> ENV)) (define (EmptyEnv) (lambda (id) (error ...))) (The un-Schemely name is to avoid replacing previous code that used the `EmptyEnv' name for the constructor that was created by the type definition.) The next thing we tackle is `lookup'. The previous definition that was used is: (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (cases env [(EmptyEnv) (error 'lookup "no binding for ~s" name)] [(Extend id val rest-env) (if (eq? id name) val (lookup name rest-env))])) How should it be modified now? Easy -- an environment is a mapping: a Scheme procedure that will do the searching job itself. We don't need to modify the contract since we're still using `ENV', except a different implementation for it. The new definition is: (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (env name)) Note that `lookup' does almost nothing -- it simply delegates the real work to the `env' argument. This is a good hint for the error message that empty mappings should throw -- (: EmptyEnv : (-> ENV)) (define (EmptyEnv) (lambda (id) (error 'lookup "no binding for ~s" id))) Finally, `Extend' -- this was previously created by the variant case of the ENV type definition: [Extend (id Symbol) (v VAL) (rest-env ENV)] keeping the same type that is implied by this variant means that the new `Extend' should look like this: (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) ...) The question is -- how do we extend a given environment? Well, first, we know that the result should be mapping -- a `symbol -> VAL' function that expects an identifier to look for: (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) (lambda (name) ...)) Next, we know that in the generated mapping, if we look for `id' then the result should be `v': (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) (lambda (name) (if (eq? name id) v ...))) If the `name' that we're looking for is not the same as `id', then we need to search through the previous environment, eg: (lookup name rest). But we know what `lookup' does -- it simply delegates back to the mapping function (which is our `rest' argument), so we can take a direct route: (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) (lambda (name) (if (eq? name id) v (rest-env name)))) (Note that the last line is simply `(lookup name rest-env)', but we know that we have a functional implementation.) To see how all this works, try out extending an empty environment a few times and examine the result. For example, the environment that we began with: (define (my-map id) (cond [(eq? 'a id) 1] [(eq? 'b id) 2] [else (error ...)])) behaves in the same way (if the type of values is numbers) as (Extend 'a 1 (Extend 'b 2 (EmptyEnv))) The new code is now the same, except for the environment code: ---------------------------------------------------------------------- #| The grammar: ::= | { + } | { - } | { * } | { / } | { with { } } | | { fun { } } | { call } Evaluation rules: eval(N,env) = N eval({+ E1 E2},env) = eval(E1,env) + eval(E2,env) eval({- E1 E2},env) = eval(E1,env) - eval(E2,env) eval({* E1 E2},env) = eval(E1,env) * eval(E2,env) eval({/ E1 E2},env) = eval(E1,env) / eval(E2,env) eval(x,env) = lookup(x,env) eval({with {x E1} E2},env) = eval(E2,extend(x,eval(E1,env),env)) eval({fun {x} E},env) = <{fun {x} E},env> eval({call E1 E2},env1) = eval(Ef,extend(x,eval(E2,env1),env2)) if eval(E1,env1)=<{fun {x} Ef},env2> = 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 op left right) (let ([make-node (match op ['+ Add] ['- Sub] ['* Mul] ['/ Div] ['call Call] [else (error 'parse-sexpr "don't know about ~s" op)])]) (make-node (parse-sexpr left) (parse-sexpr right)))] [else (error 'parse-sexpr "bad syntax in ~s" sexpr)])) (: parse : (String -> FLANG)) ;; parses a string containing an FLANG expression to a FLANG AST (define (parse str) (parse-sexpr (string->sexpr str))) ;; Types for environments, values, and a lookup function (define-type VAL [NumV (n Number)] [FunV (name Symbol) (body FLANG) (env ENV)]) ;; Define a type for functional environments (define-type ENV = (Symbol -> VAL)) (: EmptyEnv : (-> ENV)) (define (EmptyEnv) (lambda (id) (error 'lookup "no binding for ~s" id))) (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (env name)) (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) (lambda (name) (if (eq? name id) v (rest-env name)))) (: arith-op : ((Number Number -> Number) VAL VAL -> VAL)) ;; gets a Scheme numeric binary operator, and uses it within a NumV ;; wrapper (define (arith-op op val1 val2) (define: (NumV->number [v : VAL]) : Number (cases v [(NumV n) n] [else (error 'arith-op "expects a number, got: ~s" v)])) (NumV (op (NumV->number val1) (NumV->number val2)))) (: eval : (FLANG ENV -> VAL)) ;; evaluates FLANG expressions by reducing them to values (define (eval expr env) (cases expr [(Num n) (NumV n)] [(Add l r) (arith-op + (eval l env) (eval r env))] [(Sub l r) (arith-op - (eval l env) (eval r env))] [(Mul l r) (arith-op * (eval l env) (eval r env))] [(Div l r) (arith-op / (eval l env) (eval r env))] [(With bound-id named-expr bound-body) (eval bound-body (Extend bound-id (eval named-expr env) env))] [(Id name) (lookup name env)] [(Fun bound-id bound-body) (FunV bound-id bound-body env)] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV bound-id bound-body f-env) (eval bound-body (Extend bound-id (eval arg-expr env) f-env))] [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) (EmptyEnv))]) (cases result [(NumV 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 "{with {x 3} {with {f {fun {y} {+ x y}}} {with {x 5} {call f 4}}}}") => 7) (test (run "{call {call {fun {x} {call x 1}} {fun {x} {fun {y} {+ x y}}}} 123}") => 124) ---------------------------------------------------------------------- ======================================================================== >>> More Closures (on both levels) Scheme closures (=functions) can be used in other places too, and as we have seen, they can do more than encapsulate various values -- they can also hold the behavior that is expected of these values. To demonstrate this we will deal with closures in our language. We currently use a variant that holds the three pieces of relevant information: [FunV (name Symbol) (body FLANG) (env ENV)] We can replace this by a functional object, which will hold the three values. First, change the VAL type to hold functions for FunV values: (define-type VAL [NumV (n Number)] [FunV (p (? -> ?))]) And note that the procedure should somehow encapsulate the same information that was there previously, the question is *how* this information is going to be done, and this will determine the actual type. This information plays a role in two places in our evaluator -- generating a closure in the `Fun' case, and using it in the `Call' case: [(Fun bound-id bound-body) (FunV bound-id bound-body env)] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV bound-id bound-body f-env) (eval bound-body ;* (Extend bound-id ;* (eval arg-expr env) ;* f-env))] ;* [else (error 'eval "`call' expects a function, got: ~s" fval)]))] we can simply fold the marked functionality bit of `Call' into a Scheme function that will be stored in a `FunV' object -- this piece of functionality takes an argument value, extends the closure's environment with its value and the function's name, and continues to evaluate the function body. Folding all of this into a function gives us: (lambda (arg-val) (eval bound-body (Extend bound-id arg-val env))) where the values of `bound-body', `bound-id', and `val' are known at the time that the FunV is *constructed*. Doing this gives us the following code for the two cases: [(Fun bound-id bound-body) (FunV (lambda: ([arg-val : VAL]) (eval bound-body (Extend bound-id arg-val env))))] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV proc) (proc (eval arg-expr env))] [else (error 'eval "`call' expects a function, got: ~s" fval)]))] And now the type of the function is clear: (define-type VAL [NumV (n Number)] [FunV (p (VAL -> VAL))]) And again, the rest of the code is unmodified: ---------------------------------------------------------------------- (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 op left right) (let ([make-node (match op ['+ Add] ['- Sub] ['* Mul] ['/ Div] ['call Call] [else (error 'parse-sexpr "don't know about ~s" op)])]) (make-node (parse-sexpr left) (parse-sexpr right)))] [else (error 'parse-sexpr "bad syntax in ~s" sexpr)])) (: parse : (String -> FLANG)) ;; parses a string containing an FLANG expression to a FLANG AST (define (parse str) (parse-sexpr (string->sexpr str))) ;; Types for environments, values, and a lookup function (define-type VAL [NumV (n Number)] [FunV (p (VAL -> VAL))]) ;; Define a type for functional environments (define-type ENV = (Symbol -> VAL)) (: EmptyEnv : (-> ENV)) (define (EmptyEnv) (lambda (id) (error 'lookup "no binding for ~s" id))) (: lookup : (Symbol ENV -> VAL)) (define (lookup name env) (env name)) (: Extend : (Symbol VAL ENV -> ENV)) (define (Extend id v rest-env) (lambda (name) (if (eq? name id) v (rest-env name)))) (: arith-op : ((Number Number -> Number) VAL VAL -> VAL)) ;; gets a Scheme numeric binary operator, and uses it within a NumV ;; wrapper (define (arith-op op val1 val2) (define: (NumV->number [v : VAL]) : Number (cases v [(NumV n) n] [else (error 'arith-op "expects a number, got: ~s" v)])) (NumV (op (NumV->number val1) (NumV->number val2)))) (: eval : (FLANG ENV -> VAL)) ;; evaluates FLANG expressions by reducing them to values (define (eval expr env) (cases expr [(Num n) (NumV n)] [(Add l r) (arith-op + (eval l env) (eval r env))] [(Sub l r) (arith-op - (eval l env) (eval r env))] [(Mul l r) (arith-op * (eval l env) (eval r env))] [(Div l r) (arith-op / (eval l env) (eval r env))] [(With bound-id named-expr bound-body) (eval bound-body (Extend bound-id (eval named-expr env) env))] [(Id name) (lookup name env)] [(Fun bound-id bound-body) (FunV (lambda: ([arg-val : VAL]) (eval bound-body (Extend bound-id arg-val env))))] [(Call fun-expr arg-expr) (let ([fval (eval fun-expr env)]) (cases fval [(FunV proc) (proc (eval arg-expr env))] [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) (EmptyEnv))]) (cases result [(NumV 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 "{with {x 3} {with {f {fun {y} {+ x y}}} {with {x 5} {call f 4}}}}") => 7) (test (run "{call {call {fun {x} {call x 1}} {fun {x} {fun {y} {+ x y}}}} 123}") => 124) ---------------------------------------------------------------------- ========================================================================