recognizers

A collection of recognizers



\
\ an alternative implementation of recognizers. It
\ uses a separate stack module, that can be used
\ to implement the search order words independently
\
\ Date: Jan 28, 2017
\ Author: Matthias Trute
\ License: Public Domain

s" tester.fs" INCLUDED
s" Stack.4th" INCLUDED

\ Allocate a recognizer stack
: REC-STACK ( size -- stack-id ) STACK ;

4 REC-STACK VALUE FORTH-RECOGNIZER

\ replace a recognizer stack
: SET-RECOGNIZERS ( rec-n .. rec-1 n recstack-id -- )
  SET-STACK
;

: GET-RECOGNIZERS ( recstack-id -- rec-n .. rec-1 n )
  GET-STACK
;

\ define a recognizer with three actions. Suggesting DT:* names
: DT-TOKEN: ( XT-INTERPRET XT-COMPILE XT-POSTPONE "<spaces>name" -- )
  CREATE SWAP ROT , , , 
;

: DT>POST ( DT:TOKEN -- XT-POSTPONE ) CELL+ CELL+ @ ;
: DT>COMP ( DT:TOKEN -- XT-COMPILE  )       CELL+ @ ;
: DT>INT  ( DT:TOKEN -- XT-INTERPRET)             @ ;

:NONAME -1 ABORT" :=(" ; DUP DUP DT-TOKEN: DT:NULL

: (recognize) ( addr len XT -- addr len 0 | i*x DT:TOKEN -1 )
   ROT ROT 2DUP 2>R ROT EXECUTE 2R> ROT
   DUP DT:NULL = ( -- i*x addr len dt:token f )
   IF DROP 0 ELSE NIP NIP -1 THEN
;

: RECOGNIZE ( addr len stack-id -- i*x dt:token | dt:null )
    ['] (recognize) SWAP map-stack ( -- i*x dt:token -1 | addr len 0 )
    0= IF \ no recognizer did the job, remove addr/len
     2DROP DT:NULL
    THEN
;

\ Now build the runtime environment needed to play with all of the above

s" rec-find.4th" INCLUDED
s" rec-num.4th" INCLUDED

' REC:NUM ' REC:FIND 2 FORTH-RECOGNIZER SET-RECOGNIZERS

VERBOSE ON

:noname 1 ; :noname 2 ; :noname 3 ; dt-token: dt:test

T{ dt:test dt>int catch -> 1 0 }T
T{ dt:test dt>comp catch -> 2 0 }T
T{ dt:test dt>post catch -> 3 0 }T

T{ S" 1234"  FORTH-RECOGNIZER RECOGNIZE -> 1234  DT:NUM   }T
T{ S" 1234." FORTH-RECOGNIZER RECOGNIZE -> 1234. DT:DNUM  }T
T{ S" DUP"   FORTH-RECOGNIZER RECOGNIZE -> ' DUP -1 DT:XT }T
T{ S" UNKOWN WORD" FORTH-RECOGNIZER RECOGNIZE  -> DT:NULL }T