Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Changed recognizer return value

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