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 : | pazsan | 1.7 | : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ; |
| 19 : | pazsan | 1.1 | |
| 20 : | pazsan | 1.7 | (field) r>int ( r-addr -- addr ) 0 cells , |
| 21 : | pazsan | 1.13 | (field) r>comp ( r-addr -- addr ) 1 cells , |
| 22 : | (field) r>lit ( r-addr -- addr ) 2 cells , | ||
| 23 : | pazsan | 1.1 | |
| 24 : | pazsan | 1.14 | ' no.extensions dup dup Create r:fail A, A, A, |
| 25 : | |||
| 26 : | pazsan | 1.15 | : lit, ( n -- ) postpone Literal ; |
| 27 : | : nt, ( nt -- ) name>comp execute ; | ||
| 28 : | pazsan | 1.18 | : nt-ex ( nt -- ) |
| 29 : | [ cell 1 floats - dup [IF] ] lp+!# [ dup , [THEN] drop ] | ||
| 30 : | r> >l name>int execute @local0 >r lp+ ; | ||
| 31 : | pazsan | 1.15 | |
| 32 : | pazsan | 1.16 | ' nt-ex |
| 33 : | ' nt, | ||
| 34 : | ' lit, | ||
| 35 : | pazsan | 1.10 | Create r:word rot A, swap A, A, |
| 36 : | pazsan | 1.1 | |
| 37 : | pazsan | 1.14 | : word-recognizer ( addr u -- nt r:word | addr u r:fail ) |
| 38 : | pazsan | 1.1 | 2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup |
| 39 : | pazsan | 1.14 | IF nip nip r:word ELSE drop r:fail THEN ; |
| 40 : | pazsan | 1.1 | |
| 41 : | pazsan | 1.16 | ' noop |
| 42 : | ' lit, | ||
| 43 : | pazsan | 1.1 | dup |
| 44 : | pazsan | 1.10 | Create r:num rot A, swap A, A, |
| 45 : | pazsan | 1.1 | |
| 46 : | pazsan | 1.16 | ' noop |
| 47 : | :noname ( n -- ) postpone 2Literal ; | ||
| 48 : | pazsan | 1.1 | dup |
| 49 : | pazsan | 1.10 | Create r:2num rot A, swap A, A, |
| 50 : | pazsan | 1.7 | |
| 51 : | \ snumber? should be implemented as recognizer stack | ||
| 52 : | pazsan | 1.1 | |
| 53 : | pazsan | 1.14 | : num-recognizer ( addr u -- n/d table | addr u r:fail ) |
| 54 : | pazsan | 1.1 | 2dup 2>r snumber? dup |
| 55 : | IF | ||
| 56 : | pazsan | 1.14 | 2rdrop 0> IF r:2num ELSE r:num THEN EXIT |
| 57 : | pazsan | 1.1 | THEN |
| 58 : | pazsan | 1.14 | drop 2r> r:fail ; |
| 59 : | pazsan | 1.3 | |
| 60 : | pazsan | 1.1 | \ recognizer stack |
| 61 : | |||
| 62 : | $10 Constant max-rec# | ||
| 63 : | |||
| 64 : | : get-recognizers ( rec-addr -- xt1 .. xtn n ) | ||
| 65 : | pazsan | 1.8 | dup swap @ dup >r cells bounds swap ?DO |
| 66 : | pazsan | 1.1 | I @ |
| 67 : | pazsan | 1.8 | cell -LOOP r> ; |
| 68 : | pazsan | 1.1 | |
| 69 : | : set-recognizers ( xt1 .. xtn n rec-addr -- ) | ||
| 70 : | over max-rec# u>= abort" Too many recognizers" | ||
| 71 : | pazsan | 1.8 | 2dup ! cell+ swap cells bounds ?DO |
| 72 : | pazsan | 1.1 | I ! |
| 73 : | pazsan | 1.8 | cell +LOOP ; |
| 74 : | pazsan | 1.1 | |
| 75 : | pazsan | 1.7 | Variable forth-recognizer |
| 76 : | |||
| 77 : | pazsan | 1.10 | ' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot |
| 78 : | pazsan | 1.7 | 2 forth-recognizer ! |
| 79 : | pazsan | 1.10 | \ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers |
| 80 : | pazsan | 1.1 | |
| 81 : | \ recognizer loop | ||
| 82 : | |||
| 83 : | : do-recognizer ( addr u rec-addr -- token table ) | ||
| 84 : | dup cell+ swap @ cells bounds ?DO | ||
| 85 : | pazsan | 1.14 | I perform dup r:fail <> IF UNLOOP EXIT THEN drop |
| 86 : | pazsan | 1.1 | cell +LOOP |
| 87 : | pazsan | 1.3 | r:fail ; |
| 88 : | pazsan | 1.1 | |
| 89 : | pazsan | 1.6 | \ nested recognizer helper |
| 90 : | |||
| 91 : | pazsan | 1.14 | \ : nest-recognizer ( addr u -- token table | addr u r:fail ) |
| 92 : | \ xxx-recognizer do-recognizer ; | ||
| 93 : | pazsan | 1.6 | |
| 94 : | pazsan | 1.1 | : interpreter-r ( addr u -- ... xt ) |
| 95 : | pazsan | 1.16 | forth-recognizer do-recognizer r>int @ ; |
| 96 : | pazsan | 1.1 | |
| 97 : | pazsan | 1.7 | ' interpreter-r IS parser1 |
| 98 : | |||
| 99 : | pazsan | 1.1 | : compiler-r ( addr u -- ... xt ) |
| 100 : | pazsan | 1.16 | forth-recognizer do-recognizer r>comp @ ; |
| 101 : | pazsan | 1.1 | |
| 102 : | : [ ( -- ) \ core left-bracket | ||
| 103 : | \G Enter interpretation state. Immediate word. | ||
| 104 : | ['] interpreter-r IS parser1 state off ; immediate | ||
| 105 : | |||
| 106 : | : ] ( -- ) \ core right-bracket | ||
| 107 : | \G Enter compilation state. | ||
| 108 : | ['] compiler-r IS parser1 state on ; | ||
| 109 : | |||
| 110 : | pazsan | 1.16 | : >int ( token table -- ) r>int perform ; |
| 111 : | : >comp ( token table -- ) r>comp perform ; | ||
| 112 : | pazsan | 1.7 | : >postpone ( token table -- ) |
| 113 : | pazsan | 1.16 | >r r@ r>lit perform r> r>comp @ compile, ; |
| 114 : | pazsan | 1.7 | |
| 115 : | pazsan | 1.4 | : postpone ( "name" -- ) \ core |
| 116 : | \g Compiles the compilation semantics of @i{name}. | ||
| 117 : | pazsan | 1.19 | parse-name forth-recognizer do-recognizer >postpone |
| 118 : | ; immediate restrict | ||
| 119 : | pazsan | 1.4 |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |