Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Use (field) to build recognizer struct

    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: (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 ,
   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: