Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Postpone is compile-only

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