This subrule attaches operator precedence information to a match object (such as an operator token). A typical invocation for the subrule might be:

token infix:sym<+> { <sym> <O( q{ %additive, :pirop<add> } )> }

This says to add all of the attribute of the %additive hash (described below) and a pirop entry into the match object returned by the infix:sym<+> token (as the O named capture). Note that this is a alphabetic 'O", not a digit zero.

Currently the O subrule accepts a string argument describing the hash to be stored. (Note the q{ ... } above. Eventually it may be possible to omit the 'q' such that an actual (constant) hash constructor is passed as an argument to O.

The hash built via the string argument to O is cached, so that subsequent parses of the same token re-use the hash built from previous parses of the token, rather than building a new hash on each invocation.

The save argument is used to build "hash" aggregates that can be referred to by subsequent calls to O. For example,

NQP::Grammar.O(':prec<t=>, :assoc<left>', '%additive' );

specifies the values to be associated with later references to "%additive". Eventually it will likely be possible to use true hashes from a package namespace, but this works for now.

Currently the only pairs recognized have the form :pair , :!pair , and :pair<strval>.

        # First, get the hash cache.  Right now we have one
        # cache for all grammars; eventually we may need a way to
        # separate them out by cursor type.
        .local pmc ohash
        ohash = get_global '%!ohash'
        unless null ohash goto have_ohash
        ohash = new ['Hash']
        set_global '%!ohash', ohash
      have_ohash:

        # See if we've already created a Hash for the current
        # specification string -- if so, use that.
        .local pmc hash
        hash = ohash[spec]
        unless null hash goto hash_done

        # Otherwise, we need to build a new one.
        hash = new ['Hash']
        .local int pos, eos
        pos = 0
        eos = length spec
      spec_loop:
        pos = find_not_cclass .CCLASS_WHITESPACE, spec, pos, eos
        if pos >= eos goto spec_done
        $S0 = substr spec, pos, 1
        if $S0 == ',' goto spec_comma
        if $S0 == ':' goto spec_pair

        # If whatever we found doesn't start with a colon, treat it
        # as a lookup of a previously saved hash to be merged in.
        .local string lookup
        .local int lpos
        # Find the first whitespace or comma
        lpos = find_cclass .CCLASS_WHITESPACE, spec, pos, eos
        $I0 = index spec, ',', pos
        if $I0 < 0 goto have_lookup_lpos
        if $I0 >= lpos goto have_lookup_lpos
        lpos = $I0
      have_lookup_lpos:
        $I0 = lpos - pos
        lookup = substr spec, pos, $I0
        .local pmc lhash, lhash_it
        lhash = ohash[lookup]
        if null lhash goto err_lookup
        lhash_it = iter lhash
      lhash_loop:
        unless lhash_it goto lhash_done
        $S0 = shift lhash_it
        $P0 = lhash[$S0]
        hash[$S0] = $P0
        goto lhash_loop
      lhash_done:
        pos = lpos
        goto spec_loop

        # We just ignore commas between elements for now.
      spec_comma:
        inc pos
        goto spec_loop

        # If we see a colon, then we want to parse whatever
        # comes next like a pair.
      spec_pair:
        # eat colon
        inc pos
        .local string name
        .local pmc value
        value = new ['Boolean']

        # If the pair is of the form :!name, then reverse the value
        # and skip the colon.
        $S0 = substr spec, pos, 1
        $I0 = iseq $S0, '!'
        pos += $I0
        $I0 = not $I0
        value = $I0

        # Get the name of the pair.
        lpos = find_not_cclass .CCLASS_WORD, spec, pos, eos
        $I0 = lpos - pos
        name = substr spec, pos, $I0
        pos = lpos

        # Look for a <...> that follows.
        $S0 = substr spec, pos, 1
        unless $S0 == '<' goto have_value
        inc pos
        lpos = index spec, '>', pos
        $I0 = lpos - pos
        $S0 = substr spec, pos, $I0
        value = box $S0
        pos = lpos + 1
      have_value:
        # Done processing the pair, store it in the hash.
        hash[name] = value
        goto spec_loop
      spec_done:
        # Done processing the spec string, cache the hash for later.
        ohash[spec] = hash
      hash_done:

        # If we've been called as a subrule, then build a pass-cursor
        # to indicate success and set the hash as the subrule's match object.
        if has_save goto save_hash
        ($P0, $S0, $I0) = self.'!cursor_start'()
        $P0.'!cursor_pass'($I0, '')
        setattribute $P0, cur_class, '$!match', hash
        .return ($P0)

        # save the hash under a new entry
      save_hash:
        ohash[save] = hash
        .return (self)

      err_lookup:
        self.'panic'('Unknown operator precedence specification "', lookup, '"')
    };
}

Throw an exception at the current cursor location. If the message doesn't end with a newline, also output the line number and offset of the match.

method panic(*@args) {
    my $pos := self.pos();
    my $target := nqp::getattr_s(self, NQPCursor, '$!target');
    @args.push(' at line ');
    @args.push(HLL::Compiler.lineof($target, $pos) + 1);
    @args.push(', near "');
    @args.push(pir::escape__SS(nqp::substr($target, $pos, 10)));
    @args.push('"');
    nqp::die(nqp::join('', @args))
}

method FAILGOAL($goal) {
    my $sub := Q:PIR {
        %r = getinterp
        %r = %r['sub';1]
    };
    self.panic("Unable to parse ", ~$sub, ", couldn't find final $goal");
}

Return the start/stop delimiter pair based on peeking at target position pos.

method peek_delimiters($target, $pos) {
    Q:PIR {
        .local pmc self
        self = find_lex 'self'
        .local string target
        $P0 = find_lex '$target'
        target = $P0
        .local int pos
        $P0 = find_lex '$pos'
        pos = $P0

        .local string brackets, start, stop
        $P0 = find_lex '$brackets'
        brackets = $P0

        # peek at the next character
        start = substr target, pos, 1
        # colon and word characters aren't valid delimiters
        if start == ':' goto err_colon_delim
        $I0 = is_cclass .CCLASS_WORD, start, 0
        if $I0 goto err_word_delim
        $I0 = is_cclass .CCLASS_WHITESPACE, start, 0
        if $I0 goto err_ws_delim

        # assume stop delim is same as start, for the moment
        stop = start

        # see if we have an opener or closer
        $I0 = index brackets, start
        if $I0 < 0 goto bracket_end
        # if it's a closing bracket, that's an error also
        $I1 = $I0 % 2
        if $I1 goto err_close
        # it's an opener, so get the closing bracket
        inc $I0
        stop = substr brackets, $I0, 1

        # see if the opening bracket is repeated
        .local int len
        len = 0
      bracket_loop:
        inc pos
        inc len
        $S0 = substr target, pos, 1
        if $S0 == start goto bracket_loop
        if len == 1 goto bracket_end
        start = repeat start, len
        stop = repeat stop, len
      bracket_end:
        .return (start, stop, pos)

      err_colon_delim:
        self.'panic'('Colons may not be used to delimit quoting constructs')
      err_word_delim:
        self.'panic'('Alphanumeric character is not allowed as a delimiter')
      err_ws_delim:
        self.'panic'('Whitespace character is not allowed as a delimiter')
      err_close:
        self.'panic'('Use of a closing delimiter for an opener is reserved')
    };
}

token quote_EXPR(*@args) {
    :my %*QUOTEMOD;
    :my $*QUOTE_START;
    :my $*QUOTE_STOP;
    {
        Q:PIR {            
            .local pmc self, cur_class, args
            self = find_lex 'self'
            cur_class = find_lex '$cursor_class'
            args = find_lex '@args'

            .local pmc quotemod, true
            quotemod = find_lex '%*QUOTEMOD'
            true = box 1

          args_loop:
            unless args goto args_done
            .local string mod
            mod = shift args
            mod = substr mod, 1
            quotemod[mod] = true
            if mod == 'qq' goto opt_qq
            if mod == 'b' goto opt_b
            goto args_loop
          opt_qq:
            quotemod['s'] = true
            quotemod['a'] = true
            quotemod['h'] = true
            quotemod['f'] = true
            quotemod['c'] = true
            quotemod['b'] = true
          opt_b:
            quotemod['q'] = true
            goto args_loop
          args_done:

            .local pmc start, stop
            .local string target
            .local int pos
            target = repr_get_attr_str self, cur_class, '$!target'
            pos = repr_get_attr_int self, cur_class, '$!pos'
            (start, stop) = self.'peek_delimiters'(target, pos)
            store_lex '$*QUOTE_START', start
            store_lex '$*QUOTE_STOP', stop
        }
    }
    <quote_delimited>
}

token quotemod_check($mod) {
    <?{ %*QUOTEMOD{$mod} }>
}

method starter() {
    Q:PIR {
        .local pmc self, cur
        .local string target, start
        .local int pos
        self = find_lex 'self'

        (cur, target, pos) = self.'!cursor_start'()

        $P0 = find_dynamic_lex '$*QUOTE_START'
        if null $P0 goto fail
        start = $P0

        $I0 = length start
        $S0 = substr target, pos, $I0
        unless $S0 == start goto fail
        pos += $I0
        cur.'!cursor_pass'(pos, 'starter')
      fail:
        .return (cur)
    };
}

method stopper() {
    Q:PIR {
        .local pmc self, cur
        .local string target, stop
        .local int pos
        self = find_lex 'self'

        (cur, target, pos) = self.'!cursor_start'()

        $P0 = find_dynamic_lex '$*QUOTE_STOP'
        if null $P0 goto fail
        stop = $P0

        $I0 = length stop
        $S0 = substr target, pos, $I0
        unless $S0 == stop goto fail
        pos += $I0
        cur.'!cursor_pass'(pos, 'stopper')
      fail:
        .return (cur)
    };
}

our method split_words($words) {
    Q:PIR {
        .include 'src/Regex/constants.pir'
        .local string words
        $P0 = find_lex '$words'
        words = $P0
        .local int pos, eos
        .local pmc result
        pos = 0
        eos = length words
        result = new ['ResizablePMCArray']
      split_loop:
        pos = find_not_cclass .CCLASS_WHITESPACE, words, pos, eos
        unless pos < eos goto split_done
        $I0 = find_cclass .CCLASS_WHITESPACE, words, pos, eos
        $I1 = $I0 - pos
        $S0 = substr words, pos, $I1
        push result, $S0
        pos = $I0
        goto split_loop
      split_done:
        .return (result)
    };
}

An operator precedence parser.

method EXPR($preclim = '') {
    Q:PIR {
        .local pmc self, cur_class
        self = find_lex 'self'
        cur_class = find_lex '$cursor_class'

        .local string preclim
        $P0 = find_lex '$preclim'
        preclim = $P0
        
        .local pmc here
        .local string tgt
        .local int pos
        (here, tgt, pos) = self.'!cursor_start'()

        .local string termishrx
        termishrx = 'termish'

        .local pmc opstack, termstack
        opstack = new ['ResizablePMCArray']
        .lex '@opstack', opstack
        termstack = new ['ResizablePMCArray']
        .lex '@termstack', termstack

      term_loop:
        .local pmc termcur
        repr_bind_attr_int here, cur_class, "$!pos", pos
        termcur = here.termishrx()
        pos = repr_get_attr_int termcur, cur_class, "$!pos"
        repr_bind_attr_int here, cur_class, "$!pos", pos
        if pos < 0 goto fail
        .local pmc termish
        termish = termcur.'MATCH'()

        # interleave any prefix/postfix we might have found
        .local pmc termOPER, prefixish, postfixish
        termOPER = termish
      termOPER_loop:
        $I0 = exists termOPER['OPER']
        unless $I0 goto termOPER_done
        termOPER = termOPER['OPER']
        goto termOPER_loop
      termOPER_done:
        prefixish = termOPER['prefixish']
        postfixish = termOPER['postfixish']
        if null prefixish goto prefix_done

      prepostfix_loop:
        unless prefixish goto prepostfix_done
        unless postfixish goto prepostfix_done
        .local pmc preO, postO
        .local string preprec, postprec
        $P0 = prefixish[0]
        $P0 = $P0['OPER']
        preO = $P0['O']
        preprec = preO['prec']
        $P0 = postfixish[-1]
        $P0 = $P0['OPER']
        postO = $P0['O']
        postprec = postO['prec']
        if postprec < preprec goto post_shift
        if postprec > preprec goto pre_shift
        $S0 = postO['uassoc']
        if $S0 == 'right' goto pre_shift
      post_shift:
        $P0 = pop postfixish
        push opstack, $P0
        goto prepostfix_loop
      pre_shift:
        $P0 = shift prefixish
        push opstack, $P0
        goto prepostfix_loop
      prepostfix_done:

      prefix_loop:
        unless prefixish goto prefix_done
        $P0 = shift prefixish
        push opstack, $P0
        goto prefix_loop
      prefix_done:
        delete termish['prefixish']

      postfix_loop:
        if null postfixish goto postfix_done
        unless postfixish goto postfix_done
        $P0 = pop postfixish
        push opstack, $P0
        goto postfix_loop
      postfix_done:
        delete termish['postfixish']

        $P0 = termish['term']
        push termstack, $P0

        # Now see if we can fetch an infix operator
        .local pmc wscur, infixcur, infix
        
        # First, we need ws to match.
        repr_bind_attr_int here, cur_class, "$!pos", pos
        wscur = here.'ws'()
        pos = repr_get_attr_int wscur, cur_class, '$!pos'
        if pos < 0 goto term_done
        repr_bind_attr_int here, cur_class, "$!pos", pos
        
        # Next, try the infix itself.
        infixcur = here.'infixish'()
        pos = repr_get_attr_int infixcur, cur_class, '$!pos'
        if pos < 0 goto term_done
        infix = infixcur.'MATCH'()

        # We got an infix.
        .local pmc inO
        $P0 = infix['OPER']
        inO = $P0['O']
        termishrx = inO['nextterm']
        if termishrx goto have_termishrx
      nonextterm:
        termishrx = 'termish'
      have_termishrx:

        .local string inprec, inassoc, opprec
        inprec = inO['prec']
        unless inprec goto err_inprec
        if inprec < preclim goto term_done
        inassoc = inO['assoc']

        $P0 = inO['sub']
        if null $P0 goto subprec_done
        inO['prec'] = $P0
      subprec_done:

      reduce_loop:
        unless opstack goto reduce_done
        $P0 = opstack[-1]
        $P0 = $P0['OPER']
        $P0 = $P0['O']
        opprec = $P0['prec']
        unless opprec > inprec goto reduce_gt_done
        self.'EXPR_reduce'(termstack, opstack)
        goto reduce_loop
      reduce_gt_done:

        unless opprec == inprec goto reduce_done
        # equal precedence, use associativity to decide
        unless inassoc == 'left' goto reduce_done
        # left associative, reduce immediately
        self.'EXPR_reduce'(termstack, opstack)
      reduce_done:

        push opstack, infix        # The Shift
        repr_bind_attr_int here, cur_class, "$!pos", pos
        wscur = here.'ws'()
        pos = repr_get_attr_int wscur, cur_class, '$!pos'
        repr_bind_attr_int here, cur_class, "$!pos", pos
        if pos < 0 goto fail
        goto term_loop
      term_done:

      opstack_loop:
        unless opstack goto opstack_done
        self.'EXPR_reduce'(termstack, opstack)
        goto opstack_loop
      opstack_done:

      expr_done:
        .local pmc term
        term = pop termstack
        pos = here.'pos'()
        here = self.'!cursor_start'()
        here.'!cursor_pass'(pos)
        repr_bind_attr_int here, cur_class, '$!pos', pos
        setattribute here, cur_class, '$!match', term
        here.'!reduce'('EXPR')
        goto done

      fail:
      done:
        .return (here)

      err_internal:
        $I0 = termstack
        here.'panic'('Internal operator parser error, @termstack == ', $I0)
      err_inprec:
        infixcur.'panic'('Missing infixish operator precedence')
    };
}

method EXPR_reduce($termstack, $opstack) {
    Q:PIR {
        .local pmc self, termstack, opstack
        self = find_lex 'self'
        termstack = find_lex '$termstack'
        opstack = find_lex '$opstack'

        .local pmc op, opOPER, opO
        .local string opassoc
        op = pop opstack
        
        # Give it a fresh capture list, since we'll have assumed it has
        # no positional captures and not taken them.
        .local pmc cap_class
        cap_class = find_lex 'NQPCapture'
        $P0 = new ['ResizablePMCArray']
        setattribute op, cap_class, '@!array', $P0
        
        opOPER = op['OPER']
        opO = opOPER['O']
        $P0 = opO['assoc']
        opassoc = $P0
        if opassoc == 'unary' goto op_unary
        if opassoc == 'list' goto op_list
      op_infix:
        .local pmc right, left
        right = pop termstack
        left = pop termstack
        op[0] = left
        op[1] = right
        $P0 = opO['reducecheck']
        if null $P0 goto op_infix_1
        $S0 = $P0
        self.$S0(op)
      op_infix_1:
        self.'!reduce_with_match'('EXPR', 'INFIX', op)
        goto done

      op_unary:
        .local pmc arg, afrom, ofrom
        arg = pop termstack
        op[0] = arg
        afrom = arg.'from'()
        ofrom = op.'from'()
        if afrom < ofrom goto op_postfix
      op_prefix:
        self.'!reduce_with_match'('EXPR', 'PREFIX', op)
        goto done
      op_postfix:
        self.'!reduce_with_match'('EXPR', 'POSTFIX', op)
        goto done

      op_list:
        .local string sym
        sym = ''
        $P0 = opOPER['sym']
        if null $P0 goto op_list_1
        sym = $P0
      op_list_1:
        arg = pop termstack
        unshift op, arg
      op_sym_loop:
        unless opstack goto op_sym_done
        $S0 = ''
        $P0 = opstack[-1]
        $P0 = $P0['OPER']
        $P0 = $P0['sym']
        if null $P0 goto op_sym_1
        $S0 = $P0
      op_sym_1:
        if sym != $S0 goto op_sym_done
        arg = pop termstack
        unshift op, arg
        $P0 = pop opstack
        goto op_sym_loop
      op_sym_done:
        arg = pop termstack
        unshift op, arg
        self.'!reduce_with_match'('EXPR', 'LIST', op)
        goto done

      done:
        push termstack, op
    };
}

method ternary($match) {
    $match[2] := $match[1];
    $match[1] := $match{'infix'}{'EXPR'};
}

method MARKER($markname) {
    my %markhash := Q:PIR {
        %r = get_global '%!MARKHASH'
        unless null %r goto have_markhash
        %r = new ['Hash']
        set_global '%!MARKHASH', %r
      have_markhash:
    };
    my $cur := self."!cursor_start"();
    $cur."!cursor_pass"(self.pos());
    %markhash{$markname} := $cur;
}

method MARKED($markname) {
    my %markhash := Q:PIR {
        %r = get_global '%!MARKHASH'
        unless null %r goto have_markhash
        %r = new ['Hash']
        set_global '%!MARKHASH', %r
      have_markhash:
    };
    my $cur := %markhash{$markname};
    unless nqp::istype($cur, NQPCursor) && $cur.pos() == self.pos() {
        $cur := self."!cursor_start"();
    }
    $cur
}

method LANG($lang, $regex) {
    my $lang_cursor := %*LANG{$lang}.'!cursor_init'(self.target(), :p(self.pos()));
    if self.HOW.traced(self) {
        $lang_cursor.HOW.trace-on($lang_cursor, self.HOW.trace_depth(self));
    }
    my $*ACTIONS    := %*LANG{$lang ~ '-actions'};
    $lang_cursor."$regex"();  
}
}