In this lecture we will try to show some of the benefits of generic programming. At the same time a technique of program transformation is shown. Keep in mind that the example is too simple to show off the full prowess of the program transformation technique. QSORT As an example we will use QSORT of Wil Baden that has apparently been published in 1983. We will see that in 1983 Forth was almost ahead of the C++ of 1998, and at least could have been using techniques known at the time. (On the premise that we take the lack of static and dynamic type checking for granted, as an essential feature of Forth and not something that will change as the language ``evolves''.) At first let us have a look at Wil's code, such as he has published on his web site. \ ---------------------------------------------------------- \ Set PRECEDES for different datatypes or sort order. DEFER PRECEDES ' < IS PRECEDES \ For sorting character strings in increasing order: : SPRECEDES ( addr addr -- flag ) >R COUNT R> COUNT COMPARE 0< ; ' SPRECEDES IS PRECEDES : EXCHANGE ( addr_1 addr_2 -- ) DUP @ >R OVER @ SWAP ! R> SWAP ! ; : -CELL ( -- n ) -1 CELLS ; : CELL- ( addr -- addr' ) 1 CELLS - ; : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP OVER - 2/ -CELL AND + @ >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP @ R@ PRECEDES WHILE CELL+ REPEAT SWAP BEGIN R@ OVER @ PRECEDES WHILE CELL- REPEAT 2DUP > NOT IF 2DUP EXCHANGE >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R> DROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; : QSORT ( lo hi -- ) PARTITION ( lo_1 hi_1 lo_2 hi_2) 2OVER 2OVER - + ( . . . . lo_1 hi_1+lo_2-hi_2) < IF 2SWAP THEN ( lo_1 hi_1 lo_2 hi_2) 2DUP < IF RECURSE ELSE 2DROP THEN 2DUP < IF RECURSE ELSE 2DROP THEN ; : SORT ( addr n -- ) DUP 2 < IF 2DROP EXIT THEN 1- CELLS OVER + ( addr addr+{n-1}cells) QSORT ( ) ; \ ---------------------------------------------------------- The heart of the matter is in PARTITION. The range of items to be sorted, represented by [lo,hi] , is split into two subranges [lo1, hi1] and [lo2,hi2], where each item of the first range is smaller than each element of the second range. We use square brackets here using the mathematical convention of an inclusive range, i.e. the boundary indices belong to the range. Mathematics uses round brackets for non-inclusive ranges, i.e. the range (1,3) only contains 2. The trick is that an item is selected, somewhere in the middle (2/) called the pivot, and what is smaller is swapped to the first partition, what is larger is swapped to the second partition. Then the smaller ranges are partitioned again, until the range are trivially sorted because they consist of one element. What is meant by smaller? You see that Wil leaves that up to the user to decide. The word PRECEDES is a vector, i.e. it contains a reference to a word to be executed, and that word may be changed to whatever is appropriate. You see that the execution token of < is filled in as a default. This code is marvellously fast at sorting a table like the following CREATE INT-TABLE 9 , 4 , 3 , 7 , 0 , 8 , 2 , 6 , 1 , 5 , (And will come into its own only for tables a great deal larger.) It may also be used to sort a table of floats provided all floats are one cell wide like the integers. CREATE FLOAT-TABLE 9.0E0 F, 4.0E0 F, 3.0E0 F, 7.0E0 F, 0.0E0 F, 8.0E0 F, 2.0E0 F, 6.0E0 F, 1.0E0 F, 5.0E0 F, AND indeed we say ' F< IS PRECEDES It cannot be used however to sort the following table of doubles CREATE DOUBLE-TABLE 9.0 , , 4.0 , , 3.0 , , 7.0 , , 0.0 , , 8.0 , , 2.0 , , 6.0 , , 1.0 , , 5.0 , , On the other hand With : $PRECEDES EXECUTE SWAP EXECUTE COMPARE 0 > ; again it CAN be used to sort the following table of strings : A0 S" nine" ; : A1 S" fout" ; : A2 S" three" ; : A3 S" seven" ; : A4 S" zero" ; : A5 S" eight" ; : A6 S" two" ; : A7 S" six" ; : A8 S" one" ; : A9 S" five" ; CREATE STRING-TABLE ' A0 , ' A1 , ' A2 , ' A3 , ' A4 , ' A5 , ' A6 , ' A7 , ' A8 , ' A9 And A5 (``eight'') will go to the top. And lastly it will fail on " nine | fout | three | seven | zero | eight | two | six | one | five |" CREATE x-TABLE , , Considered as 10 8 character strings. One of the reasons of the failures is immediately apparent in EXCHANGE . It is assumed that the things to exchange are one cell wide. More hidden in PARTITION is that we want the element to compare with to reside on the return stack, aghain taking up one cell. Especially with the last example, that will be a problem. ALGORIHTMIC TRANSFORMATION In order to make QSORT do what we want, we first define a regression test. This is a test that we do before and after an improvement. If the test doesn't come out the same, the "improvement" is rejected. In this way we can go ahead step by step, and it is possible in the end that the result doesn't look anything we started with. This is called algorithmic transformation. You see we will do a lot of small changes. What we do not want is any debugging after say 200 small changes. Especially not when you are in a maintenance situation and your program is horribly complicated and not written by you. (Of course such a program doesn't make a good example to treat in a few pages.) The test looks as follows ' INT-TABLE DUP 9 CELLS + QSORT : ' INT-TABLE DUP 9 CELLS + BOUNDS I @ . 0 CELL+ +LOOP : We expect 0 1 2 3 4 5 6 7 8 9 ' FLOAT-TABLE DUP 9 CELLS + QSORT : ' FLOAT-TABLE DUP 9 CELLS + BOUNDS I @ F. 0 CELL+ +LOOP : We expect 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 We want to make the algorithm more powerful. This translates in a larger regression test that in our case shows that we can sort the STRING-TABLE . On no account will we accept a regression test that is less powerful. A DIGRESSION: SOFTWARE MAINTENANCE The rules about what changes are allowed are simple: the changes must be ``infinitesimal'' . An infinitesimal change has the following properties: 1. The change must result in theoritically equivalent code (what you are supposed to understand by this is, is explained in more detail in the following section.) 2. It must pass pass the regression test. 3. You can't think of a smaller change that would pass the regression test again. In software maintenance the real regression test may mean that the complicated machine with dozens of moving parts still works. A test may cost up to a hundred thousand euro. Still we want to test each minute change in principle. That is possible to have it ``hike'' along whith a larger change that is requested by a customer, and that demands a test anyway. There is an exception. If your analysis proves that a certain test will reveal a bug, show the bug in actual symptons to the user. Now he probably wants it removed. This makes it a customer requested change and you are no longer bound to rule 2, you are allowed to make an actual functional change. Now you add the test that would reveal the bug to the regression test. SET UP THRE REGRESSION TEST At this point we set up the regression test, typically using a makefile. If you are on a brain dead system, you may have trouble making a fitting regression test. Do it any way. Go back to DOS boxes, transport your code over a network. Run an emulator. Do what ever is necessary, but do it. You cannot proceed past this point without a regression test. At this point our regression test consists of sorting INT-TABLE FLOAT-TABLE and STRING-TABLE. OUR FIRST CHANGE : ALIGN-DOWN Let us return to SQORT. Puzzling to me is the story around -CELL. At this point I already known that in the final version this will be eliminated without leaving a trace. This doesn't prevent me from treating this change with utmost care. I fear that it might only work in a two complement system. I understand that it is used to take the average of two addresses in combination with ``AND +'' and then sort of align it to be a cell boundary, but lower than the original. So our first infinitesimal change is. : -CELL ( -- n ) -1 CELLS ; becomes \ For ADDRESS return a next lower ADDRESS that is aligned. \ This may work only on two complement machines. : ALIGN-DOWN -1 CELL AND + ; and 2DUP OVER - 2/ -CELL AND + @ >R ( R: median) becomes 2DUP OVER - 2/ ALIGN-DOWN @ >R ( R: median) This is an infinitesimal change. Renaming a function must result in theoretically the same code. And moving code inside a function from the place where it is called is again impossible to fail. There cannot be a smaller change. Only moving ``AND'' makes no sense, and keeping the original name is also out of the question. So this is an infinitesimal change. Some CS-people would argue that it is not necessary to test this. Don't listen to them. They know nothing about life. Listen to me. Run the regression test. Even if you have to wait months, such as in the case of the embedded systems I was talking about. So be it. Now you may look back at the change differently. This change may be the code people will see for months, or for an indefinite time, if I were to leave. The warning about two-complement may save thousands of Euro in 3 years time. (Or it may be that there is no problem at all on non-two complement systems. Interestingly, analysing this is a waste of time and I will not do it. Unless of course, such a system is going to be actually used at some point. Then I will look up ``two complement'' in my log book, or they will, if they are smart enough. Remember: ALIGN-DOWN will be eliminated shortly.) To my surprise and relief the regression test succeeds. OUR SECOND CHANGE : EXCHANGE In view of the table with fixed length strings ("one | ...") we need to introduce a general word to swap memory area's. EXCHANGE is indeed a good name for this (thank you, Wil!) and it is almost unbelievable that nobody came up with this, it is similar to MOVE and certainly a candidate for a kernel word. If we do not have a word like that, making a generic QSORT -- one that can be used always -- makes no sense. We will find ourselves coding exchanges all the time, and might as well recode QSORT all the time. (The current practice.) \ Exchange the content at ADDRESS1 and ADDRESS2 over a fixed LENGTH. : EXCHANGE 0 ?DO OVER I + OVER I + OVER C@ OVER C@ >R SWAP C! R> SWAP C! LOOP 2DROP ; This type of code shows the ugly side of Forth. Anyway, let us assume that it is a word considered standard, used extensively and tested beyond doubt, guaranteed by the vendor of your Forth, whatever. That means that testing EXCHANGE itself falls outside of the regressing test, and introducing it in QSORT is an infinitesimal change. We need a new name for Wil's ECHANGE , let us call it <--> . Again this change will not live long, because of course the exchanging must be done via vectored execution, in the same way as the comparison. \ Exchange the content of one cell at ADDRESS1 and ADDRESS2. : <--> 0 CELL+ EXCHANGE ; To my surprise and relief the regression test succeeds. You might get bored with infinitesimal changes at this point. Make no mistake. At the end of the day the code will be seemingly unrelated with what we started with in a non-trivial maintenance project. OUR THIRD CHANGE : SIMPLICATION It is practice in quicksort to sort the smaller partition first. That doesn't influence the sorting time, but it prevents that the stack space needed is as large as the stuff to be sorted. In the following let us say we have N items. You see, if partitioning in two succeeds very good, we will have 2 log N levels of partitioning and some 2 log N cells of stack are needed. Worst case partitioning may partition in a piece 1 and a piece N-1 . So we have N steps whatever partition we choose to do next, but if we take the largest part to repartition first a stack depth of N results. But now practice. My N is a million. Wil takes an element at the middle each time. The unwanted behaviour -- a million things on the stack -- occurs if this element is exactly the smallest number of the million, then the smallest number of the 999,999 remaining and so on. This is extremely unlikely. It can only be generated artificially as a test case. Even then my computer has stack depth of a million to spare and will run the test without a hitch (and faster). (In the early days of qsort people where bitten by this, because they selected the first element. The unwanted behaviour resulted when the input was already sorted or almost sorted. This of course occurs in actual practice. But using a middle pivot make qsort behave optimally for sorted input.) So out go the following two lines : 2OVER 2OVER - + ( . . . . lo_1 hi_1+lo_2-hi_2) < IF 2SWAP THEN ( lo_1 hi_1 lo_2 hi_2) If you are on a 16 bit machine, the practical result is that you can no longer sort 64 k worth of items, but 64K/Q where Q is a small number, say 2. At the end of the ride, we will review this issue and maybe put back in equivalent code. (We will put it back. And in hind sight we will see that this change makes no sense. But this is the kind of thing you should do at this point.) To my surprise and relief the regression test succeeds. OUR FIRST NO-CHANGE : INDICES It is clear that if we want to make qsort oblivious of the kind of item to sort we rather not want to use addresses. There is no reasonable way to select the middle item in that way. We could pass the lenght of each item. But I don't want to assume that they have the same length. So what remains is using indices. Where it says '< IS PRECEEDES we introduced : MY< CELLS BUFFER + @ CELLS BUFFER + @ SWAP < ; This also removes the ugly assymetry between the vectors for PRECEEDES and <--> . In one case we pass address, and in another case we pass content. In the strings example we pass addresses, and then the content which turns out to be addresses as well, and make my poor brain hurt. Lets experiment a bit. The word SORT disappears, or better it will get a stack phrase like. \ Sort the range FIRST to LAST (inclusive) of item compared by the xt \ COMPARING and exchanged by the xt EXHANGING. \ ``For FIRST<=IR ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP @ R@ PRECEDES WHILE CELL+ REPEAT SWAP BEGIN R@ OVER @ PRECEDES WHILE CELL- REPEAT 2DUP > NOT IF 2DUP EXCHANGE >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R> DROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; : QSORT ( lo hi -- ) PARTITION ( lo_1 hi_1 lo_2 hi_2) 2DUP < IF RECURSE ELSE 2DROP THEN 2DUP < IF RECURSE ELSE 2DROP THEN ; -------------------------- ---------------------- Using indices this becomes: ------------- what we get ---------------------- : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP + 2/ >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP R@ PRECEDES WHILE 1+ REPEAT SWAP BEGIN R@ OVER PRECEDES WHILE 1- REPEAT 2DUP > NOT IF 2DUP EXCHANGE >R 1+ R> 1- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R> DROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; -------------------------- ---------------------- We leave out SORT, because we don't need it anymore. For the test we just use 0 9 QSORT. This looks like an improvement for simplicity. The ``DUP R@ PRECEDES'' is more symmetric than ``DUP @ R@ PRECEDES''. The code ``ALIGN-DOWN @'' just disappeared. It makes it easier to check against the basic idea of qsort. It looks like an infinitesimal change. But we needed a defered EXCHANGE. This was the code that went into it. : MY-EXCHANGE ( i1 i2 -- ) CELLS INT-TABLE + SWAP CELLS INT-TABLE + SWAP DUP @ >R OVER @ SWAP ! R> SWAP ! ; However, to your distress the regression test fails. (Not to mine, because I made this up.) This is the result of the test : 0 3 4 7 1 2 5 6 8 9 What is going on is that the element we compare against changes place. From then on we effectively compare against some random element. So what we want to do just cannot be done with qsort. Dead end. QSORT REVISITED If you can't win, change the rules of the game. We felt in the previous section that we were almost there. So what if we bent qsort a little bit? After all, the only thing we need is that the pivot doesn't get exchanged. Is that too much to ask? Looking more precisely at the PARTITION we see that if we fill an array with all fives all of them get exchanged. We select the pivot, in the middle, a 5 , and then require the first, a 5, to be less then the pivot, lest we exchange it. So is this algorithm floating around in Forth circles for decades slightly off the mark? Indeed if we consult Knuth (The Art of Programming, part 3) we see that normally a smaller or equal comparison is used. Actually, the Forth algorithm is very clever. The answer is infinite loops. What if we have all 5 and then search up for something smaller then 5? You end with an address outside of the area to be sorted, and a fetch from there may lead to a crash. And sorting where all items are the same is not an important case anyway. By doing a smaller than comparision we are sure we will find something somewhere, even if it is merely the pivot. Normally you would go for three parts. The first part is all less than or equal to the pivot, the second part is the pivot, and the third part is all greater than or equal to the pivot. Because the pivot is in place we need not place it into one of the partitions. Indeed a range [1,10] is paritioned [1,3] , pivot at place 4 and range [5,10]. So we expect to be able to replace DEFER PRECEDES ' < IS PRECEDES by DEFER PRECEDES ' <= IS PRECEDES Knuth has not our problem, because he takes the first element as the pivot, and after partitioning swap it into place. Knuth however suffers from the problem that sorted input takes a lot of time. What we will do is use the proper <=. Now the pivot never gets exchanged. We get then a partitioning like [1,4] [5,10] with the pivot in the first paritioning. We ma just leave it at that. Or we may consider the optimisation to exchange the pivot with item 4 and have the partitioning [1,3] 4 [5,10]. OUR SECOND NOCHANGE: FIXING PRECEEDES Fixing PRECEEDES in the above sense, is not an infinitesimal change to the algorithm. It is not a change in the algorithm at all. It is a change in the user manual. And it is reflected in a change in the regression test itself, and no change in QSORT. Of course we will have to run the regression test, so to say to test the test. To our dismay it takes 10 iterations to get the regression test in order again. And it dumps core. It crashes. (No examples, because I didn't actually try this out. Maybe it doesn't even crash nicely.) Lesson. You may change the rules of the game. But then you really must be Master of the Situation. More often than not that is not the case. OUR FOURTH CHANGE: ADDRESS ON RETURN STACK We may have failed in the previous step, but we did gain. We gained insight. The more precise analysis above shows that there is no choice but keeping track where our pivot remains. The first change we make is to hold the address of the pivot instead of the content. Then we must place a @ fetch after each R@ and We have to add a test whether the pivot is about to move, and replace the top of the return stack with that new address. The code for this is straightforward, but the algorithm suffers in simplicity and speed. That is the price we have to pay. : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP OVER - 2/ ALIGN-DOWN + >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP @ R@ @ PRECEDES WHILE CELL+ REPEAT SWAP BEGIN R@ @ OVER @ PRECEDES WHILE CELL- REPEAT 2DUP > NOT IF \ Do we have a new position for our pivot? OVER R@ = IF R> DROP DUP >R ELSE DUP R@ = IF R> DROP OVER >R THEN THEN 2DUP (<-->) >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R> DROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; This was an infinitesimal change, but a large one. It was not possible to make it smaller. To my surprise and relief the regression test succeeds. OUR FIFTH CHANGE: PRECEDES USES ADDRESSES We are now in a position to make the next move towards using indices, instead of addresses. That is by passing the addresses to PRECEDES instead of the content. (Like in STL the standard library for C++.) This is not only infinitesimal, it is also in absolute sense a small change, it amounts to eliminating four fetches from PARTITION. It looks much better, because the same ``things'' are passed to PRECEDES and to <--> . This is important, because it makes you forget about what type of data is there, the only important thing is the manipulation. : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP OVER - 2/ ALIGN-DOWN + >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP R@ PRECEDES WHILE CELL+ REPEAT SWAP BEGIN R@ OVER PRECEDES WHILE CELL- REPEAT 2DUP > NOT IF \ Do we have a new position for our pivot? OVER R@ = IF R> DROP DUP >R ELSE DUP R@ = IF R> DROP OVER >R THEN THEN 2DUP (<-->) >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) R> DROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; Note that two of the four fetches where added just in the previous step. To my surprise and relief the regression test succeeds. OUR SIXTH CHANGE: CLEANUP I somehow don't like the names PRECEDES and (<-->) It is time to come up with a naming convention. I think we should have just < and <--> in the SORT module. However Forth has no modules and wordlists are too slimy, sticky and slippery (if it is possible to be all that at the same time!) So vectors have to stand off by a naming convention to reduce the risk of name clashes. The solution is to prepend the name with a ``*'' to be associated with the c- reference operator. (``&'' would be better but that one is taken.). When we are at it, we introduce RDROP that is pretty ubiquitous and can be defined easily anyway. : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP OVER - 2/ ALIGN-DOWN + >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP R@ *< WHILE CELL+ REPEAT SWAP BEGIN R@ OVER *< WHILE CELL- REPEAT 2DUP > NOT IF \ Do we have a new position for our pivot? OVER R@ = IF RDROP DUP >R ELSE DUP R@ = IF RDROP OVER >R THEN THEN 2DUP *<--> >R CELL+ R> CELL- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) RDROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; Furthermore the whole deferring stuff must be hidden in the SORT module, meaning that there are no assignement to deferred vectors outside of SORT. If you want to sort you have to pass the low and high addresses and two execution tokens. As follows : ( lo hi xt-c xt-e -- ) : SORT '*<--> >BODY ! '*< >BODY ! QSORT ; Note that there is no use for IS . Anyway I hate that word because it looks ahead in the input stream, and that is exactly the reason the word is no use. Note that I do this cleanup as soon as it comes up, even now we are just one step short of our goal. This is the right way, lest we use much time in the frenzy that results when all those opportunities open up. To my surprise and relief the regression test succeeds. OUR SIXTH CHANGE: PRECEDES USES INDICES At last we now can use indices instead of addresses: Indices were our ultimate goal, we have attained sufficient generality at this point that we can sort all the other tables described in the introduction. We have attained genericity. : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP + 2/ >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP R@ *< WHILE 1+ REPEAT SWAP BEGIN R@ OVER *< WHILE 1- REPEAT 2DUP > NOT IF \ Do we have a new position for our pivot? OVER R@ = IF RDROP DUP >R ELSE DUP R@ = IF RDROP OVER >R THEN THEN 2DUP *<--> >R 1+ R> 1- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) RDROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; There is a lot to be changed in the regression test. To my surprise and relief the regression test succeeds. Isn't it beautiful? Let us have a look at it without those ugly comments. : PARTITION 2DUP + 2/ >R 2DUP BEGIN SWAP BEGIN DUP R@ *< WHILE 1+ REPEAT SWAP BEGIN R@ OVER *< WHILE 1- REPEAT 2DUP > NOT IF OVER R@ = IF RDROP DUP >R ELSE DUP R@ = IF RDROP OVER >R THEN THEN 2DUP *<--> >R 1+ R> 1- THEN 2DUP > UNTIL RDROP SWAP ROT ; : QSORT PARTITION 2DUP < IF RECURSE ELSE 2DROP THEN 2DUP < IF RECURSE ELSE 2DROP THEN ; This looks clean and crisp compared to Knuth's algorithm Q (TACP part 3). But this is actual code... OUR TENTH CHANGE: NOTHING TO DO EXCEPT .... Suddenly we find ourselves in the position that all the examples can be sorted using the new qsort. With great effort the regression test is expanded. But then it succeeds for all examples. OUR ELEVENTH CHANGE: OPTIMISATIONS. We read back looking for optimisations that can be put back in. 1. Two lines in SORT : 2OVER 2OVER - + ( . . . . lo_1 hi_1+lo_2-hi_2) < IF 2SWAP THEN ( lo_1 hi_1 lo_2 hi_2) This probably is worthwhile. Is it? Answer test. This is left as an exercise for the reader. BOTTOM LINE We have now a generic algorithm for qsort. Using EXCHANGE to exchange memory area's and properly filling in PRECEEDES and <--> vectors we can have the joy of really fast sorting. \ For INDEX1 and INDEX2 and TABLE, return corresponding ADDRESS1 \ and ADDRESS2 . : PAIR[] >R CELLS R@ + SWAP CELLS R@ + SWAP RDROP ; With proper description of the words using the Stallman convention we get at last : \ ----------------- auxiliary ------------------------------- \ Exchange the content at ADDRESS1 and ADDRESS2 over a fixed LENGTH. : EXCHANGE 0 ?DO OVER I + OVER I + OVER C@ OVER C@ >R SWAP C! R> SWAP C! LOOP 2DROP ; \ For INDEX1 and INDEX2 and TABLE, return corresponding ADDRESS1 \ and ADDRESS2 . : PAIR[] >R CELLS R@ + SWAP CELLS R@ + SWAP RDROP ; \ ----------------- quick sort proper ----------------------- \ Compare item N1 and N2. Return ``N1'' IS lower and not equal. DEFER *< \ Exchange item N1 and N2. DEFER *<--> \ Sort the range LOW to HIGH inclusive observing *< and *<--> : PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 ) 2DUP + 2/ >R ( R: median) 2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1) SWAP BEGIN DUP R@ *< WHILE 1+ REPEAT SWAP BEGIN R@ OVER *< WHILE 1- REPEAT 2DUP > NOT IF \ Do we have a new position for our pivot? OVER R@ = IF RDROP DUP >R ELSE DUP R@ = IF RDROP OVER >R THEN THEN 2DUP *<--> >R 1+ R> 1- THEN 2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1) RDROP ( R: ) SWAP ROT ( lo_1 hi_1 lo_2 hi_2) ; \ Sort the range LOW to HIGH inclusive observing \ ``LOW'' and ``HIGH'' must be indices compatible with the current \ values of *< and *<--> : (QSORT) ( lo hi -- ) PARTITION ( lo_1 hi_1 lo_2 hi_2) 2DUP < IF RECURSE ELSE 2DROP THEN 2DUP < IF RECURSE ELSE 2DROP THEN ; \ Sort the range FIRST to LAST (inclusive) of item compared by the xt \ COMPARING and exchanged by the xt EXHANGING. \ All indices in this range must be proper to pass to both of the xt's. \ The xt's are filled in into *< and *<--> and must observe the \ interface. \ After the call we have that : \ ``For FIRST<=I EXECUTE leaves TRUE.'' : QSORT '*<--> >BODY ! '*< >BODY ! (QSORT) ;