Return to recognizer.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/recognizer.fs, revision 1.1

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: 
        !            18: : recognizer: ( xt1 xt2 xt3 xt4 -- ) Create 2swap swap 2, swap 2, ;
        !            19: 
        !            20: : r>int     ( r-addr -- )  @ ;
        !            21: : r>compint ( r-addr -- )  cell+ @ ;
        !            22: : r>comp    ( r-addr -- )  cell+ cell+ @ ;
        !            23: : r>lit     ( r-addr -- )  cell+ cell+ cell+ @ ;
        !            24: 
        !            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:     forth-recognizer do-recognizer r>int ;
        !            84: 
        !            85: : compiler-r ( addr u -- ... xt )
        !            86:     forth-recognizer do-recognizer r>comp ;
        !            87: 
        !            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: