--- gforth/kernel/recognizer.fs 2011/10/06 20:15:06 1.8 +++ gforth/kernel/recognizer.fs 2012/05/28 14:15:04 1.17 @@ -18,40 +18,42 @@ : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ; (field) r>int ( r-addr -- addr ) 0 cells , -(field) r>comp ( r-addr -- ) 1 cells , -(field) r>lit ( r-addr -- ) 2 cells , +(field) r>comp ( r-addr -- addr ) 1 cells , +(field) r>lit ( r-addr -- addr ) 2 cells , -:noname ( ... nt -- ) name>int execute ; -:noname ( ... nt -- ) name>comp execute ; -:noname ( ... nt -- ) postpone Literal ; -Create r:interpreter rot A, swap A, A, +' no.extensions dup dup Create r:fail A, A, A, + +: 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, -:noname ( 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 - IF - nip nip r:interpreter true EXIT - THEN ; Constant int-recognizer + IF nip nip r:word ELSE drop r:fail THEN ; ' noop -:noname postpone Literal ; +' lit, dup -Create r:number rot A, swap A, A, +Create r:num rot A, swap A, A, ' noop -:noname postpone 2Literal ; +:noname ( n -- ) postpone 2Literal ; dup -Create r:2number rot A, swap A, A, +Create r:2num rot A, swap A, A, \ snumber? should be implemented as recognizer stack -:noname ( addr u -- nt int-table true | addr u false ) +: num-recognizer ( addr u -- n/d table | addr u r:fail ) 2dup 2>r snumber? dup IF - 2rdrop 0> IF r:2number ELSE r:number THEN true EXIT + 2rdrop 0> IF r:2num ELSE r:num THEN EXIT THEN - drop 2r> false ; Constant num-recognizer - -' no.extensions dup dup Create r:fail A, A, A, + drop 2r> r:fail ; \ recognizer stack @@ -70,25 +72,22 @@ $10 Constant max-rec# Variable forth-recognizer -int-recognizer A, num-recognizer A, max-rec# 2 - cells allot +' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot 2 forth-recognizer ! -\ num-recognizer int-recognizer 2 forth-recognizer set-recognizers +\ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers \ recognizer loop : do-recognizer ( addr u rec-addr -- token table ) dup cell+ swap @ cells bounds ?DO - I perform IF UNLOOP EXIT THEN + I perform dup r:fail <> IF UNLOOP EXIT THEN drop cell +LOOP r:fail ; \ nested recognizer helper -: r:table>flag ( table -- table true | false ) - dup r:fail <> dup 0= IF nip THEN ; - -\ : nest-recognizer ( addr u -- token table true | addr u false ) -\ xxx-recognizer do-recognizer r:table>flag ; +\ : nest-recognizer ( addr u -- token table | addr u r:fail ) +\ xxx-recognizer do-recognizer ; : interpreter-r ( addr u -- ... xt ) forth-recognizer do-recognizer r>int @ ; @@ -106,8 +105,9 @@ int-recognizer A, num-recognizer A, max- \G Enter compilation state. ['] compiler-r IS parser1 state on ; +: >int ( token table -- ) r>int perform ; +: >comp ( token table -- ) r>comp perform ; : >postpone ( token table -- ) - dup r:fail = IF no.extensions THEN >r r@ r>lit perform r> r>comp @ compile, ; : postpone ( "name" -- ) \ core