CS 61A Week 7 solutions LAB 1 EXERCISES =============== 3. Why doesn't make-procedure call eval? Because none of the arguments to lambda should be evaluated. In particular, the expressions that make up the body of the procedure are not evaluated until the procedure is *invoked*! 4.1, left-to-right (define (list-of-values exps env) ;; left to right (if (no-operands? exps) '() (let ((left (eval (first-operand exps) env))) (cons left (list-of-values (rest-operands exps) env))))) (define (list-of-values exps env) ;; right (if (no-operands? exps) '() (let ((right (list-of-values (rest-operands exps) env))) (cons (eval (first-operand exps) env) right)))) 4.2, Louis reordering (a) The trouble is that APPLICATION? cheats. The book has (define (application? exp) (pair? exp)) It really should be something like (define (application? exp) (and (pair? exp) (not (member (car exp) '(quote set! define if lambda begin cond))))) They get away with the shorter version precisely because EVAL doesn't call APPLICATION? until after it's checked for all the possible special forms. Louis (quite reasonably, I think) wants to rely on APPLICATION? behaving correctly no matter when it's called. (b) All we are changing is the syntax of an application, so we change the procedures that define the "application" abstract data type. These are on page 372 of the text. The new versions are: (define (application? exp) (tagged-list? exp 'call)) (define (operator exp) (cadr exp)) (define (operands exp) (cddr exp)) 4.4 AND and OR special forms The book suggests two solutions: make them primitive special forms or make them derived expressions. We'll do both. As primitive special forms: Change the COND clause in EVAL by adding (cond ... ((and? exp) (eval-and exp env)) ((or? exp) (eval-or exp env)) ...) (define (eval-and exp env) (define (iter tests) (cond ((null? tests) #t) ((null? (cdr tests)) (eval (car tests) env)) ((true? (eval (car tests) env)) (iter (cdr tests))) (else #f))) (iter (cdr exp))) (define (eval-or exp env) (define (iter tests) (if (null? tests) #f (let ((result (eval (car tests) env))) (if (true? result) result (iter (cdr tests)))))) (iter (cdr exp))) Now for the derived expression technique. Modify the COND clause in EVAL this way instead: (cond ... ((and? exp) (eval (and->if (cdr exp)) env)) ((or? exp) (eval (or->if (cdr exp)) env)) ...) (define (and->if exps) (cond ((null? exps) #t) ((null? (cdr exps)) (car exps)) (else (make-if (car exps) (and->if (cdr exps)) #f)))) (define (or->if exps) (if (null? exps) #f (make-if (car exps) (car exps) (or->if (cdr exps))))) This version is elegant but has the disadvantage that you end up computing the first true value twice. 4.5 Cond => notation (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "...")) (IF (COND-ARROW-CLAUSE? FIRST) (LIST (MAKE-LAMBDA '(COND-FOO) (MAKE-IF 'COND-FOO (LIST (COND-ARROW-DOER FIRST) 'COND-FOO) (EXPAND-CLAUSES REST))) (COND-PREDICATE FIRST)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest))))))) (define (cond-arrow-clause? clause) (and (pair? clause) (= (length clause) 3) (eq? (cadr clause) '=>))) (define (cond-arrow-doer clause) (caddr clause)) This may be a little confusing. What it does is to turn a clause like (test => recipient) into ((lambda (cond-foo) (if cond-foo (recipient cond-foo) )) test) Using the name cond-foo here is a kludge, because what if the user has used the same name for some other purpose within the clause? The right thing would be to generate an otherwise-untypable symbol each time. But this is complicated enough already. By the way, this is really trying to do (let ((cond-foo test)) (if ...)) but we don't yet have LET in the metacircular Scheme. It might be easier to do this by abandoning the whole idea of cond->if and just implementing cond directly. LAB 2 Exercises =============== 4.27 Lazy vs. mutation The first time you type COUNT you get 1; the second time you get 2. Why? When you say (define w (id (id 10))) the DEFINE special form handler eval-definition EVALs its second argument (id (id 10)). Given an application, EVAL calls APPLY to invoke ID for the outer invocation, but the inner invocation is providing an argument to a compound procedure, so it's delayed. That's why COUNT is 1 -- the outer call to ID has actually happened, but not the inner one. The value of W is therefore a promise to compute (id 10), since ID returns its argument. When you ask the evaluator to print W, that promise is fulfilled, and so COUNT becomes 2. 4.29 Memoizing or not You'd expect a program that uses the same argument repeatedly to be most strongly affected. For example, I wrote (define (n-copies n stuff) (if (= n 0) '() (cons stuff (n-copies (- n 1) stuff)))) Then if you use n-copies with something requiring a fair amount of computation, such as (n-copies 6 (factorial 7)) you can see a dramatic difference. About their square/id example, remember to (set! count 0) before each experiment. Then the memoizing version leaves count at 1, whereas the non-memoizing version sets count to 2. HOMEWORK ======== 1. Abelson and Sussman Exercises 4.3 data-directed eval The table itself could be done in several ways; perhaps the easiest is to use the built-in table from chapter 2. So we say: (put 'quote 'eval text-of-quotation) (put 'define 'eval eval-definition) (put 'set! 'eval eval-assignment) Where the original eval does something other than (foo exp env) we have to write an interface procedure. For example: (define (eval-lambda exp env) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) (put 'lambda 'eval eval-lambda) (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) (else (let ((form (get (operator exp) 'eval))) (if form ;; IT'S A SPECIAL FORM (form exp env) ;; SO form IS THE PROCEDURE TO CALL (apply (eval (operator exp) env) (list-of-values (operands exp) env) )))))) The first two COND clauses deal with atomic expressions: numbers (which are self-evaluating) and symbols (which represent variables). If the expression is neither of those, then it's a list, and we look at its CAR. We look that up in the table; if we find it, the expression is a special form, and we invoke the particular procedure that knows about that special form. Otherwise, it's a regular procedure. We're neglecting various kinds of errors that might occur with mal-formed input. We also have to rewrite text-of-quotation so that it accepts an extra input, the environment, even though it doesn't need it: (define (text-of-quotation exp env) (cadr exp)) And we have to write a new "front end" to cond->if: (define (eval-cond exp env) (eval (cond->if exp) env)) and put that in the table. 4.6 Implementing LET ;; In eval's big cond we put ((let? exp) (eval (let->combination exp) env)) ;; Now for the guts of the problem: (define (let->combination exp) (cons (make-lambda (let-formals exp) (let-body exp)) (let-actuals exp))) ;; And now for the data abstraction stuff: (define (let? exp) (tagged-list? exp 'let)) (define (let-formals exp) (map car (cadr exp))) (define (let-actuals exp) (map cadr (cadr exp))) (define (let-body exp) (cddr exp)) Please note that this problem becomes MUCH easier if you ruthlessly separate the semantics (let->combination) from the mickey mouse work of extracting the syntactic components. I actually wrote this in the order in which it appears here; in essence I solved the problem completely before I thought at all about syntactic issues. 4.7 Implementing Let* (define (let*->nested-lets exp) (if (null? (let-bindings exp)) (make-let '() (let-body exp)) (make-let (list (car (let-bindings exp))) (list (make-let* (cdr (let-bindings exp)) (let-body exp)))))) (define (let-bindings exp) (cadr exp)) (define (make-let bindings body) (cons 'let (cons bindings body))) (define (make-let* bindings body) (cons 'let* (cons bindings body))) I'm cheating slightly by using LET-BODY for a LET* expression instead of inventing a whole new abstract data type. In principle someone might want to change Scheme so that the syntax of LET* looks different from the syntax of LET. 4.13 make-unbound First, about the design issues: I see three possibilities. You can require that the symbol be bound in the current environment and remove that binding only; you can remove the nearest single binding; or you can remove all bindings of that symbol. Perhaps the best solution in any case where it's not obvious what the right semantics is would be to provide all three versions: unbind-this-frame, unbind-nearest, and unbind-all. That way the user can decide for herself what best suits the application at hand. Failing that, I vote for the second choice: removing the nearest binding. Here's why. First of all, the third version can be written in terms of the second: (define (unbind-all sym) (cond ((bound? sym) (unbind-nearest sym) (unbind-all sym)) (else '()))) (This assumes we have a predicate bound? that returns true if there is an accesible binding for the symbol. If we provide any form of unbinding we should probably provide that too.) But the second can't be written in terms of the third. So if we're only having one we should have the more flexible one. I rule out the first (current frame only) because I can easily imagine wanting to write a procedure like (define (cleanup) (make-unbound 'a) (make-unbound 'b) (make-unbound 'c)) that removes global variables at the end of a computation, but this wouldn't be possible under the first option. (Why not?) I have also implicitly decided another design question: should this be a special form that requires an unevaluated symbol, like set!, or should it be an ordinary procedure whose actual parameter is evaluated? In order to make things like unbind-all (above) work, it should be an ordinary procedure. (What I want to get unbound is the actual argument to unbind-all, not the symbol "sym" itself.) Then again, I think set! should be an ordinary procedure, too, so perhaps you're asking the wrong person. Trouble is, we can't REALLY make make-unbound an ordinary procedure because it has to have access to the environment. If Scheme were dynamically scoped, any procedure in the evaluator could just make a free reference to "env" to get the current user environment, but as it is we have to have eval treat make-unbound specially. So we'll make it a special form but still have it evaluate everything. (define (eval-make-unbound exp env) (define (unbind-in-frame sym frame) (define (remove-not-first-binding vars vals) (if (eq? sym (cadr vars)) (begin (set-cdr! vars (cddr vars)) (set-cdr! vals (cddr vals))) (remove-not-first-binding (cdr vars) (cdr vals)))) (if (eq? sym (car (frame-variables frame))) (begin (set-car! frame (cdr (frame-variables frame))) (set-cdr! frame (cdr (frame-values frame)))) (remove-not-first-binding (frame-variables frame) (frame-values frame)))) (define (env-iter sym env) (cond ((eq? env the-empty-environment) 'okay) ((memq sym (frame-variables (first-frame env))) (unbind-in-frame sym (first-frame env))) (else (env-iter sym (enclosing-environment env))))) (env-iter (cadr exp) env)) This is rather messier than one might wish, because if the binding in question is the first one in a frame, we have to remove it differently from if it's not the first in a frame. In the first case we mutate the header pair of the frame; in the second case we splice elements out of two lists. Had this evaluator been written with unbinding in mind, they might have picked a different data structure. Env-iter looks for the first frame in which the symbol is bound, then unbinds it in that frame. Unbind-in-frame first checks the first binding specially, then uses remove-not-first-binding to check the other bindings. Strictly speaking, I should have made mutators for the frame abstraction. The obvious choice would be set-frame-variables! and set-frame-values!, but actually that only makes sense if we know that the frame is represented as two parallel lists. If the frame is represented as an a-list, as in exercise 4.11, then a better choice would be set-frame-bindings!. So the really right thing, to keep the abstraction barrier solid, is to have a mutator frame-remove-binding! that would be like the unbind-in-frame part of the code above. It would be different for different representations, but would have the same effect above the abstraction barrier. Finally, we have to modify eval, adding ((make-unbound? exp) (eval-make-unbound exp env)) to the big cond. (define (make-unbound? exp) (tagged-list? exp 'make-unbound)) 4.14 why doesn't map work? This question is about level confusion. Let's talk about meta-Scheme, the one implemented by the metacircular evaluator, and under-Scheme, the regular Scheme in which the MCE is written. Eva defines MAP in meta-Scheme. In particular, when MAP tries to invoke a meta-Scheme procedure for each element of the list, it's doing a meta-Scheme invocation. Louis uses the MAP that's defined in under-Scheme. When he calls MAP, he is giving it a meta-Scheme procedure as its first argument, but it's expecting an under-Scheme procedure. From the point of view of under-Scheme, a meta-Scheme procedure isn't a procedure at all -- it's a list whose car is the word PROCEDURE. 4.15 the halting problem This is the most famous problem in automata theory, the most elegant proof that some things can't be done no matter how sophisticated our computers become. The proof was first given using the "Turing machine," an abstract machine that's used only for proving theorems. But the same idea works in any formal system that's capable of representing a procedure as data; the key element of the proof is the fact that the hypothetical HALTS? is a higher-order function. Suppose that (HALTS? TRY TRY) returns #T. Then when we call (TRY TRY) it says, after argument substitution, (if (halts? try try) (run-forever) 'halted) But this will run forever, and so (TRY TRY) runs forever, and so (HALTS? TRY TRY) should have returned #F. Similarly, suppose that (HALTS? TRY TRY) returns #F. Then (TRY TRY) turns into the same IF expression shown above, but this time the value of that expression is the word HALTED -- that is, it halts. So (HALTS? TRY TRY) should have returned #T. 4.23 Efficiency of analyze-sequence For a sequence with just one expression, the book's version does the following analysis: First, the body of analyze-sequence is the LET. Suppose that the result of analyzing the one expression is PROC. Then the variable PROCS will have as its value a list whose only element is PROC. That's not null, so (still in the analysis part) we call (LOOP PROC '()). In LOOP, since (in this case) REST-PROCS is null, LOOP just returns PROC. So if the analysis of EXP gives PROC, then the analysis of (BEGIN EXP) also gives PROC. In the same one-expression case, Alyssa's version returns (lambda (env) (execute-sequence (list PROC) env)) So every time this execution procedure is called, execute-sequence will check that (cdr procs) is empty, which it is, and then calls PROC with the environment as its argument. This test of (null? (cdr procs)) is done for every execution, whereas in the book's version it was done just once. How about the two-expression case. Suppose that the analysis of EXP1 gives PROC1, and the anaylsis of EXP2 gives PROC2. The book's version will call, in effect, (loop PROC1 (list PROC2)). This in turn calls (sequentially PROC1 PROC2), which returns (lambda (env) (PROC1 env) (PROC2 env)) as the execution procedure. (There is a recursive call to LOOP, but it doesn't change the result, because this time the second argument is null.) Alyssa's version makes the execution procedure be (lambda (env) (execute-sequence (list PROC1 PROC2) env))) which in effect means (lambda (env) (cond ((null? (list PROC2)) ...) (else (PROC1 env) (cond ((null? '()) (PROC2 env)) ...)))) Each time this is executed, we do two unnecessary checks for the nullness of a list -- unnecessary because we already knew while doing the analysis how many expressions are in the sequence. 4.24 How fast? Hint: You'll get the most dramatic results when an expression is evaluated over and over, i.e., with a recursive procedure. 4.26 Normal order vs. special forms For Ben's side of the argument we must implement UNLESS as a derived expression: (define (unless->if exp) (make-if (unless-predicate exp) (unless-consequent exp) (unless-alternative exp))) (define unless-predicate cadr) (define unless-alternative caddr) (define unless-consequent cadddr) Notice that we reversed the order of the last two subexpressions in the call to make-if. Then we just add a clause ((unless? exp) (eval (unless->if exp) env)) to the ordinary metacircular evaluator, or ((unless? exp) (analyze (unless->if exp))) to the analyzing evaluator. For Alyssa's side of the argument, we need a case in which it's useful to have a Scheme special form available as an ordinary procedure. The only thing we can do with ordinary procedures but not with special forms is use them as arguments to higher-order procedures. An example using UNLESS will be a little strained, so first we'll look at a more common situation involving a different special form, namely AND. We'd like to be able to say (define (all-true? tf-list) (accumulate and tf-list)) Now, here's the strained example using UNLESS: Suppose we have a list of true-false values and we'd like to add up the number of true ones. Here's a somewhat strange way to do it: (define zero-list (cons 0 '())) (set-cdr! zero-list zero-list) (define one-list (cons 1 '())) (set-cdr! one-list one-list) (define (howmany-true tf-list) (apply + (map unless tf-list zero-list one-list))) Zero-list is an infinite list of zeros; one-list is an infinite list of ones. We make use of the fact that MAP's end test is that its first argument is empty, so MAP will return a list the same size as the argument tf-list. For example, if tf-list is (#t #t #f #t) then map will return (1 1 0 1) created, in effect, this way: (list (unless #t 0 1) (unless #t 0 1) (unless #f 0 1) (unless #t 0 1)) And so + will return 3, the number of trues in the list. 4.28 Why force the operator of a combination? Thunks are made by APPLY, representing arguments to defined procedures. So we need a case in which the operand of an expression is the result of applying a defined procedure. Here's an example: (((lambda (a b) a) + -) 2 3) 4.30 Side effects vs. lazy evaluation (a) Why is Ben right about for-each? For-each includes the expression (proc (car items)). As we discussed in ex. 4.28, the lazy evaluator will force the operator of that expression, i.e., PROC. The resulting procedure has two invocations of primitives, NEWLINE and DISPLAY. Evaluating those invocations will actually call the procedures, and the argument X to DISPLAY will be evaluated because DISPLAY is primitive. (b) What happens in Cy's example? First of all, in ordinary Scheme both (p1 1) and (p2 1) give the result (1 2). With the book's version of eval-sequence, (p1 1) is still (1 2) but (p2 1) is 1, because the SET! will never happen. The subprocedure P has a two-expression sequence as its body, and the first expression will never be evaluated. With Cy's version both (p1 1) and (p2 1) are (1 2), as in ordinary Scheme. (c) Why doesn't Cy's version change part (a)? The change isn't as dramatic as it may seem. Don't think that the original eval-sequence calls delay-it! It calls EVAL, and most of the time EVAL does return a value, not a thunk. In particular, a procedure call is carried out right away; it's only the *arguments* to the procedure that are delayed. That's why Cy had to use a weird example in which a SET! expression is used as an argument to a procedure in order to get the wrong result. (d) What's the right thing to do? The combination of lazy evaluation and mutation in the same language is so confusing that programmers would be surprised no matter which choice we made. That's why, in the real world, the languages that use normal order evaluation are *functional* languages in which there is no mutation or other side effects. In such a language, there are no sequences (if there are no side effects, what would be the point?) and the problem doesn't arise. But if we really wanted to have a normal-order Scheme, we'd probably want to change the semantics of the language as little as possible -- programs that work in ordinary Scheme should work in lazy Scheme too. So I think Cy is right. 4.33 Quoted lazy lists Instead of ((quoted? exp) (text-of-quotation exp)) we need a more complicated treatment to turn the ordinary lists of the underlying Scheme into lazy lists. ((quoted? exp) (process-quotation (text-of-quotation exp) env)) (define (process-quotation quoted env) (if (pair? quoted) (lazy-cons (process-quotation (car quoted) env) (process-quotation (cdr quoted) env) env) quoted)) (define (lazy-cons x y env) (make-procedure '(m) (list (list 'm x y)) env)) or alternatively (define (lazy-cons x y env) (apply (lookup-variable-value 'cons env) (list x y))) This lazy-cons is the below-the-line equivalent of the above-the-line CONS on page 409. 2. Type checking When we define a procedure, we don't even look at the parameter list; it's just stored as part of the procedure. That doesn't need to be changed. When do we have to check the type? We do it when we're invoking a procedure, as part of the process of binding names to values. This happens in extend-environment and make-frame. The only change to extend-environment is that it has to supply the environment that we're extending to make-frame, because make-frame will have to look up the type predicates: (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals BASE-ENV) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) Make-frame, which was trivial before this change, now has some real work to do: (define (make-frame variables values BASE-ENV) (DEFINE (TYPE-CHECK VAR VAL) (IF (AND (PAIR? VAR) (NOT (APPLY (EVAL (CAR VAR) BASE-ENV) (LIST VAL)))) (ERROR "WRONG ARGUMENT TYPE" VAL))) (DEFINE (SCAN VARS VALS) (COND ((NULL? VARS) #T) (ELSE (TYPE-CHECK (CAR VARS) (CAR VALS)) (SCAN (CDR VARS) (CDR VALS))))) (SCAN VARIABLES VALUES) (cons (JUST-NAMES variables) values)) (DEFINE (JUST-NAMES VARS) (COND ((NULL? VARS) '()) ((PAIR? (CAR VARS)) (CONS (CADAR VARS) (JUST-NAMES (CDR VARS)))) (ELSE (CONS (CAR VARS) (JUST-NAMES (CDR VARS)))))) Another approach would be to try to modify the procedure as it's being created (therefore, in make-procedure, called from eval) so that the type checks become part of the procedure's body. This can be done, but it's quite tricky to get it right. For example, in what environment should the names of the type predicates be looked up? It's a real misunderstanding of the problem to write a solution in which specific type predicates such as INTEGER? are built into the evaluator. If there's a type checking system, it should work for user-defined types as well as for primitive types. For example, I should be able to say that an argument must be a prime number, or must be a three-letter word. Extra Practice 4.10 new syntax Okay, let's make the syntax of IF look like it does in those other bad languages. (After all, any change we make to Scheme's syntax *has* to make it worse!) The new syntax will be (if ... then ... else ...). (define (if? exp) (and (tagged-list? exp 'if) (eq? (caddr exp) 'then) (or (= (length exp) 4) (eq? (list-ref exp 4) 'else)))) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (cadddr exp)) (define (if-alternative exp) (list-ref exp 5)) Of course you can do lots of other changes too, so if you're copying last semester's answers next semester, the reader will be suspicious if you come up with this choice! :-) 4.11 changed frame representation (define (make-frame variables values) (attach-tag 'frame (map cons variables values))) (define (frame-variables frame) (map car (contents frame))) (define (frame-values frame) (map cdr (contents frame))) (define (add-binding-to-frame! var val frame) (set-cdr! frame (cons (cons var val) (contents frame)))) If I hadn't attached a tag to the frames, this would be harder. I wouldn't be able to have an add-binding-to-frame! procedure because there wouldn't be anything in an empty frame to mutate. Instead, define-variable! would have to get more complicated. It appears as if nothing else has to change, (and so we said until James Lin pointed it out in April, 2000.) In fact, define-variable and set-var-value! don't work if they are given copies of the data, as happens above. A more complete solution requires these programs to change too. Here's a fix. The programs actually get shorter if you use assoc. RJF (define (make-frame variables values) (attach-tag 'frame (map cons variables values))) (define (add-binding-to-frame! var val frame) (set-cdr! frame (cons (cons var val) (contents frame)))) (define (set-variable-value! var val env) (define (env-loop env) (define (scan pair) ; a (variable . val) pair or #f (cond (pair (set-cdr! pair val)) ;we found it (else (env-loop (enclosing-environment env))))) (if (eq? env the-empty-environment) (error "Unbound variable -- SET!" var) (let ((frame (first-frame env))) (scan (assoc var (cdr frame))) ; eh, forget data abstraction.. ))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan pair) (cond (pair (set-cdr! pair val)) (else (add-binding-to-frame! var val frame)) )) (scan (assoc var (cdr frame) )))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan pair) (cond (pair (cdr pair)) (else (env-loop (enclosing-environment env))) )) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (assoc var (cdr frame)))))) (env-loop env)) 4.22 LET in analyzing evaluator This is easy, given the hint about 4.6. We don't have to change the procedure LET->COMBINATION we wrote for that exercise; since it deals entirely with the expression, and not with the values of variables, all of its work can be done in the analysis phase. All we do is change this COND clause in EVAL: ((let? exp) (eval (let->combination exp) env)) to this COND clause in ANALYZE: ((let? exp) (analyze (let->combination exp))) 4.25 UNLESS in normal vs. applicative order In ordinary (applicative order) Scheme, this version of FACTORIAL will be an infinite loop, because the argument subexpression (* n (factorial (- n 1))) is evaluated before UNLESS is called, whether or not n is 1. In normal order Scheme it'll work fine, because the argument subexpressions aren't evaluated until they're needed. What will actually happen is that each use of the special form IF within UNLESS will force the computation of (= n 1), but no multiplications will happen until the evaluator tries to print the result. In effect, (factorial 5) returns the thunk (lambda () (* 5 (* 4 (* 3 (* 2 (* 1 1)))))) and that gets evaluated just in time to print the answer. 4.32 Lazy trees One possibility is to use doubly-lazy lists as an alternative to interleaving, when dealing with a naturally two-dimensional problem. For example, to get pairs of integers, we could say (define (pairs a b) (cons (map (lambda (x) (cons (car a) x)) b) (pairs (cdr a) b))) Then we could use this data structure with two-dimensional versions of the usual higher order procedures. For example: (define (2dfilter pred s) (if (null? s) '() (cons (filter pred (car s)) (2dfilter pred (cdr s)))))