[svn:parrot] r44571 - in branches/ops_pct/compilers/opsc: src/Ops src/Ops/Compiler t
bacek at svn.parrot.org
bacek at svn.parrot.org
Mon Mar 1 12:33:39 UTC 2010
Author: bacek
Date: Mon Mar 1 12:33:38 2010
New Revision: 44571
URL: https://trac.parrot.org/parrot/changeset/44571
Log:
Add normalization of op args as in ops2c
Modified:
branches/ops_pct/compilers/opsc/src/Ops/Compiler.pm
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
branches/ops_pct/compilers/opsc/t/05-opsfile.t
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler.pm Mon Mar 1 12:33:07 2010 (r44570)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler.pm Mon Mar 1 12:33:38 2010 (r44571)
@@ -6,3 +6,4 @@
Ops::Compiler.parsegrammar(Ops::Compiler::Grammar);
Ops::Compiler.parseactions(Ops::Compiler::Actions);
}
+
Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Mon Mar 1 12:33:07 2010 (r44570)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm Mon Mar 1 12:33:38 2010 (r44571)
@@ -48,7 +48,7 @@
my @args := list();
if ($<op_params>) {
- @args := $<op_params>[0].ast;
+ @args := @($<op_params>[0].ast);
}
my $past := Ops::Op.new(
@@ -58,6 +58,7 @@
:flags(%flags),
:args(@args),
+ :normalized_args(normalize_args(@args)),
$<op_body>.ast
);
@@ -65,6 +66,68 @@
make $past;
}
+# Normalize args
+# For each arg produce LoL of all available variants
+# E.g. "in" will produce "i" and "ic" variants
+#
+# type one of <i p s n>
+# direction one of <i o io>
+# is_label one of <0 1>
+
+sub normalize_args(@args) {
+ my @result;
+ for @args -> $arg {
+ my $res := PAST::Var.new(
+ :isdecl(1)
+ );
+
+ if $arg<type> eq 'LABEL' {
+ $res<type> := 'i';
+ $res<is_label> := 1;
+ }
+ else {
+ $res<is_label> := 0;
+ }
+
+ if $arg<type> eq 'INTKEY' {
+ $res<type> := 'ki';
+ }
+ else {
+ $res<type> := lc(substr($arg<type>, 0, 1));
+ }
+
+ my $use := $arg<direction>;
+
+ if $use eq 'in' {
+ $res<variant> := $res<type> ~ "c";
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'invar' {
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'inconst' {
+ $res<type> := $res<type> ~ "c";
+ $res<direction> := 'i';
+ }
+ elsif $use eq 'inout' {
+ $res<direction> := 'io';
+ }
+ else {
+ $res<direction> := 'o';
+ }
+
+ @result.push($res);
+ }
+ @result;
+}
+
+# Expand normalized arguments. Create list of all possible variants of arguments.
+sub expand_arguments(*@args) {
+ return unless + at args;
+}
+
+
+
method op_params($/) {
my $past := PAST::Stmts.new(
:node($/)
Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm Mon Mar 1 12:33:07 2010 (r44570)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm Mon Mar 1 12:33:38 2010 (r44571)
@@ -86,13 +86,14 @@
=end
-method new(:$code!, :$type!, :$name!, :@args!, :%flags!) {
+method new(:$code!, :$type!, :$name!, :@args!, :@normalized_args!, :%flags!) {
self<CODE> := $code;
self<TYPE> := $type;
self<NAME> := $name;
self<ARGS> := @args;
+ self<NORMARGS> := @normalized_args;
self<FLAGS> := %flags;
self<BODY> := '';
self<JUMP> := 0;
Modified: branches/ops_pct/compilers/opsc/t/03-past.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/03-past.t Mon Mar 1 12:33:07 2010 (r44570)
+++ branches/ops_pct/compilers/opsc/t/03-past.t Mon Mar 1 12:33:38 2010 (r44571)
@@ -64,6 +64,23 @@
ok($arg<direction> eq 'inconst', 'Third direction is correct');
ok($arg<type> eq 'NUM', 'Third type is correct');
+# Check normalization
+ at args := $op<NORMARGS>;
+$arg := @args[0];
+ok($arg<direction> eq 'o', 'First direction is correct');
+ok($arg<type> eq 'i', 'First type is correct');
+ok(!($arg<variant>), 'First arg without variant');
+
+$arg := @args[1];
+ok($arg<direction> eq 'i', 'Second direction is correct');
+ok($arg<type> eq 'p', 'Second type is correct');
+ok($arg<variant> eq 'pc', 'Second variant is correct');
+
+$arg := @args[2];
+ok($arg<direction> eq 'i', 'Third direction is correct');
+ok($arg<type> eq 'nc', 'Third type is correct');
+ok(!($arg<variant>), 'Third arg without variant');
+
# Don't forget to update plan!
Modified: branches/ops_pct/compilers/opsc/t/05-opsfile.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/05-opsfile.t Mon Mar 1 12:33:07 2010 (r44570)
+++ branches/ops_pct/compilers/opsc/t/05-opsfile.t Mon Mar 1 12:33:38 2010 (r44571)
@@ -20,4 +20,5 @@
say( "Parsed " ~ +$f<parsed_ops>);
ok( $f<parsed_ops> == 84 + 116, "Ops parsed correctly");
+
# vim: expandtab shiftwidth=4 ft=perl6:
More information about the parrot-commits
mailing list