while (stream_getline($src)) {
last if (/^\s*\}\s*;\s*/);
- if (/^\s*\.(push|kind|ctype|check)\s*=\s*(.*?)\s*;\s*$/) {
+ if (/^\s*\.(kind|ctype|dtor|ctor|push|check)\s*=\s*(.*?)\s*;\s*$/) {
$t{$1} = $2;
if ($1 eq "kind") {
- if ($2 =~ /^'([si])'$/) {
+ if ($2 =~ /^'([bis])'$/) {
$t{kind} = $1;
} else {
- fatal($src, "error: .kind should be 'i' or 's' got $2)");
+ fatal($src, "error: .kind should be [ibs] got $2)");
}
}
} elsif (!/^\s*$/) {
}
}
- for my $i ('kind', 'ctype') {
- fatal($src, "incomplete type $type: missing .$i") unless defined $t{$i};
+ for ('kind', 'ctype') {
+ fatal($src, "incomplete type $type: missing .$_") unless defined $t{$_};
+ }
+ if ($t{kind} eq 's') {
+ for ('dtor', 'ctor') {
+ fatal($src, "incomplete type $type: missing .$_") unless defined $t{$_};
+ }
}
unless (defined $t{check}) {
- if ($t{kind} eq 's') {
- $t{check} = 'luaL_checkstring($L, $$)';
+ if ($t{kind} eq 'b') {
+ $t{check} = '(luaL_checkint($L, $$) == 0)';
}
if ($t{kind} eq 'i') {
- $t{check} = 'luaL_checkint($l, $$)';
+ $t{check} = 'luaL_checkint($L, $$)';
+ }
+
+ if ($t{kind} eq 's') {
+ $t{check} = 'luaL_checkstring($L, $$)';
}
}
+ $t{ctypefmt} .= ' %s' unless (($t{ctypefmt} = $t{ctype}) =~ s/:/ \%s :/);
+ $t{ctype} =~ s/:.*//;
+
return $types{$type} = \%t;
}
}
}
- if (defined $t{type}->{push}) {
- $call =~ s/\$\$/$t{type}->{push}/;
+ die "UNIMPLEMENTED" if defined $t{type}->{push};
+
+ if ($t{type}->{kind} eq 'b') {
+ put_line($f, 0);
+ print " lua_pushboolean(L, $call);\n";
+ }
+
+ if ($t{type}->{kind} eq 'i') {
+ put_line($f, 0);
+ print " lua_pushint(L, $call);\n";
}
if ($t{type}->{kind} eq 's') {
}
}
- if ($t{type}->{kind} eq 'i') {
- put_line($f, 0);
- print " lua_pushint(L, $call);\n";
- }
-
printf " return %d;\n", ($f->{type} ne "void");
print "}\n";
}
put_line($p, 0);
print " $p->{init},\n";
} else {
+ print " 0,\n" if ($t{type}->{kind} eq 'b');
print " 0,\n" if ($t{type}->{kind} eq 'i');
print " NULL,\n" if ($t{type}->{kind} eq 's');
}
next if $t{const};
put_line($p, 0);
- print " m_strreplace(&$var, $p->{init});\n" if ($t{type}->{kind} eq 's');
- print " $var = $p->{init};\n" if ($t{type}->{kind} eq 'i');
+ if ($t{type}->{dtor}) {
+ my $dtor = $t{type}->{dtor};
+ $dtor =~ s/\$L/L/;
+ $dtor =~ s/\$\$/\&$var/;
+ print " $dtor;\n";
+ }
+ print " $var = $p->{init};\n"
}
print "};\n";
};
foreach (@{$pkg->{props}}) {
my $p = $pkg->{members}{$_};
my %t = find_type($p, $p->{type});
- print " $t{type}->{ctype} $p->{name};\n";
+ if ($t{const}) {
+ printf " const $t{type}->{ctypefmt};\n", $p->{name};
+ } else {
+ printf " $t{type}->{ctypefmt};\n", $p->{name};
+ }
}
put_line($pkg, 0);
print <<EOF;
EOF
}
+sub dump_struct_static($) {
+ my ($pkg) = @_;
+
+ print "static struct {\n";
+ foreach (@{$pkg->{props}}) {
+ my $p = $pkg->{members}{$_};
+ my %t = find_type($p, $p->{type});
+ if ($t{const}) {
+ printf " const $t{type}->{ctypefmt};\n", $p->{name};
+ } else {
+ printf " $t{type}->{ctypefmt};\n", $p->{name};
+ }
+ }
+ put_line($pkg, 0);
+ print "} $pkg->{cname} = {\n";
+
+ foreach (@{$pkg->{props}}) {
+ my $p = $pkg->{members}{$_};
+ my %t = find_type($p, $p->{type});
+
+ if ($t{const}) {
+ put_line($p, 0);
+ print " $p->{init},\n";
+ } else {
+ print " 0,\n" if ($t{type}->{kind} eq 'b');
+ print " 0,\n" if ($t{type}->{kind} eq 'i');
+ print " NULL,\n" if ($t{type}->{kind} eq 's');
+ }
+ }
+
+ print <<EOF;
+};
+
+static void $pkg->{cname}_init(void)
+{
+EOF
+
+ foreach (@{$pkg->{props}}) {
+ my $p = $pkg->{members}{$_};
+ my %t = find_type($p, $p->{type});
+ my $var = $pkg->{cname}.".".$p->{name};
+
+ next if $t{const};
+
+ put_line($p, 0);
+ if ($t{type}->{dtor}) {
+ my $dtor = $t{type}->{dtor};
+ $dtor =~ s/\$L/L/;
+ $dtor =~ s/\$\$/\&$var/;
+ print " $dtor;\n";
+ }
+ print " $var = $p->{init};\n"
+ }
+ print "};\n";
+};
+
#}}}
#{{{ dump package
-sub dump_package_full($) {
- my $pkg = shift;
+sub dump_package_full($$) {
+ my ($pkg, $static) = @_;
- dump_struct_full($pkg);
+ if ($static) {
+ dump_struct_static($pkg);
+ } else {
+ dump_struct_full($pkg);
+ }
map { print "\n"; dump_fun($pkg->{name}, $pkg->{members}{$_}); } @{$pkg->{meths}};
print <<EOF;
foreach (@{$pkg->{props}}) {
my $p = $pkg->{members}{$_};
my %t = find_type($p, $p->{type});
- my $call = $pkg->{cname}.".".$p->{name};
+ my $call = $t{type}->{push} || '$$';
+
+ $call =~ s/\$L/L/;
+ $call =~ s/\$\$/$pkg->{cname}.$p->{name}/;
my $tok = $p->{name};
$tok =~ tr/a-z/A-Z/;
- if ($t{type}->{kind} eq 's') {
- $call = "lua_pushstring(L, $call)";
+ if ($t{type}->{kind} eq 'b') {
+ $call = "lua_pushboolean(L, $call)";
}
if ($t{type}->{kind} eq 'i') {
$call = "lua_pushinteger(L, $call)";
}
- if (defined $t{type}->{push}) {
- $call =~ s/\$\$/$t{type}->{push}/;
+ if ($t{type}->{kind} eq 's') {
+ $call = "lua_pushstring(L, $call)";
}
put_line($p, 0);
put_line($p, 0);
print " case LTK_$tok: \n";
- print " m_strreplace(&$var, $check)" if ($t{type}->{kind} eq 's');
- print " $var = $check" if ($t{type}->{kind} eq 'i');
-
- print ";\n return 1;\n";
+ if ($t{type}->{dtor}) {
+ my $dtor = $t{type}->{dtor};
+ $dtor =~ s/\$L/L/;
+ $dtor =~ s/\$\$/\&$var/;
+ print " $dtor;\n";
+ }
+ if ($t{type}->{ctor}) {
+ my $ctor = $t{type}->{ctor};
+ $ctor =~ s/\$L/L/;
+ $ctor =~ s/\$\$/$check/;
+ $check = $ctor;
+ }
+ print " $var = $check;\n";
+ print " return 1;\n";
}
print <<EOF;
if (/^\s*\@type\s+([a-zA-Z]\w*)\s*=\s*{\s*$/) {
parse_type(\%src, $1);
$resync = 1;
+ } elsif (/^\s*static\s+\@package\s+([a-zA-Z]\w*)\s+{\s*$/) {
+ dump_package_full(parse_package(\%src, $1), 1);
+ $resync = 1;
} elsif (/^\s*\@package\s+([a-zA-Z]\w*)\s+{\s*$/) {
- dump_package_full(parse_package(\%src, $1));
+ dump_package_full(parse_package(\%src, $1), 0);
$resync = 1;
} elsif (/^\s*(\@\w*)/) {
fatal(\%src, "syntax error: unknown directive `$1'");
print;
}
}
- print "/* vi"."m:set ft=c: */\n";
stream_close(\%src);
}