Annotation of gforth/kernel/recognizer.fs, revision 1.10
1.1 pazsan 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:
1.7 pazsan 18: : recognizer: ( xt1 xt2 xt3 -- ) Create rot , swap , , ;
1.1 pazsan 19:
1.7 pazsan 20: (field) r>int ( r-addr -- addr ) 0 cells ,
21: (field) r>comp ( r-addr -- ) 1 cells ,
22: (field) r>lit ( r-addr -- ) 2 cells ,
1.1 pazsan 23:
24: :noname ( ... nt -- ) name>int execute ;
25: :noname ( ... nt -- ) name>comp execute ;
26: :noname ( ... nt -- ) postpone Literal ;
1.10 ! pazsan 27: Create r:word rot A, swap A, A,
1.1 pazsan 28:
1.10 ! pazsan 29: : word-recognizer ( addr u -- nt int-table true | addr u false )
1.1 pazsan 30: 2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
31: IF
1.10 ! pazsan 32: nip nip r:word true EXIT
1.9 pazsan 33: THEN ;
1.1 pazsan 34:
35: ' noop
36: :noname postpone Literal ;
37: dup
1.10 ! pazsan 38: Create r:num rot A, swap A, A,
1.1 pazsan 39:
40: ' noop
41: :noname postpone 2Literal ;
42: dup
1.10 ! pazsan 43: Create r:2num rot A, swap A, A,
1.7 pazsan 44:
45: \ snumber? should be implemented as recognizer stack
1.1 pazsan 46:
1.9 pazsan 47: : num-recognizer ( addr u -- n/d int-table true | addr u false )
1.1 pazsan 48: 2dup 2>r snumber? dup
49: IF
1.10 ! pazsan 50: 2rdrop 0> IF r:2num ELSE r:num THEN true EXIT
1.1 pazsan 51: THEN
1.9 pazsan 52: drop 2r> false ;
1.1 pazsan 53:
1.7 pazsan 54: ' no.extensions dup dup Create r:fail A, A, A,
1.3 pazsan 55:
1.1 pazsan 56: \ recognizer stack
57:
58: $10 Constant max-rec#
59:
60: : get-recognizers ( rec-addr -- xt1 .. xtn n )
1.8 pazsan 61: dup swap @ dup >r cells bounds swap ?DO
1.1 pazsan 62: I @
1.8 pazsan 63: cell -LOOP r> ;
1.1 pazsan 64:
65: : set-recognizers ( xt1 .. xtn n rec-addr -- )
66: over max-rec# u>= abort" Too many recognizers"
1.8 pazsan 67: 2dup ! cell+ swap cells bounds ?DO
1.1 pazsan 68: I !
1.8 pazsan 69: cell +LOOP ;
1.1 pazsan 70:
1.7 pazsan 71: Variable forth-recognizer
72:
1.10 ! pazsan 73: ' word-recognizer A, ' num-recognizer A, max-rec# 2 - cells allot
1.7 pazsan 74: 2 forth-recognizer !
1.10 ! pazsan 75: \ ' num-recognizer ' word-recognizer 2 forth-recognizer set-recognizers
1.1 pazsan 76:
77: \ recognizer loop
78:
79: : do-recognizer ( addr u rec-addr -- token table )
80: dup cell+ swap @ cells bounds ?DO
81: I perform IF UNLOOP EXIT THEN
82: cell +LOOP
1.3 pazsan 83: r:fail ;
1.1 pazsan 84:
1.6 pazsan 85: \ nested recognizer helper
86:
87: : r:table>flag ( table -- table true | false )
88: dup r:fail <> dup 0= IF nip THEN ;
89:
90: \ : nest-recognizer ( addr u -- token table true | addr u false )
91: \ xxx-recognizer do-recognizer r:table>flag ;
92:
1.1 pazsan 93: : interpreter-r ( addr u -- ... xt )
1.2 pazsan 94: forth-recognizer do-recognizer r>int @ ;
1.1 pazsan 95:
1.7 pazsan 96: ' interpreter-r IS parser1
97:
1.1 pazsan 98: : compiler-r ( addr u -- ... xt )
1.2 pazsan 99: forth-recognizer do-recognizer r>comp @ ;
1.1 pazsan 100:
101: : [ ( -- ) \ core left-bracket
102: \G Enter interpretation state. Immediate word.
103: ['] interpreter-r IS parser1 state off ; immediate
104:
105: : ] ( -- ) \ core right-bracket
106: \G Enter compilation state.
107: ['] compiler-r IS parser1 state on ;
108:
1.7 pazsan 109: : >postpone ( token table -- )
110: dup r:fail = IF no.extensions THEN
111: >r r@ r>lit perform r> r>comp @ compile, ;
112:
1.4 pazsan 113: : postpone ( "name" -- ) \ core
114: \g Compiles the compilation semantics of @i{name}.
1.7 pazsan 115: parse-name forth-recognizer do-recognizer >postpone ; immediate
1.4 pazsan 116:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>