Show that we can represent pairs of nonnegative integers using only numbers and arithmetic operations if we represent the pair a and b as the integer that is the product 2^a * 3^b. Give the corresponding definitions of the procedures cons, car, and cdr.

He confesses that couldn’t figure the math, and points to a solution in the schemewiki. In the end, it is assumed that the code works because one base used is even (2) and the other is odd (3), so the resulting integer can only be divided by 2 a number of times equal to a. In fact, the solution to this problem has nothing to do with parity, but with the fundamental theorem of arithmetic:

the fundamental theorem of arithmetic (or the unique-prime-factorization theorem) states that any integer greater than 1 can be written as a unique product (up to ordering of the factors) of prime numbers. For example,

6936 = 2^3 * 3^1 * 17^2
1200 = 2^4 * 3^1 * 5^2

are two numbers satisfying the hypothesis of the theorem that can be written as the product of prime numbers.

What this means is that if we use prime numbers as bases for the construction of pairs as numbers, we have a guarantee that we will be able to retrieve the original numbers back, because the numbers we have encoded in the “pair” are the only representation possible. So what really matters is that 2 and 3 are prime numbers. In fact, using 5 and 7 as bases would work perfectly as well:

(define *const-m* 5)
(define *const-n* 7)
 
;; "integer logarithm", a friendly misnomer
(define (ilog a b)
  (let loop ((i 0)
             (a a))
    (if (zero? (remainder a b))
    (loop (+ i 1) (quotient a b))
    i)))
 
(define (kons a b)
  (* (expt *const-m* a) (expt *const-n* b)))
 
(define (kar a)
  (ilog a *const-m*))
 
(define (kdr a)
  (ilog a *const-n*))

Let’s see a quick session. By the way, Scheme’s support for integers of arbitrary size really helps here:

> (define a (kons 23 56))
> a
2522320911913220782729737303110106900811912937176227569580078125
> (kar a)
23
> (kdr a)
56
> (define b (kons 127 99))
> (kar b)
127
> (kdr b)
99

As a side note, instead of something like my ilog, the solution in schemewiki uses this function:

(define (count-0-remainder-divisions n divisor) 
  (define (iter try-exp) 
   (if (= 0 (remainder n (exp divisor try-exp))) 
       (iter (+ try-exp 1))  ;; Try another division. 
       (- try-exp 1))) 
 
  ;; We don't need to try 0 divisions, as that will obviously pass. 
  (iter 1))

It uses exponentiation in every step of the loop, which strikes me as very inefficient.

Using CPS as intermediate language has many advantages in general and specially for Scheme. In general, it is a simpler, more uniform language in which all transfers of control are explicit and all intermediate values are named. For Scheme, it makes all continuations explicit, which can then be captured by call-with-current-continuation. Nevertheless, most optimising compilers that use CPS as intermediate language marks introduced continuation closures as special and allocate them on the usual call/return control stack, even for Scheme, because the stack interacts better with memory caches in current processors. Capturing the current continuation is implemented with more complicated techniques like copying the control stack to the heap.

But how exactly does CPS make it easier to apply optimisations to the code? I am going to illustrate one of the possible optimisations with an example based on the code to solve the N-Queens problem:

(define (nqueens n)
 
  (define (dec-to n)
    (let loop ((i n) (l '()))
      (if (= i 0) l (loop (- i 1) (cons i l)))))
 
  (define (try x y z)
    (if (null? x)
      (if (null? y)
        1
        0)
      (+ (if (ok? (car x) 1 z)
           (try (append (cdr x) y) '() (cons (car x) z))
           0)
         (try (cdr x) (cons (car x) y) z))))
 
  (define (ok? row dist placed)
    (if (null? placed)
      #t
      (and (not (= (car placed) (+ row dist)))
           (not (= (car placed) (- row dist)))
           (ok? row (+ dist 1) (cdr placed)))))
 
  (try (dec-to n) '() '()))

For now I will focus on the ok? procedure. After macro expansion we have:

(letrec ((ok? (lambda (row dist placed)
                   (if (null? placed)
                       #t
                       ((lambda (temp1)
                          (if temp1
                              ((lambda (temp2)
                                 (if temp2
                                     (ok? row (+ dist 1) (cdr placed))
                                     temp2))
                               (not (= (car placed) (- row dist))))
                              temp1))
                        (not (= (car placed) (+ row dist)))))))))

The expansion of the and macro has created some procedures that are applied to their arguments right away, and not needed otherwise. Now let us convert this code to CPS:

(letrec ((ok? (lambda (k1 row dist placed)
                (letrec ((k2 (lambda (r1)
                                 (if r1
                                     (k1 #t)
                                     (letrec ((l1 (lambda (k3 temp1)
                                                      (if temp1
                                                          (letrec ((l2 (lambda (k4 temp2)
                                                                           (if temp2
                                                                               (letrec ((k5 (lambda (r2)
                                                                                                (letrec ((k6 (lambda (r3)
                                                                                                                 (ok? k4 row r2 r3))))
                                                                                                  (cdr k6 placed)))))
                                                                                 (+ k5 dist 1))
                                                                               (k4 temp2)))))
                                                            (letrec ((k7 (lambda (r4)
                                                                             (letrec ((k8 (lambda (r5)
                                                                                              (letrec ((k9 (lambda (r6)
                                                                                                               (letrec ((k10
                                                                                                                         (lambda (r7)
                                                                                                                           (l2 k3 r7))))
                                                                                                                 (not k10 r6)))))
                                                                                                (= k9 r4 r5)))))
                                                                               (- k8 row dist)))))
                                                              (car k7 placed)))
                                                          (k3 temp1)))))
                                       (letrec ((k11 (lambda (r8)
                                                        (letrec ((k12 (lambda (r9)
                                                                         (letrec ((k13 (lambda (r10)
                                                                                          (letrec ((k14 (lambda (r11)
                                                                                                           (l1 k1 r11))))
                                                                                            (not k14 r10)))))
                                                                           (= k13 r8 r9)))))
                                                          (+ k12 row dist)))))
                                         (car k11 placed)))))))
                  (null? k2 placed))))))

The code has increased in size but is simpler and easier to analyse and manipulate. For instance, in the code above we see that l2 is a procedure that is called only once, and is not passed as an argument to any other procedure. We can then replace the only call site of l2 with the body of the procedure, provided that we substitute the formal parameters for the actual arguments. This inlining is called β-reduction. Since no argument in the CPS can have side effects, β-reduction is sound:

(letrec ((ok? (lambda (k1 row dist placed)
                (letrec ((k2 (lambda (r1)
                                 (if r1
                                     (k1 #t)
                                     (letrec ((l1 (lambda (k3 temp1)
                                                    (if temp1
                                                        (letrec ((k7 (lambda (r4)
                                                                       (letrec ((k8 (lambda (r5)
                                                                                      (letrec ((k9 (lambda (r6)
                                                                                                     (letrec ((k10
                                                                                                               (lambda (r7)
                                                                                                                 (if r7
                                                                                                                     (letrec ((k5 (lambda (r2)
                                                                                                                                    (letrec ((k6 (lambda (r3)
                                                                                                                                                   (ok? k3 row r2 r3))))
                                                                                                                                      (cdr k6 placed)))))
                                                                                                                       (+ k5 dist 1))
                                                                                                                     (k3 r7)))))
                                                                                                       (not k10 r6)))))
                                                                                        (= k9 r4 r5)))))
                                                                         (- k8 row dist)))))
                                                          (car k7 placed))
                                                          (k3 temp1)))))
                                       (letrec ((k11 (lambda (r8)
                                                        (letrec ((k12 (lambda (r9)
                                                                         (letrec ((k13 (lambda (r10)
                                                                                          (letrec ((k14 (lambda (r11)
                                                                                                           (l1 k1 r11))))
                                                                                            (not k14 r10)))))
                                                                           (= k13 r8 r9)))))
                                                          (+ k12 row dist)))))
                                         (car k11 placed)))))))
                  (null? k2 placed))))))

After this we got rid of l2, which means less one closure to allocate and call. We can do the same with l1:

(letrec ((ok? (lambda (k1 row dist placed)
                (letrec ((k2 (lambda (r1)
                                 (if r1
                                     (k1 #t)
                                     (letrec ((k11 (lambda (r8)
                                                     (letrec ((k12 (lambda (r9)
                                                                     (letrec ((k13 (lambda (r10)
                                                                                     (letrec ((k14 (lambda (r11)
                                                                                                     (if r11
                                                                                                         (letrec ((k7 (lambda (r4)
                                                                                                                        (letrec ((k8 (lambda (r5)
                                                                                                                                       (letrec ((k9 (lambda (r6)
                                                                                                                                                      (letrec ((k10
                                                                                                                                                                (lambda (r7)
                                                                                                                                                                  (if r7
                                                                                                                                                                      (letrec ((k5 (lambda (r2)
                                                                                                                                                                                     (letrec ((k6 (lambda (r3)
                                                                                                                                                                                                    (ok? k1 row r2 r3))))
                                                                                                                                                                                       (cdr k6 placed)))))
                                                                                                                                                                        (+ k5 dist 1))
                                                                                                                                                                      (k1 r7)))))
                                                                                                                                                        (not k10 r6)))))
                                                                                                                                         (= k9 r4 r5)))))
                                                                                                                          (- k8 row dist)))))
                                                                                                           (car k7 placed))
                                                                                                         (k1 r11)))))
                                                                                       (not k14 r10)))))
                                                                       (= k13 r8 r9)))))
                                                       (+ k12 row dist)))))
                                       (car k11 placed))))))
                  (null? k2 placed))))))

So we see that two closures previously introduced during macro expansion are now gone. Notice that the continuation passed to the recursive call to ok? is k1, confirming that tail calls do not create new continuations. In the original code we see a procedure called dec-to which is also called only once as an argument to try. That procedure is also β-reduced in the same compiler pass. Other optimisations are also made simple by CPS, and I have implemented some of them in the same pass: Dead-variable elimination, removal of unreachable branches and dropping unused arguments to known procedures.

“In particular, we are relaxing all restrictions on the development tools used to create iOS apps, as long as the resulting apps do not download any code. This should give developers the flexibility they want, while preserving the security we need.”

So any tool or language, Scheme included, is fair game now. Let’s code!

(when (launch-authorised? president)
  (fuel-missile icbm)
  (open-hatch silo)
  (launch-missile icbm))

Another example of control operator is the very useful and-let* macro, semi-standardised in SRFI-2, tests several expressions in sequence, aborting the computation if any of them evaluates to false, optionally binding variables to the expressions’s resulting values in nested scopes otherwise. If none of the expressions evaluate to false, the body is executed in the resulting lexical environment. Those familiar with Haskell may find it somewhat similar to the Maybe monad.

Actually several of Scheme’s own standard control operators are macros, implemented almost exactly as user-defined macros. A named let can be easily rewritten as a letrec operator:

;; a named let expression
(let collect ((seq (produce-list-of-numbers))
              (even '())
              (odd '()))
  (if (null? seq)
      (cons even odd)
      (let ((num (car seq)))
        (if (even? num)
            (collect (cdr seq) (cons num even) odd)
            (collect (cdr seq) even (cons num odd))))))
 
;; becomes a letrec expression
(letrec ((collect (lambda (seq even odd)
                    (if (null? seq)
                        (cons even odd)
                        (let ((num (car seq)))
                         (if (even? num)
                             (collect (cdr seq) (cons num even) odd)
                             (collect (cdr seq) even (cons num odd))))))))
  (collect (produce-list-of-numbers) '() '()))

Macros are of course not limited to adding new control operators to a language. One can design his own little language for solving specific problems, like stocks trading. Or a data modelling language, a graphics drawing language etc. A language for object-oriented programming such as Meroon can be seamlessly embedded within Scheme. Paul Graham’s On Lisp book on advanced Common Lisp programming has several chapters devoted to macros. In short, the developer becomes almost as powerful as the language designer, and such distinction is blurred. Armed with such power, the developer becomes much more productive and, therefore, happy.

Unfortunately not many programming languages provide good macro facilities. The C preprocessor, for instance, only does textual replacement and is no aware of expressions. Granted, the syntax of the programming languages of the Lisp family is very simple and uniform, making better macros possible. Nevertheless other languages like Haskell and OCaml with more complex syntax also provide such facilities.

3.3.1 — Applications may only use Documented APIs in the manner prescribed by Apple and must not use or call any private APIs.

to

3.3.1 — Applications may only use Documented APIs in the manner prescribed by Apple and must not use or call any private APIs. Applications must be originally written in Objective-C, C, C++, or JavaScript as executed by the iPhone OS WebKit engine, and only code written in C, C++, and Objective-C may compile and directly link against the Documented APIs (e.g., Applications that link to Documented APIs through an intermediary translation or compatibility layer or tool are prohibited).

The intended effect is obviously to ban third-party abstraction layers, like then soon-to-be-released Adobe’s Flash for iPhone. But the wording is very broad and cover too many uses of other programming languages and technologies. Steve Jobs demoed himself the Tap Tap Revenge game for iPhone, which reportedly uses Lua. The backslash was too big to ignore, making Apple revise the agreement again. This time section 3.3.2 was changed from

3.3.2 – No interpreted code may be downloaded or used in an Application except for code that is interpreted and run by Apple’s Documented APIs and built-in interpreter(s).

to

3.3.2 – Unless otherwise approved by Apple in writing, no interpreted code may be downloaded or used in an Application except for code that is interpreted and run by Apple’s Documented APIs and built-in interpreter(s). Notwithstanding the foregoing, with Apple’s prior written consent, an Application may use embedded interpreted code in a limited way if such use is solely for providing minor features or functionality that are consistent with the intended and advertised purpose of the Application.

Although still requiring Apple’s prior written approval, it leaves the door open for the use of other programming languages on iOS devices. Apple Outsider believes this is all about Lua, and he may be right. But of course Lua is not the only game in town.

I always thought my use of Scheme in Reverso was ok with the previous version of the license agreement. No code is ever downloaded, and not interpreted either; Gambit-C compiles Scheme code to C which is compiled with Apple’s official tools to create a native library. But this changed with the new 3.3.1 section because my code was not originally written in one of the approved languages. James Long, who first compiled Gambit-C for the iPhone, claimed that Scheme was dead on the iPhone. But then Apple relented and changed section 3.3.2. What about now?

I believe that makes Scheme usable again, if used just like in Reverso: as a library. The application is written in Objective-C, but uses Scheme code (compiled to C) to only add features “that are consistent with the intended and advertised purpose of the Application”. Albeit it can be claimed that the code is not interpreted, this use follows the spirit of the law, even if it does not follow its letter.

“If now, while they are one people, all speaking the same language, they have started to do this, nothing will later stop them from doing whatever they propose to do.” – Genesis XI, v.6

I believe I have got the first Scheme application past Apple review into the iTunes App Store. It is yet another Reversi clone, called Reverso. It is a combination of 90% Scheme and 10% Objective-C, written with Gambit-C Scheme. James Long has already shown how to compile Gambit-C for the iPhone, and I started from there. My Scheme code is compiled to C by Gambit and later by GCC to produce native ARM code, bundled in a static library, which is ok with the iPhone SDK license agreement. The Objective-C then calls the library as a pure C library. The Scheme code deals with position evaluation, alpha-beta pruning, transposition tables, move legality, different strategies and so on. The Objective-C code deals with sound, animations, GUI, user preferences, basically everything that calls the iPhone OS API. Reversi was chosen because I like strategy games and it is much more algorithmic than artistic, and I am no artist.

The performance of the code is excellent. I used some Gambit-specific declarations, only fixnum arithmetic, pre-allocated a large heap, and called the garbage-collector every time the user needed to think. The search is not memory intensive, but the transposition tables are. I did not write a specific hash function but relied on Gambit-C’s table type. The boards used during search were retrieved from a pool (the newest Gambit-C has made subu8vector-move! a public API), so they did not put pressure on the garbage-collector. In the end it was a very successful experiment. Developing with Scheme is orders of magnitude more productive than with most other languages. Gambit-C is also one of the best Scheme compilers out there, and made my job a lot easier.

Update: There was a bug in the application that caused it to play poorly. The weak AI was not Gambit’s or Scheme’s fault, but mine. I already sent an updated version to Apple that will play much better. Besides fixing the bug, I am now using Zobrist’s hashing instead of Gambit’s own hash function, that performs poorly for game positions. It is still written in Scheme, though. Now I am waiting for the approval of the update, and to hear further feedback from my users.

“You think you know when you can learn, are more sure when you can write, even more when you can teach, but certain when you can program.” – Alan Perlis

Just after have read Lisp in Small Pieces I felt the urge to write a Scheme compiler. This sentiment is common in the Lisp community, I guess. There are dozens of Scheme systems, some good, some bad, some maintained, some abandoned. There are large optimising compilers and small interpreters for embedded systems. But I, well, needed to know. I needed to know how to write a program that takes another as input and generates simple instructions that do the same computation. I needed to know how to a write a program that interprets those instructions, a runtime to provide primitives, a garbage collector to manage memory etc. So I started doing some coding in my spare time, and called the monster Sly Scheme.

I failed miserably. I began with the reader, believing that basic I/O was fundamental for a REPL (the REPL was the goal I set myself to achieve). The reader was growing too complex and my interest simply disappeared. Then I focused on the types, creating a large hierarchy of them, only to lose interest again. After some time I came across Abdulaziz Ghuloum’s An Incremental Approach to Compiler Construction, which starts with the compiler itself. Let another Scheme do the I/O! I then took this path, running my compiler with Gambit-C. But instead of generating machine code, it generated instructions for a virtual machine. I then proceeded in lockstep: Wrote in Scheme a new compiler feature, and then in C just enough to interpret the new instructions. Finally most of R4RS Scheme is compilable. Then I wrote a simple stop-and-copy garbage collector with two semi spaces. After that, I needed a runtime with enough procedures to run the compiler without Gambit-C. Almost an year later, I have my REPL (I am not that bad as a programmer, but this is just a hobby that I do in my spare time).

The code now sits in a Github repository. For those who cares to check it out, I must warn that everything was done as simplistic as possible, so I could have a working interpreter ASAP. Some things were even done outright stupidly. The compiler generates too many closures, it fails with simple cases, the VM uses a giant switch, it is slow, the garbage collector too etc. I probably will hack this code for the years to come, even if only as a hobby of mine. But the most important contribution of this project is how much I have been learning from it.

In a large class of problems one is given a start state and some predicate for a desired final state. Moreover, the rules that dictate how a successor state is generated from a previous one are also given. Take a board game for instance, like tic-tac-toe. There is the initial state (which is the empty board), the predicate for a desired state (a state in which tree pieces of mine are aligned), and rules to create one state from another (the rules of the game). Another example of such problems is the “Escape from Zurg” one, that is stated as follows:

Buzz, Woody, Rex, and Hamm have to escape from Zurg. They merely have to cross one last bridge before they are free. However, the bridge is fragile and can hold at most two of them at the same time. Moreover, to cross the bridge a flashlight is needed to avoid traps and broken parts. The problem is that our friends have only one flashlight with one battery that lasts for only 60 minutes (this is not a typo: sixty). The toys need different times to cross the bridge (in either direction):

TOY	TIME
Buzz	5 minutes
Woody	10 minutes
Rex	20 minutes
Hamm	25 minutes

Since there can be only two toys on the bridge at the same time, they cannot cross the bridge all at once. Since they need the flashlight to cross the bridge, whenever two have crossed the bridge, somebody has to go back and bring the flashlight to those toys on the other side that still have to cross the bridge. The problem now is: In which order can the four toys cross the bridge in time (that is, in 60 minutes) to be saved from Zurg?

This class of problems is usually solved by searching. The initial state and all the successors ultimately build a DAG (directed acyclic graph) that is called the search space. Some search spaces are small, like tic-tac-toe playing or even the “Escape from Zurg” puzzle. Others are large, like playing Reversi; even larger, like playing Chess; others are infinite. Needless to say that that are better searching ways than others. This same puzzle, for instance, was solved in Scheme by Ben Simon using the cool amb operator. The amb operator uses first-class continuations to backtrack and take another path in case the first one fails. It was an elegant solution for this puzzle, but it is not adequate for general searching because it backtracks blindly. There are others ways to search blindly, for instance depth-first search and breadth-first search.

In a depth-first search, we analyse the successors of a given state until there are no more successors to analyse, and then backtrack to a previous level of the tree. In a breadth-first search, we analyse the whole fringe of the tree (the horizon nodes) before expanding it one level further using the successor rules. This is good for infinite search spaces, because we will eventually find a solution if there is one. The implementation in Scheme is straightforward:

 
(define (depth-first states successors goal?)
  (if (null? states)
      #f
      (let ((state (car states)))
        (if (goal? state)
            state
            (depth-first (append (successors state)
                                 (cdr states))
                         successors
                         goal?)))))
 
(define (breadth-first states successors goal?)
  (if (null? states)
      #f
      (let ((state (car states)))
        (if (goal? state)
            state            
            (breadth-first (append (cdr states)
                                   (successors state))
                           successors
                           goal?)))))

This is actually all we need for simple searches. Of course we need to supply the initial state, the procedure that generates successors and the goal predicate. These are specific for each kind of problem. Let’s see the Zurg problem procedures:

 
;; the type of the states found in our puzzle
(define-type state
  (previous unprintable:)       ;; previous state
  near                          ;; toys in near shore
  far                           ;; toys in far shore
  flashlight                    ;; location of flashlight
  time)                         ;; time consumed so far
 
(define (start-state)
  (make-state #f
              '(buzz woody rex hamm)
              '()
              'near
              0))
 
(define (final-state? state)
  (and (null? (state-near state))
       (<= (state-time state) 60)))
 
;; at most two toys can travel across the bridge
;; the flashlight must be used in all crossings
(define (successors state)
  (let ((orig (if (eqv? (state-flashlight state)
                        'near)
                  (state-near state)
                  (state-far state)))
        (dest (if (eqv? (state-flashlight state)
                        'near)
                  (state-far state)
                  (state-near state))))
    (map (lambda (toy-pair)
           (let ((toy1 (car toy-pair))
                 (toy2 (cdr toy-pair)))
             (make-next-state state
                              (remove toy2
                                      (remove toy1 orig))
                              (ucons toy1
                                     (cons toy2 dest))
                              (max (time-cost toy1)
                                   (time-cost toy2)))))
         (product orig orig))))

The previous procedures use some utilities:

 
(define (make-next-state state orig dest time)
  (if (eqv? (state-flashlight state) 'near)
      (make-state state orig dest 'far (+ (state-time state) time))
      (make-state state dest orig 'near (+ (state-time state) time))))
 
;; the time each toy takes to cross the bridge
(define time-cost
  (let ((costs '((buzz . 5)
                 (woody . 10)
                 (rex . 20)
                 (hamm . 25))))
    (lambda (toy)
      (let ((pair (assv toy costs)))
        (and pair
             (cdr pair))))))
 
(define (ucons a b)
  (if (memv a b)
      b
      (cons a b)))
 
(define (product lis1 lis2)
  (let lp1 ((lis1 lis1)
            (res '()))
    (if (null? lis1)
        res
        (let ((i1 (car lis1)))
          (let lp2 ((lis2 lis2)
                    (res res))
            (if (null? lis2)
                (lp1 (cdr lis1) res)
                (let ((i2 (car lis2)))
                  (if (member (cons i2 i1) res)
                      (lp2 (cdr lis2) res)
                      (lp2 (cdr lis2) (cons (cons i1 i2) res))))))))))

Our successors procedure does not take time in account. So it is possible for a branch of the tree to go on indefinitely. To guarantee that we will arrive at a solution, we use a breadth-first search:

 
(define (print-path state)
  (let loop ((state state)
             (path '()))
    (if state
        (loop (state-previous state)
              (cons state path))
        (for-each println path))))
 
(print-path (breadth-first (list (start-state)) successors final-state?))

With the result:

#<state #14 near: (buzz woody rex hamm) far: () flashlight: near time: 0>
#<state #15 near: (rex hamm) far: (buzz woody) flashlight: far time: 10>
#<state #16 near: (woody rex hamm) far: (buzz) flashlight: near time: 20>

#<state #17 near: (woody) far: (rex hamm buzz) flashlight: far time: 45>
#<state #18 near: (buzz woody) far: (rex hamm) flashlight: near time: 50>
#<state #19 near: () far: (buzz woody rex hamm) flashlight: far time: 60>

If we change our successors procedure a little, we can use depth-first search:

 
(define (successors2 state)
  (let ((orig (if (eqv? (state-flashlight state)
                        'near)
                  (state-near state)
                  (state-far state)))
        (dest (if (eqv? (state-flashlight state)
                        'near)
                  (state-far state)
                  (state-near state))))
    (filter (lambda (s)
              (<= (state-time s) 60))          ;; filtering out bad states
            (map (lambda (toy-pair)
                   (let ((toy1 (car toy-pair))
                         (toy2 (cdr toy-pair)))
                     (make-next-state state
                                      (remove toy2
                                              (remove toy1 orig))
                                      (ucons toy1
                                             (cons toy2 dest))
                                      (max (time-cost toy1)
                                           (time-cost toy2)))))
                 (product orig orig)))))
 
(print-path (depth-first (list (start-state)) successors2 final-state?))

The advantage of changing the successors procedure is that depth-first searches are usually faster than breadth-first searches, in this case 483ms vs. 24630ms. Also, it uses less memory. So it is always a good idea to try to cut the search space as soon as possible.