let's add a super keyword

diff --git a/qcsrc/menu/auto-super.pl b/qcsrc/menu/auto-super.pl
new file mode 100644 (file)
index 0000000..1685f53
--- /dev/null
+++ b/qcsrc/menu/auto-super.pl
@@ -0,0 +1,94 @@
+my %classoffile = ();
+my %classes = ();
+my %baseclass = ();
+my %methods = ();
+my %attrs = ();
+my %methodnames = ();
+
+print STDERR "Scanning...\n";
+for my $f(@ARGV)
+{
+       open my $fh, '<', $f;
+       while(<$fh>)
+       {
+               if(/^CLASS\(([^)]*)\)(?:\s*EXTENDS\(([^)]*)\))?/)
+               {
+                       $classes{$1} = defined($2) ? $2 : "Object";
+                       $classoffile{$f} = $1;
+               }
+               if(/^\s*METHOD\(([^),]*),\s*([^),]*)/)
+               {
+                       $methods{$1}{$2} = $1;
+                       $methodnames{"$2$1"} = $f;
+               }
+               if(/^\s*ATTRIB(?:ARRAY)?\(([^),]*),\s*([^),]*)/)
+               {
+                       $attrs{$1}{$2} = $1;
+               }
+       }
+       close $fh;
+}
+
+# propagate down methods etc.
+print STDERR "Propagating...\n";
+for my $class(keys %classes)
+{
+       print STDERR "$class";
+       my $base = $class;
+       for(;;)
+       {
+               $base = $classes{$base};
+               last if not defined $base;
+               print STDERR " -> $base";
+               while(my ($method, $definingclass) = each %{$methods{$base}})
+               {
+                       $methods{$class}{$method} = $definingclass
+                               if not defined $methods{$class}{$method};
+               }
+               while(my ($attr, $definingclass) = each %{$attrs{$base}})
+               {
+                       $attrs{$class}{$attr} = $definingclass
+                               if not defined $attrs{$class}{$attr};
+               }
+       }
+       print STDERR "\n";
+}
+
+# change all calls to base method to super, complain about skipping
+print STDERR "Fixing...\n";
+for my $f(@ARGV)
+{
+       open my $fh, '<', $f;
+       my $s = do { undef local $/; <$fh>; };
+       my $s0 = $s;
+       close $fh;
+
+       my $class = $classoffile{$f};
+       my $base = $classes{$class};
+       next if not defined $base;
+
+       my @methods_super = map { [ $_ . $methods{$base}{$_}, "SUPER($class).$_" ]; } keys %{$methods{$base}};
+       for(@methods_super)
+       {
+               my ($search, $replace) = @$_;
+               my $n = ($s =~ s/\b$search\b/$replace/g);
+               print STDERR "[$f] $search -> $replace... $n replacements\n"
+                       if $n;
+       }
+
+       for(grep { $methodnames{$_} ne $f } keys %methodnames)
+       {
+               if($s =~ /\b$_\b/)
+               {
+                       print STDERR "[$f] calls non-super external method directly: $_\n";
+               }
+       }
+
+       if($s ne $s0)
+       {
+               print STDERR "Rewriting $f...\n";
+               open my $fh, '>', $f;
+               print $fh $s;
+               close $fh;
+       }
+}

diff --git a/qcsrc/menu/oo/base.h b/qcsrc/menu/oo/base.h
index 65bfbf55607c82eb65e2003496d41519803614a5..2a413a6937bc33786b1c4dd90db1c4df5a4ba2bd 100644 (file)
--- a/qcsrc/menu/oo/base.h
+++ b/qcsrc/menu/oo/base.h
@@ -1,8 +1,26 @@
 .string classname;
+entity vtblObject;
+.string vtblname;
+.entity vtblbase;
+entity spawnVtbl(entity e, entity b)
+{
+       entity v;
+       v = spawn();
+       copyentity(e, v);
+       v.vtblname = v.classname;
+       v.classname = "vtbl";
+       if(b)
+               v.vtblbase = b;
+       else
+               v.vtblbase = v;
+       return v;
+}
 entity spawnObject()
 {
        entity e;
        e = spawn();
        e.classname = "Object";
+       if(!vtblObject)
+               vtblObject = spawnVtbl(e, null_entity);
        return e;
 }

diff --git a/qcsrc/menu/oo/classdefs.h b/qcsrc/menu/oo/classdefs.h
index b62638017dd4bdb0af36df4f69a4a412a4b20598..e4ac44e2c8ff78b564c60026ff9de6de5e2c7135 100644 (file)
--- a/qcsrc/menu/oo/classdefs.h
+++ b/qcsrc/menu/oo/classdefs.h
@@ -13,11 +13,13 @@
 #undef ATTRIB
 #undef ATTRIBARRAY
 #undef ENDCLASS
+#undef SUPER
 #endif
 
-#define CLASS(cname)                       entity spawn##cname();
+#define CLASS(cname)                       entity spawn##cname(); entity vtbl##cname;
 #define EXTENDS(base)                
 #define METHOD(cname,name,prototype)       prototype name##cname; .prototype name;
 #define ATTRIB(cname,name,type,val)        .type name;
 #define ATTRIBARRAY(cname,name,type,cnt)   .type name[cnt];
 #define ENDCLASS(cname)                    .float instanceOf##cname;
+#define SUPER(cname)

diff --git a/qcsrc/menu/oo/constructors.h b/qcsrc/menu/oo/constructors.h
index 6aa2eafc4f9412bb8a184741c5ae749857bc9d44..5f2132469fc2297a84245705f27866502f21ed42 100644 (file)
--- a/qcsrc/menu/oo/constructors.h
+++ b/qcsrc/menu/oo/constructors.h
@@ -13,11 +13,13 @@
 #undef ATTRIB
 #undef ATTRIBARRAY
 #undef ENDCLASS
+#undef SUPER
 #endif
 
 #define CLASS(cname)                       entity spawn##cname() { entity me;
-#define EXTENDS(base)                      me = spawn##base ();
+#define EXTENDS(base)                      me = spawn##base (); entity basevtbl; basevtbl = vtbl##base;
 #define METHOD(cname,name,prototype)       me.name = name##cname;
 #define ATTRIB(cname,name,type,val)        me.name = val;
 #define ATTRIBARRAY(cname,name,type,cnt)   me.name = me.name;
-#define ENDCLASS(cname)                    me.instanceOf##cname = 1; me.classname = #cname; return me; }
+#define ENDCLASS(cname)                    me.instanceOf##cname = 1; me.classname = #cname; if(!vtbl##cname) vtbl##cname = spawnVtbl(me, basevtbl); return me; }
+#define SUPER(cname)

diff --git a/qcsrc/menu/oo/implementation.h b/qcsrc/menu/oo/implementation.h
index 24d914050e5c30b663469a9f29badd434228c3e7..1caed113ea8545e94f3f20869f4b8425e85e5bcf 100644 (file)
--- a/qcsrc/menu/oo/implementation.h
+++ b/qcsrc/menu/oo/implementation.h
@@ -13,4 +13,7 @@
 #undef ATTRIB
 #undef ATTRIBARRAY
 #undef ENDCLASS
+#undef SUPER
 #endif
+
+#define SUPER(cname) (vtbl##cname.vtblbase)