Re: balanced REDUCE: a challenge for the brave

mhx@xxxxxx (Marcel Hendrix) writes Re: balanced REDUCE: a challenge for the brave

anton@xxxxxxxxxxxxxxxxxxxxxxxxxx (Anton Ertl) writes Re: balanced REDUCE: a challenge for the brave
[..]
To explain the problem, let's start out with a simple unbalanced
reduce:

: reduce ( 0 x1 ... [x2 x3 -- x4] -- x )
[..]

Why not use two deques a and b:
[..]

That proves to be overkill. Using a single deque, however, gives this nice
code (the first 4 lines are normally not needed):

: REDUCE ( 0 n1 ... nn xt -- )
[IS] action a CLEAR
BEGIN DUP
WHILE a PUSHLEFT
REPEAT DROP

BEGIN a SIZE 1 >
WHILE a POPLEFT a POPLEFT action a PUSHRIGHT
REPEAT a POPLEFT ;

The code for a deque is appended.

-marcel

-- ----------------
\ : ?ALLOCATE THROW ;
\ : #CELLS 4 / ;
\ : H. . ;
\ : DEC. . ;
\ : 2^x 1 SWAP LSHIFT ;

: DEQUE ( size -- )
CREATE HERE >R \ <base> <loffs> <roffs> <org>
0 , 0 ,
0 , -1 CELLS ,
0 ,
CELLS DUP 2* ALLOCATE ?ALLOCATE
DUP R@ 4 CELLS + !
+ DUP R@ !
R> 2 CELLS + !
DOES> ;

: PUSHRIGHT ( n q -- ) 2 CELLS + 1 CELLS OVER CELL+ +! 2@ + ! ;
: PUSHLEFT ( n q -- ) -1 CELLS OVER CELL+ +! 2@ + ! ;
: POPRIGHT ( q -- n ) 2 CELLS + DUP 2@ + @ -1 CELLS ROT CELL+ +! ;
: POPLEFT ( q -- n ) DUP 2@ + @ 1 CELLS ROT CELL+ +! ;
: CLEAR ( q -- ) 0 OVER CELL+ ! -1 CELLS SWAP 3 CELLS + ! ;
: SIZE ( q -- n ) DUP 3 CELLS + @ SWAP CELL+ @ - CELL+ #CELLS ;
: REMOVE ( q -- ) 4 CELLS + @ FREE ?ALLOCATE ;

: .INFO ( q -- )
CR ." left = " DUP CELL+ @ #CELLS .
." , right is " DUP 3 CELLS + @ #CELLS .
." , base is " DUP 4 CELLS + @ H.
." , size = " SIZE DEC. ;

#17 2^x DEQUE a

DEFER action ( a b -- c )

: REDUCE ( 0 n1 ... nn xt -- )
[IS] action a CLEAR
BEGIN DUP
WHILE a PUSHLEFT
REPEAT DROP

BEGIN a SIZE 1 >
WHILE a POPLEFT a POPLEFT action a PUSHRIGHT
REPEAT a POPLEFT ;


.