Mercurial > hg > Gears > GearsAgda

comparison src/parallel_execution/generate_stub.pl @ 373:03fdea4ef680

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix perl script
author Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
date Tue, 11 Jul 2017 18:18:14 +0900
parents d6ce4273e7d1
children b46f38645587
comparison
equal deleted inserted replaced
372:d6ce4273e7d1 373:03fdea4ef680
36 my %dataGearVar; 36 my %dataGearVar;
37 my %outputVar; # output var initializer 37 my %outputVar; # output var initializer
38 my %outputArgs; # continuation's output variables 38 my %outputArgs; # continuation's output variables
39 my %dataGear; 39 my %dataGear;
40 my %dataGearName; 40 my %dataGearName;
41 my %generic;
42 my %dataGearVarType;
41 my $implementation; 43 my $implementation;
42 my $interface; 44 my $interface;
45
46 # interface definision
47 #
48 # typedef struct Stack<Type, Impl>{
49 # Type* stack;
50 # Type* data;
51 # Type* data1;
52 # __code whenEmpty(...);
53 # __code clear(Impl* stack,__code next(...));
54 # __code push(Impl* stack,Type* data, __code next(...));
55 # __code pop(Impl* stack, __code next(Type*, ...));
56 # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...));
57 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
58 # __code get(Impl* stack, Type** data, __code next(...));
59 # __code get2(Impl* stack,..., __code next(...));
60 # __code next(...);
61 # } Stack;
62 #
63 # calling example
64 #
65 # goto nodeStack->push((union Data*)node, stackTest3);
66 #
67 # generated meta level code
68 #
69 # Gearef(context, Stack)->stack = nodeStack->stack;
70 # Gearef(context, Stack)->data = (union Data*)node;
71 # Gearef(context, Stack)->next = C_stackTest3;
72 # goto meta(context, nodeStack->push);
43 73
44 sub getDataGear { 74 sub getDataGear {
45 my ($filename) = @_; 75 my ($filename) = @_;
46 my ($codeGearName, $name, $inTypedef); 76 my ($codeGearName, $name, $inTypedef);
47 open my $fd,"<",$filename or die("can't open $filename $!"); 77 open my $fd,"<",$filename or die("can't open $filename $!");
48 while (<$fd>) { 78 while (<$fd>) {
49 if (! $inTypedef) { 79 if (! $inTypedef) {
50 if (/^typedef struct (\w+)/) { 80 if (/^typedef struct (\w+)\s*<(.*)>/) {
51 $inTypedef = 1; 81 $inTypedef = 1;
52 $name = $1; 82 $name = $1;
53 $dataGear{$name} = $_; 83 $dataGear{$name} = $_;
54 $var{$name} = {}; 84 $var{$name} = {};
55 $code{$name} = {}; 85 $code{$name} = {};
86 $generic{$name} = \split(/,/,$2);
87 } elsif (/^typedef struct (\w+)/) {
88 $inTypedef = 1;
89 $name = $1;
90 $dataGear{$name} = $_;
91 $var{$name} = {};
92 $code{$name} = {};
93 $generic{$name} = [];
56 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { 94 } elsif (/^(\w+)(\*)+ create(\w+)\(/) {
57 if (defined $interface) { 95 if (defined $interface) {
58 die "duplicate interface $interface\n"; 96 die "duplicate interface $interface\n";
59 } 97 }
60 $interface = $1; 98 $interface = $1;
72 my $tname = $2; 110 my $tname = $2;
73 if ($ttype =~ /^(union|struct) (\w+)/) { 111 if ($ttype =~ /^(union|struct) (\w+)/) {
74 $ttype = $2; 112 $ttype = $2;
75 } 113 }
76 $var{$name}->{$tname} = $ttype; 114 $var{$name}->{$tname} = $ttype;
77 } elsif (/\_\_code (\w+)\(/) { 115 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
78 $code{$name}->{$1} = 1; 116 my $args = $2;
117 my $method = $1;
118 $code{$name}->{$method} = [];
119 while($args) {
120 if ($args =~ s/(^\s*,\s*)//) {
121 }
122 # continuation case
123 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
124 my $next = $2;
125 my @args = split(/,/,$3);
126 push(@{$code{$name}->{$method}},$next);
127 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
128 my $structType = $1;
129 my $typeName = $2;
130 my $varName = $4;
131 my $typeField = lcfirst($typeName);
132 push(@{$code{$name}->{$method}},$varName);
133 } elsif ($args =~ s/(.*,)//) {
134 } else {
135 last;
136 }
137 }
79 } 138 }
80 if (/^}/) { 139 if (/^}/) {
81 $inTypedef = 0; 140 $inTypedef = 0;
82 } 141 }
83 } 142 }
97 for my $n ( @{$dataGearVar{$codeGearName}} ) { 156 for my $n ( @{$dataGearVar{$codeGearName}} ) {
98 # we already have it 157 # we already have it
99 return 0 if ( $n eq $varname1); 158 return 0 if ( $n eq $varname1);
100 } 159 }
101 push @{$dataGearVar{$codeGearName}}, $varname1; 160 push @{$dataGearVar{$codeGearName}}, $varname1;
161 push @{$dataGearVarType{$codeGearName}}, $typeName;
102 if ($typeName eq $implementation) { 162 if ($typeName eq $implementation) {
103 # get implementation 163 # get implementation
104 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; 164 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
105 } else { 165 } else {
106 for my $ivar (keys %{$var{$interface}}) { 166 for my $ivar (keys %{$var{$interface}}) {
251 # output data var can be use before write 311 # output data var can be use before write
252 # it should be initialze by gearef 312 # it should be initialze by gearef
253 print $fd $outputVar{$codeGearName}; 313 print $fd $outputVar{$codeGearName};
254 } 314 }
255 next; 315 next;
316 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) {
317 # handling goto statement
318 # convert it to the meta call form with two arugments, that is context and enum Code
319 my $prev = $1;
320 my $next = $2;
321 my $method = $3;
322 my @args = split(/,/,$4);
323 my @types = @{$dataGearVarType{$codeGearName}};
324 my $ntype;
325 for my $v (@{$dataGearVar{$codeGearName}}) {
326 my $t = shift @types;
327 if ($v eq $next) {
328 $ntype = $t;
329 }
330 }
331 print $fd "\tGearef(context, $ntype)->$next = $next->$next;\n";
332 # Put interface argument
333 my $prot = $code{$ntype}->{$method};
334 for my $arg (@args) {
335 my $p = shift @$prot;
336 next if ($p eq $arg);
337 print $fd "\tGearef(context, $ntype)->$p = $arg;\n";
338 }
339 print $fd "${prev}goto meta(context, $next->$next->$ntype.$method);\n";
340 next;
256 } elsif (/^(.*)goto (\w+)\((.*)\);/) { 341 } elsif (/^(.*)goto (\w+)\((.*)\);/) {
257 # handling goto statement 342 # handling goto statement
258 # convert it to the meta call form with two arugments, that is context and enum Code 343 # convert it to the meta call form with two arugments, that is context and enum Code
259 my $prev = $1; 344 my $prev = $1;
260 my $next = $2; 345 my $next = $2;