--- gforth/kernel/recognizer.fs	2011/10/05 20:48:16	1.1
+++ gforth/kernel/recognizer.fs	2012/07/02 21:59:48	1.21
@@ -1,5 +1,22 @@
 \ 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
 \ what to do with it.  I want to separate the parse action from
 \ the interpret/compile/postpone action, so that recognizers
@@ -8,82 +25,95 @@
 \ The "design pattern" used here is the *factory*, even though
 \ the recognizer does not return a full-blown object.
 \ 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
 \ one stack or live on other stacks, e.g. on the FP stack)
-\ and the table contains for actions (as array of four xts:
-\ interpret it, compile interpretation semantics
-\ compile it, compile it as literal.
-
-: recognizer: ( xt1 xt2 xt3 xt4 -- ) Create 2swap swap 2, swap 2, ;
-
-: r>int     ( r-addr -- )  @ ;
-: r>compint ( r-addr -- )  cell+ @ ;
-: r>comp    ( r-addr -- )  cell+ cell+ @ ;
-: r>lit     ( r-addr -- )  cell+ cell+ cell+ @ ;
-
-:noname ( ... nt -- ) name>int execute ;
-:noname ( ... nt -- ) name>int compile, ;
-:noname ( ... nt -- ) name>comp execute ;
-:noname ( ... nt -- ) postpone Literal ;
-recognizer: r:int-table
+\ and the table contains three actions (as array of three xts):
+\ interpret it, compile it, compile it as literal.
+
+: recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
+
+(field) r>int      ( r-addr -- addr )  0 cells ,
+(field) r>comp     ( r-addr -- addr )  1 cells ,
+(field) r>lit      ( r-addr -- addr )  2 cells ,
+
+' no.extensions dup dup Create r:fail A, A, A,
+
+: lit, ( n -- ) postpone Literal ;
+: nt, ( nt -- ) name>comp execute ;
+: nt-ex ( nt -- )
+    [ 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
-    IF
-	nip nip r:int-table true  EXIT
-    THEN ; Constant int-recognizer
+    IF  nip nip r:word  ELSE  drop r:fail  THEN ;
 
 ' noop
-:noname  postpone Literal ;
-dup
+' lit,
 dup
-recognizer: r:number
+Create r:num rot A, swap A, A,
 
 ' noop
-:noname  postpone 2Literal ;
-dup
+:noname ( n -- ) postpone 2Literal ;
 dup
-recognizer: r:2number
+Create r:2num rot A, swap A, A,
 
-:noname ( addr u -- nt int-table true | addr u false )
+\ snumber? should be implemented as recognizer stack
+
+: num-recognizer ( addr u -- n/d table | addr u r:fail )
     2dup 2>r snumber?  dup
     IF
-	2rdrop 0> IF  r:2number   ELSE  r:number  THEN  true  EXIT
+	2rdrop 0> IF  r:2num   ELSE  r:num  THEN  EXIT
     THEN
-    drop 2r> false ; Constant num-recognizer
+    drop 2r> r:fail ;
 
 \ recognizer stack
 
 $10 Constant max-rec#
-Variable forth-recognizer max-rec# cells allot
 
 : get-recognizers ( rec-addr -- xt1 .. xtn n )
-    dup cell+ swap @ dup >r cells bounds ?DO
+    dup swap @ dup >r cells bounds swap ?DO
 	I @
-    cell +LOOP  r> ;
+    cell -LOOP  r> ;
 
 : set-recognizers ( xt1 .. xtn n rec-addr -- )
     over max-rec# u>= abort" Too many recognizers"
-    2dup ! swap cells bounds swap ?DO
+    2dup ! cell+ swap cells bounds ?DO
 	I !
-    cell -LOOP ;
+    cell +LOOP ;
+
+Variable forth-recognizer
 
-num-recognizer int-recognizer 2 forth-recognizer set-recognizers
+' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot
+2 forth-recognizer !
+\ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers
 
 \ recognizer loop
 
 : do-recognizer ( addr u rec-addr -- token table )
     dup cell+ swap @ cells bounds ?DO
-	I perform IF  UNLOOP  EXIT  THEN
+	I perform dup r:fail <>  IF  UNLOOP  EXIT  THEN  drop
     cell +LOOP
-    no.extensions ;
+    r:fail ;
+
+\ nested recognizer helper
+
+\ : nest-recognizer ( addr u -- token table | addr u r:fail )
+\   xxx-recognizer do-recognizer ;
 
 : interpreter-r ( addr u -- ... xt )
-    forth-recognizer do-recognizer r>int ;
+    forth-recognizer do-recognizer r>int @ ;
+
+' interpreter-r IS parser1
 
 : compiler-r ( addr u -- ... xt )
-    forth-recognizer do-recognizer r>comp ;
+    forth-recognizer do-recognizer r>comp @ ;
 
 : [ ( -- ) \  core	left-bracket
     \G Enter interpretation state. Immediate word.
@@ -93,3 +123,13 @@ num-recognizer int-recognizer 2 forth-re
     \G Enter compilation state.
     ['] compiler-r     IS parser1 state on  ;
 
+: >int      ( token table -- )  r>int perform ;
+: >comp     ( token table -- )  r>comp perform ;
+: >postpone ( token table -- )
+    >r r@ r>lit perform r> r>comp @ compile, ;
+
+: postpone ( "name" -- ) \ core
+    \g Compiles the compilation semantics of @i{name}.
+    parse-name forth-recognizer do-recognizer >postpone
+; immediate restrict
+