Diff for /gforth/kernel/recognizer.fs between versions 1.12 and 1.17

version 1.12, 2011/10/06 21:17:21 version 1.17, 2012/05/28 14:15:04
Line 18 Line 18
 : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;  : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
   
 (field) r>int      ( r-addr -- addr )  0 cells ,  (field) r>int      ( r-addr -- addr )  0 cells ,
 (field) r>comp     ( r-addr -- )       1 cells ,  (field) r>comp     ( r-addr -- addr )  1 cells ,
 (field) r>lit      ( r-addr -- )       2 cells ,  (field) r>lit      ( r-addr -- addr )  2 cells ,
   
 :noname ( ... nt -- ) name>int execute ;  ' no.extensions dup dup Create r:fail A, A, A,
 :noname ( ... nt -- ) name>comp execute ;  
 :noname ( ... nt -- ) postpone Literal ;  : lit, ( n -- ) postpone Literal ;
   : nt, ( nt -- ) name>comp execute ;
   : nt-ex ( nt -- )  r> >l name>int execute @local0 >r lp+ ;
   
   ' nt-ex
   ' nt,
   ' lit,
 Create r:word rot A, swap A, A,  Create r:word rot A, swap A, A,
   
 : word-recognizer ( addr u -- nt int-table true | addr u false )  : word-recognizer ( addr u -- nt r:word | addr u r:fail )
     2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup      2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
     IF      IF  nip nip r:word  ELSE  drop r:fail  THEN ;
         nip nip r:word true  EXIT  
     THEN ;  
   
 ' noop  ' noop
 :noname  postpone Literal ;  ' lit,
 dup  dup
 Create r:num rot A, swap A, A,  Create r:num rot A, swap A, A,
   
 ' noop  ' noop
 :noname  postpone 2Literal ;  :noname ( n -- ) postpone 2Literal ;
 dup  dup
 Create r:2num rot A, swap A, A,  Create r:2num rot A, swap A, A,
   
 \ snumber? should be implemented as recognizer stack  \ snumber? should be implemented as recognizer stack
   
 : num-recognizer ( addr u -- n/d int-table true | addr u false )  : num-recognizer ( addr u -- n/d table | addr u r:fail )
     2dup 2>r snumber?  dup      2dup 2>r snumber?  dup
     IF      IF
         2rdrop 0> IF  r:2num   ELSE  r:num  THEN  true  EXIT          2rdrop 0> IF  r:2num   ELSE  r:num  THEN  EXIT
     THEN      THEN
     drop 2r> false ;      drop 2r> r:fail ;
   
 ' no.extensions dup dup Create r:fail A, A, A,  
   
 \ recognizer stack  \ recognizer stack
   
Line 78  Variable forth-recognizer Line 80  Variable forth-recognizer
   
 : do-recognizer ( addr u rec-addr -- token table )  : do-recognizer ( addr u rec-addr -- token table )
     dup cell+ swap @ cells bounds ?DO      dup cell+ swap @ cells bounds ?DO
         I perform IF  UNLOOP  EXIT  THEN          I perform dup r:fail <>  IF  UNLOOP  EXIT  THEN  drop
     cell +LOOP      cell +LOOP
     r:fail ;      r:fail ;
   
 \ nested recognizer helper  \ nested recognizer helper
   
 : r:table>flag ( table -- table true | false )  \ : nest-recognizer ( addr u -- token table | addr u r:fail )
     dup r:fail <> dup 0= IF  nip  THEN ;  \   xxx-recognizer do-recognizer ;
   
 \ : nest-recognizer ( addr u -- token table true | addr u false )  
 \   xxx-recognizer do-recognizer r:table>flag ;  
   
 : interpreter-r ( addr u -- ... xt )  : interpreter-r ( addr u -- ... xt )
     forth-recognizer do-recognizer r>int @ ;      forth-recognizer do-recognizer r>int @ ;

Removed from v.1.12  
changed lines
  Added in v.1.17


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>