changeset 124:53be0626c3fa

tweak trans_impl
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 03 Dec 2019 09:31:42 +0900
parents f6558602f31e
children f103beea19f4
files src/gearsTools/trans_impl.pl src/impl/FileRead.cbc
diffstat 2 files changed, 37 insertions(+), 43 deletions(-) [+]
line wrap: on
line diff
--- a/src/gearsTools/trans_impl.pl	Mon Dec 02 19:21:20 2019 +0900
+++ b/src/gearsTools/trans_impl.pl	Tue Dec 03 09:31:42 2019 +0900
@@ -6,15 +6,13 @@
 use lib "$FindBin::Bin/lib";
 use Gears::Util;
 
+use Getopt::Std;
 use File::Spec;
-use Getopt::Std;
 
 my %opt;
 getopts("w" => \%opt);
 
 my $impl_file = shift or die 'require impl file';
-
-use Data::Dumper;
 my $impl_ir         = Gears::Util->parse_with_rewrite(File::Spec->rel2abs($impl_file));
 my $interface_file  = Gears::Util->find_header($impl_ir->{isa},"$FindBin::Bin/..");
 
@@ -107,6 +105,7 @@
 sub emit_code_gears {
   my ($out, $impl_ir, $inter_ir) = @_;
   my $impl = $impl_ir->{name};
+  my $interface_name = $inter_ir->{name};
 
   my @inter_data = @{$inter_ir->{data}};
   my $instance_inter = shift @inter_data;
@@ -117,22 +116,45 @@
   $instance_impl =~ s/([A-Z])/_\l$1/g;
   my $data_gear_types = {};
 
+  if (defined $impl_ir->{codes}) {
+    for my $cg (@{$impl_ir->{codes}}) {
+      my $data_gears = $cg->{args};
+      while ($data_gears =~ /Type\*\s*(\w+),/g) {
+          $data_gears =~ s/Type\*/struct $impl*/;
+      }
+
+      while ($data_gears =~ /Isa\*\s*(\w+),/g) {
+          $data_gears =~ s/Isa\*/struct $interface_name*/;
+      }
+      print $out "__code $cg->{name}$impl(";
+      print $out "$data_gears) {\n\n";
+
+      #__code next(...), __code whenEmpty(...)
+      my @cg = ();
+      while ($data_gears =~ /__code ([\w(\.)\*\s,]+?\)),?/g) {
+        push(@cg, $1);
+      }
+
+      if (@cg) {
+        if (@cg == 2) {
+          print $out "  if (:TODO:) {\n";
+          print $out "       goto ",shift(@cg),";\n";
+          print $out "  }\n";
+          print $out "  goto ",shift(@cg),";\n";
+        } else {
+          print $out "  goto ",shift(@cg),";\n";
+        }
+      }
+      print $out "}\n\n";
+    }
+  }
+
   for my $code_ir (@{$inter_ir->{codes}}) {
     my $data_gears = $code_ir->{args};
     $data_gears =~ s/Impl/struct $impl/g;
+
     while ($data_gears =~ /Type\*\s*(\w+),/g) {
-      my $target = $1;
-      if (exists $data_gear_types->{$target}){
-        $data_gears =~ s/Type\*/$data_gear_types->{$target}/;
-      } else {
-        my $td = "";
-        map { $td = $_ if ($_ =~ /$target/) } @inter_data;
-        if ($td =~ /(\w+)\s*([\w\*]+)\s*(\w+)/) {
-          my $tmp = "$1 $2";
-          $data_gears =~ s/Type\*/$tmp/;
-          $data_gear_types->{$target} = $tmp;
-        }
-      }
+        $data_gears =~ s/Type\*/struct $interface_name*/;
     }
 
     print $out "__code $code_ir->{name}$impl(";
--- a/src/impl/FileRead.cbc	Mon Dec 02 19:21:20 2019 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-#include "../context.h";
-#interface "SysRead.h";
-
-// ----
-// typedef struct FileRead<Type, Isa> impl SysRead {
-//   struct file* f;
-// } FileRead;
-// ----
-
-SysRead* createFileRead(struct Context* cbc_context) {
-    struct SysRead* sys_read  = new SysRead();
-    struct FileRead* file_read = new FileRead();
-    sys_read->sys_read = (union Data*)file_read;
-    file_read->f = NULL;
-    sys_read->num = NULL;
-    sys_read->read = C_readFileRead;
-    sys_read->next = C_nextFileRead;
-    return sys_read;
-}
-__code readFileRead(__code next(...)) {
-
-  goto next(...);
-}
-
-__code nextFileRead(...) {
-
-}
-