languages/cardinal/src/parser/actions.pm

   1 # Copyright (C) 2008, The Perl Foundation.
   2 # $Id$
   3
   4 =begin comments
   5
   6 cardinal::Grammar::Actions - ast transformations for cardinal
   7
   8 This file contains the methods that are used by the parse grammar
   9 to build the PAST representation of an cardinal program.
  10 Each method below corresponds to a rule in F<src/parser/grammar.pg>,
  11 and is invoked at the point where C<{*}> appears in the rule,
  12 with the current match object as the first argument.  If the
  13 line containing C<{*}> also has a C<#= key> comment, then the
  14 value of the comment is passed as the second argument to the method.
  15
  16 =end comments
  17
  18 class cardinal::Grammar::Actions;
  19
  20 method TOP($/) {
  21     my $past := $( $<comp_stmt> );
  22     $past.blocktype('declaration');
  23     $past.pirflags(':load');
  24
  25     our $?INIT;
  26         if defined( $?INIT ) {
  27         $?INIT.unshift(
  28             PAST::Var.new(
  29                 :name('$def'),
  30                 :scope('lexical'),
  31                 :isdecl(1)
  32             )
  33         );
  34         $?INIT.blocktype('declaration');
  35         $?INIT.pirflags(':init :load');
  36         $past.unshift( $?INIT );
  37         $?INIT := PAST::Block.new(); # For the next eval.
  38     }
  39
  40     make $past;
  41 }
  42
  43 method comp_stmt($/,$key) {
  44     our $?BLOCK;
  45     our @?BLOCK;
  46     our $?BLOCK_SIGNATURED;
  47     if $key eq 'open' {
  48         if $?BLOCK_SIGNATURED {
  49             $?BLOCK := $?BLOCK_SIGNATURED;
  50             $?BLOCK_SIGNATURED := 0;
  51         }
  52         else {
  53             $?BLOCK := PAST::Block.new( PAST::Stmts.new(), :node($/));
  54         }
  55         @?BLOCK.unshift($?BLOCK);
  56     }
  57     if $key eq 'close' {
  58         my $past := @?BLOCK.shift();
  59         $?BLOCK := @?BLOCK[0];
  60         $past.push( $( $<stmts> ) );
  61         make $past;
  62     }
  63 }
  64
  65 method stmts($/) {
  66     my $past := PAST::Stmts.new( :node($/) );
  67     for $<stmt> {
  68         $past.push($($_));
  69     }
  70     make $past;
  71 }
  72
  73 method basic_stmt($/, $key) {
  74     make $( $/{$key} );
  75 }
  76
  77 method stmt($/) {
  78     my $past := $( $<basic_stmt> );
  79     for $<stmt_mod> {
  80         my $modifier := $( $_ );
  81         $modifier.push($past);
  82         $past := $modifier;
  83     }
  84     make $past;
  85 }
  86
  87 method stmt_mod($/) {
  88     my $op;
  89     if $<sym> eq 'until' {
  90         ## there is no :pasttype('until'); this is called repeat_until
  91         $op := 'repeat_until';
  92     }
  93     else {
  94         ## if, while and unless are valid :pasttypes.
  95         $op := ~$<sym>;
  96     }
  97     make PAST::Op.new( $( $<expr> ), :pasttype($op), :node($/) );
  98
  99 }
 100
 101 method expr($/) {
 102     my $past := $( $<arg> );
 103     if +$<not> {
 104         $past := PAST::Op.new( $past, :pirop('n_not'), :node($/) );
 105     }
 106     if $<expr> {
 107         my $op;
 108         if ~$<op>[0] eq 'and' { $op := 'if'; }
 109         else { $op := 'unless'; }
 110         $past := PAST::Op.new( $past, $( $<expr>[0] ), :pasttype($op), :node($/) );
 111     }
 112     make $past;
 113 }
 114
 115 method return_stmt($/) {
 116     my $past := $($<call_args>);
 117     $past.pasttype('inline');
 118     $past.inline('    .return(%0)');
 119     make $past;
 120 }
 121
 122 ## not entirely sure what alias does, but this is a guess...
 123 method alias($/) {
 124     my $fname := $<fname>[0];
 125     my $alias := $<fname>[1];
 126     make PAST::Op.new( $alias, $fname, :pasttype('bind'), :node($/) );
 127 }
 128
 129 method begin($/) {
 130     my $past := $( $<comp_stmt> );
 131     my $sub := PAST::Compiler.compile( $past );
 132     $sub();
 133     ## XXX what to do here? empty block? stolen from rakudo.
 134     make PAST::Block.new( :node($/) );
 135 }
 136
 137 method end($/) {
 138     my $past := PAST::Block.new( $( $<comp_stmt> ), :node($/) );
 139     $past.blocktype('declaration');
 140     my $sub := PAST::Compiler.compile( $past );
 141     PIR q<  $P0 = get_hll_global ['cardinal'], '@?END_BLOCKS' >;
 142     PIR q<  $P1 = find_lex '$sub' >;
 143     PIR q<  push $P0, $P1 >;
 144     make $past;
 145 }
 146
 147 method indexed_assignment($/) {
 148     my $key := $( $<key> );
 149     my $rhs := $( $<rhs> );
 150     my $primary := $( $<basic_primary> );
 151
 152     my $past := PAST::Op.new( :name('[]='), :pasttype('callmethod'), :node($/) );
 153
 154     $past.push( $primary );
 155     $past.push( $key );
 156     $past.push( $rhs );
 157
 158     make $past;
 159 }
 160 method member_assignment($/) {
 161     my $rhs := $( $<rhs> );
 162     my $primary := $( $<basic_primary> );
 163
 164     my $past := PAST::Op.new( :name(~$<key><ident> ~ '='), :pasttype('callmethod'), :node($/) );
 165
 166     $past.push( $primary );
 167     $past.push( $rhs );
 168
 169     make $past;
 170 }
 171 method assignment($/) {
 172     my $lhs := $( $<mlhs> );
 173     our $?BLOCK;
 174     my $name := $lhs.name();
 175     unless $?BLOCK.symbol(~$name) {
 176         our @?BLOCK;
 177         my $exists := 0;
 178         my $scope;
 179         for @?BLOCK {
 180             if $_ {
 181                 my $sym_table := $_.symbol(~$name);
 182                 if $sym_table {
 183                     $exists := 1;
 184                     $scope := '' ~ $sym_table<scope>;
 185                 }
 186             }
 187         }
 188         our $?CLASS;
 189         if $exists == 0 && defined($?CLASS) {
 190             my $block := $?CLASS[0];
 191             my $sym_table := $block.symbol(~$name);
 192             if $sym_table {
 193                 $exists := 1;
 194                 $scope := '' ~ $sym_table<scope>;
 195             }
 196         }
 197         if $exists == 0 {
 198             $lhs.isdecl(1);
 199             $scope := 'lexical';
 200         }
 201         $?BLOCK.symbol(~$name, :scope($scope));
 202         $lhs.scope($scope);
 203     }
 204
 205     my $rhs := $( $<mrhs> );
 206     make PAST::Op.new( $lhs, $rhs, :pasttype('bind'), :lvalue(1), :node($/) );
 207 }
 208
 209 method mlhs($/, $key) {
 210     make $( $/{$key} );
 211 }
 212
 213 method lhs($/, $key) {
 214     make $( $/{$key} );
 215 }
 216
 217 method member_variable($/) {
 218     make $( $<primary> );
 219     # XXX fix field.
 220 }
 221
 222 method indexed($/) {
 223     my $args;
 224     if $<args> {
 225         $args := $( $<args>[0] );
 226     }
 227
 228     my $past := PAST::Op.new( :name('[]'), :pasttype('callmethod'), :node($/) );
 229     while $args[0] {
 230         $past.push( $args.shift() );
 231     }
 232
 233     make $past;
 234 }
 235
 236 method variable($/, $key) {
 237     my $past;
 238     if $key eq 'varname' {
 239         $past := $( $/<varname> );
 240     }
 241     elsif $key eq 'self' {
 242         $past := PAST::Op.new(:inline('%r = self'));
 243     }
 244     elsif $key eq 'nil' {
 245         $past := PAST::Var.new(:scope('package'), :name('nil'));
 246     }
 247     make $past;
 248 }
 249
 250 method varname($/, $key) {
 251     my $past := $( $/{$key} );
 252     if is_a_sub(~$/) { # unary sub
 253         $past := PAST::Op.new( :pasttype('call'), :node($/), $past );
 254     }
 255     make $past;
 256 }
 257
 258 method global($/) {
 259     my @namespace;
 260     our @?BLOCK;
 261     my $toplevel := @?BLOCK[0];
 262     $toplevel.symbol(~$/, :scope('package'), :namespace(@namespace));
 263     make PAST::Var.new( :name(~$/), :scope('package'), :namespace(@namespace), :viviself('Undef'), :node($/) );
 264 }
 265
 266 method instance_variable($/) {
 267     our $?CLASS;
 268     our $?BLOCK;
 269     my $name := ~$/;
 270     my $past := PAST::Var.new(  :name($name), :scope('attribute'), :viviself('Undef'), :node($/) );
 271     my $block := $?CLASS[0];
 272     unless $block.symbol(~$/) {
 273         $?CLASS.push(
 274             PAST::Op.new(
 275                 :pasttype('call'),
 276                 :name('!keyword_has'),
 277                 PAST::Var.new(
 278                     :name('$def'),
 279                     :scope('lexical')
 280                 ),
 281                 PAST::Val.new( :value($name) )
 282             )
 283         );
 284
 285         $block.symbol(~$name, :scope('attribute'));
 286         $?BLOCK.symbol(~$name, :scope('attribute'));
 287     }
 288     make $past;
 289 }
 290
 291 method class_variable($/) {
 292     our $?CLASS;
 293     our $?BLOCK;
 294     my $name := ~$/;
 295     my $past := PAST::Var.new(  :name($name), :scope('package'), :viviself('Undef'), :node($/) );
 296     my $block := $?CLASS[0];
 297     unless $block.symbol(~$/) {
 298         $block.symbol(~$name, :scope('package'));
 299         $?BLOCK.symbol(~$name, :scope('package'));
 300     }
 301     make $past;
 302 }
 303
 304 method local_variable($/) {
 305     our $?BLOCK;
 306     my $past := PAST::Var.new( :name(~$/), :node($/), :viviself('Undef') );
 307     if $?BLOCK.symbol($<ident>) {
 308         my $scope := '' ~ $?BLOCK.symbol($<ident>)<scope>;
 309         $past.scope(~$scope);
 310     }
 311     else {
 312         our @?BLOCK;
 313         my $exists := 0;
 314         my $scope;
 315         for @?BLOCK {
 316             if $_ {
 317                 my $sym_table := $_.symbol(~$<ident>);
 318                 if $sym_table {
 319                     $exists := 1;
 320                     $scope := '' ~ $sym_table<scope>;
 321                 }
 322             }
 323         }
 324         if $exists == 0 {
 325             $past.scope('package');
 326             my @a;
 327             $past.namespace(@a);
 328         }
 329         else {
 330             $past.scope($scope);
 331         }
 332     }
 333     make $past;
 334 }
 335
 336 method funcall($/) {
 337     my $past := $( $<local_variable> );
 338     make $past;
 339 }
 340
 341 method constant_variable($/) {
 342     my @a;
 343     my $name := ~$/;
 344     if $name eq 'Array' { $name := "CardinalArray"; }
 345     elsif $name eq 'Hash' { $name := "CardinalHash"; }
 346     elsif $name eq 'String' { $name := "CardinalString"; }
 347     my $past := PAST::Var.new( :name($name), :scope('package'), :node($/), :viviself('Undef'), :namespace( @a ) );
 348     make $past;
 349 }
 350
 351
 352 method if_stmt($/) {
 353     my $cond := +$<expr> - 1;
 354     my $comp := $( $<comp_stmt>[$cond] );
 355     $comp.blocktype('immediate');
 356     my $past := PAST::Op.new( $( $<expr>[$cond] ),
 357                               $comp,
 358                               :pasttype('if'),
 359                               :node( $/ )
 360                             );
 361     if ( $<else> ) {
 362         my $else := $( $<else>[0] ) ;
 363         $else.blocktype('immediate');
 364         $past.push( $else );
 365     }
 366     while ($cond != 0) {
 367         $cond := $cond - 1;
 368         $comp := $( $<comp_stmt>[$cond] );
 369         $comp.blocktype('immediate');
 370         $past := PAST::Op.new( $( $<expr>[$cond] ),
 371                                $comp,
 372                                $past,
 373                                :pasttype('if'),
 374                                :node( $/ )
 375                              );
 376     }
 377     make $past;
 378 }
 379
 380 method unless_stmt($/) {
 381     my $cond := $( $<expr> );
 382     my $body := $( $<comp_stmt> );
 383     $body.blocktype('immediate');
 384     my $past := PAST::Op.new( $cond, $body, :pasttype('unless'), :node($/) );
 385     if $<else> {
 386         $past.push( $( $<else>[0] ) );
 387     }
 388     make $past;
 389 }
 390
 391 method else($/) {
 392     make $( $<comp_stmt> );
 393 }
 394
 395 method ensure($/) {
 396     make $( $<comp_stmt> );
 397 }
 398
 399 method while_stmt($/) {
 400     my $cond := $( $<expr> );
 401     my $body := $( $<comp_stmt> );
 402     $body.blocktype('immediate');
 403     make PAST::Op.new( $cond, $body, :pasttype(~$<sym>), :node($/) );
 404 }
 405
 406 method for_stmt($/) {
 407     my $list := $( $<expr> );
 408     my $body := $( $<comp_stmt> );
 409     my $var := $( $<variable> );
 410     $body.blocktype('declaration');
 411     $var.scope('parameter');
 412     $var.isdecl(0);
 413     $body[0].push($var);
 414     make PAST::Op.new( $list, $body, :pasttype('for'), :node($/) );
 415 }
 416
 417 method control_command($/,$key) {
 418     $/.panic("next, break, and redo aren't implemented yet");
 419 }
 420
 421 method module($/) {
 422     my $past := $( $<comp_stmt> );
 423     my $name := $( $<module_identifier> );
 424     $past.namespace( $name.name() );
 425     $past.blocktype('declaration');
 426     make $past;
 427 }
 428
 429 method begin_end($/) {
 430     my $past := $( $<comp_stmt> );
 431     # XXX handle resque and ensure clauses
 432     make $past;
 433 }
 434
 435 method classdef($/,$key) {
 436     our $?CLASS;
 437     our @?CLASS;
 438     our $?INIT;
 439
 440     my $name := ~$<module_identifier><ident>;
 441     if $key eq 'open' {
 442         my $decl := PAST::Stmts.new();
 443         $decl.push(
 444             PAST::Op.new(
 445                 :pasttype('bind'),
 446                 PAST::Var.new(
 447                     :name('$def'),
 448                     :scope('lexical')
 449                 ),
 450                 PAST::Op.new(
 451                     :pasttype('call'),
 452                     :name('!keyword_class'),
 453                     PAST::Val.new( :value($name) )
 454                 )
 455             )
 456         );
 457         @?CLASS.unshift( $?CLASS );
 458         $?CLASS := $decl;
 459         $?CLASS.unshift( PAST::Block.new() );
 460     }
 461     else {
 462         my $block := $( $<comp_stmt> );
 463         $block.namespace($name);
 464         $block.blocktype('declaration');
 465         $block.pirflags(':init :load');
 466
 467         $?CLASS.push(
 468             PAST::Op.new(
 469                 :pasttype('callmethod'),
 470                 :name('register'),
 471                 PAST::Var.new(
 472                     :scope('package'),
 473                     :name('!CARDINALMETA'),
 474                     :namespace('CardinalObject')
 475                 ),
 476                 PAST::Var.new(
 477                     :scope('lexical'),
 478                     :name('$def')
 479                 ),
 480                 PAST::Val.new(
 481                     :value('CardinalObject'),
 482                     :named( PAST::Val.new( :value('parent') ) )
 483                 )
 484             )
 485         );
 486
 487         unless defined( $?INIT ) {
 488             $?INIT := PAST::Block.new();
 489         }
 490         for @( $?CLASS ) {
 491             if $_.WHAT() eq 'Block' {
 492                 $block.push( $_ );
 493             }
 494             else {
 495                 $?INIT.push( $_ );
 496             }
 497         }
 498
 499         # Restore outer class.
 500         if +@?CLASS {
 501             $?CLASS := @?CLASS.shift();
 502         }
 503         else {
 504             $?CLASS := @?CLASS[0];
 505         }
 506
 507
 508         make $block;
 509     }
 510 }
 511
 512 method functiondef($/) {
 513     my $past := $( $<comp_stmt> );
 514     my $name := $<fname>;
 515     my $arity := +$past[0]<arity>;
 516     #my $args := $( $<argdecl> );
 517     #$past.push($args);
 518     $past.name(~$name);
 519     our $?BLOCK;
 520     our $?CLASS;
 521     $?BLOCK.symbol(~$name, :scope('package'), :arity($arity));
 522     if defined($?CLASS) {
 523         $past.pirflags(':method');
 524     }
 525     make $past;
 526 }
 527
 528 method sig_identifier($/) {
 529     my $past := $($<identifier>);
 530     if +$<default> == 1 {
 531         $past.viviself( $( $<default>[0] ) );
 532     }
 533     make $past;
 534 }
 535
 536 method block_signature($/) {
 537     my $params := PAST::Stmts.new( :node($/) );
 538     my $past := PAST::Block.new($params, :blocktype('declaration'));
 539     for $<sig_identifier> {
 540         my $parameter := $( $_ );
 541         $past.symbol($parameter.name(), :scope('lexical'));
 542         $parameter.scope('parameter');
 543         $params.push($parameter);
 544     }
 545     if $<slurpy_param> {
 546         my $slurp := $( $<slurpy_param>[0] || $<slurpy_param> );
 547         $past.symbol($slurp.name(), :scope('lexical'));
 548         $params.push( $slurp );
 549     }
 550
 551     if $<block_param> {
 552         my $block := $( $<block_param>[0] );
 553         $past.symbol($block.name(), :scope('lexical'));
 554         $params.push($block);
 555     }
 556     $params.arity( +$<sig_identifier> + +$<block_param> );
 557     our $?BLOCK_SIGNATURED := $past;
 558     make $past;
 559 }
 560
 561 method slurpy_param($/) {
 562     my $past := $( $<identifier> );
 563     $past.slurpy(1);
 564     $past.scope('parameter');
 565     make $past;
 566 }
 567
 568 method block_param($/) {
 569     my $past := $( $<identifier> );
 570     $past.scope('parameter');
 571     make $past;
 572 }
 573
 574 method identifier($/) {
 575     make PAST::Var.new( :name(~$<ident>), :node($/) );
 576 }
 577
 578 method module_identifier($/) {
 579     make PAST::Var.new( :name(~$/), :scope('package'), :node($/) );
 580 }
 581
 582 method mrhs($/) {
 583     make $( $<args> );
 584 }
 585
 586 method methodcall($/) {
 587     my $op := $<operation>;
 588     my $past;
 589     if $<call_args> {
 590         $past := $( $<call_args>[0] );
 591     }
 592     else {
 593         $past := PAST::Op.new();
 594     }
 595
 596     $past.pasttype('callmethod');
 597
 598     if $<do_block> {
 599         $past.push( $( $<do_block>[0] ) );
 600     }
 601
 602     $past.name(~$op);
 603     make $past;
 604 }
 605
 606 method do_block($/) {
 607     my $past := $( $<comp_stmt> );
 608     make $past;
 609 }
 610
 611 method super_call($/) {
 612     my $past := $( $<call_args> );
 613     ## how to invoke super.xxx ?
 614     make $past;
 615 }
 616
 617 method operation($/) {
 618     make $( $<identifier> );
 619 }
 620
 621 method call_args($/) {
 622     my $past;
 623     if $<args> {
 624         $past := $( $<args> );
 625     }
 626     else {
 627         $past := PAST::Op.new( :pasttype('call'), :node($/) );
 628     }
 629     if $<do_block> {
 630         $past.push( $( $<do_block>[0] ) );
 631     }
 632     make $past;
 633 }
 634
 635 method args($/) {
 636     my $past := PAST::Op.new( :pasttype('call'), :node($/) );
 637     for $<arg> {
 638         $past.push( $($_) );
 639     }
 640     make $past;
 641 }
 642
 643 method basic_primary($/, $key) {
 644     make $( $/{$key} );
 645 }
 646
 647 method primary($/) {
 648     my $past := $( $<basic_primary> );
 649
 650     # XXX check this out:
 651     for $<post_primary_expr> {
 652         my $postexpr := $( $_ );
 653         $postexpr.unshift($past);
 654         $past := $postexpr;
 655     }
 656     make $past;
 657 }
 658
 659 method post_primary_expr($/, $key) {
 660     make $( $/{$key} );
 661 }
 662
 663 method scope_identifier($/) {
 664     make $( $<identifier> );
 665     # XXX handle :: operator.
 666 }
 667
 668 method literal($/, $key) {
 669     my $past := $( $/{$key} );
 670     make $past;
 671 }
 672
 673 method pcomp_stmt($/) {
 674     make $( $<comp_stmt> );
 675 }
 676
 677 method quote_string($/) {
 678     make $( $<quote_expression> );
 679 }
 680
 681 method warray($/) {
 682     make $( $<quote_expression> );
 683 }
 684
 685 method array($/) {
 686     my $list;
 687     if $<args> {
 688         $list := $( $<args>[0] );
 689         $list.name('list');
 690     }
 691     else {
 692         $list := PAST::Op.new( :name('list'), :node($/) );
 693     }
 694
 695     make $list;
 696 }
 697
 698 method ahash($/) {
 699     my $hash := PAST::Op.new( :name('hash'), :node($/) );
 700     if $<assocs> {
 701         my $items := $( $<assocs>[0] );
 702         for @($items) {
 703             $hash.push( $_ );
 704         }
 705     }
 706     make $hash;
 707 }
 708
 709 method assocs($/) {
 710     my $assoc := PAST::Stmts.new(:node($/));
 711     for $<assoc> {
 712         my $item := $( $_ );
 713         $assoc.push($item);
 714     }
 715     make $assoc;
 716 }
 717
 718 method assoc($/) {
 719     my $past := PAST::Op.new(:name('list'), :node($/));
 720     $past.push( $( $<arg>[0] ) );
 721     $past.push( $( $<arg>[1] ) );
 722     make $past;
 723 }
 724
 725 method float($/) {
 726     make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
 727 }
 728
 729 method integer($/) {
 730     make PAST::Val.new( :value( ~$/ ), :returns('CardinalInteger'), :node($/) );
 731 }
 732
 733 method string($/) {
 734     make PAST::Val.new( :value( ~$<string_literal> ), :returns('CardinalString'), :node($/) );
 735 }
 736
 737 method regex($/) {
 738     make $($<quote_expression>);
 739 }
 740
 741 method quote_expression($/, $key) {
 742     my $past;
 743     if $key eq 'quote_regex' {
 744         our $?NS;
 745         $past := PAST::Block.new(
 746             $<quote_regex>,
 747             :compiler('PGE::Perl6Regex'),
 748             :namespace($?NS),
 749             :blocktype('declaration'),
 750             :node( $/ )
 751         );
 752     }
 753     elsif $key eq 'quote_concat' {
 754         if +$<quote_concat> == 1 {
 755             $past := $( $<quote_concat>[0] );
 756         }
 757         else {
 758             $past := PAST::Op.new(
 759                 :name('list'),
 760                 :pasttype('call'),
 761                 :node( $/ )
 762             );
 763             for $<quote_concat> {
 764                 $past.push( $($_) );
 765             }
 766         }
 767     }
 768     make $past;
 769 }
 770
 771
 772 method quote_concat($/) {
 773     my $terms := +$<quote_term>;
 774     my $count := 1;
 775     my $past := $( $<quote_term>[0] );
 776     while ($count != $terms) {
 777         $past := PAST::Op.new(
 778             $past,
 779             $( $<quote_term>[$count] ),
 780             :pirop('n_concat'),
 781             :pasttype('pirop')
 782         );
 783         $count := $count + 1;
 784     }
 785     make $past;
 786 }
 787
 788
 789 method quote_term($/, $key) {
 790     my $past;
 791     if ($key eq 'literal') {
 792         $past := PAST::Val.new(
 793             :value( ~$<quote_literal> ),
 794             :returns('CardinalString'), :node($/)
 795         );
 796     }
 797     elsif ($key eq 'variable') {
 798         $past := $( $<variable> );
 799     }
 800     elsif ($key eq 'circumfix') {
 801         $past := $( $<circumfix> );
 802         if $past.WHAT() eq 'Block' {
 803             $past.blocktype('immediate');
 804         }
 805     }
 806     make $past;
 807 }
 808
 809 method arg($/, $key) {
 810     ## Handle the operator table
 811     ##
 812     if ($key eq 'end') {
 813         make $($<expr>);
 814     }
 815     else {
 816         my $past := PAST::Op.new( :name($<type>),
 817                                   :pasttype($<top><pasttype>),
 818                                   :pirop($<top><pirop>),
 819                                   :lvalue($<top><lvalue>),
 820                                   :node($/)
 821                                 );
 822         for @($/) {
 823             $past.push( $($_) );
 824         }
 825         make $past;
 826     }
 827 }
 828
 829 sub is_a_sub($name) {
 830     our $?BLOCK;
 831     our @?BLOCK;
 832     if $?BLOCK.symbol(~$name) {
 833         if defined($?BLOCK.symbol(~$name)<arity>) {
 834             return(1);
 835         }
 836         else {
 837             return(0);
 838         }
 839     }
 840     for @?BLOCK {
 841         if $_ {
 842             my $sym_table := $_.symbol(~$name);
 843             if $sym_table {
 844                 if defined($sym_table<arity>) {
 845                     return(1);
 846                 }
 847                 else {
 848                     return(0);
 849                 }
 850             }
 851         }
 852     }
 853     my $lex := lex_lookup($name);
 854     if $lex && ~lookup_class($lex) eq 'Sub' { return(1); }
 855     return(0);
 856 }
 857
 858 # Local Variables:
 859 #   mode: cperl
 860 #   cperl-indent-level: 4
 861 #   fill-column: 100
 862 # End:
 863 # vim: expandtab shiftwidth=4:
 864