languages/pynie/src/parser/Actions.pm

   1 # $Id$
   2 # Copyright (C) 2007, The Perl Foundation.
   3
   4 class Pynie::Grammar::Actions;
   5
   6 method TOP($/) {
   7     make $( $<file_input> );
   8 }
   9
  10 method file_input($/) {
  11     my $past := PAST::Stmts.new( :node($/) );
  12     for $<statement> {
  13         $past.push( $($_) );
  14     }
  15     make $past;
  16 }
  17
  18 method suite($/, $key) {
  19     make $( $/{$key} );
  20 }
  21
  22 method suite1($/) {
  23     make $( $<stmt_list> );
  24 }
  25
  26 method suite2($/) {
  27     my $past := PAST::Stmts.new( :node($/) );
  28     for $<statement> {
  29         $past.push($($_));
  30     }
  31     make $past;
  32 }
  33
  34 method statement($/, $key) {
  35     make $($/{$key});
  36 }
  37
  38 method stmt_list($/) {
  39     my $past := PAST::Stmts.new( :node($/) );
  40     for $<simple_stmt> {
  41         $past.push( $($_) );
  42     }
  43     make $past;
  44 }
  45
  46 method compound_stmt($/, $key) {
  47     make $($/{$key});
  48 }
  49
  50 method assert_stmt($/) {
  51     ## assert exp1
  52     ##
  53     ## translates to:
  54     ##
  55     ## if __debug__:
  56     ##   if not exp1
  57     ##
  58
  59     ## XXX handle exp2.
  60
  61     my $exp1 := $( $<exp1> );
  62
  63     ## XXX change into "AssertionError"
  64     my $exception := PAST::Op.new( :inline('    %r = new "Exception"') );
  65
  66     my $throwcode := PAST::Op.new( $exception, :pirop('throw'), :node($/) );
  67
  68     my $debugcode := PAST::Op.new( $exp1, $throwcode,
  69                                    :pasttype('unless'),
  70                                    :node($/) );
  71
  72     my $debugflag := PAST::Var.new( :name('__debug__'),
  73                                     :scope('package'),
  74                                     :viviself('Undef'),
  75                                     :node($/) );
  76
  77     my $past := PAST::Op.new( $debugflag,
  78                               $debugcode,
  79                               :pasttype('if'),
  80                               :node($/) );
  81
  82     make $past;
  83 }
  84
  85 method if_stmt($/) {
  86     my $cond := +$<expression> - 1;
  87     my $past := PAST::Op.new( $( $<expression>[$cond] ),
  88                               $( $<suite>[$cond] ),
  89                               :pasttype('if'),
  90                               :node( $/ )
  91                             );
  92     if ( $<else> ) {
  93         $past.push( $( $<else>[0] ) );
  94     }
  95     while ($cond != 0) {
  96         $cond := $cond - 1;
  97         $past := PAST::Op.new( $( $<expression>[$cond] ),
  98                                $( $<suite>[$cond] ),
  99                                $past,
 100                                :pasttype('if'),
 101                                :node( $/ )
 102                              );
 103     }
 104     make $past;
 105 }
 106
 107 method while_stmt($/) {
 108     my $past := PAST::Op.new( $( $<expression> ),
 109                               $( $<suite> ),
 110                               :pasttype('while'),
 111                               :node( $/ )
 112                             );
 113     if $<else> {
 114         ##  handle 'else' clause
 115         $past := PAST::Stmts.new( $past,
 116                                   $( $<else>[0] ),
 117                                   :node( $/ )
 118                                 );
 119     }
 120     make $past;
 121 }
 122
 123 method parameter_list($/) {
 124     ## the only place for parameters to live is in a function block;
 125     ## create that here already.
 126     my $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
 127
 128     ## handle normal parameters
 129     for $<defparameter> {
 130         $past.push( $($_) );
 131     }
 132
 133     ## handle '*' <identifier>
 134     if $<excess_positional_parameter> {
 135         my $slurpparam := $( $<excess_positional_parameter> );
 136         $past.push( $slurpparam );
 137     }
 138     ## handle '**' <identifier>
 139     if $<excess_keyword_parameter> {
 140         my $dictparam := $( $<excess_keyword_parameter> );
 141         $past.push( $dictparam );
 142     }
 143     make $past;
 144 }
 145
 146 method defparameter($/) {
 147     my $past := $( $<parameter> );
 148     $past.scope('parameter');
 149
 150     ## add the default value for this parameter, if any
 151     if $<expression> {
 152         my $defaultvalue := $( $<expression>[0] );
 153         $past.viviself( $defaultvalue );
 154     }
 155     make $past;
 156 }
 157
 158 method parameter($/, $key) {
 159     make $( $/{$key} )
 160 }
 161
 162 method sublist($/) {
 163     ## XXX
 164 }
 165
 166 method excess_positional_parameter($/) {
 167     ## a :slurpy argument
 168     my $past := $( $<identifier> );
 169     $past.scope('parameter');
 170     $past.slurpy(1);
 171     make $past;
 172 }
 173
 174 method excess_keyword_parameter($/) {
 175     ## a :named, :slurpy argument
 176     my $past := $( $<identifier> );
 177     $past.scope('parameter');
 178     $past.slurpy(1);
 179     $past.named(1);
 180     make $past;
 181 }
 182
 183 method lambda_form($/) {
 184     my $past;
 185     if $<parameter_list> {
 186         $past := $( $<parameter_list>[0] );
 187     }
 188     else { # if no parameters, create a block here:
 189         $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
 190     }
 191
 192     my $expr := $( $<expression> );
 193
 194     ## add a return statement to this block
 195     $past.push( PAST::Op.new( $expr, :pasttype('return'), :node($/) ) );
 196     $past.control('return_pir');
 197     make $past;
 198 }
 199
 200 method funcdef($/) {
 201     my $past;
 202
 203     if $<parameter_list> {
 204         $past := $( $<parameter_list>[0] );
 205     }
 206     else {
 207         $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
 208     }
 209     my $name := $( $<funcname> );
 210     $past.name( $name.name() );
 211     $past.push( $($<suite>) );
 212
 213     $past.control('return_pir');
 214     make $past;
 215 }
 216
 217 method funcname($/) {
 218     make $( $<identifier> );
 219 }
 220
 221 method argument_list($/) {
 222     my $past;
 223
 224     if $<positional_arguments> {
 225         $past := $( $<positional_arguments> );
 226     }
 227     else {
 228         $past := PAST::Op.new( :pasttype('call'), :node($/) );
 229     }
 230
 231     if $<keyword_arguments> {
 232         for $( $<keyword_arguments> ) {
 233         ## XXX should this be: for @( $<keyword_arguments> )??
 234             $past.push( $_ );
 235         }
 236     }
 237
 238     make $past;
 239 }
 240
 241 method positional_arguments($/) {
 242     my $past := PAST::Op.new( :pasttype('call'), :node($/) );
 243     for $<expression> {
 244         $past.push($($_));
 245     }
 246     make $past;
 247 }
 248
 249 method keyword_arguments($/) {
 250     my $past := PAST::Op.new( :pasttype('call'), :node($/) );
 251     for $<keyword_item> {
 252         $past.push($($_));
 253     }
 254     make $past;
 255 }
 256
 257 method keyword_item($/) {
 258     my $past := $( $<expression> );
 259     my $name := $( $<identifier> );
 260
 261     ## XXX why doesn't this work??
 262     #$past.named( $name.name() );
 263     #make PAST::Val.new( :value('100'), :named('x'), :node($/) );
 264     make $past;
 265 }
 266
 267 method classname($/) {
 268     make $( $<identifier> );
 269 }
 270
 271 method classdef($/) {
 272     ## a class definition is a set of statements
 273     my $past := PAST::Stmts.new( :node($/) );
 274
 275     ## create an anonymous sub that generates the class
 276     my $cdef  := PAST::Block.new( :blocktype('declaration'), :node($/) );
 277     my $cname := $( $<classname> );
 278     my $pir   := '    $P0 = newclass "' ~ $cname.name() ~ '"';
 279     $cdef.push( PAST::Op.new( :inline($pir) ) );
 280     $cdef.pirflags(':init :anon');
 281
 282     ## handle parents, if available
 283     if $<inheritance> {
 284         my $parent    := $( $<inheritance>[0] );
 285         my $pir       := '    addparent $P0, %0';
 286         my $addparent := PAST::Op.new( $parent, :inline($pir), :node($/) );
 287         $cdef.push($addparent);
 288     }
 289     $past.push($cdef);
 290
 291     ## handle class contents
 292     my $suite := $( $<suite> );
 293
 294     make $past;
 295 }
 296
 297 method del_stmt($/) {
 298     our $?BLOCK;
 299
 300     my $targets := $( $<target_list> );
 301
 302     my $past := PAST::Stmts.new( :node($/) );
 303
 304     my $pir := "    .local pmc ns\n"
 305              ~ '    ns = get_hll_namespace';
 306
 307     $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
 308     for @($targets) {
 309         $pir := '    delete ns["' ~ $_.name() ~ '"]';
 310         $past.push( PAST::Op.new( :inline($pir), :node($/) ) );
 311     }
 312
 313     make $past;
 314 }
 315
 316 method pass_stmt($/) {
 317     ## pass statement doesn't do anything, but do create a PAST
 318     ## node to prevent special case code.
 319     make PAST::Op.new( :inline('    # pass'), :node($/) );
 320 }
 321
 322 method raise_stmt($/) {
 323     ## XXX finish this
 324     my $numexpr := +$<expression>;
 325
 326     ## think of better structure to handle this:
 327     if $numexpr == 0 {
 328
 329     }
 330     elsif $numexpr == 1 {
 331
 332     }
 333     elsif $numexpr == 2 {
 334         #my $exctype  := $( $<expression> );
 335         #my $excvalue := $( $<expression> );
 336     }
 337     elsif $numexpr == 3 {
 338
 339     } # else will never happen.
 340
 341     ## XXX for now this'll do:
 342     my $exc  := PAST::Op.new( :inline('    %r = new "Exception"'), :node($/) );
 343     my $pir  := '    throw %0';
 344     my $past := PAST::Op.new( $exc, :inline($pir), :node($/) );
 345
 346     make $past;
 347 }
 348
 349 method simple_stmt($/, $key) {
 350     make $( $/{$key} );
 351 }
 352
 353 method expression_stmt($/) {
 354     make $( $<expression_list> );
 355 }
 356
 357 method return_stmt($/) {
 358     my $past := PAST::Op.new( :pasttype('return'), :node($/) );
 359     if $<expression_list> {
 360         my $retvals := $( $<expression_list>[0] );
 361         $past.push($retvals);
 362     }
 363     make $past;
 364 }
 365
 366 method global_stmt($/) {
 367     our $?BLOCK;
 368     for $<identifier> {
 369         $?BLOCK.symbol( $( $_ ).name(), :scope('package') );
 370     }
 371     ## make a no-op
 372     make PAST::Op.new( :inline('    # global declaration'), :node($/) );
 373 }
 374
 375 method expression_list($/) {
 376     my $past;
 377     if (+$<expression> == 1) {
 378         $past := $( $<expression>[0] );
 379     }
 380     else {
 381         $past := PAST::Op.new( :name('listmaker'), :node($/) );
 382         for $<expression> {
 383             $past.push( $($_) );
 384         }
 385     }
 386     make $past;
 387 }
 388
 389
 390 method identifier($/) {
 391     make PAST::Var.new( :name( ~$/ ),
 392                         :scope('package'),
 393                         :node($/) );
 394 }
 395
 396
 397 method print_stmt($/) {
 398     my $past := PAST::Op.new( :name('printnl'), :node($/) );
 399     for $<expression> {
 400         $past.push( $($_) );
 401     }
 402     if $/[0] {
 403         $past.name('print');
 404     }
 405     make $past;
 406 }
 407
 408
 409 method expression($/, $key) {
 410     ## XXX incomplete.
 411     if $key eq 'lambda_form' {
 412         make $( $<lambda_form> );
 413     }
 414     else {
 415         make $( $<or_test>[0] );
 416     }
 417 }
 418
 419 method test($/, $key) {
 420     make $( $/{$key} );
 421 }
 422
 423 method or_test($/) {
 424     my $count := +$<and_test> - 1;
 425     my $past := $( $<and_test>[$count] );
 426     while $count != 0 {
 427         $count := $count - 1;
 428         my $past := PAST::Op.new( $($<and_test>[$count]),
 429                                   $past,
 430                                   :pasttype('if') );
 431     }
 432     make $past;
 433 }
 434
 435 method and_test($/) {
 436     my $count := +$<not_test> - 1;
 437     my $past := $( $<not_test>[$count] );
 438     while $count != 0 {
 439         $count := $count - 1;
 440         my $past := PAST::Op.new( $($<not_test>[$count]),
 441                                   $past,
 442                                   :pasttype('unless') );
 443     }
 444     make $past;
 445 }
 446
 447
 448 method not_test($/) {
 449     my $past := $( $<in_test> );
 450     for $<nots> {
 451         $past := PAST::Op.new( $past, :pirop('not'), :node($/) );
 452     }
 453     make $past;
 454 }
 455
 456
 457 method in_test($/) {
 458     make $($<is_test>[0]);
 459 }
 460
 461
 462 method is_test($/) {
 463     make $($<comparison>[0]);
 464 }
 465
 466 method comparison($/, $key) {
 467     if ($key eq 'end') {
 468         make $($<expr>);
 469     }
 470     else {
 471         my $past := PAST::Op.new( :name($<type>),
 472                                   :pasttype($<top><pasttype>),
 473                                   :pirop($<top><pirop>),
 474                                   :lvalue($<top><lvalue>),
 475                                   :node($/)
 476                                 );
 477         for @($/) {
 478             $past.push( $($_) );
 479         }
 480         make $past;
 481     }
 482 }
 483
 484 method list_iter($/, $key) {
 485     make $( $/{$key} );
 486 }
 487
 488 method list_for($/) {
 489     ## XXX
 490 }
 491
 492 method list_if($/) {
 493     ## XXX
 494 }
 495
 496 method primary($/) {
 497     my $past := $( $<atom> );
 498     ## $past is the first child of each <postop>, so unshift it
 499     ## so it ends up at the front of the list.
 500     for $<postop> {
 501         my $postop := $($_);
 502         $postop.unshift($past);
 503         $past := $postop;
 504     }
 505     make $past;
 506 }
 507
 508 method postop($/, $key) {
 509     make $( $/{$key} );
 510 }
 511
 512 method call($/, $key) {
 513     # XXX fix this.
 514     #make $( $/{$key} );
 515     if $<argument_list> {
 516         make $( $<argument_list>[0] );
 517     }
 518     else {
 519         make PAST::Op.new( :pasttype('call'), :node($/) );
 520     }
 521 }
 522
 523 method subscription($/) {
 524     make PAST::Var.new( $( $<tuple_or_scalar> ), :scope('keyed'));
 525 }
 526
 527 method atom($/, $key) {
 528     make $( $/{$key} );
 529 }
 530
 531 method literal($/, $key) {
 532     make $( $/{$key} );
 533 }
 534
 535 method integer($/) {
 536     make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
 537 }
 538
 539 method floatnumber($/) {
 540     make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
 541 }
 542
 543 method stringliteral($/, $key) {
 544     make $( $/{$key} );
 545 }
 546
 547 method shortstring($/) {
 548     make PAST::Val.new( :value( ~$/[0] ), :node($/) );
 549 }
 550
 551 method parenth_form($/) {
 552     if +$<tuple_or_scalar> {
 553     make $( $<tuple_or_scalar>[0] );
 554     }
 555     else {
 556         make PAST::Op.new( :name('tuplemaker'),
 557                            :pasttype('call'));
 558     }
 559 }
 560
 561 method assignment_stmt($/) {
 562     my $lhs     := $( $<target_list> );
 563     my $explist := $( $<expression_list> );
 564     my $past    := PAST::Stmts.new( :node($/) );
 565
 566     for @($lhs) {
 567         my $rhs := $explist.shift();
 568         $past.push( PAST::Op.new( $_, $rhs, :pasttype('bind'), :node($/) ) );
 569     }
 570
 571     make $past;
 572 }
 573
 574 method target_list($/) {
 575     my $past := PAST::VarList.new( :node($/) );
 576     for $<target> {
 577         $past.push( $($_) );
 578     }
 579     make $past;
 580 }
 581
 582 method target($/, $key) {
 583     my $past := $( $/{$key} );
 584     $past.lvalue(1);
 585     make $past;
 586 }
 587
 588 method list_literal($/) {
 589     my $past := PAST::Op.new( :name('listmaker'), :pasttype('call'), :node($/) );
 590     for $<expression> {
 591         $past.push( $($_) );
 592     }
 593     make $past;
 594 }
 595
 596 method list_display($/, $key) {
 597     make $( $/{$key} );
 598 }
 599
 600 method dict_display($/) {
 601     if $<key_datum_list> {
 602         make $( $<key_datum_list>[0] );
 603     }
 604     else {
 605         ## if there's no list of key_datum items, have 'dictmaker' return an empty
 606         ## dictionary.
 607         make PAST::Op.new( :name('dictmaker'), :pasttype('call'), :node($/) );
 608     }
 609 }
 610
 611 method key_datum_list($/) {
 612     my $past := PAST::Op.new( :name('dictmaker'), :pasttype('call'), :node($/) );
 613     for $<key_datum> {
 614         $past.push( $( $_ ) );
 615     }
 616     make $past;
 617 }
 618
 619 method key_datum($/) {
 620     my $key   := $( $<key> );
 621     my $value := $( $<value> );
 622     ## this only works if $key /has/ a name() method
 623     ## XXX need for some generic solution for all PAST node types.
 624     my $hashedkey := PAST::Val.new( :value($key.name()) );
 625     $value.named($hashedkey);
 626     make $value;
 627 }
 628
 629 method tuple_or_scalar($/, $key) {
 630     make $( $/{$key} );
 631 }
 632
 633 method tuple_constructor($/) {
 634     my $past := PAST::Op.new( :name('tuplemaker'), :pasttype('call'), :node($/) );
 635     for $<expression> {
 636         $past.push( $($_) );
 637     }
 638     make $past;
 639 }