Changeset 21602 for misc

Show
Ignore:
Timestamp:
07/29/08 05:11:17 (5 months ago)
Author:
putter
Message:

[rx_on_re] Started moving AST node definition to p6. Mostly relocated MatchN p5 unchanged into emit5.pm.

Location:
misc/elfish/rx_on_re
Files:
4 modified

Legend:

Unmodified
Added
Removed

  • misc/elfish/rx_on_re/emit5.pm

    r21587 r21602  
    4545 
    4646  method regex_prelude () { 
    47     self.expand_backtrack_macros(' 
     47    my $rmare = self.expand_backtrack_macros(' 
    4848 
    4949{ package VersionConstraints; 
    … …  
    671671} 
    672672'); 
     673   my $match = ' 
     674 
     675#====================================================================== 
     676# Match 
     677# 
     678{ 
     679  package Regexp::ModuleA::ReentrantEngine::Match2; 
     680  @Regexp::ModuleA::ReentrantEngine::Match2::ISA = 
     681    qw(Regexp::ModuleA::ReentrantEngine::Match0); 
     682 
     683  use overload 
     684    \'bool\' => \'match_boolean\', 
     685    \'""\'   => \'match_string\', 
     686    \'@{}\'  => \'match_array\', 
     687    \'%{}\'  => \'match_hash\', 
     688    ; 
     689 
     690  sub _match_enable_overload2 { } 
     691  sub _match_enable_overload1 { die "assert not reached" } 
     692 
     693  package Regexp::ModuleA::ReentrantEngine::Match1; 
     694  @Regexp::ModuleA::ReentrantEngine::Match1::ISA = 
     695    qw(Regexp::ModuleA::ReentrantEngine::Match0); 
     696 
     697  use overload 
     698    \'bool\' => \'match_boolean\', 
     699    \'""\'   => \'match_string\', 
     700    \'@{}\'  => \'match_array\', 
     701    \'%{}\'  => \'match_hash\', 
     702    ; 
     703 
     704  # sub _match_enable_overload1 is still required. 
     705 
     706  package Regexp::ModuleA::ReentrantEngine::Match0; 
     707 
     708  sub _match_enable_overload2 { 
     709    my($o)=@_; 
     710    use Carp; Carp::confess if ref($o) !~ /[a-z]/; 
     711#    eval {print STDERR $o->match_describe,"\n";}; 
     712#    if($@){use Data::Dumper; print STDERR Dumper $o;} 
     713    for my $m (map{ref($_)eq\'ARRAY\'?@$_:$_}@{$o->match_array}) { $m->_match_enable_overload2 } 
     714    for my $m (map{ref($_)eq\'ARRAY\'?@$_:$_}values %{$o->match_hash}) { $m->_match_enable_overload2 } 
     715    bless $o, \'Regexp::ModuleA::ReentrantEngine::Match2\'; 
     716  } 
     717  sub _match_enable_overload1 { 
     718    my($o)=@_; 
     719    for my $m (map{ref($_)eq\'ARRAY\'?@$_:$_}@{$o->match_array}) { $m->_match_enable_overload1 } 
     720    for my $m (map{ref($_)eq\'ARRAY\'?@$_:$_}values %{$o->match_hash}) { $m->_match_enable_overload1 } 
     721    bless $o, \'Regexp::ModuleA::ReentrantEngine::Match1\'; 
     722  } 
     723 
     724  sub match_boolean {${$_[0]}->{match_boolean}} 
     725  sub match_string  {${$_[0]}->{match_string}} 
     726  sub match_array   {${$_[0]}->{match_array}} 
     727  sub match_hash    {${$_[0]}->{match_hash}} 
     728 
     729  sub from          {${$_[0]}->{match_from}} 
     730  sub to            {${$_[0]}->{match_to}} 
     731 
     732  sub match_value   {${$_[0]}->{match_value}} 
     733 
     734  sub new_failed {my($cls)=@_; $cls->new()->match_set_as_failed()} 
     735  sub new { 
     736    my($cls)=@_; 
     737    my $h = { 
     738      match_boolean => 1, 
     739      match_string  => "", 
     740      match_array   => [], 
     741      match_hash    => {}, 
     742      match_from    => undef, 
     743      match_to      => undef, 
     744      match_value   => undef 
     745      }; 
     746    my $o = \$h; 
     747    bless $o,$cls; 
     748    #$o->match_set(1,"",[],{}); 
     749    return $o; 
     750  } 
     751  sub match_set { 
     752    my($o,$b,$s,$a,$h,$from,$to)=@_; 
     753    $$o->{match_boolean} = $b; 
     754    $$o->{match_string}  = $s; 
     755    $$o->{match_array}   = $a; 
     756    $$o->{match_hash}    = $h; 
     757    $$o->{match_from}    = $from; 
     758    $$o->{match_to}      = $to; 
     759    $$o->{match_value}   = undef; 
     760    return $o; 
     761  } 
     762  sub match_set_as_failed { 
     763    my($o)=@_; 
     764    $o->match_set(0,"",[],{}); 
     765    return $o; 
     766  } 
     767  sub match_set_value { 
     768    my($o,$v)=@_; 
     769    $$o->{match_value} = $v; 
     770  } 
     771   
     772  sub match_describe { 
     773    my($o,$verbose_p)=@_; 
     774    my $vp = $verbose_p; 
     775    my $os = $o->match_string; 
     776    $os = $o->match__indent_except_top($os) if $os =~ /\n/; 
     777    my $s = $verbose_p ? $o->match__describe_name_as : ""; 
     778    $s .= "<".($o->match_boolean?"1":"0").",\"$os\",["; 
     779    for my $v (@{$o->match_array}) { 
     780      my $vs = ""; 
     781      if(ref($v) eq \'ARRAY\') { 
     782        $vs = "[\n".$o->match__indent(join(",\n",map{ 
     783          $_->match_describe($vp) 
     784          }@$v))."\n]"; 
     785      } else { 
     786        $vs = $v->match_describe($vp); 
     787      } 
     788      $s .= "\n".$o->match__indent($vs).","; 
     789    } 
     790    $s .= "\n " if @{$o->match_array}; 
     791    $s .= "],{"; 
     792    for my $k (keys(%{$o->match_hash})) { 
     793      my $v = $o->match_hash->{$k}; 
     794      my $vs = ""; 
     795      if(ref($v) eq \'ARRAY\') { 
     796        $vs = "[\n".$o->match__indent(join(",\n",map{ 
     797          $_->match_describe($vp) 
     798          }@$v))."\n]"; 
     799      } else { 
     800        $vs = $v->match_describe($vp); 
     801      } 
     802      $s .= "\n  $k => " .$o->match__indent_except_top($vs).","; 
     803    } 
     804    $s .= "\n " if %{$o->match_hash}; 
     805    $s .= "},"; 
     806    my($from,$to)=($o->from,$o->to); 
     807    $from = "" if !defined $from; 
     808    $to   = "" if !defined $to; 
     809    $s .= "$from,$to"; 
     810    my $val = $o->match_value; 
     811    $s .= defined $val ? ",$val" : ""; 
     812    $s .= ">"; 
     813    return $s; 
     814  } 
     815  sub match__indent {my($o,$s)=@_; $s =~ s/^(?!\Z)/  /mg; $s} 
     816  sub match__indent_except_top {my($o,$s)=@_; $s =~ s/^(?<!\A)(?!\Z)/  /mg; $s} 
     817  sub match__describe_name_as { 
     818    my($o)=@_; 
     819    my $s = overload::StrVal($o); 
     820    $s .= "{".$$o->{RULE}."}" if defined $$o->{RULE}; 
     821    $s; 
     822  } 
     823 
     824  sub match_copy { 
     825    my($o)=@_; 
     826    my $m = ref($o)->new()->match_set($o->match_boolean, 
     827                                      $o->match_string, 
     828                                      $o->match_array, 
     829                                      $o->match_hash, 
     830                                      $o->from, 
     831                                      $o->to); 
     832    $$m->{match_value} = $$o->{match_value}; 
     833    $$m->{RULE} = $$o->{RULE}; 
     834    $m; 
     835  } 
     836 
     837  sub match_x_process_children { 
     838    my($o,$fun)=@_; 
     839    my $a = [map{ref($_)eq\'ARRAY\'?[map{$fun->($_)}@$_]:$fun->($_)} @{$o->match_array}]; 
     840    my $oh = $o->match_hash; 
     841    my %h = map{ 
     842      my $k = $_; 
     843      my $v = $oh->{$k}; 
     844      my $v1 = $v; 
     845      if(ref($v) eq \'ARRAY\') { 
     846        $v1 = [map{$fun->($_)}@$v]; 
     847      } else { 
     848        $v1 = $fun->($v); 
     849      } 
     850      ($k,$v1); 
     851    } keys %{$oh}; 
     852    ($a,\%h); 
     853  } 
     854 
     855} 
     856 
     857'; 
     858    $rmare ~ "\n" ~ $match; 
    673859  }; 
    674860}; 

  • misc/elfish/rx_on_re/nodes.pm

    r20727 r21602  
     1# Warning: This file is mechanically written.  Your changes will be overwritten. 
     2package Regexp::ModuleA::AST { 
     3 
     4  class Pat5 is BaseClass { 
     5    has $.match; 
     6    has $.pat; 
     7    has $.notes; 
     8     
     9    method newp($match,$pat) { self.new('match', $match, 'pat', $pat) } 
     10    method callback($emitter) { $emitter.cb__Pat5(self) } 
     11    method node_name() { 'Pat5' } 
     12    method field_names() { ['pat'] } 
     13    method field_values() { [$.pat] } 
     14    method irx1_describe() { 
     15      'Pat5('~$.pat.irx1_describe~')' 
     16    } 
     17 
     18  } 
     19  class Exact is BaseClass { 
     20    has $.match; 
     21    has $.text; 
     22    has $.notes; 
     23     
     24    method newp($match,$text) { self.new('match', $match, 'text', $text) } 
     25    method callback($emitter) { $emitter.cb__Exact(self) } 
     26    method node_name() { 'Exact' } 
     27    method field_names() { ['text'] } 
     28    method field_values() { [$.text] } 
     29    method irx1_describe() { 
     30      'Exact('~$.text.irx1_describe~')' 
     31    } 
     32 
     33  } 
     34  class Mod_expr is Mod_Base { 
     35    has $.match; 
     36    has $.mods; 
     37    has $.expr; 
     38    has $.notes; 
     39     
     40    method newp($match,$mods,$expr) { self.new('match', $match, 'mods', $mods, 'expr', $expr) } 
     41    method callback($emitter) { $emitter.cb__Mod_expr(self) } 
     42    method node_name() { 'Mod_expr' } 
     43    method field_names() { ['mods','expr'] } 
     44    method field_values() { [$.mods,$.expr] } 
     45    method irx1_describe() { 
     46      'Mod_expr('~$.mods.irx1_describe~','~$.expr.irx1_describe~')' 
     47    } 
     48 
     49  } 
     50  class Mod_inline is Mod_Base { 
     51    has $.match; 
     52    has $.mods; 
     53    has $.notes; 
     54     
     55    method newp($match,$mods) { self.new('match', $match, 'mods', $mods) } 
     56    method callback($emitter) { $emitter.cb__Mod_inline(self) } 
     57    method node_name() { 'Mod_inline' } 
     58    method field_names() { ['mods'] } 
     59    method field_values() { [$.mods] } 
     60    method irx1_describe() { 
     61      'Mod_inline('~$.mods.irx1_describe~')' 
     62    } 
     63 
     64  } 
     65  class Backref is BaseClass { 
     66    has $.match; 
     67    has $.backref_n; 
     68    has $.notes; 
     69     
     70    method newp($match,$backref_n) { self.new('match', $match, 'backref_n', $backref_n) } 
     71    method callback($emitter) { $emitter.cb__Backref(self) } 
     72    method node_name() { 'Backref' } 
     73    method field_names() { ['backref_n'] } 
     74    method field_values() { [$.backref_n] } 
     75    method irx1_describe() { 
     76      'Backref('~$.backref_n.irx1_describe~')' 
     77    } 
     78 
     79  } 
     80  class Cap is BaseClass { 
     81    has $.match; 
     82    has $.expr; 
     83    has $.notes; 
     84     
     85    method newp($match,$expr) { self.new('match', $match, 'expr', $expr) } 
     86    method callback($emitter) { $emitter.cb__Cap(self) } 
     87    method node_name() { 'Cap' } 
     88    method field_names() { ['expr'] } 
     89    method field_values() { [$.expr] } 
     90    method irx1_describe() { 
     91      'Cap('~$.expr.irx1_describe~')' 
     92    } 
     93 
     94  } 
     95  class Grp is BaseClass { 
     96    has $.match; 
     97    has $.expr; 
     98    has $.notes; 
     99     
     100    method newp($match,$expr) { self.new('match', $match, 'expr', $expr) } 
     101    method callback($emitter) { $emitter.cb__Grp(self) } 
     102    method node_name() { 'Grp' } 
     103    method field_names() { ['expr'] } 
     104    method field_values() { [$.expr] } 
     105    method irx1_describe() { 
     106      'Grp('~$.expr.irx1_describe~')' 
     107    } 
     108 
     109  } 
     110  class Alias is BaseClass { 
     111    has $.match; 
     112    has $.target; 
     113    has $.target_spec; 
     114    has $.expr; 
     115    has $.notes; 
     116     
     117    method newp($match,$target,$target_spec,$expr) { self.new('match', $match, 'target', $target, 'target_spec', $target_spec, 'expr', $expr) } 
     118    method callback($emitter) { $emitter.cb__Alias(self) } 
     119    method node_name() { 'Alias' } 
     120    method field_names() { ['target','target_spec','expr'] } 
     121    method field_values() { [$.target,$.target_spec,$.expr] } 
     122    method irx1_describe() { 
     123      'Alias('~$.target.irx1_describe~','~$.target_spec.irx1_describe~','~$.expr.irx1_describe~')' 
     124    } 
     125 
     126  } 
     127  class Quant is BaseClass { 
     128    has $.match; 
     129    has $.min; 
     130    has $.max; 
     131    has $.expr; 
     132    has $.nongreedy; 
     133    has $.notes; 
     134     
     135    method newp($match,$min,$max,$expr,$nongreedy) { self.new('match', $match, 'min', $min, 'max', $max, 'expr', $expr, 'nongreedy', $nongreedy) } 
     136    method callback($emitter) { $emitter.cb__Quant(self) } 
     137    method node_name() { 'Quant' } 
     138    method field_names() { ['min','max','expr','nongreedy'] } 
     139    method field_values() { [$.min,$.max,$.expr,$.nongreedy] } 
     140    method irx1_describe() { 
     141      'Quant('~$.min.irx1_describe~','~$.max.irx1_describe~','~$.expr.irx1_describe~','~$.nongreedy.irx1_describe~')' 
     142    } 
     143 
     144  } 
     145  class Alt is BaseClass { 
     146    has $.match; 
     147    has $.exprs; 
     148    has $.notes; 
     149     
     150    method newp($match,$exprs) { self.new('match', $match, 'exprs', $exprs) } 
     151    method callback($emitter) { $emitter.cb__Alt(self) } 
     152    method node_name() { 'Alt' } 
     153    method field_names() { ['exprs'] } 
     154    method field_values() { [$.exprs] } 
     155    method irx1_describe() { 
     156      'Alt('~$.exprs.irx1_describe~')' 
     157    } 
     158 
     159  } 
     160  class Conj is BaseClass { 
     161    has $.match; 
     162    has $.exprs; 
     163    has $.notes; 
     164     
     165    method newp($match,$exprs) { self.new('match', $match, 'exprs', $exprs) } 
     166    method callback($emitter) { $emitter.cb__Conj(self) } 
     167    method node_name() { 'Conj' } 
     168    method field_names() { ['exprs'] } 
     169    method field_values() { [$.exprs] } 
     170    method irx1_describe() { 
     171      'Conj('~$.exprs.irx1_describe~')' 
     172    } 
     173 
     174  } 
     175  class Seq is BaseClass { 
     176    has $.match; 
     177    has $.exprs; 
     178    has $.notes; 
     179     
     180    method newp($match,$exprs) { self.new('match', $match, 'exprs', $exprs) } 
     181    method callback($emitter) { $emitter.cb__Seq(self) } 
     182    method node_name() { 'Seq' } 
     183    method field_names() { ['exprs'] } 
     184    method field_values() { [$.exprs] } 
     185    method irx1_describe() { 
     186      'Seq('~$.exprs.irx1_describe~')' 
     187    } 
     188 
     189  } 
     190  class ASpace is BaseClass { 
     191    has $.match; 
     192    has $.aspace_inpkg; 
     193    has $.text; 
     194    has $.notes; 
     195     
     196    method newp($match,$aspace_inpkg,$text) { self.new('match', $match, 'aspace_inpkg', $aspace_inpkg, 'text', $text) } 
     197    method callback($emitter) { $emitter.cb__ASpace(self) } 
     198    method node_name() { 'ASpace' } 
     199    method field_names() { ['aspace_inpkg','text'] } 
     200    method field_values() { [$.aspace_inpkg,$.text] } 
     201    method irx1_describe() { 
     202      'ASpace('~$.aspace_inpkg.irx1_describe~','~$.text.irx1_describe~')' 
     203    } 
     204 
     205  } 
     206  class Subrule is BaseClass { 
     207    has $.match; 
     208    has $.created_in_pkg; 
     209    has $.name; 
     210    has $.exprs; 
     211    has $.neg; 
     212    has $.nocap; 
     213    has $.notes; 
     214     
     215    method newp($match,$created_in_pkg,$name,$exprs,$neg,$nocap) { self.new('match', $match, 'created_in_pkg', $created_in_pkg, 'name', $name, 'exprs', $exprs, 'neg', $neg, 'nocap', $nocap) } 
     216    method callback($emitter) { $emitter.cb__Subrule(self) } 
     217    method node_name() { 'Subrule' } 
     218    method field_names() { ['created_in_pkg','name','exprs','neg','nocap'] } 
     219    method field_values() { [$.created_in_pkg,$.name,$.exprs,$.neg,$.nocap] } 
     220    method irx1_describe() { 
     221      'Subrule('~$.created_in_pkg.irx1_describe~','~$.name.irx1_describe~','~$.exprs.irx1_describe~','~$.neg.irx1_describe~','~$.nocap.irx1_describe~')' 
     222    } 
     223 
     224  } 
     225  class ARegex is BaseClass { 
     226    has $.match; 
     227    has $.modpat; 
     228    has $.mods; 
     229    has $.expr; 
     230    has $.notes; 
     231     
     232    method newp($match,$modpat,$mods,$expr) { self.new('match', $match, 'modpat', $modpat, 'mods', $mods, 'expr', $expr) } 
     233    method callback($emitter) { $emitter.cb__ARegex(self) } 
     234    method node_name() { 'ARegex' } 
     235    method field_names() { ['modpat','mods','expr'] } 
     236    method field_values() { [$.modpat,$.mods,$.expr] } 
     237    method irx1_describe() { 
     238      'ARegex('~$.modpat.irx1_describe~','~$.mods.irx1_describe~','~$.expr.irx1_describe~')' 
     239    } 
     240 
     241  } 
     242  class Biind is BaseClass { 
     243    has $.match; 
     244    has $.created_in_pkg; 
     245    has $.name; 
     246    has $.expr; 
     247    has $.notes; 
     248     
     249    method newp($match,$created_in_pkg,$name,$expr) { self.new('match', $match, 'created_in_pkg', $created_in_pkg, 'name', $name, 'expr', $expr) } 
     250    method callback($emitter) { $emitter.cb__Biind(self) } 
     251    method node_name() { 'Biind' } 
     252    method field_names() { ['created_in_pkg','name','expr'] } 
     253    method field_values() { [$.created_in_pkg,$.name,$.expr] } 
     254    method irx1_describe() { 
     255      'Biind('~$.created_in_pkg.irx1_describe~','~$.name.irx1_describe~','~$.expr.irx1_describe~')' 
     256    } 
     257 
     258  } 
     259  class Namespace is BaseClass { 
     260    has $.match; 
     261    has $.created_in_pkg; 
     262    has $.nsname; 
     263    has $.bindings; 
     264    has $.pkg; 
     265    has $.notes; 
     266     
     267    method newp($match,$created_in_pkg,$nsname,$bindings,$pkg) { self.new('match', $match, 'created_in_pkg', $created_in_pkg, 'nsname', $nsname, 'bindings', $bindings, 'pkg', $pkg) } 
     268    method callback($emitter) { $emitter.cb__Namespace(self) } 
     269    method node_name() { 'Namespace' } 
     270    method field_names() { ['created_in_pkg','nsname','bindings','pkg'] } 
     271    method field_values() { [$.created_in_pkg,$.nsname,$.bindings,$.pkg] } 
     272    method irx1_describe() { 
     273      'Namespace('~$.created_in_pkg.irx1_describe~','~$.nsname.irx1_describe~','~$.bindings.irx1_describe~','~$.pkg.irx1_describe~')' 
     274    } 
     275 
     276  } 
     277  class Code is BaseClass { 
     278    has $.match; 
     279    has $.code; 
     280    has $.notes; 
     281     
     282    method newp($match,$code) { self.new('match', $match, 'code', $code) } 
     283    method callback($emitter) { $emitter.cb__Code(self) } 
     284    method node_name() { 'Code' } 
     285    method field_names() { ['code'] } 
     286    method field_values() { [$.code] } 
     287    method irx1_describe() { 
     288      'Code('~$.code.irx1_describe~')' 
     289    } 
     290 
     291  } 
     292  class CodeRx is BaseClass { 
     293    has $.match; 
     294    has $.code; 
     295    has $.notes; 
     296     
     297    method newp($match,$code) { self.new('match', $match, 'code', $code) } 
     298    method callback($emitter) { $emitter.cb__CodeRx(self) } 
     299    method node_name() { 'CodeRx' } 
     300    method field_names() { ['code'] } 
     301    method field_values() { [$.code] } 
     302    method irx1_describe() { 
     303      'CodeRx('~$.code.irx1_describe~')' 
     304    } 
     305 
     306  } 
     307  class Independent is BaseClass { 
     308    has $.match; 
     309    has $.expr; 
     310    has $.notes; 
     311     
     312    method newp($match,$expr) { self.new('match', $match, 'expr', $expr) } 
     313    method callback($emitter) { $emitter.cb__Independent(self) } 
     314    method node_name() { 'Independent' } 
     315    method field_names() { ['expr'] } 
     316    method field_values() { [$.expr] } 
     317    method irx1_describe() { 
     318      'Independent('~$.expr.irx1_describe~')' 
     319    } 
     320 
     321  } 
     322  class Conditional is BaseClass { 
     323    has $.match; 
     324    has $.test; 
     325    has $.expr_then; 
     326    has $.expr_else; 
     327    has $.notes; 
     328     
     329    method newp($match,$test,$expr_then,$expr_else) { self.new('match', $match, 'test', $test, 'expr_then', $expr_then, 'expr_else', $expr_else) } 
     330    method callback($emitter) { $emitter.cb__Conditional(self) } 
     331    method node_name() { 'Conditional' } 
     332    method field_names() { ['test','expr_then','expr_else'] } 
     333    method field_values() { [$.test,$.expr_then,$.expr_else] } 
     334    method irx1_describe() { 
     335      'Conditional('~$.test.irx1_describe~','~$.expr_then.irx1_describe~','~$.expr_else.irx1_describe~')' 
     336    } 
     337 
     338  } 
     339  class Lookaround is BaseClass { 
     340    has $.match; 
     341    has $.is_forward; 
     342    has $.is_positive; 
     343    has $.expr; 
     344    has $.notes; 
     345     
     346    method newp($match,$is_forward,$is_positive,$expr) { self.new('match', $match, 'is_forward', $is_forward, 'is_positive', $is_positive, 'expr', $expr) } 
     347    method callback($emitter) { $emitter.cb__Lookaround(self) } 
     348    method node_name() { 'Lookaround' } 
     349    method field_names() { ['is_forward','is_positive','expr'] } 
     350    method field_values() { [$.is_forward,$.is_positive,$.expr] } 
     351    method irx1_describe() { 
     352      'Lookaround('~$.is_forward.irx1_describe~','~$.is_positive.irx1_describe~','~$.expr.irx1_describe~')' 
     353    } 
     354 
     355  } 
     356  class CommitSequence is BaseClass { 
     357    has $.match; 
     358    has $.notes; 
     359     
     360    method newp($match) { self.new('match', $match) } 
     361    method callback($emitter) { $emitter.cb__CommitSequence(self) } 
     362    method node_name() { 'CommitSequence' } 
     363    method field_names() { [] } 
     364    method field_values() { [] } 
     365    method irx1_describe() { 
     366      'CommitSequence('~')' 
     367    } 
     368 
     369  } 
     370  class CommitGroup is BaseClass { 
     371    has $.match; 
     372    has $.notes; 
     373     
     374    method newp($match) { self.new('match', $match) } 
     375    method callback($emitter) { $emitter.cb__CommitGroup(self) } 
     376    method node_name() { 'CommitGroup' } 
     377    method field_names() { [] } 
     378    method field_values() { [] } 
     379    method irx1_describe() { 
     380      'CommitGroup('~')' 
     381    } 
     382 
     383  } 
     384  class CommitRegex is BaseClass { 
     385    has $.match; 
     386    has $.notes; 
     387     
     388    method newp($match) { self.new('match', $match) } 
     389    method callback($emitter) { $emitter.cb__CommitRegex(self) } 
     390    method node_name() { 'CommitRegex' } 
     391    method field_names() { [] } 
     392    method field_values() { [] } 
     393    method irx1_describe() { 
     394      'CommitRegex('~')' 
     395    } 
     396 
     397  } 
     398  class CommitMatch is BaseClass { 
     399    has $.match; 
     400    has $.notes; 
     401     
     402    method newp($match) { self.new('match', $match) } 
     403    method callback($emitter) { $emitter.cb__CommitMatch(self) } 
     404    method node_name() { 'CommitMatch' } 
     405    method field_names() { [] } 
     406    method field_values() { [] } 
     407    method irx1_describe() { 
     408      'CommitMatch('~')' 
     409    } 
     410 
     411  } 
     412} 

  • misc/elfish/rx_on_re/nodes_create.pl

    r20727 r21602  
     1#!/usr/bin/perl 
     2use strict; 
     3use warnings; 
     4 
     5my $def = <<'END_DEF'; 
     6 
     7Pat5 pat 
     8Exact text 
     9Mod_expr mods expr 
     10Mod_inline mods 
     11Backref backref_n 
     12Cap expr 
     13Grp expr 
     14Alias target target_spec expr 
     15Quant min max expr nongreedy 
     16Alt exprs 
     17Conj exprs 
     18Seq exprs 
     19ASpace aspace_inpkg text 
     20Subrule created_in_pkg name exprs neg nocap 
     21ARegex modpat mods expr 
     22Biind created_in_pkg name expr 
     23Namespace created_in_pkg nsname bindings pkg 
     24Code code 
     25CodeRx code 
     26Independent expr 
     27Conditional test expr_then expr_else 
     28Lookaround is_forward is_positive expr 
     29CommitSequence 
     30CommitGroup 
     31CommitRegex 
     32CommitMatch 
     33 
     34END_DEF 
     35 
     36sub write_ir_info5 { 
     37  my($file)=@_; 
     38  my $code = <<'END_CODE'; 
     39# Warning: This file is mechanically written.  Your changes will be overwritten. 
     40package IRx1_Info::Node; 
     41 
     42our @extra_fields = qw( match ); 
     43sub new { 
     44  my($cls,$name,$fields)=@_; 
     45  bless { 
     46    name => $name, 
     47    fields => $fields, 
     48    all_fields => [@extra_fields,@$fields], 
     49  }, $cls; 
     50} 
     51sub name { shift->{name} } 
     52sub fields { @{shift->{fields}} } 
     53sub all_fields { @{shift->{all_fields}} } 
     54 
     55package IRx1_Info; 
     56my $def = <<'END_DEF'; 
     57<<DEF>> 
     58END_DEF 
     59 
     60# IR nodes 
     61our @nodes; 
     62our %node_index; 
     63 
     64sub nodes { @nodes } 
     65sub node_named { my($cls,$name)=@_; $node_index{$name} } 
     66 
     67sub load_ir_node_config { 
     68  my $node_class = __PACKAGE__.'::Node'; 
     69  my $ir_config = $def; 
     70  for my $line (split(/\n/,$ir_config)) { 
     71    next if $line =~ /^\s*$|^\s*\#/; 
     72    $line =~ s/#.*//; 
     73    my($name,@fields)=eval('qw{'.$line.'}'); 
     74    my $node = $node_class->new($name,\@fields); 
     75    push(@nodes,$node); 
     76    $node_index{$name} = $node; 
     77  } 
     78} 
     79load_ir_node_config(); 
     80 
     811; 
     82__END__ 
     83END_CODE 
     84    $code =~ s/<<DEF>>/$def/; 
     85    text2file($code,$file); 
     86} 
     87 
     88 
     89sub write_ir_nodes { 
     90  my($file)=@_; 
     91  my $code = "".unindent(<<'  END'); 
     92    # Warning: This file is mechanically written.  Your changes will be overwritten. 
     93    package Regexp::ModuleA::AST { 
     94 
     95  END 
     96 
     97  for my $node (IRx1_Info->nodes) { 
     98    my($name,@fields)=($node->name,$node->fields); 
     99    my @all = $node->all_fields; 
     100     
     101    my $base = 'BaseClass'; 
     102    $base = "${1}_Base" if $name =~ /([^_]+)_/; 
     103    my $has = join("",map{"has \$.$_;\n        "} @all,'notes'); 
     104    my $params = join(',',map{"\$$_"}@all); 
     105    my $init = join(', ',map{"'$_', \$$_"} @all); 
     106    my $field_names = join(',',map{"'$_'"}@fields); 
     107    my $field_values = join(',',map{'$.'.$_}@fields); 
     108 
     109    $code .= unindent(<<"    END",'  '); 
     110      class $name is $base { 
     111        $has 
     112        method newp($params) { self.new($init) } 
     113        method callback(\$emitter) { \$emitter.cb__$name(self) } 
     114        method node_name() { '$name' } 
     115        method field_names() { [$field_names] } 
     116        method field_values() { [$field_values] } 
     117        method irx1_describe() { 
     118          @{["'".$name."('~".join("','~",(map{'$.'.$_.'.irx1_describe~'}@fields))."')'"]} 
     119        } 
     120 
     121      } 
     122    END 
     123  } 
     124  $code .= unindent(<<'  END'); 
     125    } 
     126  END 
     127  text2file($code,$file); 
     128} 
     129 
     130 
     131sub text2file { 
     132  my($text,$file)=@_; 
     133  open(F,">$file") or die "open() failed on $file: $!"; 
     134  print F $text; 
     135  close F; 
     136} 
     137 
     138#XXX doesn't actually work. 
     139sub unindent { 
     140  my($s,$leave_indent)=@_; 
     141  $leave_indent ||= ""; 
     142  $s =~ /^( *)$leave_indent/; 
     143  my $indent = $1; 
     144  $s =~ s/^$indent//mg; 
     145  $s; 
     146} 
     147 
     148write_ir_info5("./nodes_info.p5"); 
     149require "./nodes_info.p5"; 
     150write_ir_nodes("./nodes.pm"); 

  • misc/elfish/rx_on_re/remains_of_Regexp_ModuleA.pm

    r21587 r21602  
    328328# 
    329329{ 
    330   package Regexp::ModuleA::ReentrantEngine::Match2; 
    331   @Regexp::ModuleA::ReentrantEngine::Match2::ISA = 
    332     qw(Regexp::ModuleA::ReentrantEngine::Match0); 
    333  
    334   use overload 
    335     'bool' => 'match_boolean', 
    336     '""'   => 'match_string', 
    337     '@{}'  => 'match_array', 
    338     '%{}'  => 'match_hash', 
    339     ; 
    340  
    341   sub _match_enable_overload2 { } 
    342   sub _match_enable_overload1 { die "assert not reached" } 
    343  
    344   package Regexp::ModuleA::ReentrantEngine::Match1; 
    345   @Regexp::ModuleA::ReentrantEngine::Match1::ISA = 
    346     qw(Regexp::ModuleA::ReentrantEngine::Match0); 
    347  
    348   use overload 
    349     'bool' => 'match_boolean', 
    350     '""'   => 'match_string', 
    351     '@{}'  => 'match_array', 
    352     '%{}'  => 'match_hash', 
    353     ; 
    354  
    355   # sub _match_enable_overload1 is still required. 
    356  
    357330  package Regexp::ModuleA::ReentrantEngine::Match0; 
    358331 
    359   sub _match_enable_overload2 { 
    360     my($o)=@_; 
    361     use Carp; Carp::confess if ref($o) !~ /[a-z]/; 
    362 #    eval {print STDERR $o->match_describe,"\n";}; 
    363 #    if($@){use Data::Dumper; print STDERR Dumper $o;} 
    364     for my $m (map{ref($_)eq'ARRAY'?@$_:$_}@{$o->match_array}) { $m->_match_enable_overload2 } 
    365     for my $m (map{ref($_)eq'ARRAY'?@$_:$_}values %{$o->match_hash}) { $m->_match_enable_overload2 } 
    366     bless $o, 'Regexp::ModuleA::ReentrantEngine::Match2'; 
    367   } 
    368   sub _match_enable_overload1 { 
    369     my