runtime/parrot/library/PGE/Text.pir

   1 =head1 TITLE
   2
   3 PGE::Text - rules for extracting delimited text sequences from strings
   4
   5 =head1 DESCRIPTION
   6
   7 The various rules in this module may be used to extract delimited
   8 strings from within PGE rules.  (They can of course be called directly,
   9 also.)
  10
  11 =cut
  12
  13 .namespace [ "PGE::Text" ]
  14
  15 .include "cclass.pasm"
  16
  17 .sub "__onload" :load
  18     .local pmc base
  19     $P0 = subclass 'PGE::Grammar', 'PGE::Text'
  20 .end
  21
  22 =head2 Available rules
  23
  24 =over 4
  25
  26 =item C<bracketed(PMC target, string delim)>
  27
  28 Extracts a balanced-bracket-delimited substring from the
  29 current position of C<target> using the delimiters specified
  30 by C<delim>, and returns a C<Match> object containing the result
  31 of the extraction.
  32
  33 =cut
  34
  35 .sub "bracketed"
  36     .param pmc tgt                                 # target to match
  37     .param string delim        :optional           # optional delimiters
  38     .param int has_delim       :opt_flag
  39     .param pmc adverbs         :slurpy :named      # named options
  40     .local pmc mob                                 # return match object
  41     .local string target                           # target as string
  42     .local string bal, bra, ket                    # balanced brackets
  43     .local string delim_bra, delim_ket             # delims for this match
  44     .local string lookket                          # closing bracket char
  45     .local int from, pos                           # current match position
  46     .local int balanced                            # in balanced match
  47     .local pmc stack                               # lookket backtracking
  48
  49     stack = new 'ResizableStringArray'
  50     $P0 = get_hll_global ['PGE'], 'Match'
  51     (mob, pos, target) = $P0.'new'(tgt)
  52     from = pos
  53
  54     if has_delim goto mkdelims
  55     delim = "{}()[]<>"
  56
  57   mkdelims:                                        # set up delimiters
  58     delim_bra = ''                                 # list of open delims
  59     delim_ket = ''                                 # list of close delims
  60     bal = '{}()[]<>'                               # list of balance delims
  61     bra = '{{(([[<<'                               # balanced openers
  62     ket = '}}))]]>>'                               # balanced closers
  63     $I0 = length delim                             # length of delim string
  64   mkdelims_1:
  65     dec $I0
  66     if $I0 < 0 goto extract
  67     $S0 = substr delim, $I0, 1
  68     $I1 = index bal, $S0
  69     if $I1 < 0 goto mkdelims_2
  70     $S1 = substr bra, $I1, 1
  71     delim_bra .= $S1
  72     $S1 = substr ket, $I1, 1
  73     delim_ket .= $S1
  74     goto mkdelims_1
  75   mkdelims_2:
  76     delim_bra .= $S0
  77     delim_ket .= $S0
  78     goto mkdelims_1
  79
  80   extract:
  81     $S0 = substr target, pos, 1
  82     if $S0 == "\\" goto end                        # leading escape fails
  83     $I0 = index delim_bra, $S0
  84     if $I0 < 0 goto end                            # no leading delim fails
  85     lookket = ''
  86     balanced = 1
  87   next:
  88     $S0 = substr target, pos, 1                    # check current pos
  89     if $S0 == '' goto fail                         # end of string -> fail
  90     if $S0 == "\\" goto escape                     # skip escaped pos
  91     if $S0 == lookket goto close                   # end of current nest
  92     if balanced < 0 goto skip                      # skip to next char
  93     $I0 = index delim_bra, $S0                     # open new nest?
  94     if $I0 >= 0 goto open
  95     $I0 = index delim_ket, $S0                     # unbalanced nest?>
  96     if $I0 >= 0 goto fail
  97   skip:
  98     inc pos                                        # move to next char
  99     goto next                                      # try next
 100   escape:
 101     pos += 2                                       # skip escape + char
 102     goto next                                      # try next
 103   open:                                            # open new nesting
 104     push stack, lookket                            # save current nest
 105     lookket = substr delim_ket, $I0, 1             # search to end of nest
 106     balanced = index bra, $S0                      # is this a balanced nest?
 107     inc pos                                        # skip open char
 108     goto next                                      # continue scanning
 109   close:                                           # close current nesting
 110     lookket = pop stack                            # restore previous nest
 111     balanced = 1                                   # we're balancing again
 112     inc pos                                        # skip close char
 113     if lookket != '' goto next                     # still nested?
 114     mob.'to'(pos)                                  # set end of match
 115     $I0 = from + 1                                # create delim-less submatch
 116     $I1 = pos - 1
 117     $P0 = mob.'new'(mob, 'pos' => $I0)
 118     $P0.'to'($I1)
 119     mob[0] = $P0
 120   fail:                                            # fail match
 121   end:
 122     .return (mob)
 123 .end
 124
 125 =back
 126
 127 =head1 AUTHOR
 128
 129 Patrick Michaud (pmichaud@pobox.com) is the author and maintainer.
 130 Patches and suggestions should be sent to the Perl 6 compiler list
 131 (perl6-compiler@perl.org).
 132
 133 =cut
 134
 135 # Local Variables:
 136 #   mode: pir
 137 #   fill-column: 100
 138 # End:
 139 # vim: expandtab shiftwidth=4 ft=pir: