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 @ ; |