Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/recognizer.fs, revision 1.5

1.1       pazsan      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: 
1.2       pazsan     20: (field) r>int     ( r-addr -- addr )  0 cells ,
                     21: (field) r>compint ( r-addr -- )       1 cells ,
                     22: (field) r>comp    ( r-addr -- )       2 cells ,
                     23: (field) r>lit     ( r-addr -- )       3 cells ,
1.1       pazsan     24: 
                     25: :noname ( ... nt -- ) name>int execute ;
                     26: :noname ( ... nt -- ) name>int compile, ;
                     27: :noname ( ... nt -- ) name>comp execute ;
                     28: :noname ( ... nt -- ) postpone Literal ;
1.5     ! pazsan     29: recognizer: r:interpreter
1.1       pazsan     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
1.5     ! pazsan     34:        nip nip r:interpreter true  EXIT
1.1       pazsan     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: 
1.3       pazsan     56: ' no.extensions dup 2dup recognizer: r:fail
                     57: 
1.1       pazsan     58: \ recognizer stack
                     59: 
                     60: $10 Constant max-rec#
                     61: Variable forth-recognizer max-rec# cells allot
                     62: 
                     63: : get-recognizers ( rec-addr -- xt1 .. xtn n )
                     64:     dup cell+ swap @ dup >r cells bounds ?DO
                     65:        I @
                     66:     cell +LOOP  r> ;
                     67: 
                     68: : set-recognizers ( xt1 .. xtn n rec-addr -- )
                     69:     over max-rec# u>= abort" Too many recognizers"
                     70:     2dup ! swap cells bounds swap ?DO
                     71:        I !
                     72:     cell -LOOP ;
                     73: 
                     74: num-recognizer int-recognizer 2 forth-recognizer set-recognizers
                     75: 
                     76: \ recognizer loop
                     77: 
                     78: : do-recognizer ( addr u rec-addr -- token table )
                     79:     dup cell+ swap @ cells bounds ?DO
                     80:        I perform IF  UNLOOP  EXIT  THEN
                     81:     cell +LOOP
1.3       pazsan     82:     r:fail ;
1.1       pazsan     83: 
                     84: : interpreter-r ( addr u -- ... xt )
1.2       pazsan     85:     forth-recognizer do-recognizer r>int @ ;
1.1       pazsan     86: 
                     87: : compiler-r ( addr u -- ... xt )
1.2       pazsan     88:     forth-recognizer do-recognizer r>comp @ ;
1.1       pazsan     89: 
                     90: : [ ( -- ) \  core     left-bracket
                     91:     \G Enter interpretation state. Immediate word.
                     92:     ['] interpreter-r  IS parser1 state off ; immediate
                     93: 
                     94: : ] ( -- ) \ core      right-bracket
                     95:     \G Enter compilation state.
                     96:     ['] compiler-r     IS parser1 state on  ;
                     97: 
1.4       pazsan     98: : postpone ( "name" -- ) \ core
                     99:     \g Compiles the compilation semantics of @i{name}.
                    100:     parse-name forth-recognizer do-recognizer >r
                    101:     r@ r>lit perform r> r>comp @ compile, ; immediate
                    102: