version 1.4, 2011/10/05 21:06:11
|
version 1.12, 2011/10/06 21:17:21
|
Line 15
|
Line 15
|
\ interpret it, compile interpretation semantics |
\ interpret it, compile interpretation semantics |
\ compile it, compile it as literal. |
\ compile it, compile it as literal. |
|
|
: recognizer: ( xt1 xt2 xt3 xt4 -- ) Create 2swap swap 2, swap 2, ; |
: 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>compint ( r-addr -- ) 1 cells , |
(field) r>comp ( r-addr -- ) 1 cells , |
(field) r>comp ( r-addr -- ) 2 cells , |
(field) r>lit ( r-addr -- ) 2 cells , |
(field) r>lit ( r-addr -- ) 3 cells , |
|
|
|
:noname ( ... nt -- ) name>int execute ; |
:noname ( ... nt -- ) name>int execute ; |
:noname ( ... nt -- ) name>int compile, ; |
|
:noname ( ... nt -- ) name>comp execute ; |
:noname ( ... nt -- ) name>comp execute ; |
:noname ( ... nt -- ) postpone Literal ; |
:noname ( ... nt -- ) postpone Literal ; |
recognizer: r:int-table |
Create r:word rot A, swap A, A, |
|
|
:noname ( addr u -- nt int-table true | addr u false ) |
: word-recognizer ( addr u -- nt int-table true | addr u false ) |
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:int-table true EXIT |
nip nip r:word true EXIT |
THEN ; Constant int-recognizer |
THEN ; |
|
|
' noop |
' noop |
:noname postpone Literal ; |
:noname postpone Literal ; |
dup |
dup |
dup |
Create r:num rot A, swap A, A, |
recognizer: r:number |
|
|
|
' noop |
' noop |
:noname postpone 2Literal ; |
:noname postpone 2Literal ; |
dup |
dup |
dup |
Create r:2num rot A, swap A, A, |
recognizer: r:2number |
|
|
\ snumber? should be implemented as recognizer stack |
|
|
:noname ( addr u -- nt int-table true | addr u false ) |
: num-recognizer ( addr u -- n/d int-table true | addr u false ) |
2dup 2>r snumber? dup |
2dup 2>r snumber? dup |
IF |
IF |
2rdrop 0> IF r:2number ELSE r:number THEN true EXIT |
2rdrop 0> IF r:2num ELSE r:num THEN true EXIT |
THEN |
THEN |
drop 2r> false ; Constant num-recognizer |
drop 2r> false ; |
|
|
' no.extensions dup 2dup recognizer: r:fail |
' no.extensions dup dup Create r:fail A, A, A, |
|
|
\ recognizer stack |
\ recognizer stack |
|
|
$10 Constant max-rec# |
$10 Constant max-rec# |
Variable forth-recognizer max-rec# cells allot |
|
|
|
: get-recognizers ( rec-addr -- xt1 .. xtn n ) |
: get-recognizers ( rec-addr -- xt1 .. xtn n ) |
dup cell+ swap @ dup >r cells bounds ?DO |
dup swap @ dup >r cells bounds swap ?DO |
I @ |
I @ |
cell +LOOP r> ; |
cell -LOOP r> ; |
|
|
: set-recognizers ( xt1 .. xtn n rec-addr -- ) |
: set-recognizers ( xt1 .. xtn n rec-addr -- ) |
over max-rec# u>= abort" Too many recognizers" |
over max-rec# u>= abort" Too many recognizers" |
2dup ! swap cells bounds swap ?DO |
2dup ! cell+ swap cells bounds ?DO |
I ! |
I ! |
cell -LOOP ; |
cell +LOOP ; |
|
|
num-recognizer int-recognizer 2 forth-recognizer set-recognizers |
Variable forth-recognizer |
|
|
|
' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot |
|
2 forth-recognizer ! |
|
\ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers |
|
|
\ recognizer loop |
\ recognizer loop |
|
|
Line 81 num-recognizer int-recognizer 2 forth-re
|
Line 82 num-recognizer int-recognizer 2 forth-re
|
cell +LOOP |
cell +LOOP |
r:fail ; |
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 ; |
|
|
: interpreter-r ( addr u -- ... xt ) |
: interpreter-r ( addr u -- ... xt ) |
forth-recognizer do-recognizer r>int @ ; |
forth-recognizer do-recognizer r>int @ ; |
|
|
|
' interpreter-r IS parser1 |
|
|
: compiler-r ( addr u -- ... xt ) |
: compiler-r ( addr u -- ... xt ) |
forth-recognizer do-recognizer r>comp @ ; |
forth-recognizer do-recognizer r>comp @ ; |
|
|
Line 95 num-recognizer int-recognizer 2 forth-re
|
Line 106 num-recognizer int-recognizer 2 forth-re
|
\G Enter compilation state. |
\G Enter compilation state. |
['] compiler-r IS parser1 state on ; |
['] compiler-r IS parser1 state on ; |
|
|
|
: >int ( token table -- ) r>int perform ; |
|
: >comp ( token table -- ) r>comp perform ; |
|
: >postpone ( token table -- ) |
|
>r r@ r>lit perform r> r>comp @ compile, ; |
|
|
: postpone ( "name" -- ) \ core |
: postpone ( "name" -- ) \ core |
\g Compiles the compilation semantics of @i{name}. |
\g Compiles the compilation semantics of @i{name}. |
parse-name forth-recognizer do-recognizer >r |
parse-name forth-recognizer do-recognizer >postpone ; immediate |
r@ r>lit perform r> r>comp @ compile, ; immediate |
|
|
|