Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.1 | \ recognizer-based interpreter 05oct2011py |
| 2 : | |||
| 3 : | \ Recognizer are words that take a string and try to figure out | ||
| 4 : | \ what to do with it. I want to separate the parse action from | ||
| 5 : | \ the interpret/compile/postpone action, so that recognizers | ||
| 6 : | \ are more general than just be used for the interpreter. | ||
| 7 : | |||
| 8 : | \ The "design pattern" used here is the *factory*, even though | ||
| 9 : | \ the recognizer does not return a full-blown object. | ||
| 10 : | \ A recognizer has the stack effect | ||
| 11 : | \ ( addr u -- token table true | addr u false ) | ||
| 12 : | \ where the token is the result of the parsing action (can be more than | ||
| 13 : | \ one stack or live on other stacks, e.g. on the FP stack) | ||
| 14 : | \ and the table contains for actions (as array of four xts: | ||
| 15 : | \ interpret it, compile interpretation semantics | ||
| 16 : | \ compile it, compile it as literal. | ||
| 17 : | |||
| 18 : | : recognizer: ( xt1 xt2 xt3 xt4 -- ) Create 2swap swap 2, swap 2, ; | ||
| 19 : | |||
| 20 : | : r>int ( r-addr -- ) @ ; | ||
| 21 : | : r>compint ( r-addr -- ) cell+ @ ; | ||
| 22 : | : r>comp ( r-addr -- ) cell+ cell+ @ ; | ||
| 23 : | : r>lit ( r-addr -- ) cell+ cell+ cell+ @ ; | ||
| 24 : | |||
| 25 : | :noname ( ... nt -- ) name>int execute ; | ||
| 26 : | :noname ( ... nt -- ) name>int compile, ; | ||
| 27 : | :noname ( ... nt -- ) name>comp execute ; | ||
| 28 : | :noname ( ... nt -- ) postpone Literal ; | ||
| 29 : | recognizer: r:int-table | ||
| 30 : | |||
| 31 : | :noname ( addr u -- nt int-table true | addr u false ) | ||
| 32 : | 2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup | ||
| 33 : | IF | ||
| 34 : | nip nip r:int-table true EXIT | ||
| 35 : | THEN ; Constant int-recognizer | ||
| 36 : | |||
| 37 : | ' noop | ||
| 38 : | :noname postpone Literal ; | ||
| 39 : | dup | ||
| 40 : | dup | ||
| 41 : | recognizer: r:number | ||
| 42 : | |||
| 43 : | ' noop | ||
| 44 : | :noname postpone 2Literal ; | ||
| 45 : | dup | ||
| 46 : | dup | ||
| 47 : | recognizer: r:2number | ||
| 48 : | |||
| 49 : | :noname ( addr u -- nt int-table true | addr u false ) | ||
| 50 : | 2dup 2>r snumber? dup | ||
| 51 : | IF | ||
| 52 : | 2rdrop 0> IF r:2number ELSE r:number THEN true EXIT | ||
| 53 : | THEN | ||
| 54 : | drop 2r> false ; Constant num-recognizer | ||
| 55 : | |||
| 56 : | \ recognizer stack | ||
| 57 : | |||
| 58 : | $10 Constant max-rec# | ||
| 59 : | Variable forth-recognizer max-rec# cells allot | ||
| 60 : | |||
| 61 : | : get-recognizers ( rec-addr -- xt1 .. xtn n ) | ||
| 62 : | dup cell+ swap @ dup >r cells bounds ?DO | ||
| 63 : | I @ | ||
| 64 : | cell +LOOP r> ; | ||
| 65 : | |||
| 66 : | : set-recognizers ( xt1 .. xtn n rec-addr -- ) | ||
| 67 : | over max-rec# u>= abort" Too many recognizers" | ||
| 68 : | 2dup ! swap cells bounds swap ?DO | ||
| 69 : | I ! | ||
| 70 : | cell -LOOP ; | ||
| 71 : | |||
| 72 : | num-recognizer int-recognizer 2 forth-recognizer set-recognizers | ||
| 73 : | |||
| 74 : | \ recognizer loop | ||
| 75 : | |||
| 76 : | : do-recognizer ( addr u rec-addr -- token table ) | ||
| 77 : | dup cell+ swap @ cells bounds ?DO | ||
| 78 : | I perform IF UNLOOP EXIT THEN | ||
| 79 : | cell +LOOP | ||
| 80 : | no.extensions ; | ||
| 81 : | |||
| 82 : | : interpreter-r ( addr u -- ... xt ) | ||
| 83 : | forth-recognizer do-recognizer r>int ; | ||
| 84 : | |||
| 85 : | : compiler-r ( addr u -- ... xt ) | ||
| 86 : | forth-recognizer do-recognizer r>comp ; | ||
| 87 : | |||
| 88 : | : [ ( -- ) \ core left-bracket | ||
| 89 : | \G Enter interpretation state. Immediate word. | ||
| 90 : | ['] interpreter-r IS parser1 state off ; immediate | ||
| 91 : | |||
| 92 : | : ] ( -- ) \ core right-bracket | ||
| 93 : | \G Enter compilation state. | ||
| 94 : | ['] compiler-r IS parser1 state on ; | ||
| 95 : |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |