( Title: RECURSE tests File: recurse-test.fs Author: David N. Williams License: Public Domain [tests] LGPL [definitions supplied by Bill Muench] Version: 0.6.0 Revised: March 19, 2010 The date above may reflect cosmetic changes not logged here. Version 0.6.0 18Mar10 * Started with 19Feb10 tests of Bill Muench's recursive _-ORDER, extracted from order-test.fs. * Added tests for his recursive versions of PICK, ROLL, and -ROLL. Bill Muench, developer of eForth, shared an interesting collection of ANS/ISO Forth word definitions that use RECURSE. Because it seemed to me they exercised the rules for RECURSE rather well, I asked his permission to use them in ttester tests for RECURSE. He agreed that the definitions could be treated as open source, and this file is the result. The word that exercises RECURSE most strongly is _-ORDER, a factor in his definition of the word -ORDER, which removes all copies of a specified wid from the search order. The other three words are recursive implementations of PICK, ROLL, and -ROLL. As words that many Forthers assiduously avoid, they carry the caveat that they are not being promoted as good Forth practice. The interest here is their use of RECURSE. The only half tongue-in-cheek repetition of "never" in their comments comes directly from Bill's source. The same caveat most definitely applies to the recursive implementation of -ROT in terms of the recursive -ROLL, which is used in a second implementation of _-ORDER to exercise RECURSE both directly and indirectly. Finally, the use of RECURSE in PICK and ROLL is not that different from its use in the other words, and their tests may be considered redundant as tests of RECURSE. REFERENCES For eForth: http://www.baymoon.com/~bimu/forth/ For -ORDER: http://www-personal.umich.edu/~williams/archive/forth/utilities/#order ) [UNDEFINED] \\ [IF] \ for degugging : \\ ( -- ) -1 parse 2drop BEGIN refill 0= UNTIL ; [THEN] s" ttester.fs" included true VERBOSE ! : ?.cr ( -- ) VERBOSE @ IF cr THEN ; ?.cr variable #errors 0 #errors ! :noname ( c-addr u -- ) \ for ttester ( Display an error message followed by the line that had the error. ) 1 #errors +! ERROR1 ; ERROR-XT ! decimal [UNDEFINED] -ROT [IF] : -ROT ROT ROT ; [THEN] \ ***BEGIN LGPL ( The words in this section are ) \ Copyright (C) 2010 by Bill Muench ( This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or at your option any later version. This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. ) : _-ORDER ( w n*wid n -- n'*wid w n' ) ( A factor in Bill Muench's -ORDER, from eForth. The wid items on the data stack there are replaced by arbitrary values here. This word exercises the rules for the use of RECURSE with the return stack, control flow words, and EXIT. Assume that n is nonnegative. The input sequence n*wid may or may not contain copies of w. The output n'*wid* has any copies removed, and n' is n minus the number removed. The implementation uses the return stack to invert the order of wids, and recursively removes them to build the output on the data stack. ) dup IF 1- swap >r ( >> ) RECURSE ( << ) ( wid*i w i) ( R: wid') over r@ xor IF 1+ r> -rot EXIT THEN r> drop THEN ; \ Recursive versions of XXX have names >>XXX<<. : >>PICK<< ( n -- n )( 6.2.2030 ( 0x50 ) \ never PICK ?DUP IF SWAP >R 1- ( >> ) RECURSE ( << ) R> SWAP EXIT THEN DUP ; : >>ROLL<< ( n ... +n -- ... n )( 6.2.2150 ( 0x4F ) \ never never ROLL ?DUP IF SWAP >R 1- ( >> ) RECURSE ( << ) R> SWAP THEN ; : >>-ROLL<< ( ... n +n -- n ... ) \ never never never -ROLL ?DUP IF ROT >R 1- ( >> ) RECURSE ( << ) R> THEN ; \ ***END LGPL : >>-ROT<< ( a b c -- c a b ) 2 >>-ROLL<< ; : _-ORDER-2 ( w n*wid n -- n'*wid w n' ) ( This version is the same as _-ORDER, except it uses a recursive version of -ROT. So it not only uses RECURSE directly, but also calls a word that uses RECURSE. ) dup IF 1- swap >r ( >> ) RECURSE ( << ) ( wid*i w i) ( R: wid') over r@ xor IF 1+ r> >>-ROT<< EXIT THEN r> drop THEN ; TESTING RECURSE T{ 1 0 _-ORDER -> 1 0 }T T{ 1 1 1 _-ORDER -> 1 0 }T T{ 1 2 3 2 _-ORDER -> 2 3 1 2 }T T{ 1 1 1 2 _-ORDER -> 1 0 }T T{ 1 2 1 2 3 _-ORDER -> 2 2 1 2 }T T{ 1 2 1 2 1 4 _-ORDER -> 2 2 1 2 }T T{ 1 1 2 1 2 4 _-ORDER -> 2 2 1 2 }T T{ 1 2 2 1 3 _-ORDER -> 2 2 1 2 }T T{ 1 0 >>PICK<< -> 1 1 }T T{ 2 1 1 >>PICK<< -> 2 1 2 }T T{ 3 2 1 2 >>PICK<< -> 3 2 1 3 }T T{ 0 >>ROLL<< -> }T T{ 2 1 1 >>ROLL<< -> 1 2 }T T{ 3 2 1 2 >>ROLL<< -> 2 1 3 }T T{ 4 3 2 1 3 >>ROLL<< -> 3 2 1 4 }T T{ 1 0 >>ROLL<< -> 1 }T T{ 3 2 1 1 >>ROLL<< -> 3 1 2 }T T{ 4 3 2 1 2 >>ROLL<< -> 4 2 1 3 }T T{ 5 4 3 2 1 3 >>ROLL<< -> 5 3 2 1 4 }T T{ 0 >>-ROLL<< -> }T T{ 2 1 1 >>-ROLL<< -> 1 2 }T T{ 3 2 1 2 >>-ROLL<< -> 1 3 2 }T T{ 4 3 2 1 3 >>-ROLL<< -> 1 4 3 2 }T T{ 1 0 >>-ROLL<< -> 1 }T T{ 3 2 1 1 >>-ROLL<< -> 3 1 2 }T T{ 4 3 2 1 2 >>-ROLL<< -> 4 1 3 2 }T T{ 5 4 3 2 1 3 >>-ROLL<< -> 5 1 4 3 2 }T T{ 1 2 3 >>-ROT<< -> 3 1 2 }T T{ 1 2 3 4 >>-ROT<< -> 1 4 2 3 }T T{ 1 0 _-ORDER-2 -> 1 0 }T T{ 1 1 1 _-ORDER-2 -> 1 0 }T T{ 1 2 3 2 _-ORDER-2 -> 2 3 1 2 }T T{ 1 1 1 2 _-ORDER-2 -> 1 0 }T T{ 1 2 1 2 3 _-ORDER-2 -> 2 2 1 2 }T T{ 1 2 1 2 1 4 _-ORDER-2 -> 2 2 1 2 }T T{ 1 1 2 1 2 4 _-ORDER-2 -> 2 2 1 2 }T T{ 1 2 2 1 3 _-ORDER-2 -> 2 2 1 2 }T VERBOSE @ [IF] cr .( #ERRORS: ) #errors @ . cr [THEN]