Incremental Parser in Ren/C, Red and Rebol 2

parser.r

#!/usr/local/bin/rebol -qs parser.test.reb

Rebol [
    Title: "Parser"
    Author: "Christopher Ross-Gill"
    Date: 13-Feb-2018
    Home: https://github.com/rgchris/Scripts
    File: %parser.r
    Version: 0.1.0
    Purpose: {Incremental Parser}
    Rights: http://opensource.org/licenses/Apache-2.0
]

parser: make object! [
    index: none
    emit: report: state-rules: rule: none
    is-paused: is-done: none

    state: prior-state: return-state: state-rule: active-rule: none

    use: func ['target [word!] /until end-tag [string!] /return][
        prior-state: :state
        if return [return-state: :state]
        state: target
        state-rule: active-rule: any [
            select state-rules :target
            do make error! rejoin ["No Such Parser State: " uppercase form target]
        ]
    ]

    return: has [rule][
        rule: use :return-state
        return-state: none
        rule
    ]

    process: [
        any [index: active-rule]
    ]

    new: func [
        "Initialize the tokenization process"
        source [string!] "Source to tokenize"
        states [block! map!] "Parser States"
    ][
        make self [
            index: :source
            state-rules: :states
            state: prior-state: return-state: state-rule: active-rule: none
            is-paused: is-done: false
        ]
    ]

    start: func [
        "Start the parser process"
    ][
        case [
            not string? index [
                make error! "Parser not initialized correctly"
            ]
            not state [
                make error! "No active parser state"
            ]
        ]

        parse/all/case index process
        self
    ]

    stop: func [
        "Pause the parser process"
    ][
        is-done: true
        active-rule: [to end skip]
        self
    ]

    pause: func [
        "Pause the parser process"
    ][
        is-paused: true
        active-rule: [end skip]
        self
    ]

    resume: func [
        "Resume the parser process"
    ][
        case [
            not string? index [
                make error! "Parser not initialized correctly"
            ]
            not state [
                make error! "No active parser state"
            ]
        ]

        is-paused: false
        active-rule: :state-rule
        parse/all/case index process

        self
    ]
]

parser.reb

#!/usr/local/bin/ren-c parser.test.reb

Rebol [
    Title: "Parser"
    Author: "Christopher Ross-Gill"
    Date: 13-Feb-2018
    Home: https://github.com/rgchris/Scripts
    File: %parser.reb
    Version: 0.1.0
    Purpose: {Incremental Parser}
    Rights: http://opensource.org/licenses/Apache-2.0
    Type: module
    Name: rgchris.parser
    Exports: [parser]
]

parser: make object! [
    index: _
    emit: report: state-rules: rule: _
    is-paused: is-done: false

    state: prior-state: return-state: state-rule: active-rule: _

    use: func ['target [word!] /until end-tag [string!] /return][
        prior-state: :state
        if return [return-state: :state]
        state: target
        state-rule: active-rule: any [
            select state-rules :target
            fail ["No Such Parser State:" uppercase spelling-of target]
        ]
    ]

    return: has [rule][
        rule: use :return-state
        return-state: _
        rule
    ]

    process: [
        while [index: active-rule]
    ]

    new: func [
        "Initialize the tokenization process"
        source [string!] "Source to tokenize"
        states [block! map!] "Parser States"
    ][
        make self [
            index: :source
            state-rules: :states
            state: prior-state: return-state: state-rule: active-rule: _
            is-paused: is-done: false
        ]
    ]

    start: func [
        "Start the parser process"
    ][
        case [
            not string? index [
                fail "Parser not initialized correctly"
            ]
            not state [
                fail "No active parser state"
            ]
        ]

        parse/case index process
        self
    ]

    stop: func [
        "Pause the parser process"
    ][
        is-done: true
        active-rule: [to end fail]
        self
    ]

    pause: func [
        "Pause the parser process"
    ][
        is-paused: true
        active-rule: [fail]
        self
    ]

    resume: func [
        "Resume the parser process"
    ][
        case [
            not string? index [
                fail "Parser not initialized correctly"
            ]
            not state [
                fail "No active parser state"
            ]
        ]

        is-paused: false
        active-rule: :state-rule
        parse/case index process

        self
    ]
]

parser.red

#!/usr/local/bin/red parser.test.reb

Red [
    Title: "Parser"
    Author: "Christopher Ross-Gill"
    Date: 13-Feb-2018
    Home: https://github.com/rgchris/Scripts
    File: %parser.red
    Version: 0.1.0
    Purpose: {Incremental Parser}
    Rights: http://opensource.org/licenses/Apache-2.0
]

parser: func [
    "Initialize the tokenization process"
    source [string!] "Source to tokenize"
    states [block! map!] "Parser States"
    /new
][
    make object! [
        index: :source
        state-rules: :states

        is-paused: is-done: none

        state: prior-state: return-state: state-rule: active-rule: none

        use: func ['target [word!] /until end-tag [string!] /return][
            prior-state: :state
            if return [return-state: :state]
            state: target
            state-rule: active-rule: any [
                select state-rules to set-word! :target
                do make error! rejoin ["No Such Parser State: " uppercase form target]
            ]
        ]

        return: has [rule][
            rule: use :return-state
            return-state: none
            rule
        ]

        start: func [
            "Start the parser process"
        ][
            case [
                not string? index [
                    do make error! "Parser not initialized correctly"
                ]
                not state [
                    do make error! "No active parser state"
                ]
            ]

            until [
                any [
                    is-paused
                    is-done
                    not parse/case index [active-rule index: to end]
                ]
            ]

            self
        ]

        pause: func [
            "Pause the parser process"
        ][
            is-paused: true
            self
        ]

        resume: func [
            "Resume the parser process"
        ][
            case [
                not string? index [
                    do make error! "Parser not initialized correctly"
                ]
                not state [
                    do make error! "No active parser state"
                ]
            ]

            is-paused: false
            active-rule: :state-rule

            until [
                any [
                    is-paused
                    is-done
                    not parse/case index [active-rule index:]
                ]
            ]

            self
        ]

        stop: func [
            "Pause the parser process"
        ][
            is-done: true
            self
        ]
    ]
]

parser.test.reb

Red []
Rebol [
    Title: "Test Parser Module"
    Date: 13-Feb-2018
    Author: "Christopher Ross-Gill"
    Needs: [
        %parser.reb
    ]
]

if find any [system/script/args []] "--version" [print "Parsing Experiment" quit]

case [
    object? try [parser] [
        print "Ren/C Runtime"
    ]

    rebol [
        print "Rebol 2 Runtime"
        do %parser.r
    ]

    /else [
        print "Red Runtime"
        do %parser.red
    ]
]

states: [
    is-a [
          #"a" (print "A in A")
        | #"b" (print "B in A -> B" abba-parser/use is-b)
        | #"c" (print "C?!" abba-parser/stop)
        | end (print "End in A" abba-parser/use done)
    ]

    is-b [
          mark: #"a" (print "A in B -> A" abba-parser/use is-a) :mark
        | #"b" (print "B in B")
        | end (print "End in B" abba-parser/use is-a)
    ]

    done [
        end (print "DONE!!!" abba-parser/stop)
    ]
]

if datatype? map! [
    states: make map! states
]

print ""

abba-parser: parser/new "aba" states
abba-parser/use is-a
abba-parser/start

print ""

abba-parser: parser/new "bab" states
abba-parser/use is-a
abba-parser/start

print ""

abba-parser: parser/new "bcab" states
abba-parser/use is-a
abba-parser/start

probe abba-parser/index