Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

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

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