Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Recognizer doc update

    1: \ recognizer-based interpreter                       05oct2011py
    2: 
    3: \ Copyright (C) 2012 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation, either version 3
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: \ Recognizer are words that take a string and try to figure out
   21: \ what to do with it.  I want to separate the parse action from
   22: \ the interpret/compile/postpone action, so that recognizers
   23: \ are more general than just be used for the interpreter.
   24: 
   25: \ The "design pattern" used here is the *factory*, even though
   26: \ the recognizer does not return a full-blown object.
   27: \ A recognizer has the stack effect
   28: \ ( addr u -- token table | addr u r:fail )
   29: \ where the token is the result of the parsing action (can be more than
   30: \ one stack or live on other stacks, e.g. on the FP stack)
   31: \ and the table contains three actions (as array of three xts):
   32: \ interpret it, compile it, compile it as literal.
   33: 
   34: : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
   35: 
   36: (field) r>int      ( r-addr -- addr )  0 cells ,
   37: (field) r>comp     ( r-addr -- addr )  1 cells ,
   38: (field) r>lit      ( r-addr -- addr )  2 cells ,
   39: 
   40: ' no.extensions dup dup Create r:fail A, A, A,
   41: 
   42: : lit, ( n -- ) postpone Literal ;
   43: : nt, ( nt -- ) name>comp execute ;
   44: : nt-ex ( nt -- )
   45:     [ cell 1 floats - dup [IF] ] lp+!# [ dup , [THEN] drop ]
   46:     r> >l name>int execute @local0 >r lp+ ;
   47: 
   48: ' nt-ex
   49: ' nt,
   50: ' lit,
   51: Create r:word rot A, swap A, A,
   52: 
   53: : word-recognizer ( addr u -- nt r:word | addr u r:fail )
   54:     2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
   55:     IF  nip nip r:word  ELSE  drop r:fail  THEN ;
   56: 
   57: ' noop
   58: ' lit,
   59: dup
   60: Create r:num rot A, swap A, A,
   61: 
   62: ' noop
   63: :noname ( n -- ) postpone 2Literal ;
   64: dup
   65: Create r:2num rot A, swap A, A,
   66: 
   67: \ snumber? should be implemented as recognizer stack
   68: 
   69: : num-recognizer ( addr u -- n/d table | addr u r:fail )
   70:     2dup 2>r snumber?  dup
   71:     IF
   72: 	2rdrop 0> IF  r:2num   ELSE  r:num  THEN  EXIT
   73:     THEN
   74:     drop 2r> r:fail ;
   75: 
   76: \ recognizer stack
   77: 
   78: $10 Constant max-rec#
   79: 
   80: : get-recognizers ( rec-addr -- xt1 .. xtn n )
   81:     dup swap @ dup >r cells bounds swap ?DO
   82: 	I @
   83:     cell -LOOP  r> ;
   84: 
   85: : set-recognizers ( xt1 .. xtn n rec-addr -- )
   86:     over max-rec# u>= abort" Too many recognizers"
   87:     2dup ! cell+ swap cells bounds ?DO
   88: 	I !
   89:     cell +LOOP ;
   90: 
   91: Variable forth-recognizer
   92: 
   93: ' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot
   94: 2 forth-recognizer !
   95: \ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers
   96: 
   97: \ recognizer loop
   98: 
   99: : do-recognizer ( addr u rec-addr -- token table )
  100:     dup cell+ swap @ cells bounds ?DO
  101: 	I perform dup r:fail <>  IF  UNLOOP  EXIT  THEN  drop
  102:     cell +LOOP
  103:     r:fail ;
  104: 
  105: \ nested recognizer helper
  106: 
  107: \ : nest-recognizer ( addr u -- token table | addr u r:fail )
  108: \   xxx-recognizer do-recognizer ;
  109: 
  110: : interpreter-r ( addr u -- ... xt )
  111:     forth-recognizer do-recognizer r>int @ ;
  112: 
  113: ' interpreter-r IS parser1
  114: 
  115: : compiler-r ( addr u -- ... xt )
  116:     forth-recognizer do-recognizer r>comp @ ;
  117: 
  118: : [ ( -- ) \  core	left-bracket
  119:     \G Enter interpretation state. Immediate word.
  120:     ['] interpreter-r  IS parser1 state off ; immediate
  121: 
  122: : ] ( -- ) \ core	right-bracket
  123:     \G Enter compilation state.
  124:     ['] compiler-r     IS parser1 state on  ;
  125: 
  126: : >int      ( token table -- )  r>int perform ;
  127: : >comp     ( token table -- )  r>comp perform ;
  128: : >postpone ( token table -- )
  129:     >r r@ r>lit perform r> r>comp @ compile, ;
  130: 
  131: : postpone ( "name" -- ) \ core
  132:     \g Compiles the compilation semantics of @i{name}.
  133:     parse-name forth-recognizer do-recognizer >postpone
  134: ; immediate restrict
  135: