[svn:parrot] r44586 - in branches/ops_pct/compilers/opsc: src/Ops src/Ops/Compiler t
bacek at svn.parrot.org
bacek at svn.parrot.org
Tue Mar 2 11:11:41 UTC 2010
Author: bacek
Date: Tue Mar 2 11:11:41 2010
New Revision: 44586
URL: https://trac.parrot.org/parrot/changeset/44586
Log:
Generate all Ops variants during parsing
Modified:
branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
branches/ops_pct/compilers/opsc/src/Ops/Op.pm
branches/ops_pct/compilers/opsc/t/03-past.t
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Tue Mar 2 11:11:08 2010 (r44585)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Tue Mar 2 11:11:41 2010 (r44586)
@@ -24,7 +24,10 @@
}
for $<op> {
- $past<ops>.push($_.ast);
+ my $ops := $_.ast;
+ for @($ops) {
+ $past<ops>.push($_);
+ }
}
make $past;
@@ -55,21 +58,33 @@
# We have to clone @norm_args. Otherwise it will be destroyed...
my @variants := expand_args(pir::clone__PP(@norm_args));
- my $past := Ops::Op.new(
- :code(-1),
+ my $op := PAST::Block.new(
:name(~$<op_name>),
- :type(~$<op_type>),
-
- :flags(%flags),
- :args(@args),
- :normalized_args(@norm_args),
- :variants(@variants),
$<op_body>.ast
);
- make $past;
+ $op<flags> := %flags;
+ $op<args> := @args;
+ $op<type> := ~$<op_type>;
+ $op<normalized_args> := @norm_args;
+
+ my $past := PAST::Stmts.new(
+ :node($/)
+ );
+
+ if @variants {
+ for @variants {
+ my $new_op := pir::clone__PP($op);
+ $new_op<args_types> := $_;
+ $past.push($new_op);
+ }
+ }
+ else {
+ $past.push($op);
+ }
+ make $past;
}
# Normalize args
Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm Tue Mar 2 11:11:08 2010 (r44585)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm Tue Mar 2 11:11:41 2010 (r44586)
@@ -84,25 +84,6 @@
C<$flags> is a hash reference containing zero or more I<hints> or
I<directives>.
-=end
-
-method new(:$code!, :$type!, :$name!, :@args!, :@normalized_args!, :@variants!, :%flags!) {
-
- self<CODE> := $code;
- self<TYPE> := $type;
-
- self<NAME> := $name;
- self<ARGS> := @args;
- self<NORMARGS> := @normalized_args;
- self<VARIANTS> := @variants;
- self<FLAGS> := %flags;
- self<BODY> := '';
- self<JUMP> := 0;
-
- self;
-}
-
-=begin
=back
@@ -134,15 +115,14 @@
=end
-method code() { self<CODE> }
+method code($code?) { self.attr('code', $code, defined($code)) }
-method type() { self<TYPE> }
+method type($type?) { self.attr('type', $type, defined($type)) }
-method name() { self<NAME> }
+method name($name?) { self.attr('name', $name, defined($name)) }
-method arguments() { self<ARGS> }
+method args($args?) { self.attr('args', $args, defined($args)) }
-method variants() { self<VARIANTS> }
method full_name() {
my $name := self.name;
@@ -165,13 +145,7 @@
=end
-method flags(*@flags) {
- if (@flags) {
- self<FLAGS> := @flags;
- }
-
- return self<FLAGS>;
-}
+method flags(%flags?) { self.attr('flags', %flags, defined(%flags)) }
=begin
@@ -183,10 +157,7 @@
=end
-method body($body?) {
- self<BODY> := $body if $body;
- self<BODY>;
-}
+method body($body?) { self.attr('body', $body, defined($body)) }
=begin
Modified: branches/ops_pct/compilers/opsc/t/03-past.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/03-past.t Tue Mar 2 11:11:08 2010 (r44585)
+++ branches/ops_pct/compilers/opsc/t/03-past.t Tue Mar 2 11:11:41 2010 (r44586)
@@ -37,18 +37,19 @@
ok($preambles[0][0] ~~ /HEADER/, 'Header parsed');
my @ops := @($past<ops>);
-ok(+ at ops == 2, 'We have 2 ops');
+# One "bar" and two "foo"
+ok(+ at ops == 3, 'We have 2 ops');
-my $op := @ops[0];
+my $op := @ops[1];
ok($op.name == 'foo', "Name parsed");
-my %flags := $op.flags;
+my %flags := $op<flags>;
ok(%flags<flow>, ':flow flag parsed');
ok(%flags<deprecated>, ':deprecated flag parsed');
ok(%flags == 2, "And there are only 2 flags");
# Check op params
-my @args := $op.arguments;
+my @args := $op<args>;
ok(+ at args == 3, "Got 3 parameters");
my $arg;
@@ -66,7 +67,7 @@
ok($arg<type> eq 'NUM', 'Third type is correct');
# Check normalization
- at args := $op<NORMARGS>;
+ at args := $op<normalized_args>;
$arg := @args[0];
ok($arg<direction> eq 'o', 'First direction is correct');
ok($arg<type> eq 'i', 'First type is correct');
@@ -82,11 +83,11 @@
ok($arg<type> eq 'nc', 'Third type is correct');
ok(!($arg<variant>), 'Third arg without variant');
-my @expanded := $op.variants;
+ok( ($op<args_types>).join('_') eq 'i_p_nc', "First variant correct");
-#_dumper(@expanded);
-ok( @expanded[0].join('_') eq 'i_p_nc', "First variant correct");
-ok( @expanded[1].join('_') eq 'i_pc_nc', "Second variant correct");
+# Second created op should have _pc_
+$op := @ops[2];
+ok( $op<args_types>.join('_') eq 'i_pc_nc', "Second variant correct");
# Don't forget to update plan!
More information about the parrot-commits
mailing list