compilers/pge/PGE/P5Regex.pir

   1 # Copyright (C) 2005-2009, Parrot Foundation.
   2 # $Id$
   3
   4 .namespace [ "PGE";"P5Regex" ]
   5
   6 .sub "compile_p5regex"
   7     .param pmc source
   8     .param pmc adverbs         :slurpy :named
   9
  10     $I0 = exists adverbs['grammar']
  11     if $I0 goto have_grammar
  12     adverbs['grammar'] = 'PGE::Grammar'
  13   have_grammar:
  14
  15     .local string target
  16     target = adverbs['target']
  17     target = downcase target
  18
  19     ##  If we're passed the results of a previous parse, use it.
  20     .local pmc match
  21     $I0 = isa source, ['PGE';'Match']
  22     if $I0 == 0 goto parse
  23     $P0 = source['expr']
  24     if null $P0 goto parse
  25     $I0 = isa $P0, ['PGE';'Exp']
  26     if $I0 == 0 goto parse
  27     match = source
  28     goto analyze
  29
  30   parse:
  31     $P0 = get_global "p5regex"
  32     match = $P0(source, adverbs :flat :named)
  33     if target != 'parse' goto check
  34     .return (match)
  35
  36   check:
  37     unless match goto check_1
  38     $S0 = source
  39     $S1 = match
  40     if $S0 == $S1 goto analyze
  41   check_1:
  42     null $P0
  43     .return ($P0)
  44
  45   analyze:
  46     .local pmc exp, pad
  47     exp = match['expr']
  48     pad = new 'Hash'
  49     pad['subpats'] = 0
  50     exp = exp.'p5analyze'(pad)
  51     .tailcall exp.'compile'(adverbs :flat :named)
  52 .end
  53
  54
  55 .sub "p5regex"
  56     .param pmc mob
  57     .param pmc adverbs        :slurpy :named
  58
  59     .local string stop, tighter
  60     .local pmc stopstack, optable
  61
  62     stopstack = get_hll_global ['PGE';'P5Regex'], '@!stopstack'
  63     optable = get_hll_global ["PGE";"P5Regex"], "$optable"
  64
  65     stop = adverbs['stop']
  66     tighter = adverbs['tighter']
  67     push stopstack, stop
  68     $P0 = optable."parse"(mob, 'stop'=>stop, 'tighter'=>tighter)
  69     $S0 = pop stopstack
  70
  71     .return ($P0)
  72 .end
  73
  74
  75 .include "cclass.pasm"
  76
  77 .const int PGE_INF = 2147483647
  78
  79 .sub "__onload" :load
  80     .local pmc optable
  81
  82     optable = new ['PGE';'OPTable']
  83     set_hll_global ["PGE";"P5Regex"], "$optable", optable
  84
  85     $P0 = get_hll_global ["PGE";"P5Regex"], "parse_lit"
  86     optable.'newtok'('term:', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
  87
  88     optable.'newtok'('term:\b', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
  89     optable.'newtok'('term:\B', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
  90     optable.'newtok'('term:^',   'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
  91     optable.'newtok'('term:$',   'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::Anchor')
  92
  93     optable.'newtok'('term:\d', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  94     optable.'newtok'('term:\D', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  95     optable.'newtok'('term:\s', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  96     optable.'newtok'('term:\S', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  97     optable.'newtok'('term:\w', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  98     optable.'newtok'('term:\W', 'equiv'=>'term:', 'nows'=>1, 'match'=>'PGE::Exp::CCShortcut')
  99
 100     optable.'newtok'('circumfix:( )',   'equiv'=>'term:', 'nows'=>1, 'nullterm'=>1, 'match'=>'PGE::Exp::CGroup')
 101     optable.'newtok'('circumfix:(?: )', 'equiv'=>'term:', 'nows'=>1, 'nullterm'=>1, 'match'=>'PGE::Exp::Group')
 102
 103     $P0 = get_hll_global ['PGE';'P5Regex'], 'parse_enumclass'
 104     optable.'newtok'('term:[', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
 105     optable.'newtok'('term:.', 'precedence'=>'=', 'nows'=>1, 'parsed'=>$P0)
 106
 107     $P0 = get_hll_global ['PGE';'P5Regex'], 'parse_quant'
 108     optable.'newtok'('postfix:*', 'looser'=>'term:', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
 109     optable.'newtok'('postfix:+', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
 110     optable.'newtok'('postfix:?', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
 111     optable.'newtok'('postfix:{', 'equiv'=>'postfix:*', 'left'=>1, 'nows'=>1, 'parsed'=>$P0)
 112
 113     optable.'newtok'('infix:',  'looser'=>'postfix:*', 'right'=>1, 'nows'=>1, 'match'=>'PGE::Exp::Concat')
 114     optable.'newtok'('infix:|', 'looser'=>'infix:',    'left'=>1,  'nows'=>1, 'match'=>'PGE::Exp::Alt')
 115
 116     optable.'newtok'('close:}', 'looser'=>'infix:|', 'nows'=>1)            # XXX: hack
 117
 118     # Create a stack for holding stop tokens
 119     $P0 = new 'ResizablePMCArray'
 120     set_hll_global ['PGE';'P5Regex'], '@!stopstack', $P0
 121
 122     $P0 = get_hll_global ["PGE";"P5Regex"], "compile_p5regex"
 123     compreg "PGE::P5Regex", $P0
 124 .end
 125
 126
 127 .sub 'parse_error'
 128     .param pmc mob
 129     .param int pos
 130     .param string message
 131     $P0 = getattribute mob, '$.pos'
 132     $P0 = pos
 133     $P0 = new 'Exception'
 134     $S0 = 'p5regex parse error: '
 135     $S0 .= message
 136     $S0 .= ' at offset '
 137     $S1 = pos
 138     $S0 .= $S1
 139     $S0 .= ", found '"
 140     $P1 = getattribute mob, '$.target'
 141     $S1 = $P1
 142     $S1 = substr $S1, pos, 1
 143     $S0 .= $S1
 144     $S0 .= "'"
 145     $P0 = $S0
 146     throw $P0
 147     .return ()
 148 .end
 149
 150
 151 .sub "parse_lit"
 152     .param pmc mob
 153     .local string target
 154     .local int pos, lastpos
 155     .local int litstart, litlen
 156     .local string initchar
 157     (mob, pos, target) = mob.'new'(mob, 'grammar'=>'PGE::Exp::Literal')
 158     lastpos = length target
 159     initchar = substr target, pos, 1
 160     unless initchar == '*' goto initchar_ok
 161     parse_error(mob, pos, "Quantifier follows nothing")
 162
 163   initchar_ok:
 164     if initchar == ')' goto end
 165     inc pos
 166     if initchar != "\\" goto term_literal
 167   term_backslash:
 168     initchar = substr target, pos, 1
 169     inc pos
 170     if pos <= lastpos goto term_backslash_ok
 171     parse_error(mob, pos, "Search pattern not terminated")
 172   term_backslash_ok:
 173     $I0 = index "nrteab", initchar
 174     if $I0 < 0 goto term_literal
 175     initchar = substr "\n\r\t\e\a\b", $I0, 1
 176   term_literal:
 177     litstart = pos
 178     litlen = 0
 179     .local string stop
 180     .local int stoplen
 181     $P0 = get_hll_global ['PGE';'P5Regex'], '@!stopstack'
 182     stop = $P0[-1]
 183     stoplen = length stop
 184   term_literal_loop:
 185     if pos >= lastpos goto term_literal_end
 186     if stoplen == 0 goto not_stop
 187     $S0 = substr target, pos, stoplen
 188     if $S0 == stop goto term_literal_end
 189   not_stop:
 190     $S0 = substr target, pos, 1
 191     $I0 = index "[](){}*?+\\|^$.", $S0
 192     # if not in circumfix:( ) throw error on end paren
 193     if $I0 >= 0 goto term_literal_end
 194     inc pos
 195     inc litlen
 196     goto term_literal_loop
 197   term_literal_end:
 198     if litlen < 1 goto term_literal_one
 199     dec pos
 200   term_literal_one:
 201     $I0 = pos - litstart
 202     $S0 = substr target, litstart, $I0
 203     $S0 = concat initchar, $S0
 204     mob.'!make'($S0)
 205     goto end
 206   end:
 207     mob.'to'(pos)
 208     .return (mob)
 209 .end
 210
 211 .sub "parse_quant"
 212     .param pmc mob
 213     .local string target
 214     .local int min, max, backtrack
 215     .local int pos, lastpos
 216     .local string key
 217     key = mob['KEY']
 218     (mob, pos, target) = mob.'new'(mob, 'grammar'=>'PGE::Exp::Quant')
 219     lastpos = length target
 220     min = 0
 221     max = PGE_INF
 222     backtrack = 0
 223     if key == '{' goto quant_range
 224     if key != '+' goto quant_max
 225     min = 1
 226   quant_max:
 227     if key != "?" goto quant_lazy
 228     max = 1
 229     goto quant_lazy
 230   quant_range:
 231     $I1 = find_not_cclass .CCLASS_NUMERIC, target, pos, lastpos
 232     if $I1 <= pos goto quant_range_max
 233     $S0 = substr target, pos
 234     min = $S0
 235     max = $S0
 236     pos = $I1
 237   quant_range_max:
 238     $S0 = substr target, pos, 1
 239     if $S0 != "," goto quant_range_end
 240     inc pos
 241     max = PGE_INF
 242     $I1 = find_not_cclass .CCLASS_NUMERIC, target, pos, lastpos
 243     if $I1 <= pos goto quant_range_end
 244     $S0 = substr target, pos
 245     max = $S0
 246     pos = $I1
 247   quant_range_end:
 248     $S0 = substr target, pos, 1
 249     if $S0 != "}" goto err_range
 250     inc pos
 251   quant_lazy:
 252     $S0 = substr target, pos, 1
 253     if $S0 != "?" goto end
 254     backtrack = PGE_BACKTRACK_EAGER
 255     inc pos
 256   end:
 257     mob["min"] = min
 258     mob["max"] = max
 259     mob["backtrack"] = backtrack
 260     mob.'to'(pos)
 261     .return (mob)
 262   err_range:
 263     parse_error(mob, pos, "Error in quantified range")
 264 .end
 265
 266
 267 .sub parse_group
 268     .param pmc mob
 269     .local string target
 270     .local int pos, lastpos
 271     (mob, pos, target) = mob.'new'(mob, 'grammar'=>'PGE::Exp::CGroup')
 272     inc pos
 273     $S0 = substr target, pos, 2
 274     if $S0 == "?:" goto nocapture
 275     goto end
 276   nocapture:
 277     pos += 2
 278   end:
 279     mob.'to'(pos)
 280     .return (mob)
 281 .end
 282
 283 .sub "parse_enumclass"
 284     .param pmc mob
 285     .local string target
 286     .local int pos, lastpos
 287     .local int isrange
 288     .local string charlist
 289     .local string key
 290     key = mob['KEY']
 291     (mob, pos, target) = mob.'new'(mob, 'grammar'=>'PGE::Exp::EnumCharList')
 292     if key == '.' goto dot
 293     lastpos = length target
 294     charlist = ""
 295     mob["isnegated"] = 0
 296     isrange = 0
 297     $S0 = substr target, pos, 1
 298     if $S0 != "^" goto scan_first
 299     mob["isnegated"] = 1
 300     inc pos
 301   scan_first:
 302     if pos >= lastpos goto err_close
 303     $S0 = substr target, pos, 1
 304     inc pos
 305     if $S0 == "\\" goto backslash
 306     goto addchar
 307   scan:
 308     if pos >= lastpos goto err_close
 309     $S0 = substr target, pos, 1
 310     inc pos
 311     if $S0 == "]" goto endclass
 312     if $S0 == "-" goto hyphenrange
 313     if $S0 != "\\" goto addchar
 314   backslash:
 315     $S0 = substr target, pos, 1
 316     inc pos
 317     $I0 = index "nrtfae0b", $S0
 318     if $I0 == -1 goto addchar
 319     $S0 = substr "\n\r\t\f\a\e\0\b", $I0, 1
 320   addchar:
 321     if isrange goto addrange
 322     charlist .= $S0
 323     goto scan
 324   addrange:
 325     isrange = 0
 326     $I2 = ord charlist, -1
 327     $I0 = ord $S0
 328     if $I0 < $I2 goto err_range
 329   addrange_1:
 330     inc $I2
 331     if $I2 > $I0 goto scan
 332     $S1 = chr $I2
 333     charlist .= $S1
 334     goto addrange_1
 335   hyphenrange:
 336     if isrange goto addrange
 337     isrange = 1
 338     goto scan
 339   endclass:
 340     if isrange == 0 goto end
 341     charlist .= "-"
 342     goto end
 343   dot:
 344     charlist = "\n"
 345     mob["isnegated"] = 1
 346   end:
 347     mob.'to'(pos)
 348     mob.'!make'(charlist)
 349     .return (mob)
 350
 351   err_close:
 352     parse_error(mob, pos, "Unmatched [")
 353   err_range:
 354     $S0 = 'Invalid [] range "'
 355     $S1 = chr $I2
 356     $S0 .= $S1
 357     $S0 .= '-'
 358     $S1 = chr $I0
 359     $S0 .= $S1
 360     $S0 .= '"'
 361     parse_error(mob, pos, $S0)
 362 .end
 363
 364
 365 .namespace [ "PGE";"Exp" ]
 366
 367 .sub "p5analyze" :method
 368     .param pmc pad
 369     .local pmc exp
 370     $I0 = 0
 371   loop:
 372     $I1 = defined self[$I0]
 373     if $I1 == 0 goto end
 374     $P0 = self[$I0]
 375     $P0 = $P0."p5analyze"(pad)
 376     self[$I0] = $P0
 377     inc $I0
 378     goto loop
 379   end:
 380     .return (self)
 381 .end
 382
 383 .namespace [ "PGE";"Exp";"CGroup" ]
 384
 385 .sub "p5analyze" :method
 386     .param pmc pad
 387     .local pmc exp
 388
 389     self["iscapture"] = 0
 390     if self != "(" goto end
 391     self["iscapture"] = 1
 392     self["isscope"] = 0
 393     self["isarray"] = 0
 394     $I0 = pad["subpats"]
 395     self["cname"] = $I0
 396     inc $I0
 397     pad["subpats"] = $I0
 398   end:
 399     exp = self[0]
 400     exp = exp."p5analyze"(pad)
 401     self[0] = exp
 402     .return (self)
 403 .end
 404
 405
 406
 407 # Local Variables:
 408 #   mode: pir
 409 #   fill-column: 100
 410 # End:
 411 # vim: expandtab shiftwidth=4 ft=pir: