rlm@2: #+TITLE: LAMBDA: The Ultimate Imperative rlm@2: #+AUTHOR: Guy Lewis Steele Jr. and Gerald Jay Sussman rlm@2: rlm@2: * Abstract rlm@2: rlm@2: We demonstrate how to model the following common programming constructs in rlm@2: terms of an applicative order language similar to LISP: rlm@2: - Simple Recursion rlm@2: - Iteration rlm@2: - Compound Statements and Expressions rlm@2: - GO TO and Assignment rlm@2: - Continuation—Passing rlm@2: - Escape Expressions rlm@2: - Fluid Variables rlm@2: - Call by Name, Call by Need, and Call by Reference rlm@2: The models require only (possibly self-referent) lambda application, rlm@2: conditionals, and (rarely) assignment. No complex data structures such as rlm@2: stacks are used. The models are transparent, involving only local syntactic rlm@2: transformations. rlm@2: Some of these models, such as those for GO TO and assignment, are already well rlm@2: known, and appear in the work of Landin, Reynolds, and others. The models for rlm@2: escape expressions, fluid variables, and call by need with side effects are rlm@2: new. This paper is partly tutorial in intent, gathering all the models rlm@2: together for purposes of context. rlm@2: This report describes research done at the Artificial Intelligence Laboratory rlm@2: of the Massachusetts Institute of Teehnology. Support for the laboratory's rlm@2: artificial intelligence research is provided in part by the Advanced Research rlm@2: Projects Agency of the Department of Defense under Office of Naval Research rlm@2: contract N000l4-75-C-0643. rlm@2: rlm@2: * Introduction rlm@2: rlm@2: We catalogue a number of common programming constructs. For each rlm@2: construct we examine "typical" usage in well-known programming languages, and rlm@2: then capture the essence of the semantics of the construct in terms of a rlm@2: common meta-language. rlm@2: The lambda calculus {Note Alonzowins} is often used as such a meta- rlm@2: language. Lambda calculus offers clean semantics, but it is clumsy because it rlm@2: was designed to be a minimal language rather than a convenient one. All rlm@2: lambda calculus "functions" must take exactly one "argument"; the only "data rlm@2: type" is lambda expressions; and the only "primitive operation‘ is variable‘ rlm@2: substitution. While its utter simplicity makes lambda calculus ideal for rlm@2: logicians, it is too primitive for use by programmers. The meta-language we rlm@2: use is a programming language called SCHEME {Note Schemepaper) which is based rlm@2: on lambda calculus. rlm@2: SCHEME is a dialect of LISP. [McCarthy 62] It is an expression- rlm@2: oriented, applicative order, interpreter-based language which allows one to rlm@2: manipulate programs as data. It differs from most current dialects of LISP in rlm@2: that it closes all lambda expressions in the environment of their definition rlm@2: or declaration, rather than in the execution environment. {Note Closures} rlm@2: This preserves the substitution semantics of lambda calculus, and has the rlm@2: consequence that all variables are lexically scoped, as in ALGOL. [Naur 63] rlm@2: Another difference is that SCHEME is implemented in such a way that tail- rlm@2: recursions execute without net growth of the interpreter stack. {Note rlm@2: Schemenote} We have chosen to use LISP syntax rather than, say, ALGOL syntax rlm@2: because we want to treat programs as data for the purpose of describing rlm@2: transformations on the code. LISP supplies names for the parts of an rlm@2: executable expression and standard operators for constructing expressions and rlm@2: extracting their components. The use of LISP syntax makes the structure of rlm@2: such expressions manifest. We use ALGOL as an expository language, because it rlm@2: is familiar to many people, but ALGOL is not sufficiently powerful to express rlm@2: the necessary concepts; in particular, it does not allow functions to return rlm@2: functions as values. we are thus forced to use a dialect of LISP in many rlm@2: cases. rlm@2: We will consider various complex programming language constructs and rlm@2: show how to model them in terms of only a few simple ones. As far as possible rlm@2: we will use only three control constructs from SCHEME: LAMBDA expressions, as rlm@2: in LISP, which are Just functions with lexically scoped free variables; rlm@2: LABELS, which allows declaration of mutually recursive procedures (Note rlm@2: Labelsdef}; and IF, a primitive conditional expression. For more complex rlm@2: modelling we will introduce an assignment primitive (ASET).i We will freely rlm@2: assume the existence of other comon primitives, such as arithmetic functions. rlm@2: The constructs we will examine are divided into four broad classes. rlm@2: The first is sfinph?Lo0pl; this contains simple recursions and iterations, and rlm@2: an introduction to the notion of continuations. The second is hmponflivo rlm@2: Connrucls; this includes compound statements, G0 T0, and simple variable rlm@2: assignments. The third is continuations, which encompasses the distinction between statements and expressions, escape operators (such as Landin's J- rlm@2: operator [Landin 65] and Reynold's escape expression [Reynolds 72]). and fluid rlm@2: (dynamically bound) variables. The fourth is Parameter Passing Mechanisms, such rlm@2: as ALGOL call—by-name and FORTRAN call-by-location. rlm@2: Some of the models presented here are already well-known, particularly rlm@2: those for G0 T0 and assignment. [McCarthy 60] [Landin 65] [Reynolds 72] rlm@2: Those for escape operators, fluid variables, and call-by-need with side rlm@2: effects are new. rlm@2: ** Simple Loops rlm@2: By /simple loops/ we mean constructs which enable programs to execute the rlm@2: same piece of code repeatedly in a controlled manner. Variables may be made rlm@2: to take on different values during each repetition, and the number of rlm@2: repetitions may depend on data given to the program. rlm@2: *** Simple Recursion rlm@2: One of the easiest ways to produce a looping control structure is to rlm@2: use a recursive function, one which calls itself to perform a subcomputation. rlm@2: For example, the familiar factorial function may be written recursively in rlm@2: ALGOL: ' rlm@2: #+begin_src algol rlm@2: integer procedure fact(n) value n: integer n: rlm@2: fact := if n=0 then 1 else n*fact(n-1); rlm@2: #+end_src rlm@2: rlm@2: The invocation =fact(n)= computes the product of the integers from 1 to n using rlm@2: the identity n!=n(n-1)! (n>0). If $n$ is zero, 1 is returned; otherwise =fact=: rlm@2: calls itself recursively to compute $(n-1)!$ , then multiplies the result by $n$ rlm@2: and returns it. rlm@2: rlm@2: This same function may be written in Clojure as follows: rlm@2: #+begin_src clojure rlm@2: (ns categorical.imperative) rlm@2: (defn fact[n] rlm@2: (if (= n 0) 1 (* n (fact (dec n)))) rlm@2: ) rlm@2: #+end_src rlm@2: rlm@2: #+results: rlm@2: : #'categorical.imperative/fact rlm@2: rlm@2: Clojure does not require an assignment to the ``variable'' fan: to return a value rlm@2: as ALGOL does. The IF primitive is the ALGOL if-then-else rendered in LISP rlm@2: syntax. Note that the arithmetic primitives are prefix operators in SCHEME. rlm@2: rlm@2: *** Iteration rlm@2: There are many other ways to compute factorial. One important way is rlm@2: through the use of /iteration/. rlm@2: A comon iterative construct is the DO loop. The most general form we rlm@2: have seen in any programming language is the MacLISP DO [Moon 74]. It permits rlm@2: the simultaneous initialization of any number of control variables and the rlm@2: simultaneous stepping of these variables by arbitrary functions at each rlm@2: iteration step. The loop is terminated by an arbitrary predicate, and an rlm@2: arbitrary value may be returned. The DO loop may have a body, a series of rlm@2: expressions executed for effect on each iteration. A version of the MacLISP rlm@2: DO construct has been adopted in SCHEME. rlm@2: rlm@2: The general form of a SCHEME DO is: rlm@2: #+begin_src nothing rlm@2: (DO (( (init1> ) rlm@2: ((var2> ) rlm@2: ( (stepn>)) rlm@2: ( (value>) rlm@2: (optional body>) rlm@2: #+end_src rlm@2: The semantics of this are that the variables are bound and initialized to the rlm@2: values of the expressions, which must all be evaluated in the rlm@2: environment outside the D0; then the predicate is evaluated in the new rlm@2: environment, and if TRUE, the (value) is evaluated and returned. Otherwise rlm@2: the (optional body) is evaluated, then each of the steppers is rlm@2: evaluated in the current environment, all the variables made to have the rlm@2: results as their values, the predicate evaluated again, and so on. rlm@2: Using D0 loops in both ALGOL and SCHEME, we may express FACT by means rlm@2: of iteration. rlm@2: #+begin_src algol rlm@2: integer procedure fact(n); value n; integer n: rlm@2: begin rlm@2: integer m, ans; rlm@2: ans := 1; rlm@2: for m := n step -l until 0 do ans := m*ans; rlm@2: fact := ans; rlm@2: end; rlm@2: #+end_src rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn fact-do[n] rlm@2: ) rlm@2: #+end_src rlm@2: rlm@2: Note that the SCHEME D0 loop in FACT has no body -- the stepping functions do rlm@2: all the work. The ALGOL DO loop has an assignment in its body; because an rlm@2: ALGOL DO loop can step only one variable, we need the assignment to step the rlm@2: the variable "manually'. rlm@2: In reality the SCHEME DO construct is not a primitive; it is a macro rlm@2: which expands into a function which performs the iteration by tail—recursion. rlm@2: Consider the following definition of FACT in SCHEME. Although it appears to rlm@2: be recursive, since it "calls itself", it is entirely equivalent to the DO rlm@2: loop given above, for it is the code that the DO macro expands into! It rlm@2: captures the essence of our intuitive notion of iteration, because execution rlm@2: of this program will not produce internal structures (e.g. stacks or variable rlm@2: bindings) which increase in size with the number of iteration steps. rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn fact-do-expand[n] rlm@2: (let [fact1 rlm@2: (fn[m ans] rlm@2: (if (zero? m) ans rlm@2: (recur (dec m) (* m ans))))] rlm@2: (fact1 n 1))) rlm@2: #+end_src rlm@2: rlm@2: From this we can infer a general way to express iterations in SCHEME in rlm@2: a manner isomorphic to the HacLISP D0. The expansion of the general D0 loop rlm@2: #+begin_src nothing rlm@2: (DO (( ) rlm@2: ( (init2) ) rlm@2: ... rlm@2: ( )) rlm@2: ( ) rlm@2: ) rlm@2: #+end_src rlm@2: is this: rlm@2: #+begin_src nothing rlm@2: (let [doloop rlm@2: (fn [dummy ... ) rlm@2: (if rlm@2: (recur ... )))] rlm@2: rlm@2: (doloop nil ... )) rlm@2: #+end_src rlm@2: The identifiers =doloop= and =dummy= are chosen so as not to conflict with any rlm@2: other identifiers in the program. rlm@2: Note that, unlike most implementations of D0, there are no side effects rlm@2: in the steppings of the iteration variables. D0 loops are usually modelled rlm@2: using assignment statements. For example: rlm@2: #+begin_src nothing rlm@2: for r :1 0 step b until c do ; rlm@2: #+end_src rlm@2: rlm@2: can be modelled as follows: [Naur 63] rlm@2: #+begin_src nothing rlm@2: begin rlm@2: x := a; rlm@2: L: if (x-c)*sign(n) > 0 then go to Endloop; rlm@2: ; rlm@2: x := x+b; rlm@2: go to L: rlm@2: Endloop: rlm@2: end; rlm@2: #+end_src rlm@2: Later we will see how such assignment statements can in general be rlm@2: modelled without using side effects. rlm@2: rlm@2: * Imperative Programming rlm@2: Lambda calculus (and related languages, such as ``pure LISP'') is often rlm@2: used for modelling the applicative constructs of programming languages. rlm@2: However, they are generally thought of as inappropriate for modelling rlm@2: imperative constructs. In this section we show how imperative constructs may rlm@2: be modelled by applicative SCHEME constructs. rlm@2: ** Compound Statements rlm@2: The simplest kind of imperative construct is the statement sequencer, rlm@2: for example the compound statement in ALGOL: rlm@2: #+begin_src algol rlm@2: begin rlm@2: S1; rlm@2: S2; rlm@2: end rlm@2: #+end_src rlm@2: rlm@2: This construct has two interesting properties: rlm@2: - (1) It performs statement S1 before S2, and so may be used for rlm@2: sequencing. rlm@2: - (2) S1 is useful only for its side effects. (In ALGOL, S2 must also rlm@2: be a statement, and so is also useful only for side effects, but rlm@2: other languages have compound expressions containing a statement rlm@2: followed by an expression.) rlm@2: rlm@2: The ALGOL compound statement may actually contain any number of statements, rlm@2: but such statements can be expressed as a series of nested two-statement rlm@2: compounds. That is: rlm@2: #+begin_src algol rlm@2: begin rlm@2: S1; rlm@2: S2; rlm@2: ... rlm@2: Sn-1; rlm@2: Sn; rlm@2: end rlm@2: #+end_src rlm@2: is equivalent to: rlm@2: rlm@2: #+begin_src algol rlm@2: begin rlm@2: S1; rlm@2: begin rlm@2: S2; rlm@2: begin rlm@2: ... rlm@2: rlm@2: begin rlm@2: Sn-1; rlm@2: Sn; rlm@2: end; rlm@2: end; rlm@2: end: rlm@2: end rlm@2: #+end_src rlm@2: rlm@2: It is not immediately apparent that this sequencing can be expressed in a rlm@2: purely applicative language. We can, however, take advantage of the implicit rlm@2: sequencing of applicative order evaluation. Thus, for example, we may write a rlm@2: two-statement sequence as follows: rlm@2: rlm@2: #+begin_src clojure rlm@2: ((fn[dummy] S2) S1) rlm@2: #+end_src rlm@2: rlm@2: where =dummy= is an identifier not used in S2. From this it is rlm@2: manifest that the value of S1 is ignored, and so is useful only for rlm@2: side effects. (Note that we did not claim that S1 is expressed in a rlm@2: purely applicative language, but only that the sequencing can be so rlm@2: expressed.) From now on we will use the form =(BLOCK S1 S2)= as an rlm@2: abbreviation for this expression, and =(BLOCK S1 S2...Sn-1 Sn)= as an rlm@2: abbreviation for rlm@2: rlm@2: #+begin_src algol rlm@2: (BLOCK S1 (BLOCK S2 (BLOCK ... (BLOCK Sn-1 Sn)...))) rlm@2: #+end_src rlm@2: rlm@2: ** 2.2. The G0 TO Statement rlm@2: rlm@2: A more general imperative structure is the compound statement with rlm@2: labels and G0 T0s. Consider the following code fragment due to rlm@2: Jacopini, taken from Knuth: [Knuth 74] rlm@2: #+begin_src algol rlm@2: begin rlm@2: L1: if B1 then go to L2; S1; rlm@2: if B2 then go to L2; S2; rlm@2: go to L1; rlm@2: L2: S3; rlm@2: #+end_src rlm@2: rlm@2: It is perhaps surprising that this piece of code can be /syntactically/ rlm@2: transformed into a purely applicative style. For example, in SCHEME we rlm@2: could write: rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (let rlm@2: [L1 (fn[] rlm@2: (if B1 (L2) (do S1 rlm@2: (if B2 (L2) (do S2 (L1)))))) rlm@2: L2 (fn[] S3)] rlm@2: (L1)) rlm@2: #+end_src rlm@2: rlm@2: As with the D0 loop, this transformation depends critically on SCHEME's rlm@2: treatment of tail-recursion and on lexical scoping of variables. The labels rlm@2: are names of functions of no arguments. In order to ‘go to" the labeled code, rlm@2: we merely call the function named by that label. rlm@2: rlm@2: ** 2.3. Simple Assignment rlm@2: Of course, all this sequencing of statements is useless unless the rlm@2: statements have side effects. An important side effect is assignment. For rlm@2: example, one often uses assignment to place intermediate results in a named rlm@2: location (i.e. a variable) so that they may be used more than once later rlm@2: without recomputing them: rlm@2: rlm@2: #+begin_src algol rlm@2: begin rlm@2: real a2, sqrtdisc; rlm@2: a2 := 2*a; rlm@2: sqrtdisc := sqrt(b^2 - 4*a*c); rlm@2: root1 := (- b + sqrtdisc) / a2; rlm@2: root2 := (- b - sqrtdisc) / a2; rlm@2: print(root1); rlm@2: print(root2); rlm@2: print(root1 + root2); rlm@2: end rlm@2: #+end_src rlm@2: rlm@2: It is well known that such naming of intermediate results may be accomplished rlm@2: by calling a function and binding the formal parameter variables to the rlm@2: results: rlm@2: rlm@2: #+begin_src clojure rlm@2: (fn [a2 sqrtdisc] rlm@2: ((fn[root1 root2] rlm@2: (do (println root1) rlm@2: (println root2) rlm@2: (println (+ root1 root2)))) rlm@2: (/ (+ (- b) sqrtdisc) a2) rlm@2: (/ (- (- b) sqrtdisc) a2)) rlm@2: rlm@2: (* 2 a) rlm@2: (sqrt (- (* b b) (* 4 a c)))) rlm@2: #+end_src rlm@2: This technique can be extended to handle all simple variable assignments which rlm@2: appear as statements in blocks, even if arbitrary G0 T0 statements also appear rlm@2: in such blocks. {Note Mccarthywins} rlm@2: rlm@2: For example, here is a program which uses G0 TO statements in the form rlm@2: presented before; it determines the parity of a non-negative integer by rlm@2: counting it down until it reaches zero. rlm@2: rlm@2: #+begin_src algol rlm@2: begin rlm@2: L1: if a = 0 then begin parity := 0; go to L2; end; rlm@2: a := a - 1; rlm@2: if a = 0 then begin parity := 1; go to L2; end; rlm@2: a := a - 1; rlm@2: go to L1; rlm@2: L2: print(parity); rlm@2: #+end_src rlm@2: rlm@2: This can be expressed in SCHEME: rlm@2: rlm@2: #+begin_src clojure rlm@2: (let rlm@2: [L1 (fn [a parity] rlm@2: (if (zero? a) (L2 a 0) rlm@2: (L3 (dec a) parity))) rlm@2: L3 (fn [a parity] rlm@2: (if (zero? a) (L2 a 1) rlm@2: (L1 (dec a) parity))) rlm@2: L2 (fn [a parity] rlm@2: (println parity))] rlm@2: (L1 a parity)) rlm@2: #+end_src rlm@2: rlm@2: The trick is to pass the set of variables which may be altered as arguments to rlm@2: the label functions. {Note Flowgraph} It may be necessary to introduce new rlm@2: labels (such as L3) so that an assignment may be transformed into the binding rlm@2: for a function call. At worst, one may need as many labels as there are rlm@2: statements (not counting the eliminated assignment and GO TO statements). rlm@2: rlm@2: ** Compound Expressions ' rlm@2: At this point we are almost in a position to model the most general rlm@2: form of compound statement. In LISP, this is called the 'PROG feature". In rlm@2: addition to statement sequencing and G0 T0 statements, one can return a /value/ rlm@2: from a PROG by using the RETURN statement. rlm@2: rlm@2: Let us first consider the simplest compound statement, which in SCHEME rlm@2: we call BLOCK. Recall that rlm@2: =(BLOCK s1 sz)= is defined to be =((lambda (dummy) s2) s1)= rlm@2: rlm@2: Notice that this not only performs Sl before S2, but also returns the value of rlm@2: S2. Furthermore, we defined =(BLOCK S1 S2 ... Sn)= so that it returns the value rlm@2: of =Sn=. Thus BLOCK may be used as a compound expression, and models a LISP rlm@2: PROGN, which is a PROG with no G0 T0 statements and an implicit RETURN of the rlm@2: last ``statement'' (really an expression). rlm@2: rlm@2: Host LISP compilers compile D0 expressions by macro-expansion. We have rlm@2: already seen one way to do this in SCHEME using only variable binding. A more rlm@2: common technique is to expand the D0 into a PROG, using variable assignments rlm@2: instead of bindings. Thus the iterative factorial program: rlm@2: rlm@2: #+begin_src clojure rlm@2: (oarxnz FACT . rlm@2: (LAMaoA (n) . rlm@2: (D0 ((M N (- H 1)) rlm@2: (Ans 1 (* M Ans))) rlm@2: ((- H 0) A"$)))) rlm@2: #+end_src rlm@2: rlm@2: would expand into: rlm@2: rlm@2: #+begin_src clojure rlm@2: (DEFINE FACT rlm@2: . (LAMeoA (M) rlm@2: (PRO6 (M Ans) rlm@2: (sszro M n rlm@2: Ans 1) ~ rlm@2: LP (tr (- M 0) (RETURN Ans)) rlm@2: (ssero M (- n 1) rlm@2: Ans (' M Ans)) rlm@2: (60 LP)))) rlm@2: #+end_src rlm@2: rlm@2: where SSETQ is a simultaneous multiple assignment operator. (SSETQ is not a rlm@2: SCHEME (or LISP) primitive. It can be defined in terms of a single assignment rlm@2: operator, but we are more interested here in RETURN than in simultaneous rlm@2: assignment. The SSETQ's will all be removed anyway and modelled by lambda rlm@2: binding.) We can apply the same technique we used before to eliminate G0 T0 rlm@2: statements and assignments from compound statements: rlm@2: rlm@2: #+begin_src clojure rlm@2: (DEFINE FACT rlm@2: (LAHBOA (I) rlm@2: (LABELS ((L1 (LAManA (M Ans) rlm@2: (LP n 1))) rlm@2: (LP (LAMaoA (M Ans) rlm@2: (IF (- M o) (nztunn Ans) rlm@2: (£2 H An$)))) rlm@2: (L2 (LAMaoA (M An ) rlm@2: (LP (- " 1) (' H flN$))))) rlm@2: (L1 NIL NlL)))) rlm@2: #+end_src clojure rlm@2: rlm@2: We still haven't done anything about RETURN. Let's see... rlm@2: - ==> the value of (FACT 0) is the value of (Ll NIL NIL) rlm@2: - ==> which is the value of (LP 0 1) rlm@2: - ==> which is the value of (IF (= 0 0) (RETURN 1) (L2 0 1)) rlm@2: - ==> which is the value of (RETURN 1) rlm@2: rlm@2: Notice that if RETURN were the /identity rlm@2: function/ (LAMBDA (X) X), we would get the right answer. This is in fact a rlm@2: general truth: if we Just replace a call to RETURN with its argument, then rlm@2: our old transformation on compound statements extends to general compound rlm@2: expressions, i.e. PROG. rlm@2: rlm@2: * Continuations rlm@2: Up to now we have thought of SCHEME's LAMBDA expressions as functions, rlm@2: and of a combination such as =(G (F X Y))= as meaning ``apply the function F to rlm@2: the values of X and Y, and return a value so that the function G can be rlm@2: applied and return a value ...'' But notice that we have seldom used LAMBDA rlm@2: expressions as functions. Rather, we have used them as control structures and rlm@2: environment modifiers. For example, consider the expression: rlm@2: =(BLOCK (PRINT 3) (PRINT 4))= rlm@2: rlm@2: This is defined to be an abbreviation for: rlm@2: =((LAMBDA (DUMMY) (PRINT 4)) (PRINT 3))= rlm@2: rlm@2: We do not care about the value of this BLOCK expression; it follows that we rlm@2: do not care about the value of the =(LAMBDA (DUMMY) ...)=. We are not using rlm@2: LAMBDA as a function at all. rlm@2: rlm@2: It is possible to write useful programs in terms of LAHBDA expressions rlm@2: in which we never care about the value of /any/ lambda expression. We have rlm@2: already demonstrated how one could represent any "FORTRAN" program in these rlm@2: terms: all one needs is PROG (with G0 and SETQ), and PRINT to get the answers rlm@2: out. The ultimate generalization of this imperative programing style is rlm@2: /continuation-passing/. (Note Churchwins} . rlm@2: rlm@2: ** Continuation-Passing Recursion rlm@2: Consider the following alternative definition of FACT. It has an extra rlm@2: argument, the continuation, which is a function to call with the answer, when rlm@2: we have it, rather than return a value rlm@2: rlm@2: #+begin_src algol. rlm@2: procedure Inc!(n, c); value n, c; rlm@2: integer n: procedure c(integer value); rlm@2: if n-=0 then c(l) else rlm@2: begin rlm@2: procedure l(!mp(d) value a: integer a; rlm@2: c(mm); rlm@2: Iacl(n-1, romp): rlm@2: end; rlm@2: #+end_src rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn fact-cps[n k] rlm@2: (if (zero? n) (k 1) rlm@2: (recur (dec n) (fn[a] (k (* n a)))))) rlm@2: #+end_src clojure rlm@2: It is fairly clumsy to use this version of‘ FACT in ALGOL; it is necessary to rlm@2: do something like this: rlm@2: rlm@2: #+begin_src algol rlm@2: begin rlm@2: integer ann rlm@2: procedure :emp(x); value 2:; integer x; rlm@2: ans :1 x; rlm@2: ]'act(3. temp); rlm@2: comment Now the variable "am" has 6; rlm@2: end; rlm@2: #+end_src rlm@2: rlm@2: Procedure =fact= does not return a value, nor does =temp=; we must use a side rlm@2: effect to get the answer out. rlm@2: rlm@2: =FACT= is somewhat easier to use in SCHEME. We can call it like an rlm@2: ordinary function in SCHEME if we supply an identity function as the second rlm@2: argument. For example, =(FACT 3 (LAMBDA (X) X))= returns 6. Alternatively, we rlm@2: could write =(FACT 3 (LAHBDA (X) (PRINT X)))=; we do not care about the value rlm@2: of this, but about what gets printed. A third way to use the value is to rlm@2: write rlm@2: =(FACT 3 (LAMBDA (x) (SQRT x)))= rlm@2: instead of rlm@2: =(SQRT (FACT 3 (LAMBDA (x) x)))= rlm@2: rlm@2: In either of these cases we care about the value of the continuation given to rlm@2: FACT. Thus we care about the value of FACT if and only if we care about the rlm@2: value of its continuation! rlm@2: rlm@2: We can redefine other functions to take continuations in the same way. rlm@2: For example, suppose we had arithmetic primitives which took continuations; to rlm@2: prevent confusion, call the version of "+" which takes a continuation '++", rlm@2: etc. Instead of writing rlm@2: =(- (+ B Z)(* 4 A C))= rlm@2: we can write rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn enable-continuation "Makes f take a continuation as an additional argument."[f] rlm@2: (fn[& args] ((fn[k] (k (apply f (reverse (rest (reverse args)))))) (last args)) )) rlm@2: (def +& (enable-continuation +)) rlm@2: (def *& (enable-continuation *)) rlm@2: (def -& (enable-continuation -)) rlm@2: rlm@2: rlm@2: (defn quadratic[a b c k] rlm@2: (*& b b rlm@2: (fn[x] (*& 4 a c rlm@2: (fn[y] rlm@2: (-& x y k)))))) rlm@2: #+end_src rlm@2: rlm@2: where =k= is the continuation for the entire expression. rlm@2: rlm@2: This is an obscure way to write an algebraic expression, and we would rlm@2: not advise writing code this way in general, but continuation-passing brings rlm@2: out certain important features of the computation: rlm@2: - [1] The operations to be performed appear in the order in which they are rlm@2: performed. In fact, they /must/ be performed in this rlm@2: order. Continuation- passing removes the need for the rule about rlm@2: left-to-right argument evaluation{Note Evalorder) rlm@2: - [2] In the usual applicative expression there are two implicit rlm@2: temporary values: those of =(* B B)= and =(* 4 A C)=. The first of rlm@2: these values must be preserved over the computation of the second, rlm@2: whereas the second is used as soon as it is produced. These facts rlm@2: are /manifest/ in the appearance and use of the variable X and Y in rlm@2: the continuation-passing version. rlm@2: rlm@2: In short, the continuation-passing version specifies /exactly/ and rlm@2: explicitly what steps are necessary to compute the value of the rlm@2: expression. One can think of conventional functional application rlm@2: for value as being an abbreviation for the more explicit rlm@2: continuation-passing style. Alternatively, one can think of the rlm@2: interpreter as supplying to each function an implicit default rlm@2: continuation of one argument. This continuation will receive the rlm@2: value of the function as its argument, and then carry on the rlm@2: computation. In an interpreter this implicit continuation is rlm@2: represented by the control stack mechanism for function returns. rlm@2: Now consider what computational steps are implied by: rlm@2: rlm@2: =(LAMBDA (A B C ...) (F X Y Z ...))= when we "apply" the LAMBDA rlm@2: expression we have some values to apply it to; we let the names A, rlm@2: B, C ... refer to these values. We then determine the values of X, rlm@2: Y, Z ... and pass these values (along with "the buck", rlm@2: i.e. control!) to the lambda expression F (F is either a lambda rlm@2: expression or a name for one). Passing control to F is an rlm@2: unconditional transfer. (Note Jrsthack) {Note Hewitthack) Note that rlm@2: we want values from X, Y, Z, ... If these are simple expressions, rlm@2: such as variables, constants, or LAMBDA expressions, the evaluation rlm@2: process is trivial, in that no temporary storage is required. In rlm@2: pure continuation-passing style, all evaluations are trivial: no rlm@2: combination is nested within another, and therefore no ‘hidden rlm@2: temporaries" are required. But if X is a combination, say (G P Q), rlm@2: then we want to think of G as a function, because we want a value rlm@2: from it, and we will need an implicit temporary place to keep the rlm@2: result while evaluating Y and Z. (An interpreter usually keeps these rlm@2: temporary places in the control stack!) On the other hand, we do not rlm@2: necessarily need a value from F. This is what we mean by tail- rlm@2: recursion: F is called tail-recursively, whereas G is not. A better rlm@2: name for tail-recursion would be "tail-transfer", since no real rlm@2: recursion is implied. This is why we have made such a fuss about rlm@2: tail-recursion: it can be used for transfer of control without rlm@2: making any commitment about whether the expression expected to rlm@2: return a value. Thus it can be used to model statement-like control rlm@2: structures. Put another way, tail—recursion does not require a rlm@2: control stack as nested recursion does. In our models of iteration rlm@2: and imperative style all the LAMBDA expressions used for control (to rlm@2: simulate GO statements, for example) are called in tail-recursive rlm@2: fashion. rlm@2: rlm@2: ** Escape Expressions rlm@2: Reynolds [Reynolds 72] defines the construction rlm@2: = escape x in r = rlm@2: rlm@2: to evaluate the expression $r$ in an environment such that the variable $x$ is rlm@2: bound to an escape function. If the escape function is never applied, then rlm@2: the value of the escape expression is the value of $r$. If the escape function rlm@2: is applied to an argument $a$, however, then evaluation of $r$ is aborted and the rlm@2: escape expression returns $a$. {Note J-operator} (Reynolds points out that rlm@2: this definition is not quite accurate, since the escape function may be called rlm@2: even after the escape expression has returned a value; if this happens, it rlm@2: “returns again"!) rlm@2: rlm@2: As an example of the use of an escape expression, consider this rlm@2: procedure to compute the harmonic mean of an array of numbers. If any of the rlm@2: numbers is zero, we want the answer to be zero. We have a function hannaunl rlm@2: which will sum the reciprocals of numbers in an array, or call an escape rlm@2: function with zero if any of the numbers is zero. (The implementation shown rlm@2: here is awkward because ALGOL requires that a function return its value by rlm@2: assignment.) rlm@2: #+begin_src algol rlm@2: begin rlm@2: real procedure Imrmsum(a, n. escfun)§ p rlm@2: real array at integer n; real procedure esciun(real); rlm@2: begin rlm@2: real sum; rlm@2: sum := 0; rlm@2: for i :1 0 until n-l do rlm@2: begin rlm@2: if a[i]=0 then cscfun(0); rlm@2: sum :1 sum ¢ I/a[i]; rlm@2: enm rlm@2: harmsum SI sum; rlm@2: end: . rlm@2: real array b[0:99]: rlm@2: print(escape x in I00/hm-m.mm(b, 100, x)); rlm@2: end rlm@2: #+end_src rlm@2: rlm@2: If harmsum exits normally, the number of elements is divided by the sum and rlm@2: printed. Otherwise, zero is returned from the escape expression and printed rlm@2: without the division ever occurring. rlm@2: This program can be written in SCHEME using the built-in escape rlm@2: operator =CATCH=: rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn harmonic-sum[coll escape] rlm@2: ((fn [i sum] rlm@2: (cond (= i (count coll) ) sum rlm@2: (zero? (nth coll i)) (escape 0) rlm@2: :else (recur (inc i) (+ sum (/ 1 (nth coll i)))))) rlm@2: 0 0)) rlm@2: rlm@2: #+end_src rlm@2: rlm@2: This actually works, but elucidates very little about the nature of ESCAPE. rlm@2: We can eliminate the use of CATCH by using continuation-passing. Let us do rlm@2: for HARMSUM what we did earlier for FACT. Let it take an extra argument C, rlm@2: which is called as a function on the result. rlm@2: rlm@2: #+begin_src clojure rlm@2: (in-ns 'categorical.imperative) rlm@2: (defn harmonic-sum-escape[coll escape k] rlm@2: ((fn[i sum] rlm@2: (cond (= i (count coll)) (k sum) rlm@2: (zero? (nth coll i)) (escape 0) rlm@2: (recur (inc i) (+ sum (/ 1 (nth coll i)))))) rlm@2: 0 0)) rlm@2: rlm@2: (let [B (range 0 100) rlm@2: after-the-catch println] rlm@2: (harmonic-sum-escape B after-the-catch (fn[y] (after-the-catch (/ 100 y))))) rlm@2: rlm@2: #+end_src rlm@2: rlm@2: Notice that if we use ESCFUN, then C does not get called. In this way the rlm@2: division is avoided. This example shows how ESCFUN may be considered to be an rlm@2: "alternate continuation". rlm@2: rlm@2: ** Dynamic Variable Scoping rlm@2: In this section we will consider the problem of dynamically scoped, or rlm@2: "fluid", variables. These do not exist in ALGOL, but are typical of many LISP rlm@2: implementations, ECL, and APL. He will see that fluid variables may be rlm@2: modelled in more than one way, and that one of these is closely related to rlm@2: continuation—pass1ng. rlm@2: rlm@2: *** Free (Global) Variables rlm@2: Consider the following program to compute square roots: rlm@2: rlm@2: #+begin_src clojure rlm@2: (defn sqrt[x tolerance] rlm@2: ( rlm@2: (DEFINE soar rlm@2: (LAHBDA (x EPSILON) rlm@2: (Pace (ANS) rlm@2: (stro ANS 1.0) rlm@2: A (coup ((< (ADS (-s x (~s ANS ANS))) EPSILON) rlm@2: (nzruau ANS))) ' rlm@2: (sero ANS (//s (+5 x (//s x ANS)) 2.0)) rlm@2: (60 A)))) . rlm@2: This function takes two arguments: the radicand and the numerical tolerance rlm@2: for the approximation. Now suppose we want to write a program QUAD to compute rlm@2: solutions to a quadratic equation; p rlm@2: (perms QUAD rlm@2: (LAHDDA (A a c) rlm@2: ((LAHBDA (A2 sonmsc) ' rlm@2: (LIST (/ (+ (- a) SQRTDISC) AZ) rlm@2: (/ (- (- B) SORTOISC) AZ))) rlm@2: (' 2 A) rlm@2: - (SORT (- (9 D 2) (' 4 A C)) (tolerance>)))) rlm@2: #+end_src rlm@2: It is not clear what to write for (tolerance). One alternative is to pick rlm@2: some tolerance for use by QUAD and write it as a constant in the code. This rlm@2: is undesirable because it makes QUAD inflexible and hard to change. _Another rlm@2: is to make QUAD take an extra argument and pass it to SQRT: rlm@2: (DEFINE QUAD rlm@2: (LANODA (A 8 C EPSILON) rlm@2: (soar ... EPSILON) ...)) rlm@2: This is undesirable because EPSILDN is not really part of the problem QUAD is rlm@2: supposed to solve, and we don't want the user to have to provide it. rlm@2: Furthermore, if QUAD were built into some larger function, and that into rlm@2: another, all these functions would have to pass EPSILON down as an extra rlm@2: argument. A third.possibi1ity would be to pass the SQRT function as an rlm@2: argument to QUAD (don't laugh!), the theory being to bind EPSILON at the rlm@2: appropriate level like this: A U‘ A rlm@2: (QUAD 3 A 5 (LAMBDA (X) (SORT X ))) rlm@2: where we define QUAD as: rlm@2: (DEFINE QUAD rlm@2: (LAMBDA (A a c soar) ...))