recognizers
A collection of recognizers
\
\ separate stacks for cell sized data
\
\ Date: Oct 15, 2016
\ Author: Matthias Trute
\ License: Public Domain
\ with ideas from Jenny Brien
\ allocate a stack region with at most
\ size elements
: STACK ( size -- stack-id )
1+ ( size ) CELLS HERE SWAP ALLOT
0 OVER ! \ empty stack
;
\ replace the stack content with data from
\ the data stack.
: SET-STACK ( rec-n .. rec-1 n recstack-id -- )
2DUP ! CELL+ SWAP CELLS BOUNDS
?DO I ! CELL +LOOP
;
\ read the whole stack to the data stack
: GET-STACK ( recstack-id -- rec-n .. rec-1 n )
DUP @ >R R@ CELLS + R@ BEGIN
?DUP
WHILE
1- OVER ( -- a n a )
@ ( -- a n r_i)
ROT CELL -
ROT ( -- r_i a n )
REPEAT
DROP R>
;
\ execute XT for earch element of the stack
\ leave the loop if the XT returns TRUE
: MAP-STACK ( i*x XT stack-id -- j*y f )
DUP CELL+ SWAP @ CELLS BOUNDS ?DO
( -- i*x XT )
I @ SWAP DUP >R EXECUTE
?DUP IF R> DROP UNLOOP EXIT THEN
R> CELL +LOOP
DROP 0
;
\ add an item as new top of the stack
: >FRONT ( x stack-id -- )
2DUP 2>R NIP GET-STACK 2R> ROT 1+ SWAP SET-STACK
;
\ add an item at the bottom of a stack
: >BACK ( x stack-id -- )
DUP >R GET-STACK 1+ R> SET-STACK
;
\ ------------- Test Cases ------------
4 STACK constant test
: s1 1 0 ; \ 0 means continue with map-stack
: s2 2 0 ;
: s3 3 0 ;
: s4 4 -1 ; \ -1 means premature exit from map-stack
\ set and get methods
T{ 0 test SET-STACK -> }T
T{ test GET-STACK -> 0 }T
T{ ' s1 1 test SET-STACK -> }T
T{ test GET-STACK -> ' s1 1 }T
T{ ' s2 ' s1 2 test SET-STACK -> }T
T{ test GET-STACK -> ' s2 ' s1 2 }T
T{ ' s1 ' s2 ' s3 3 test SET-STACK -> }T
T{ test GET-STACK -> ' s1 ' s2 ' s3 3 }T
\ testing map-stack
\ the whole stack is used for execute
T{ ' EXECUTE test MAP-STACK -> 3 2 1 0 }T
T{ ' s1 ' s2 ' s4 3 test SET-STACK -> }T
\ only the 1st element is executed
T{ ' EXECUTE test MAP-STACK -> 4 -1 }T
\ append and prepend methods
T{ ' s1 1 test SET-STACK -> }T
T{ ' s2 test >FRONT -> }T
T{ test GET-STACK -> ' s1 ' s2 2 }T
T{ ' s1 1 test SET-STACK -> }T
T{ ' s2 test >BACK -> }T
T{ test GET-STACK -> ' s2 ' s1 2 }T
by mtrute
Versions
2.1.0, 2.0.0, 1.4.5, 1.4.4, 1.4.3, 1.4.2, 1.4.1, 1.4.0, 1.3.2, 1.3.1, 1.3.0, 1.2.1, 1.2.0, 1.1.0, 1.0.1, 1.0.0
Download current as zip
Tags
recognizer, recognizerstack, stack
Dependencies
ttester 1.x.x, stack 1.x.x
Dependents
None