|
555
|
1 #!/usr/bin/env perl
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
557
|
5 use FindBin;
|
|
|
6 use lib "$FindBin::Bin/lib";
|
|
|
7 use Gears::Util;
|
|
555
|
8
|
|
557
|
9 use DDP { deparse => 1};
|
|
555
|
10
|
|
557
|
11 my $impl_file = shift or die 'require impl file';
|
|
559
|
12 my $impl_ir = Gears::Util->parse_impl($impl_file);
|
|
|
13 my $interface_file = Gears::Util->find_header($impl_ir->{isa},"$FindBin::Bin");
|
|
|
14
|
|
|
15
|
|
|
16 my $inter_ir = Gears::Util->parse_code_verbose($interface_file);
|
|
|
17 my $stdout = *STDOUT;
|
|
|
18 emit_constracutor($stdout,$impl_ir,$inter_ir);
|
|
|
19 #emit_include_part($stdout, "Stack");
|
|
|
20 #emit_impl_header_in_comment($stdout, $impl_file);
|
|
|
21
|
|
|
22 sub emit_include_part {
|
|
|
23 my ($out, $interface) = @_;
|
|
|
24 print $out <<"EOF"
|
|
|
25 #include "../context.h";
|
|
|
26 #interface "$interface.h";
|
|
|
27
|
|
|
28 EOF
|
|
|
29 }
|
|
|
30
|
|
|
31 sub emit_impl_header_in_comment {
|
|
|
32 my ($out, $impl_file) = @_;
|
|
|
33 my $line = Gears::Util->slup($impl_file);
|
|
|
34 print $out "// ----\n";
|
|
|
35 map { print $out "// $_\n" } split /\n/, $line;
|
|
|
36 print $out "// ----\n";
|
|
|
37 }
|
|
558
|
38
|
|
559
|
39 sub emit_constracutor {
|
|
|
40 my ($out, $impl_ir, $inter_ir) = @_;
|
|
|
41
|
|
|
42 my $instance_inter = shift @{$inter_ir->{data}};
|
|
|
43 if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) {
|
|
|
44 $instance_inter = $1;
|
|
|
45 }
|
|
|
46 my $instance_impl = lcfirst $impl_ir->{name};
|
|
|
47
|
|
|
48 print $out <<"EOF";
|
|
|
49 $impl_ir->{name}* create$impl_ir->{name}(struct Context* context) {
|
|
|
50 struct $impl_ir->{isa}* $instance_inter = new $impl_ir->{isa}();
|
|
|
51 struct $impl_ir->{name}* $instance_impl = new $impl_ir->{name}();
|
|
|
52 $instance_inter->$instance_inter = (union Data*)$instance_impl;
|
|
|
53 EOF
|
|
|
54
|
|
|
55 for my $datum (@{$impl_ir->{data}}) {
|
|
|
56 if ($datum =~ /\w+ \w+\* (\w+)/) {
|
|
|
57 print $out " ${instance_impl}->$1 = NULL;\n"
|
|
|
58 }
|
|
|
59 }
|
|
|
60
|
|
|
61 for my $code (@{$inter_ir->{codes}}) {
|
|
|
62 my $code_gear = $code->[0];
|
|
|
63 print $out " ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n"
|
|
|
64 }
|
|
|
65
|
|
|
66 print $out " return $instance_inter;\n";
|
|
|
67 print $out "}\n";
|
|
|
68 }
|
|
|
69
|
