[gforth] / gforth / kernel / recognizer.fs  

gforth: gforth/kernel/recognizer.fs

1 : pazsan 1.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 xt4 -- ) Create 2swap swap 2, swap 2, ;
19 :    
20 : pazsan 1.2 (field) r>int ( r-addr -- addr ) 0 cells ,
21 :     (field) r>compint ( r-addr -- ) 1 cells ,
22 :     (field) r>comp ( r-addr -- ) 2 cells ,
23 :     (field) r>lit ( r-addr -- ) 3 cells ,
24 : pazsan 1.1
25 :     :noname ( ... nt -- ) name>int execute ;
26 :     :noname ( ... nt -- ) name>int compile, ;
27 :     :noname ( ... nt -- ) name>comp execute ;
28 :     :noname ( ... nt -- ) postpone Literal ;
29 :     recognizer: r:int-table
30 :    
31 :     :noname ( addr u -- nt int-table true | addr u false )
32 :     2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
33 :     IF
34 :     nip nip r:int-table true EXIT
35 :     THEN ; Constant int-recognizer
36 :    
37 :     ' noop
38 :     :noname postpone Literal ;
39 :     dup
40 :     dup
41 :     recognizer: r:number
42 :    
43 :     ' noop
44 :     :noname postpone 2Literal ;
45 :     dup
46 :     dup
47 :     recognizer: r:2number
48 :    
49 :     :noname ( addr u -- nt int-table true | addr u false )
50 :     2dup 2>r snumber? dup
51 :     IF
52 :     2rdrop 0> IF r:2number ELSE r:number THEN true EXIT
53 :     THEN
54 :     drop 2r> false ; Constant num-recognizer
55 :    
56 :     \ recognizer stack
57 :    
58 :     $10 Constant max-rec#
59 :     Variable forth-recognizer max-rec# cells allot
60 :    
61 :     : get-recognizers ( rec-addr -- xt1 .. xtn n )
62 :     dup cell+ swap @ dup >r cells bounds ?DO
63 :     I @
64 :     cell +LOOP r> ;
65 :    
66 :     : set-recognizers ( xt1 .. xtn n rec-addr -- )
67 :     over max-rec# u>= abort" Too many recognizers"
68 :     2dup ! swap cells bounds swap ?DO
69 :     I !
70 :     cell -LOOP ;
71 :    
72 :     num-recognizer int-recognizer 2 forth-recognizer set-recognizers
73 :    
74 :     \ recognizer loop
75 :    
76 :     : do-recognizer ( addr u rec-addr -- token table )
77 :     dup cell+ swap @ cells bounds ?DO
78 :     I perform IF UNLOOP EXIT THEN
79 :     cell +LOOP
80 :     no.extensions ;
81 :    
82 :     : interpreter-r ( addr u -- ... xt )
83 : pazsan 1.2 forth-recognizer do-recognizer r>int @ ;
84 : pazsan 1.1
85 :     : compiler-r ( addr u -- ... xt )
86 : pazsan 1.2 forth-recognizer do-recognizer r>comp @ ;
87 : pazsan 1.1
88 :     : [ ( -- ) \ core left-bracket
89 :     \G Enter interpretation state. Immediate word.
90 :     ['] interpreter-r IS parser1 state off ; immediate
91 :    
92 :     : ] ( -- ) \ core right-bracket
93 :     \G Enter compilation state.
94 :     ['] compiler-r IS parser1 state on ;
95 :    
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help