languages/lolcode/src/parser/actions.pm

   1 # Copyright (C) 2008, The Perl Foundation.
   2 # $Id$
   3
   4 =begin comments
   5
   6 lolcode::Grammar::Actions - ast transformations for lolcode
   7
   8 This file contains the methods that are used by the parse grammar
   9 to build the PAST representation of an lolcode 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 lolcode::Grammar::Actions;
  19
  20 method TOP($/) {
  21     my $block := $( $<block> );
  22     my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'), :isdecl(1));
  23     $block.unshift($it);
  24     make $block;
  25 }
  26
  27
  28 method statement ($/, $key) {
  29     if (($key eq 'expression')&&($<expression><tokens>[0]<identifier> ne 'VISIBLE')) {
  30         my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'));
  31         my $past := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
  32         $past.push( $it );
  33         $past.push( $( $<expression> ) );
  34         make $past;
  35     }
  36     else {
  37         make $( $/{$key} ); # For now
  38     }
  39 }
  40
  41
  42 method declare($/) {
  43     our $?BLOCK;
  44     our @?BLOCK;
  45
  46     my $name := ~$<variable><identifier>;
  47
  48     my $var := PAST::Var.new( :name( $name ),
  49                         :viviself('Undef'),
  50                         :node( $/ )
  51                     );
  52
  53     my $scope := 'lexical';
  54     if $<scope>[0] {
  55         if ~$<scope>[0] eq 'FARAWAY' {
  56             $scope := 'package';
  57         }
  58     }
  59
  60     $var.scope(~$scope);
  61     unless $?BLOCK.symbol($name) {
  62         $?BLOCK.symbol($name, :scope($scope));
  63         $var.isdecl(1);
  64     }
  65
  66     if ($<expression>) {
  67         $var.isdecl(1);
  68         # XXX Someone clever needs to refactor this into C<assign>
  69         my $past := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
  70         $past.push( $var );
  71         $past.push( $( $<expression>[0] ) );
  72         make $past;
  73     }
  74     else {
  75         make $var;
  76     }
  77 }
  78
  79 method assign($/) {
  80     my $past := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
  81     $past.push( $( $<variable> ) );
  82     $past.push( $( $<expression> ) );
  83     make $past;
  84 }
  85
  86 method function($/,$key) {
  87     our $?BLOCK;
  88     if $key eq 'params' {
  89         our $?BLOCK_SIGNATURE;
  90         my $arglist;
  91         $arglist := PAST::Stmts.new();
  92         # if there are any parameters, get the PAST for each of them and
  93         # adjust the scope to parameter.
  94         for $<parameters> {
  95             my $param := PAST::Var.new(:name(~$_<identifier>), :scope('parameter'), :node($($_)));
  96             $param.isdecl(1);
  97             $arglist.push($param);
  98         }
  99         $?BLOCK_SIGNATURE := $arglist;
 100     }
 101     elsif $key eq 'block' {
 102         my $block := $( $<block> );
 103         $block.blocktype('declaration');
 104         $?BLOCK.symbol(~$<variable><identifier>, :arity($block.arity()));
 105
 106
 107         my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'), :isdecl(1));
 108         $block[1].unshift($it);
 109
 110         $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'));
 111         $block[1].push($it);
 112         $block.name(~$<variable><identifier>);
 113         make $block;
 114         #my $past := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
 115         #$($<variable>).isdecl(1);
 116         #$past.push( $( $<variable> ) );
 117         #$past.push( $block );
 118         #make $past;
 119     }
 120
 121
 122
 123 }
 124
 125 method ifthen($/) {
 126     my $count := +$<expression> - 1;
 127     my $expr  := $( $<expression>[$count] );
 128     my $then  := $( $<block>[$count] );
 129     $then.blocktype('immediate');
 130     my $past := PAST::Op.new( $expr, $then,
 131                               :pasttype('if'),
 132                               :node( $/ )
 133                             );
 134     if ( $<else> ) {
 135         my $else := $( $<else>[0] );
 136         $else.blocktype('immediate');
 137         $past.push( $else );
 138     }
 139     while ($count != 0) {
 140         $count := $count - 1;
 141         $expr  := $( $<expression>[$count] );
 142         $then  := $( $<block>[$count] );
 143         $then.blocktype('immediate');
 144         $past  := PAST::Op.new( $expr, $then, $past,
 145                                :pasttype('if'),
 146                                :node( $/ )
 147                              );
 148     }
 149     $expr := $past.shift();
 150     my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'));
 151     my $bind := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
 152     $bind.push( $it );
 153     $bind.push( $expr );
 154     $past.unshift( $it );
 155     my $past := PAST::Stmts.new( $bind, $past, :node( $/ ) );
 156     make $past;
 157 }
 158
 159 method switch($/) {
 160     my $count := +$<value> - 1;
 161     my $val  := $( $<value>[$count] );
 162     my $then  := $( $<block>[$count] );
 163     my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'));
 164     my $expr := PAST::Op.new(:pasttype('call'), :name('BOTH SAEM'), $it, $val);
 165     $then.blocktype('immediate');
 166     my $past := PAST::Op.new( $expr, $then,
 167                               :pasttype('if'),
 168                               :node( $/ )
 169                             );
 170     if ( $<else> ) {
 171         my $else := $( $<else>[0] );
 172         $else.blocktype('immediate');
 173         $past.push( $else );
 174     }
 175     while ($count != 0) {
 176         $count := $count - 1;
 177         $val  := $( $<value>[$count] );
 178         $expr := PAST::Op.new(:pasttype('call'), :name('BOTH SAEM'), $it, $val);
 179         $then  := $( $<block>[$count] );
 180         $then.blocktype('immediate');
 181         $past  := PAST::Op.new( $expr, $then, $past,
 182                                :pasttype('if'),
 183                                :node( $/ )
 184                              );
 185     }
 186     #$expr := $past.shift();
 187     #my $it := PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'));
 188     #my $bind := PAST::Op.new( :pasttype('bind'), :node( $/ ) );
 189     #$bind.push( $it );
 190     #$bind.push( $expr );
 191     #$past.unshift( $it );
 192     my $past := PAST::Stmts.new( $past, :node( $/ ) );
 193     make $past;
 194 }
 195
 196 method block($/,$key) {
 197     our $?BLOCK;
 198     our @?BLOCK;
 199     if $key eq 'open' {
 200         our $?BLOCK_SIGNATURE;
 201         $?BLOCK := PAST::Block.new( PAST::Stmts.new(), :node($/) );
 202         @?BLOCK.unshift($?BLOCK);
 203         my $iter := $?BLOCK_SIGNATURE.iterator();
 204         $?BLOCK.arity(0);
 205         for $iter {
 206             $?BLOCK.arity($?BLOCK.arity() + 1);
 207             $?BLOCK[0].push($_);
 208             $?BLOCK.symbol($_.name(), :scope('lexical'));
 209         }
 210     }
 211     elsif $key eq 'close' {
 212         #my $past := PAST::Block.new( :blocktype('declaration'), :node( $/ ) );
 213         my $past := @?BLOCK.shift();
 214         $?BLOCK := @?BLOCK[0];
 215         my $stmts := PAST::Stmts.new( :node( $/ ) );
 216         for $<statement> {
 217             $stmts.push( $( $_ ) );
 218         }
 219         $past.push($stmts);
 220         make $past;
 221     }
 222 }
 223
 224 method value($/, $key) {
 225     make $( $/{$key} );
 226 }
 227
 228 method bang($/) {
 229     make PAST::Val.new( :value( ~$/ ), :returns('String'), :node($/) );
 230 }
 231
 232 method expression($/) {
 233     my $past := PAST::Op.new( :name('expr_parse'), :pasttype('call'), :node( $/ ) );
 234     for $<tokens> {
 235         my $name := ~$_<identifier>;
 236         if($_<identifier>) {
 237             my $foo := lookup($name);
 238             our $?BLOCK;
 239             our @?BLOCK;
 240             if $?BLOCK.symbol($name) && $?BLOCK.symbol($name)<scope> {
 241                 $past.push(PAST::Var.new(:name($name), :scope($?BLOCK.symbol($name)<scope>)));
 242             }
 243             else {
 244                 my $inline := '%r = find_name "' ~ $_<identifier> ~ '"';
 245                 $past.push(PAST::Op.new( :inline($inline) ));
 246             }
 247         }
 248         elsif($_ eq "MKAY"){
 249             my $inline := '%r = find_name "MKAY"';
 250             $past.push(PAST::Op.new( :inline($inline) ));
 251         }
 252         else {
 253             $past.push( $( $_ ) );
 254         }
 255     }
 256     make $past;
 257 }
 258
 259 method integer($/) {
 260     make PAST::Val.new( :value( ~$/ ), :returns('Integer'), :node($/) );
 261 }
 262
 263 method float($/) {
 264     make PAST::Val.new( :value( ~$/ ), :returns('Float'), :node($/) );
 265 }
 266
 267 method boolean($/) {
 268     if (~$/ eq 'FAIL' ) {
 269         make PAST::Val.new( :value( 0 ), :returns('Boolean'), :node($/) );
 270     }
 271     else {
 272         make PAST::Val.new( :value( 1 ), :returns('Boolean'), :node($/) );
 273     }
 274 }
 275
 276 method quote($/) {
 277     make PAST::Val.new( :value( $($<yarn_literal>) ), :node($/) );
 278 }
 279
 280
 281 method variable ($/) {
 282     if ($<identifier> eq 'IT') {
 283         make PAST::Var.new( :name( 'IT' ), :scope('lexical'), :viviself('Undef'));
 284     }
 285     else {
 286         our $?BLOCK;
 287         our @?BLOCK;
 288
 289         my $var := PAST::Var.new( :name( $<identifier> ),
 290                             :scope('lexical'),
 291                             :viviself('Undef'),
 292                             :node( $/ )
 293                         );
 294         if $?BLOCK.symbol($<identifier>) {
 295             my $scope := '' ~ $?BLOCK.symbol($<identifier>)<scope>;
 296             $var.scope(~$scope);
 297         }
 298         else {
 299             our @?BLOCK;
 300             my $exists := 0;
 301             my $scope;
 302             for @?BLOCK {
 303                 if $_ {
 304                     my $sym_table := $_.symbol(~$<identifier>);
 305                     if $sym_table {
 306                         $exists := 1;
 307                         $scope := '' ~ $sym_table<scope>;
 308                     }
 309                 }
 310             }
 311             if $exists == 0 {
 312                 $var.scope('package');
 313             }
 314             else {
 315                 $var.scope($scope);
 316             }
 317         }
 318
 319         make $var;
 320     }
 321 }
 322
 323
 324 # Local Variables:
 325 #   mode: cperl
 326 #   cperl-indent-level: 4
 327 #   fill-column: 100
 328 # End:
 329 # vim: expandtab shiftwidth=4:
 330