Scheme: An Interpreter for Extended Lambda Calculus/Section 2
Section 2: Some SCHEME Programming Examples edit
Traditional Recursion edit
Here is the good old familiar recursive definition of factorial, written in SCHEME.
(DEFINE FACT (LAMBDA (N) (IF (= N 0) 1 (* N (FACT (- N 1))))))
What About Iteration? edit
There are many other ways to compute factorial. One important way is through the use of iteration. Consider the following definition of FACT. Although it appears to be recursive, since it "calls itself", it captures the essence of our intuitive notion of iteration, because execution of this program will not produce internal structures (e.g. stacks or variable bindings) which increase in size with the number of iteration steps. This surprising fact will be explained in two ways.
- We will consider programming styles in terms of substitution semantics of the lambda calculus (Section 3).
- We will show how the SCHEME interpreter is implemented (Sections 4,5).
(DEFINE FACT (LAMBDA (N) (LABELS ((FACT1 (LAMBDA (M ANS) (IF (= M 0) ANS (FACT1 (- M 1) (* M ANS)))))) (FACT1 N 1))))
A common iterative construct is the DO loop. The most general form we have seen in any programming language is the MacLISP DO [Moon]. It permits the simultaneous initialization of any number of control variables and the simultaneous stepping of these variables by arbitrary functions at each iteration step. The loop is terminated by an arbitrary predicate, and an arbitrary value may be returned. The DO loop may have a body, a series of expressions executed for effect on each iteration.
The general form of a MacLISP DO is:
(DO ((<var1> <init1> <step1>) (<var2> <init2> <step2>) . . . (<varn> <initn> <stepn>)) (<pred> <value>) <body>)
The semantics of this are that the variables are bound and initialized to the values of the <initi> expressions, which must all be evaluated in the environment outside the DO; then the predicate <pred> is evaluated in the new environment, and if TRUE, the <value> is evaluated and returned. Otherwise the body is evaluated, then each of the steppers <stepi> is evaluated in the current environment, all the variables made to have the results as their values, and the predicate evaluated again, and so on.
For example, the following MacLISP function:
(DEFUN REV (L) (DO ((L1 L (CDR L1)) (ANS NIL (CONS (CAR L1) ANS))) ((NULL L1) ANS)))
computes the reverse of a list. In SCHEME, we could write the same function, in the same iterative style, as follows:
(DEFINE REV (LAMBDA (L) (LABELS ((DOLOOP (LAMBDA (L1 ANS) (IF (NULL L1) ANS (DOLOOP (CDR L1) (CONS (CAR L1) ANS)))))) (DOLOOP L NIL))))
From this we can infer a general way to express iterations in SCHEME in a manner isomorphic to the MacLISP DO:
(LABELS ((DOLOOP (LAMBDA (<dummy> <var1> <var2> ... <varn>) (IF <pred> <value> (DOLOOP <body> <step1> <step2> ... <stepn>))))) (DOLOOP NIL <init1> <init2> ... <initn>))
This is in fact what the supplied DO AMACRO expands into. Note that there are no side effects in the steppings of the iteration variables.
Another Way To Do Recursion edit
Now consider the following alternative definition of FACT. It has an extra argument, the continuation [Reynolds], which is a function to call with the answer, when we have it, rather than return a value; that is, rather than ultimately reducing to the desired value, it reduces to a combination which is the application of the continuation to the desired value.
(DEFINE FACT (LAMBDA (N C) (IF (= N 0) (C 1) (FACT (- N 1) (LAMBDA (A) (C (* N A)))))))
Note that we can call this like an ordinary function if we supply (LAMBDA (X) X) as the second argument. For example, (FACT 3 (LAMBDA (X) X)) returns 6.
Apparently "Hairy" Control Structure edit
A classic problem difficult to solve in most programming languages, including standard (stack-oriented) LISP, is the samefringe problem [Smith and Hewitt]. The problem is to determine whether the fringes of two trees are the same, even if the internal structures of the trees are not. This problem is easy to solve if one merely computes the fringe of each tree separately as a list, and then compares the two lists. We would like to solve the problem so that the fringes are generated and compared incrementally. This is important if the fringes of the trees are very large, but differ, say, in the first position.
Consider the following obscure solution to samefringe, which is in fact isomorphic to the one written by Shrobe and presented by Smith and Hewitt. Note that SCHEME does not have the packagers of PLASMA, and so we were forced to use continuations; rather than using packages and a next operator, we pass a fringe a continuation (called the "getter") which will get the next and the rest of the fringe as its two arguments.
(DEFINE FRINGE (LAMBDA (TREE) (LABELS ((FRINGEN (LAMBDA (NODE ALT) (LAMBDA (GETTER) (IF (ATOM NODE) (GETTER NODE ALT) ((FRINGEN (CAR NODE) (LAMBDA (GETTER1) ((FRINGEN (CDR NODE) ALT) GETTER1))) GETTER)))))) (FRINGEN TREE (LAMBDA (GETTER) (GETTER '(EXHAUSTED) NIL))))))
(DEFINE SAMEFRINGE (LAMBDA (TREE1 TREE2) (LABELS ((SAME (LAMBDA (S1 S2) (S1 (LAMBDA (X1 R1) (S2 (LAMBDA (X2 R2) (IF (EQUAL X1 X2) (IF (EQUAL X1 '(EXHAUSTED)) T (SAME R1 R2)) NIL)))))))) (SAME (FRINGE TREE1) (FRINGE TREE2)))))
Now let us consider an alternative solution to the samefringe problem. We believe that this solution is clearer for two reasons:
- the implementation of
SAMEFRINGEis more clearly iterative; - rather than returning an object which will return both the first and the rest of a fringe to a given continuation,
FRINGEreturns an object which will deliver up a component in response to a request for that component.
(DEFINE FRINGE (LAMBDA (TREE) (LABELS ((FRINGE1 (LAMBDA (NODE ALT) (IF (ATOM NODE) (LAMBDA (MSG) (IF (EQ MSG 'FIRST) NODE (IF (EQ MSG 'NEXT) (ALT) (ERROR)))) (FRINGE1 (CAR NODE) (LAMBDA () (FRINGE1 (CDR NODE) ALT))))))) (FRINGE1 TREE (LAMBDA () (LAMBDA (MSG) (IF (EQ MSG 'FIRST) '*EOF* (ERROR))))))))
(DEFINE SAMEFRINGE (LAMBDA (T1 T2) (DO ((C1 (FRINGE T1) (C1 'NEXT)) (C2 (FRINGE T2) (C2 'NEXT))) ((OR (NOT (EQ (C1 'FIRST) (C2 'FIRST))) (EQ (C1 'FIRST) '*EOF*) (EQ (C2 'FIRST) '*EOF*)) (EQ (C1 'FIRST) (C2 'FIRST))))))
A much simpler and more probable problem is that of building a pattern matcher with backtracking for segment matches. The matcher presented below is intended for matching single-level list structure patterns against lists of atoms. A pattern is a list containing three types of elements:
- constant atoms, which match themselves only.
(THV x), which matches any single element in the expression consistently. We may abbreviate this as?xby means of a LISP reader macro character.(THV* x), which matches any segment of zero or more elements in the expression consistently. We may abbreviate this as!x.
The matcher returns either NIL, meaning no match is possible, or a list of two items, an alist specifying the bindings of the match variables, and a continuation to call, if you don't like this particular set of bindings, which will attempt to find another match. Thus, for example, the invocation
(MATCH '(A !B ?C ?C !B !E) '(A X Y Q Q X Y Z Z X Y Q Q X Y R))
would return the result
(((E (Z Z X Y Q Q X Y R)) (C Q) (B X Y)) <continuation1>)
where calling <continuation1> as a function of no arguments would produce the result
(((E (R)) (C Z) (B (X Y Q Q X Y))) <continuation2>)
where calling <continuation2> would produce NIL.
The MATCH function makes use of two auxiliary functions called NFIRST and NREST. The former returns a list of the first n elements of a given list, while the latter returns the tail of the given list after the first n elements.
(DEFINE NFIRST (LAMBDA (E N) (IF (= N 0) NIL (CONS (CAR E) (NFIRST (CDR E) (- N 1)))))) (DEFINE NREST (LAMBDA (E N) (IF (= N 0) E (NREST (CDR E) (- N 1)))))
The main MATCH function also uses a subfunction called MATCH1 which takes four arguments: the tail of the pattern yet to be matched; the tail of the expression yet to be matched; the alist of match bindings made so far; and a continuation to call if the match fails at this point. A subfunction of MATCH, called MATCH*, handles the matching of segments of the expression against THV* match variables. It is in the matching of segments that the potential need for backtracking enters, for segments of various lengths may have to be tried. After MATCH* matches a segment, it calls MATCH1 to continue the match, giving it a failure continuation which will back up and try to match a longer segment if possible. A failure can occur if a constant fails to match, or if one or the other of pattern and expression runs out before the other one does.
(DEFINE MATCH (LAMBDA (PATTERN EXPRESSION) (LABELS ((MATCH1 (LAMBDA (P E ALIST LOSE) (IF (NULL P) (IF (NULL E) (LIST ALIST LOSE) (LOSE)) (IF (ATOM (CAR P)) (IF (NULL E) (LOSE) (IF (EQ (CAR E) (CAR P)) (MATCH1 (CDR P) (CDR E) ALIST LOSE) (LOSE))) (IF (EQ (CAAR P) 'THV) (IF (NULL E) (LOSE) ((LAMBDA (V) (IF V (IF (EQ (CAR E) (CADR V)) (MATCH1 (CDR P) (CDR E) ALIST LOSE) (LOSE)) (MATCH1 (CDR P) (CDR E) (CONS (LIST (CADAR P) (CAR E)) ALIST) LOSE))) (ASSQ (CADAR P) ALIST))) (IF (EQ (CAAR P) 'THV*) ((LAMBDA (V) (IF V (IF (< (LENGTH E) (LENGTH (CADR V))) (LOSE) (IF (EQUAL (NFIRST E (LENGTH (CADR V))) (CADR V)) (MATCH1 (CDR P) (NREST E (LENGTH (CADR V))) ALIST LOSE) (LOSE))) (LABELS ((MATCH* (LAMBDA (N) (IF (> N (LENGTH E)) (LOSE) (MATCH1 (CDR P) (NREST E N) (CONS (LIST (CADAR P) (NFIRST E N)) ALIST) (LAMBDA () (MATCH* (+ N 1)))))))) (MATCH* 0)))) (ASSQ (CADAR P) ALIST)) (LOSE)))))))) (MATCH1 PATTERN EXPRESSION NIL (LAMBDA () NIL)))))
A Useless Multiprocessing Example edit
One thing we might want to use multiprocessing for is to try two things in parallel, and terminate as soon as one succeeds. We can do this with the following function.
(DEFINE TRY!TWO!THINGS!IN!PARALLEL (LAMBDA (F1 F2) (CATCH C ((LAMBDA (P1 P2) ((LAMBDA (F1 F2) (EVALUATE!UNINTERRUPTIBLY (BLOCK (ASET 'P1 (CREATE!PROCESS '(F1))) (ASET 'P2 (CREATE!PROCESS '(F2))) (START!PROCESS P1) (START!PROCESS P2) (STOP!PROCESS **PROCESS**)))) (LAMBDA () ((LAMBDA (VALUE) (EVALUATE!UNINTERRUPTIBLY (BLOCK (STOP!PROCESS P2) (C VALUE)))) (Fl))) (LAMBDA () ((LAMBDA (VALUE) (EVALUATE!UNINTERRUPTIBLY (BLOCK (STOP!PROCESS P1) (C VALUE)))) (F2))))) NIL NIL))))
TRY!TWO!THINGS!IN!PARALLEL takes two functions of no arguments (in order to pass an unevaluated expression and its environment in for later use, so as to avoid variable conflicts). It creates two processes to run them, and returns the value of whichever completes first.
As an example of how to misuse TRY!TWO!THINGS!IN!PARALLEL, here is a function which determines the sign of an integer using only ADD1, SUB1, and EQUAL.
(DEFINE SIGN (LAMBDA (N) (IF (EQUAL N 0) 'ZERO (TRY!TWO!THINGS!IN!PARALLEL (LAMBDA () (DO ((I 0 (ADD1 1))) ((EQUAL I N) 'POSITIVE))) (LAMBDA () (DO ((I 0 (SUB1 1))) ((EQUAL I N) 'NEGATIVE)))))))