REBOL [
    Author: "Brett Handley"
    Title: "BNF Grammar"
    Date: 18-Mar-2001
    Comment: {Yet to handle double quote as terminal.}
]

bnf-grammar: context [
    _spop: function [a-stack] [a-val] [
        if 0 < length? a-stack [
            a-val: last a-stack
            remove back tail a-stack
            a-val
        ]
    ]
    _spush: func [a-stack val] [
        append/only a-stack val
    ]
    _orsymbol: to-lit-word first [|]
    _defined: none
    _referenced: none
    _output: none
    _rule: none
    _rulestack: none
    _emit: func[x][insert/only tail _rule x]
    _id: func[x][to-word join "=" [x "="]]
    _define: func[x][
        id: _id x
        insert tail _output id
        insert tail _defined id
    ]
    _reference: function [x][id][
        id: _id x
        insert tail _rule id
        if not find _referenced id [insert tail _referenced id]
    ]
    _startmark: none
    _endmark: none
    _errormark: none
    _identifier: none
    _quotedsymbol: none
    _subrule: function [rule-name [word! none!]][new-rule][
        if rule-name [_emit rule-name]
        _emit new-rule: copy []
        _spush _rulestack _rule: new-rule
    ]
    _endsubrule: func[][
        _rule: _spop _rulestack
    ]
    syntax: [
        (_output: copy [] _rulestack: copy [] _defined: copy [] _referenced: copy [])
        any [ rule ] sp? end
    ]
    rule: [
        (_rule: copy [] _spush _rulestack _rule)
        sp? _startmark: identifier (_define _identifier )
        sp? "::=" sp? expression sp? _endmark:
        (_rule: _spop _rulestack insert/only tail _output _rule)
    ]
    expression: [
        factor-sequence
        any [ sp? "|" (_emit _orsymbol ) factor-sequence ]
        ]
    factor-sequence: [ some factor ]
    rule-identifier-guard: [
        identifier sp? "::=" (
            guarded-identifier: [to end skip] ; Failure - we came across an identifier for a new rule.
        ) | (
            guarded-identifier: [identifier] ; Success - The identifier is part of the expression.
        )
    ]
    guarded-identifier: none
    factor: [ sp? [
        rule-identifier-guard guarded-identifier (_reference _identifier) |
        quoted_symbol (_emit _quotedsymbol) |
        sp? "(" (_subrule none) expression  sp? ")" (_endsubrule) sp? |
        sp? "[" (_subrule 'opt) expression  sp? "]" (_endsubrule) sp? |
        sp? "{" (_subrule 'any) expression  sp? "}" (_endsubrule) sp?
    ]]
    identifier: [_errormark: sp? copy _identifier [letter any [ letter | digit | #"-" | #"_" ]]]
    quoted_symbol: [sp? #"^"" copy _quotedsymbol any any_character #"^"" sp? ]
    letter: charset [#"a" - #"z" #"A" - #"Z"]
    digit: charset "0123456789"
    any_character: complement charset {"}
    sp-char: charset " ^t^/"
    sp: [some sp-char]
    sp?: [any sp-char]
    set 'parse-bnf function [
        bnf
        /undefined "Returns the undefined identifiers"
        /object-spec "Returns an object specification encompassing the rules."
    ][][
        either parse/all bnf syntax [

            either undefined [
                RETURN exclude _referenced _defined
            ][
                either object-spec [
                    forskip _output 2 [
                        change _output to-set-word first _output
                    ]
                    RETURN _output: head _output
                ][
                    RETURN _output
                ]
            ]
        ][
            throw make error! "Could not parse BNF."
        ]
    ]
]