runtime/parrot/library/PGE/Util.pir

   1 =head1 TITLE
   2
   3 PGE/Util.pir - useful rules for working with PGE grammars
   4
   5 =head1 DESCRIPTION
   6
   7 This module defines a number of useful rules for various
   8 parsing tasks using PGE.
   9
  10 =head2 Functions
  11
  12 =cut
  13
  14 .namespace [ 'PGE::Util' ]
  15
  16 .include 'cclass.pasm'
  17
  18 .sub "__onload" :load
  19     .local pmc base
  20     $P0 = subclass 'PGE::Grammar', 'PGE::Util'
  21     .return ()
  22 .end
  23
  24 =over 4
  25
  26 =item die(match, [, message [, ...]] )
  27
  28 Throws an exception at the current point in the match.  If message
  29 doesn't end with a newline, also produces the line number and offset
  30 of the match.
  31
  32 =cut
  33
  34 .sub 'die'
  35     .param pmc mob                                 # match object
  36     .param pmc list            :slurpy             # message arguments
  37
  38     .local pmc iter
  39     .local string message
  40     message = ''
  41     iter = new 'Iterator', list
  42   iter_loop:
  43     unless iter goto iter_end
  44     $S0 = shift iter
  45     message .= $S0
  46     goto iter_loop
  47   iter_end:
  48
  49     # get a copy of the match object
  50     .local string target
  51     .local int pos
  52     $P0 = get_hll_global ['PGE'], 'Match'
  53     (mob, pos, target) = $P0.'new'(mob)
  54     $I0 = length message
  55     dec $I0
  56     $I0 = is_cclass .CCLASS_NEWLINE, message, $I0
  57     if $I0 goto throw_message
  58
  59     .local int lines
  60     .local pmc line_number
  61     #  FIXME: use 'line_number' method instead?
  62     line_number = get_hll_global ['PGE::Util'], 'line_number'
  63     (lines) = mob.line_number(pos)
  64     inc lines
  65     message .= ' at line '
  66     $S0 = lines
  67     message .= $S0
  68     message .= ', near "'
  69     $I0 = length target
  70     $I0 -= pos
  71     if $I0 < 10 goto add_position_1
  72     $I0 = 10
  73   add_position_1:
  74     $S0 = substr target, pos, $I0
  75     $S0 = escape $S0
  76     message .= $S0
  77     message .= "\"\n"
  78
  79   throw_message:
  80     $P0 = new 'Exception'
  81     $P0 = message
  82     throw $P0
  83
  84     mob.'to'(-3)
  85     .return (mob)
  86 .end
  87
  88
  89 =item warn(match, [, message [, ...]] )
  90
  91 Emits the list of messages to stderr.
  92
  93 =cut
  94
  95 .sub 'warn'
  96     .param pmc mob                                 # match object
  97     .param pmc list            :slurpy             # message arguments
  98
  99     .local pmc iter
 100     .local string message
 101     message = ''
 102     iter = new 'Iterator', list
 103   iter_loop:
 104     unless iter goto iter_end
 105     $S0 = shift iter
 106     message .= $S0
 107     goto iter_loop
 108   iter_end:
 109
 110     # get a copy of the match object
 111     .local string target
 112     .local int pos
 113     $P0 = get_hll_global ['PGE'], 'Match'
 114     (mob, pos, target) = $P0.'new'(mob)
 115     $I0 = length message
 116     dec $I0
 117     $I0 = is_cclass .CCLASS_NEWLINE, message, $I0
 118     if $I0 goto emit_message
 119
 120     .local int lines
 121     .local pmc line_number
 122     #  FIXME: use 'line_number' method instead?
 123     line_number = get_hll_global ['PGE::Util'], 'line_number'
 124     (lines) = mob.line_number(pos)
 125     inc lines
 126     message .= ' at line '
 127     $S0 = lines
 128     message .= $S0
 129     message .= "\n"
 130   emit_message:
 131     printerr message
 132
 133     mob.'to'(pos)
 134     .return (mob)
 135 .end
 136
 137
 138
 139 =item line_number(match [, pos])
 140
 141 Return the line number and offset of the of the line corresponding to
 142 offset C<pos> in the string targeted by C<match>.  If C<pos> isn't
 143 supplied, then use the C<from> value of C<match> as the offset.
 144 For this function the line number for the first line in the
 145 string is treated as '0'.
 146
 147 =cut
 148
 149 .sub 'line_number'
 150     .param pmc match
 151     .param int pos             :optional
 152     .param int has_pos         :opt_flag
 153
 154     if has_pos goto have_pos
 155     pos = match.'from'()
 156   have_pos:
 157
 158     # count newlines to the current position of the parse
 159     .local int pos, npos, lines
 160     .local string target
 161     $P99 = getattribute match, '$.target'
 162     target = $P99
 163     npos = 0
 164     lines = 0
 165   newline_loop:
 166     $I0 = find_cclass .CCLASS_NEWLINE, target, npos, pos
 167     if $I0 >= pos goto newline_done
 168     $S0 = substr target, $I0, 2
 169     npos = $I0 + 1
 170     inc lines
 171     if $S0 != "\r\n" goto newline_loop
 172     inc npos
 173     goto newline_loop
 174   newline_done:
 175     .return (lines, npos)
 176 .end
 177
 178
 179 =item split(regex, string [, count])
 180
 181 Split the string where the regex matches, returning an array. Optionally limit
 182 the number of splits.
 183
 184 =back
 185
 186 =cut
 187
 188 .sub 'split'
 189     .param pmc    regex
 190     .param string str
 191     .param int    count     :optional
 192     .param int    has_count :opt_flag
 193
 194     .local pmc result, match
 195     .local int pos, n
 196
 197     result = new 'ResizablePMCArray'
 198     pos    = 0
 199     n      = 1
 200
 201 split_loop:
 202     match = regex(str, 'continue'=>pos)
 203     ##  if regex not found in target, we're done
 204     unless match goto split_end
 205
 206     ##  save substring up to current match
 207     $I0 = match.from()
 208     $I0 -= pos
 209     $S0 = substr str, pos, $I0
 210     push result, $S0
 211     pos = match.to()
 212
 213     .local pmc captures
 214     captures = match.'list'()
 215     if null captures goto capture_end
 216     $I0 = elements captures
 217     $I1 = 0
 218 capture_loop:
 219     if $I1 == $I0 goto capture_end
 220     $P0 = captures[$I1]
 221     $S0 = $P0
 222     push result, $S0
 223     inc $I1
 224     goto capture_loop
 225 capture_end:
 226
 227     ##  are we counting matches?
 228     unless has_count goto split_loop
 229     ##  check if we've already split enough
 230     inc n
 231     if n < count goto split_loop
 232     # goto split_end
 233
 234 split_end:
 235     ##   save string from end of last match to end of string
 236     $S0 = substr str, pos
 237     if $S0 == "" goto end
 238     push result, $S0
 239
 240 end:
 241    .return (result)
 242 .end
 243
 244 # Local Variables:
 245 #   mode: pir
 246 #   fill-column: 100
 247 # End:
 248 # vim: expandtab shiftwidth=4 ft=pir: