[BACK]Return to recognizer.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / kernel

Diff for /gforth/kernel/recognizer.fs between versions 1.8 and 1.21

version 1.8, 2011/10/06 20:15:06 version 1.21, 2012/07/02 21:59:48
Line 1 Line 1
 \ recognizer-based interpreter                       05oct2011py  \ recognizer-based interpreter                       05oct2011py
   
   \ Copyright (C) 2012 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation, either version 3
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
   \ You should have received a copy of the GNU General Public License
   \ along with this program. If not, see http://www.gnu.org/licenses/.
   
 \ Recognizer are words that take a string and try to figure out  \ Recognizer are words that take a string and try to figure out
 \ what to do with it.  I want to separate the parse action from  \ what to do with it.  I want to separate the parse action from
 \ the interpret/compile/postpone action, so that recognizers  \ the interpret/compile/postpone action, so that recognizers
Line 8 Line 25
 \ The "design pattern" used here is the *factory*, even though  \ The "design pattern" used here is the *factory*, even though
 \ the recognizer does not return a full-blown object.  \ the recognizer does not return a full-blown object.
 \ A recognizer has the stack effect  \ A recognizer has the stack effect
 \ ( addr u -- token table true | addr u false )  \ ( addr u -- token table | addr u r:fail )
 \ where the token is the result of the parsing action (can be more than  \ where the token is the result of the parsing action (can be more than
 \ one stack or live on other stacks, e.g. on the FP stack)  \ one stack or live on other stacks, e.g. on the FP stack)
 \ and the table contains for actions (as array of four xts:  \ and the table contains three actions (as array of three xts):
 \ interpret it, compile interpretation semantics  \ interpret it, compile it, compile it as literal.
 \ compile it, compile it as literal.  
   
 : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;  : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
   
 (field) r>int      ( r-addr -- addr )  0 cells ,  (field) r>int      ( r-addr -- addr )  0 cells ,
 (field) r>comp     ( r-addr -- )       1 cells ,  (field) r>comp     ( r-addr -- addr )  1 cells ,
 (field) r>lit      ( r-addr -- )       2 cells ,  (field) r>lit      ( r-addr -- addr )  2 cells ,
   
   ' no.extensions dup dup Create r:fail A, A, A,
   
 :noname ( ... nt -- ) name>int execute ;  : lit, ( n -- ) postpone Literal ;
 :noname ( ... nt -- ) name>comp execute ;  : nt, ( nt -- ) name>comp execute ;
 :noname ( ... nt -- ) postpone Literal ;  : nt-ex ( nt -- )
 Create r:interpreter rot A, swap A, A,      [ cell 1 floats - dup [IF] ] lp+!# [ dup , [THEN] drop ]
       r> >l name>int execute @local0 >r lp+ ;
   
   ' nt-ex
   ' nt,
   ' lit,
   Create r:word rot A, swap A, A,
   
 :noname ( addr u -- nt int-table true | addr u false )  : word-recognizer ( addr u -- nt r:word | addr u r:fail )
     2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup      2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
     IF      IF  nip nip r:word  ELSE  drop r:fail  THEN ;
         nip nip r:interpreter true  EXIT  
     THEN ; Constant int-recognizer  
   
 ' noop  ' noop
 :noname  postpone Literal ;  ' lit,
 dup  dup
 Create r:number rot A, swap A, A,  Create r:num rot A, swap A, A,
   
 ' noop  ' noop
 :noname  postpone 2Literal ;  :noname ( n -- ) postpone 2Literal ;
 dup  dup
 Create r:2number rot A, swap A, A,  Create r:2num rot A, swap A, A,
   
 \ snumber? should be implemented as recognizer stack  \ snumber? should be implemented as recognizer stack
   
 :noname ( addr u -- nt int-table true | addr u false )  : num-recognizer ( addr u -- n/d table | addr u r:fail )
     2dup 2>r snumber?  dup      2dup 2>r snumber?  dup
     IF      IF
         2rdrop 0> IF  r:2number   ELSE  r:number  THEN  true  EXIT          2rdrop 0> IF  r:2num   ELSE  r:num  THEN  EXIT
     THEN      THEN
     drop 2r> false ; Constant num-recognizer      drop 2r> r:fail ;
   
 ' no.extensions dup dup Create r:fail A, A, A,  
   
 \ recognizer stack  \ recognizer stack
   
Line 70  $10 Constant max-rec# Line 90  $10 Constant max-rec#
   
 Variable forth-recognizer  Variable forth-recognizer
   
 int-recognizer A, num-recognizer A, max-rec# 2 - cells allot  ' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot
 2 forth-recognizer !  2 forth-recognizer !
 \ num-recognizer int-recognizer 2 forth-recognizer set-recognizers  \ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers
   
 \ recognizer loop  \ recognizer loop
   
 : do-recognizer ( addr u rec-addr -- token table )  : do-recognizer ( addr u rec-addr -- token table )
     dup cell+ swap @ cells bounds ?DO      dup cell+ swap @ cells bounds ?DO
         I perform IF  UNLOOP  EXIT  THEN          I perform dup r:fail <>  IF  UNLOOP  EXIT  THEN  drop
     cell +LOOP      cell +LOOP
     r:fail ;      r:fail ;
   
 \ nested recognizer helper  \ nested recognizer helper
   
 : r:table>flag ( table -- table true | false )  \ : nest-recognizer ( addr u -- token table | addr u r:fail )
     dup r:fail <> dup 0= IF  nip  THEN ;  \   xxx-recognizer do-recognizer ;
   
 \ : nest-recognizer ( addr u -- token table true | addr u false )  
 \   xxx-recognizer do-recognizer r:table>flag ;  
   
 : interpreter-r ( addr u -- ... xt )  : interpreter-r ( addr u -- ... xt )
     forth-recognizer do-recognizer r>int @ ;      forth-recognizer do-recognizer r>int @ ;
Line 106  int-recognizer A, num-recognizer A, max- Line 123  int-recognizer A, num-recognizer A, max-
     \G Enter compilation state.      \G Enter compilation state.
     ['] compiler-r     IS parser1 state on  ;      ['] compiler-r     IS parser1 state on  ;
   
   : >int      ( token table -- )  r>int perform ;
   : >comp     ( token table -- )  r>comp perform ;
 : >postpone ( token table -- )  : >postpone ( token table -- )
     dup r:fail = IF  no.extensions  THEN  
     >r r@ r>lit perform r> r>comp @ compile, ;      >r r@ r>lit perform r> r>comp @ compile, ;
   
 : postpone ( "name" -- ) \ core  : postpone ( "name" -- ) \ core
     \g Compiles the compilation semantics of @i{name}.      \g Compiles the compilation semantics of @i{name}.
     parse-name forth-recognizer do-recognizer >postpone ; immediate      parse-name forth-recognizer do-recognizer >postpone
   ; immediate restrict
   
Removed from v.1.8  
changed lines
  Added in v.1.21

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>