Re: Forth Frustrations

On Apr 17, 8:39 am, "Ed" <nos...@xxxxxxxxxxx> wrote:
"J Thomas" <jethom...@xxxxxxxxx> wrote

: REMOVE-ITEM ( xj .. badx .. badx .. x1 n badx -- xj ... x1 j )
OVER 0= IF
DROP ELSE
ROT 2DUP - 2>R \ save item along with ill-formed flag
1 0 D- \ silly Forth trick, never borrows when
subtracting zero
RECURSE
2R> IF SWAP 1+ ELSE DROP THEN
THEN ;

: -ORDER ( wid -- )
>R GET-ORDER R>
REMOVE-ITEM
SET-ORDER ;

Nice one! Smart use of recursion to simplify things. On VFX
it compiles to 121 bytes total - just 10 bytes longer than Wil's.

Ouch. OK,

---------
\ stores only j items on return stack instead of 2n items
: REMOVE-ITEM ( xj .. badx .. badx .. x1 n badx -- xj ... x1 j )
OVER 0= IF
DROP ELSE
SWAP 1- SWAP ROT 2DUP - IF
>R RECURSE R> SWAP 1+ ELSE
DROP RECURSE
THEN
THEN ;

: -ORDER1 ( wid -- )
>R GET-ORDER R>
REMOVE-ITEM
SET-ORDER ;
\ With GForth 0.6.2 this is 200 bytes, compared to Wil's 192 bytes.
\ My original was 204 and with SWAP 1- SWAP it dropped to 196.
-------

Would getting rid of the extra header matter?
-------
:NONAME ( xj .. badx .. badx .. x1 n badx -- xj ... x1 j )
OVER 0= IF
DROP ELSE
SWAP 1- SWAP ROT 2DUP - IF
>R RECURSE R> SWAP 1+ ELSE
DROP RECURSE
THEN
THEN ;

BASE @ SWAP BASE !
\ on a system that screens BASE out of range, try BLK or SCR
\ or >R : -ORDER >R GET-ORDER R> [ R> COMPILE, ] might work on one
line
\ or if you have a system with no colon-sys, just do [ COMPILE, ]

: -ORDER2 ( wid -- )
>R GET-ORDER R>
[ BASE @ COMPILE, ]
SET-ORDER ;

BASE ! \ 184 bytes with GForth.
-------

Simplify the stack stuff with a variable?
-------
ALIGN BASE @ HERE 0 , BASE !
:NONAME ( xj .. badx .. badx .. x1 n badx -- xj ... x1 j )
[ BASE @ ] LITERAL !
DUP IF
1- SWAP DUP [ BASE @ ] LITERAL @ - IF
>R RECURSE R> SWAP 1+ ELSE
DROP RECURSE
THEN
THEN ;
BASE !

: -ORDER3 ( wid -- )
>R GET-ORDER R>
[ BASE @ COMPILE, ]
SET-ORDER ;
BASE ! \ also 184
------

I can't predict what an optimising compiler would do.

It seems silly to make it unreadable to save a few bytes.

One more try.

------
\ Use loop, only recurse j times, save j items
: REMOVE-ITEM ( searchorder n badx -- newsearchorder j )
BEGIN
OVER 0= IF DROP EXIT THEN
SWAP 1- -ROT 2DUP = WHILE
NIP
REPEAT
SWAP >R RECURSE R> SWAP 1+ ;

: -ORDER ( wid -- )
>R GET-ORDER R>
REMOVE-ITEM
SET-ORDER ; \ 184 on GForth with both headers present
------

.

Relevant Pages