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