make lua packages interfaces be *.li.

[apps/madmutt.git] / lib-lua / luapkg2c.pl

diff --git a/lib-lua/luapkg2c.pl b/lib-lua/luapkg2c.pl
index 72d84c7..f1bab32 100755 (executable)
--- a/lib-lua/luapkg2c.pl
+++ b/lib-lua/luapkg2c.pl
@@ -83,7 +83,7 @@ sub parse_type($$) {
 
     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 =~ /^'([bis])'$/) {
@@ -97,8 +97,13 @@ sub parse_type($$) {
         }
     }
 
-    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 'b') {
@@ -215,9 +220,7 @@ sub dump_fun($$) {
         }
     }
 
-    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);
@@ -286,9 +289,13 @@ EOF
         next if $t{const};
 
         put_line($p, 0);
-        print "        $var = $p->{init};\n"               if ($t{type}->{kind} eq 'b');
-        print "        $var = $p->{init};\n"               if ($t{type}->{kind} eq 'i');
-        print "        m_strreplace(&$var, $p->{init});\n" if ($t{type}->{kind} eq 's');
+        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";
 };
@@ -300,7 +307,11 @@ sub dump_struct_short($) {
     foreach (@{$pkg->{props}}) {
         my $p = $pkg->{members}{$_};
         my %t = find_type($p, $p->{type});
-        printf "    $t{type}->{ctypefmt};\n", $p->{name};
+        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;
@@ -310,14 +321,74 @@ extern struct luaM_$pkg->{name}_t $pkg->{cname};
 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;
 
@@ -338,7 +409,10 @@ 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/;
@@ -355,10 +429,6 @@ EOF
             $call = "lua_pushstring(L, $call)";
         }
 
-        if (defined $t{type}->{push}) {
-            $call =~ s/\$\$/$t{type}->{push}/;
-        }
-
         put_line($p, 0);
         print  "      case LTK_$tok:\n";
         printf "        $call;\n";
@@ -394,11 +464,20 @@ EOF
 
         put_line($p, 0);
         print  "      case LTK_$tok: \n";
-        print "        $var = $check"               if ($t{type}->{kind} eq 'b');
-        print "        $var = $check"               if ($t{type}->{kind} eq 'i');
-        print "        m_strreplace(&$var, $check)" if ($t{type}->{kind} eq 's');
-
-        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;
@@ -474,8 +553,11 @@ sub do_c($) {
         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'");