Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Recognizer included

    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 -- ) Create rot , swap , , ;
   19: 
   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 ,
   23: 
   24: :noname ( ... nt -- ) name>int execute ;
   25: :noname ( ... nt -- ) name>comp execute ;
   26: :noname ( ... nt -- ) postpone Literal ;
   27: Create r:interpreter rot A, swap A, A,
   28: 
   29: :noname ( addr u -- nt int-table true | addr u false )
   30:     2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
   31:     IF
   32: 	nip nip r:interpreter true  EXIT
   33:     THEN ; Constant int-recognizer
   34: 
   35: ' noop
   36: :noname  postpone Literal ;
   37: dup
   38: Create r:number rot A, swap A, A,
   39: 
   40: ' noop
   41: :noname  postpone 2Literal ;
   42: dup
   43: Create r:2number rot A, swap A, A,
   44: 
   45: \ snumber? should be implemented as recognizer stack
   46: 
   47: :noname ( addr u -- nt int-table true | addr u false )
   48:     2dup 2>r snumber?  dup
   49:     IF
   50: 	2rdrop 0> IF  r:2number   ELSE  r:number  THEN  true  EXIT
   51:     THEN
   52:     drop 2r> false ; Constant num-recognizer
   53: 
   54: ' no.extensions dup dup Create r:fail A, A, A,
   55: 
   56: \ recognizer stack
   57: 
   58: $10 Constant max-rec#
   59: 
   60: : get-recognizers ( rec-addr -- xt1 .. xtn n )
   61:     dup cell+ swap @ dup >r cells bounds ?DO
   62: 	I @
   63:     cell +LOOP  r> ;
   64: 
   65: : set-recognizers ( xt1 .. xtn n rec-addr -- )
   66:     over max-rec# u>= abort" Too many recognizers"
   67:     2dup ! swap cells bounds swap ?DO
   68: 	I !
   69:     cell -LOOP ;
   70: 
   71: Variable forth-recognizer
   72: 
   73: int-recognizer A, num-recognizer A, max-rec# 2 - cells allot
   74: 2 forth-recognizer !
   75: \ num-recognizer int-recognizer 2 forth-recognizer set-recognizers
   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
   83:     r:fail ;
   84: 
   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: 
   93: : interpreter-r ( addr u -- ... xt )
   94:     forth-recognizer do-recognizer r>int @ ;
   95: 
   96: ' interpreter-r IS parser1
   97: 
   98: : compiler-r ( addr u -- ... xt )
   99:     forth-recognizer do-recognizer r>comp @ ;
  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: 
  109: : >postpone ( token table -- )
  110:     dup r:fail = IF  no.extensions  THEN
  111:     >r r@ r>lit perform r> r>comp @ compile, ;
  112: 
  113: : postpone ( "name" -- ) \ core
  114:     \g Compiles the compilation semantics of @i{name}.
  115:     parse-name forth-recognizer do-recognizer >postpone ; immediate
  116: