compilers/pct/src/PCT/Grammar.pir

   1 # Copyright (C) 2007-2008, Parrot Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 PCT::Grammar - base grammar with useful rules
   7
   8 =head1 SYNOPSIS
   9
  10     grammar MyGrammar is PCT::Grammar;
  11
  12     rule abc { [ word | <panic: word not found> ] }
  13
  14     rule quote {
  15         [ \' <string_literal: '> \'
  16         | \" <string_literal: "> \"
  17         ]
  18     }
  19
  20 =head1 DESCRIPTION
  21
  22 This file implements C<PCT::Grammar>, which is a basic grammar object
  23 with a few useful methods for parsing thrown in.
  24
  25 =head2 Methods
  26
  27 =over 4
  28
  29 =item panic(match [, message, ...] )
  30
  31 Throws an exception at the current point of the match, with message
  32 as part of the exception payload.  The message doesn't end with
  33 a newline, then the line number and offset of the match are
  34 also included.
  35
  36 =cut
  37
  38 .namespace [ 'PCT';'Grammar' ]
  39
  40 .sub 'onload' :anon :init :load
  41     load_bytecode 'PGE.pbc'
  42     load_bytecode 'PGE/Util.pbc'
  43     .local pmc p6meta
  44     p6meta = new 'P6metaclass'
  45     p6meta.'new_class'('PCT::Grammar', 'parent'=>'PGE::Grammar')
  46     $P0 = split '::', 'PCT::Grammar'
  47     $P0 = get_class $P0
  48     $P1 = get_hll_global ['PGE';'Util'], 'die'
  49     $P0.'add_method'('panic', $P1)
  50     .return ()
  51 .end
  52
  53
  54 =item FAILGOAL($goal [, 'dba'=>dba])
  55
  56 Invoked when goal matching fails to find the goal.  Builds an appropriate
  57 error message and delegates the rest to C<panic>.
  58
  59 =cut
  60
  61 .sub 'FAILGOAL' :method
  62     .param string goal
  63     .param pmc options         :named :slurpy
  64     .local string dba
  65     dba = options['dba']
  66     if dba goto have_dba
  67     ##  if no dba supplied, use the name of the caller sub
  68     $P0 = getinterp
  69     $P0 = $P0['sub';1]
  70     dba = $P0
  71   have_dba:
  72     .tailcall self.'panic'("Unable to parse ", dba, "; couldn't find final ", goal)
  73 .end
  74
  75
  76 =item item()
  77
  78 Here we overload the item() method from PGE::Match to
  79 throw an exception if a result object hasn't been set.
  80
  81 =cut
  82
  83 .sub 'ast' :method
  84     .local pmc obj
  85     obj = getattribute self, '$!ast'
  86     unless null obj goto end
  87     die "No result object"
  88   end:
  89     .return (obj)
  90 .end
  91
  92
  93 =item ww()
  94
  95 Special-purpose rule to return true if we're in the middle
  96 of a word -- i.e., if the previous and next character are
  97 both "word characters".  This is roughly equivalent to
  98 C<< <?after \w><?before \w> >> except it's much quicker.
  99 In particular, C<< <!ww> >> can be used by :sigspace rules
 100 to enforce whitespace between lexical words.
 101
 102 =cut
 103
 104 .include 'cclass.pasm'
 105
 106 .sub 'ww' :method
 107     .local pmc mob
 108     .local int pos
 109     .local string target
 110     $P0 = get_hll_global ['PGE'], 'Match'
 111     (mob, pos, target) = $P0.'new'(self)
 112     if pos == 0 goto fail
 113     $I0 = is_cclass .CCLASS_WORD, target, pos
 114     unless $I0 goto fail
 115     $I1 = pos - 1
 116     $I0 = is_cclass .CCLASS_WORD, target, $I1
 117     unless $I0 goto fail
 118     mob.'to'(pos)
 119   fail:
 120     .return (mob)
 121 .end
 122
 123
 124 .sub 'string_literal' :method
 125     .param string stop
 126     .param pmc adverbs         :slurpy :named
 127
 128     ##  create a new match object, get the new match position
 129     .local pmc mob
 130     .local int pos, lastpos, stoplen
 131     .local string target, escapechars
 132     (mob, pos, target) = self.'new'(self)
 133     lastpos = length target
 134     stoplen = length stop
 135     $S0 = substr stop, 0, 1
 136     escapechars = concat "\\", $S0
 137
 138     ##  leave space for close delimiter
 139     lastpos -= stoplen
 140
 141     ##  now initialize and loop through target
 142   literal_init:
 143     .local string literal, litchar
 144     literal = ''
 145
 146   literal_loop:
 147     ##  if we're beyond the last possible position, fail
 148     if pos > lastpos goto fail
 149
 150     ##  if ending delimiter, then we're done
 151     $S0 = substr target, pos, stoplen
 152     if $S0 == stop goto literal_end
 153     if pos >= lastpos goto fail
 154
 155     ##  get next character in literal
 156     litchar = substr target, pos, 1
 157     inc pos
 158
 159     ##  add non-escape characters to literal
 160     if litchar != "\\" goto add_litchar
 161
 162     ##  look at the next character, if it's always escaped, add it and
 163     ##  move on
 164     .local string escaped
 165     escaped = substr target, pos, 1
 166     $I0 = index escapechars, escaped
 167     if $I0 < 0 goto interpolated_escape
 168     inc pos
 169     literal .= escaped
 170     goto literal_loop
 171
 172   interpolated_escape:
 173     ##  if not double-quoted delim, no interpolation
 174     if stop != '"' goto add_litchar
 175     litchar = escaped
 176     inc pos
 177     $I0 = index "abefnrt0xdo", litchar
 178     if $I0 < 0 goto add_litchar
 179
 180     ##  if it's one of "xdo", then handle that specially
 181     if $I0 >= 8 goto literal_xdo
 182
 183     litchar = substr "\a\b\e\f\n\r\t\0", $I0, 1
 184     goto add_litchar
 185
 186   literal_xdo:
 187     ##  handle \x, \d, and \o escapes.  start by converting
 188     ##  the 'o', 'd', or 'x' into 8, 10, or 16 (yes, it's hack
 189     ##  but it works).  Then loop through the characters that
 190     ##  follow to compute the integer value of the codepoint,
 191     ##  and add that codepoint to our literal.
 192     .local int base, codepoint, isbracketed
 193     base = index '        o d     x', litchar
 194     codepoint = 0
 195     $S0 = substr target, pos, 1
 196     isbracketed = iseq $S0, '['
 197     pos += isbracketed
 198   literal_xdo_char_loop:
 199     $S0 = substr target, pos, 1
 200     $I0 = index '0123456789abcdef', $S0
 201     if $I0 < 0 goto literal_xdo_char_end
 202     if $I0 >= base goto literal_xdo_char_end
 203     codepoint *= base
 204     codepoint += $I0
 205     inc pos
 206     goto literal_xdo_char_loop
 207   literal_xdo_char_end:
 208     $S1 = chr codepoint
 209     concat literal, $S1
 210     unless isbracketed goto literal_xdo_end
 211     if $S0 == ']' goto literal_xdo_end
 212     if $S0 != ',' goto fail
 213     inc pos
 214     codepoint = 0
 215     goto literal_xdo_char_loop
 216   literal_xdo_end:
 217     pos += isbracketed
 218     goto literal_loop
 219
 220   add_litchar:
 221     literal .= litchar
 222     goto literal_loop
 223
 224   literal_end:
 225     mob.'to'(pos)
 226     mob.'!make'(literal)
 227     .return (mob)
 228
 229   fail:
 230     mob.'to'(-1)
 231     .return (mob)
 232 .end
 233
 234 # Local Variables:
 235 #   mode: pir
 236 #   fill-column: 100
 237 # End:
 238 # vim: expandtab shiftwidth=4 ft=pir: