Annotation of gforth/kernel/recognizer.fs, revision 1.7
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.7 ! pazsan 27: Create r:interpreter rot A, swap A, A,
1.1 pazsan 28:
29: :noname ( addr u -- nt int-table true | addr u false )
30: 2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
31: IF
1.5 pazsan 32: nip nip r:interpreter true EXIT
1.1 pazsan 33: THEN ; Constant int-recognizer
34:
35: ' noop
36: :noname postpone Literal ;
37: dup
1.7 ! pazsan 38: Create r:number rot A, swap A, A,
1.1 pazsan 39:
40: ' noop
41: :noname postpone 2Literal ;
42: dup
1.7 ! pazsan 43: Create r:2number rot A, swap A, A,
! 44:
! 45: \ snumber? should be implemented as recognizer stack
1.1 pazsan 46:
47: :noname ( addr u -- nt int-table true | addr u false )
48: 2dup 2>r snumber? dup
49: IF
50: 2rdrop 0> IF r:2number ELSE r:number THEN true EXIT
51: THEN
52: drop 2r> false ; Constant num-recognizer
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 )
61: dup cell+ swap @ dup >r cells bounds ?DO
62: I @
63: cell +LOOP r> ;
64:
65: : set-recognizers ( xt1 .. xtn n rec-addr -- )
66: over max-rec# u>= abort" Too many recognizers"
67: 2dup ! swap cells bounds swap ?DO
68: I !
69: cell -LOOP ;
70:
1.7 ! pazsan 71: Variable forth-recognizer
! 72:
! 73: int-recognizer A, num-recognizer A, max-rec# 2 - cells allot
! 74: 2 forth-recognizer !
! 75: \ num-recognizer int-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>