( 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]