languages/squaak/src/parser/actions.pm

   1 # Copyright (C) 2008, The Perl Foundation.
   2 # $Id$
   3
   4
   5 =begin comments
   6
   7 Squaak::Grammar::Actions - ast transformations for Squaak
   8
   9 This file contains the methods that are used by the parse grammar
  10 to build the PAST representation of an Squaak program.
  11 Each method below corresponds to a rule in F<src/parser/grammar.pg>,
  12 and is invoked at the point where C<{*}> appears in the rule,
  13 with the current match object as the first argument.  If the
  14 line containing C<{*}> also has a C<#= key> comment, then the
  15 value of the comment is passed as the second argument to the method.
  16
  17 =end comments
  18
  19 class Squaak::Grammar::Actions;
  20
  21 method TOP($/, $key) {
  22     our @?BLOCK;
  23     our $?BLOCK;
  24
  25     if $key eq 'open' {
  26         ## create the top-level block here; any top-level variable
  27         ## declarations are entered into this block's symbol table.
  28         ## Note that TOP *must* deliver a PAST::Block with blocktype
  29         ## "declaration".
  30         $?BLOCK := PAST::Block.new( :blocktype('declaration'), :node($/) );
  31         $?BLOCK.symbol_defaults( :scope('package') );
  32         @?BLOCK.unshift($?BLOCK);
  33     }
  34     else {
  35         ## retrieve the block created in the "if" section in this method.
  36         my $past := @?BLOCK.shift();
  37
  38         for $<stat_or_def> {
  39             $past.push($($_));
  40         }
  41         make $past;
  42     }
  43 }
  44
  45 method stat_or_def($/, $key) {
  46     make $( $/{$key} );
  47 }
  48
  49 method statement($/, $key) {
  50     make $( $/{$key} );
  51 }
  52
  53 method if_statement($/) {
  54     my $cond := $( $<expression> );
  55     my $then := $( $<block> );
  56     my $past := PAST::Op.new( $cond, $then, :pasttype('if'), :node($/) );
  57
  58     ## if there's an else clause, add it to the PAST node.
  59     if $<else> {
  60         $past.push( $( $<else>[0] ) );
  61     }
  62     make $past;
  63 }
  64
  65 method while_statement($/) {
  66     my $cond := $( $<expression> );
  67     my $body := $( $<block> );
  68     make PAST::Op.new( $cond, $body, :pasttype('while'), :node($/) );
  69 }
  70
  71 ## for var <ident> = <expr1> , <expr2> do <block> end
  72 ##
  73 ## translates to:
  74 ## do
  75 ##   var <ident> = <expr1>
  76 ##   while <ident> <= <expr2> do
  77 ##     <block>
  78 ##     <ident> = <ident> + 1
  79 ##   end
  80 ## end
  81 ##
  82 method for_statement($/) {
  83     our $?BLOCK;
  84     our @?BLOCK;
  85
  86     my $init := $( $<for_init> );
  87
  88     ## cache the name of the loop variable
  89     my $itername := $init.name();
  90
  91     ## create another PAST::Var node for the loop variable, this one is used
  92     ## for the loop condition; the node in $init has a isdecl(1) flag and a
  93     ## viviself object; $init represents the declaration of the loop var,
  94     ## $iter represents the loop variable in normal usage.
  95     my $iter := PAST::Var.new( :name($itername), :scope('lexical'), :node($/) );
  96
  97     ## the body of the loop consists of the statements written by the user and
  98     ## the increment instruction of the loop iterator.
  99
 100     my $body := @?BLOCK.shift();
 101     $?BLOCK  := @?BLOCK[0];
 102     for $<statement> {
 103         $body.push($($_));
 104     }
 105
 106     ## if a step was specified, use that; otherwise, use the default of +1.
 107     ## Note that a negative step will NOT work (unless YOU fix that :-) ).
 108     ##
 109     my $step;
 110     if $<step> {
 111         my $stepsize := $( $<step>[0] );
 112         $step := PAST::Op.new( $iter, $stepsize, :pirop('add'), :node($/) );
 113     }
 114     else { ## default is increment by 1
 115         $step := PAST::Op.new( $iter, :pirop('inc'), :node($/) );
 116     }
 117     $body.push($step);
 118
 119     ## while loop iterator <= end-expression
 120     my $cond := PAST::Op.new( $iter, $( $<expression> ), :name('infix:<=') );
 121     my $loop := PAST::Op.new( $cond, $body, :pasttype('while'), :node($/) );
 122
 123     make PAST::Stmts.new( $init, $loop, :node($/) );
 124 }
 125
 126 method for_init($/) {
 127     our $?BLOCK;
 128     our @?BLOCK;
 129
 130     ## create a new scope here, so that we can add the loop variable
 131     ## to this block here, which is convenient.
 132     $?BLOCK := PAST::Block.new( :blocktype('immediate'), :node($/) );
 133     @?BLOCK.unshift($?BLOCK);
 134
 135     my $iter := $( $<identifier> );
 136     ## set a flag that this identifier is being declared
 137     $iter.isdecl(1);
 138     $iter.scope('lexical');
 139     ## the identifier is initialized with this expression
 140     $iter.viviself( $( $<expression> ) );
 141
 142     ## enter the loop variable as a local into the symbol table.
 143     $?BLOCK.symbol($iter.name(), :scope('lexical'));
 144
 145     make $iter;
 146 }
 147
 148 method try_statement($/) {
 149     ## get the try block
 150     my $try := $( $<try> );
 151
 152     ## create a new PAST::Stmts node for the catch block;
 153     ## note that no PAST::Block is created, as this currently
 154     ## has problems with the exception object. For now this will do.
 155     my $catch := PAST::Stmts.new( :node($/) );
 156     $catch.push( $( $<catch> ) );
 157
 158     ## get the exception identifier;
 159     my $exc := $( $<exception> );
 160     $exc.isdecl( PAST::Val.new( :value(1) ) );
 161     $exc.scope('lexical');
 162     $exc.viviself( PAST::Val.new( :value(0) ) );
 163
 164     ## generate instruction to retrieve the exception objct (and the exception message,
 165     ## that is passed automatically in PIR, this is stored into $S0 (but not used).
 166     my $pir := "    .get_results (%r, $S0)\n"
 167              ~ "    store_lex '" ~ $exc.name() ~ "', %r";
 168
 169     $catch.unshift( PAST::Op.new( :inline($pir), :node($/) ) );
 170     ## do the declaration of the exception object as a lexical here:
 171     $catch.unshift( $exc );
 172
 173     make PAST::Op.new( $try, $catch, :pasttype('try'), :node($/) );
 174 }
 175
 176 method exception($/) {
 177     our $?BLOCK;
 178
 179     my $exc := $( $<identifier> );
 180     ## the exception identifier is local to the exception handler
 181     $?BLOCK.symbol($exc.name(), :scope('lexical'));
 182     make $exc;
 183 }
 184
 185 method throw_statement($/) {
 186     make PAST::Op.new( $( $<expression> ), :pirop('throw'), :node($/) );
 187 }
 188
 189 method block($/, $key) {
 190     our $?BLOCK; ## the current block
 191     our @?BLOCK; ## the scope stack
 192
 193     if $key eq 'open' {
 194         $?BLOCK := PAST::Block.new( :blocktype('immediate'), :node($/) );
 195         @?BLOCK.unshift($?BLOCK);
 196     }
 197     else {
 198         ## retrieve the current block, remove it from the scope stack
 199         ## and restore the "current" block.
 200         my $past := @?BLOCK.shift();
 201         $?BLOCK  := @?BLOCK[0];
 202
 203         for $<statement> {
 204             $past.push($($_));
 205         }
 206         make $past
 207     }
 208 }
 209
 210 method return_statement($/) {
 211     my $expr := $( $<expression> );
 212     make PAST::Op.new( $expr, :pasttype('return'), :node($/) );
 213 }
 214
 215 method do_block($/) {
 216     make $( $<block> );
 217 }
 218
 219 method assignment($/) {
 220     my $rhs := $( $<expression> );
 221     my $lhs := $( $<primary> );
 222     $lhs.lvalue(1);
 223     make PAST::Op.new( $lhs, $rhs, :pasttype('bind'), :node($/) );
 224 }
 225
 226 method sub_definition($/) {
 227     our @?BLOCK;
 228     our $?BLOCK;
 229
 230     ## note that $<parameters> creates a new PAST::Block.
 231     my $past := $( $<parameters> );
 232     my $name := $( $<identifier> );
 233
 234     ## set the function name
 235     $past.name( $name.name() );
 236     for $<statement> {
 237         $past.push($($_));
 238     }
 239
 240     ## remove the block from the scope stack
 241     ## and restore the "current" block
 242     @?BLOCK.shift();
 243     $?BLOCK := @?BLOCK[0];
 244
 245     $past.control('return_pir');
 246     make $past;
 247 }
 248
 249 method variable_declaration($/) {
 250     our $?BLOCK;
 251
 252     my $past := $( $<identifier> );
 253     $past.isdecl(1);
 254     $past.scope('lexical');
 255
 256     ## if there's an initialization value, use it to viviself the variable.
 257     if $<expression> {
 258         $past.viviself( $( $<expression>[0] ) );
 259     }
 260     else { ## otherwise initialize to undef.
 261         $past.viviself( 'Undef' );
 262     }
 263
 264     ## cache this identifier's name
 265     my $name := $past.name();
 266
 267     ## if the symbol is already declared, emit an error. Otherwise,
 268     ## enter it into the current block's symbol table.
 269     if $?BLOCK.symbol($name) {
 270         $/.panic("Error: symbol " ~ $name ~ " was already defined\n");
 271     }
 272     else {
 273         $?BLOCK.symbol($name, :scope('lexical'));
 274     }
 275     make $past;
 276 }
 277
 278 method parameters($/) {
 279     our $?BLOCK;
 280     our @?BLOCK;
 281
 282     my $past := PAST::Block.new( :blocktype('declaration'), :node($/) );
 283     for $<identifier> {
 284         my $param := $( $_ );
 285         $param.scope('parameter');
 286         $past.push($param);
 287
 288         ## enter the parameter as a lexical into the block's symbol table
 289         $past.symbol($param.name(), :scope('lexical'));
 290     }
 291
 292     ## set this block as the current block, and store it on the scope stack
 293     $?BLOCK := $past;
 294     @?BLOCK.unshift($past);
 295
 296     make $past;
 297 }
 298
 299 method sub_call($/) {
 300     my $invocant := $( $<primary> );
 301     my $past     := $( $<arguments> );
 302     ## set the invocant as the first child of the PAST::Op(:pasttype('call')) node
 303     $past.unshift( $invocant );
 304     make $past;
 305 }
 306
 307 method arguments($/) {
 308     my $past := PAST::Op.new( :pasttype('call'), :node($/) );
 309     for $<expression> {
 310         $past.push($($_));
 311     }
 312     make $past;
 313 }
 314
 315 method primary($/) {
 316     my $past := $( $<identifier> );
 317     for $<postfix_expression> {
 318         my $expr := $( $_ );
 319         ## set the current $past as the first child of $expr;
 320         ## $expr is either a key or an index; both are "keyed"
 321         ## variable access, where the first child is assumed
 322         ## to be the aggregate.
 323         $expr.unshift($past);
 324         $past := $expr;
 325     }
 326     make $past;
 327 }
 328
 329 method postfix_expression($/, $key) {
 330     make $( $/{$key} );
 331 }
 332
 333 method key($/) {
 334     my $key := $( $<expression> );
 335
 336     make PAST::Var.new( $key, :scope('keyed'),
 337                               :vivibase('Hash'),
 338                               :viviself('Undef'),
 339                               :node($/) );
 340
 341 }
 342
 343 method member($/) {
 344     my $member := $( $<identifier> );
 345     ## x.y is syntactic sugar for x{"y"}, so stringify the identifier:
 346     my $key    := PAST::Val.new( :returns('String'), :value($member.name()), :node($/) );
 347
 348     ## the rest of this method is the same as method key() above.
 349     make PAST::Var.new( $key, :scope('keyed'),
 350                               :vivibase('Hash'),
 351                               :viviself('Undef'),
 352                               :node($/) );
 353 }
 354
 355 method index($/) {
 356     my $index := $( $<expression> );
 357
 358     make PAST::Var.new( $index, :scope('keyed'),
 359                                 :vivibase('ResizablePMCArray'),
 360                                 :viviself('Undef'),
 361                                 :node($/) );
 362 }
 363
 364 method named_field($/) {
 365     my $past := $( $<expression> );
 366     my $name := $( $<string_constant> );
 367     ## the passed expression is in fact a named argument,
 368     ## use the named() accessor to set that name.
 369     $past.named($name);
 370     make $past;
 371 }
 372
 373 method array_constructor($/) {
 374     ## use the parrot calling conventions to
 375     ## create an array,
 376     ## using the "anonymous" sub !array
 377     ## (which is not a valid Squaak name)
 378     my $past := PAST::Op.new( :name('!array'), :pasttype('call'), :node($/) );
 379     for $<expression> {
 380         $past.push($($_));
 381     }
 382     make $past;
 383 }
 384
 385 method hash_constructor($/) {
 386     ## use the parrot calling conventions to
 387     ## create a hash, using the "anonymous" sub
 388     ## !hash (which is not a valid Squaak name)
 389     my $past := PAST::Op.new( :name('!hash'), :pasttype('call'), :node($/) );
 390     for $<named_field> {
 391         $past.push($($_));
 392     }
 393     make $past;
 394 }
 395
 396 method term($/, $key) {
 397     make $( $/{$key} );
 398 }
 399
 400 method identifier($/) {
 401     my $name  := ~$/;
 402     ## instead of ~$/, you can also write ~$<ident>, as an identifier
 403     ## uses the built-in <ident> rule to match identifiers.
 404     make PAST::Var.new( :name($name), :viviself('Undef'), :node($/) );
 405 }
 406
 407 method integer_constant($/) {
 408     make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
 409 }
 410
 411 method float_constant($/) {
 412     make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
 413 }
 414
 415 method string_constant($/) {
 416     make PAST::Val.new( :value( $($<string_literal>) ), :returns('String'), :node($/) );
 417 }
 418
 419 ## Handle the operator precedence table.
 420 method expression($/, $key) {
 421     if ($key eq 'end') {
 422         make $($<expr>);
 423     }
 424     else {
 425         my $past := PAST::Op.new( :name($<type>),
 426                                   :pasttype($<top><pasttype>),
 427                                   :pirop($<top><pirop>),
 428                                   :lvalue($<top><lvalue>),
 429                                   :node($/)
 430                                 );
 431         for @($/) {
 432             $past.push( $($_) );
 433         }
 434         make $past;
 435     }
 436 }
 437
 438
 439
 440 # Local Variables:
 441 #   mode: cperl
 442 #   cperl-indent-level: 4
 443 #   fill-column: 100
 444 # End:
 445 # vim: expandtab shiftwidth=4:
 446