Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/recognizer.fs, revision 1.20

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