alien.cxx: methods and virtual methods

extra/alien/cxx/cxx.factor

@@ -3,7 +3,8 @@
 USING: accessors alien.c-types alien.cxx.parser alien.marshall
 alien.inline.types classes.mixin classes.tuple kernel namespaces
 assocs sequences parser classes.parser alien.marshall.syntax
-interpolate locals effects io strings ;
+interpolate locals effects io strings make vocabs.parser words
+generic fry quotations ;
 IN: alien.cxx
 
 <PRIVATE
@@ -22,9 +23,12 @@ PRIVATE>
     [ [ class-tuple-word ] [ class-mixin ] bi dup ] dip
     add-mixin-instance define-class-tuple ;
 
-:: define-c++-method ( class-name name types effect -- )
+:: define-c++-method ( class-name generic name types effect virtual -- )
+    [ name % "_" % class-name { { CHAR: : CHAR: _ } } substitute % ] "" make           :> name'
     effect [ in>> "self" suffix ] [ out>> ] bi <effect> :> effect'
     types class-name "*" append suffix                  :> types'
     effect in>> "," join                                :> args
-    SBUF" " dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body
+    class-name virtual [ "#" append ] unless current-vocab lookup                  :> class
-    name types' effect' body define-c-marshalled ;
+    SBUF" " clone dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body
+    name' types' effect' body define-c-marshalled
+    class generic create-method name' current-vocab lookup 1quotation define ;

extra/alien/cxx/parser/parser.factor

@@ -6,5 +6,5 @@ IN: alien.cxx.parser
 : parse-c++-class-definition ( -- class superclass-mixin )
     scan scan-word ;
 
-: parse-c++-method-definition ( -- class-name name types effect )
+: parse-c++-method-definition ( -- class-name generic name types effect )
-    scan function-types-effect ;
+    scan scan-word function-types-effect ;

extra/alien/cxx/syntax/syntax-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Jeremy Hughes.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test alien.cxx.syntax alien.inline.syntax
-alien.marshall.syntax alien.marshall ;
+alien.marshall.syntax alien.marshall accessors kernel ;
 IN: alien.cxx.syntax.tests
 
 DELETE-C-LIBRARY: test
@@ -15,7 +15,9 @@ C-TYPEDEF: std::string string
 
 C++-CLASS: std::string c++-root
 
-C++-METHOD: std::string const-char* c_str ( )
+GENERIC: to-string ( obj -- str )
+
+C++-METHOD: std::string to-string const-char* c_str ( )
 
 CM-FUNCTION: std::string* new_string ( const-char* s )
     return new std::string(s);
@@ -25,8 +27,87 @@ CM-FUNCTION: std::string* new_string ( const-char* s )
 
 ALIAS: <std::string> new_string
 
-ALIAS: to-string c_str
-
 { 1 1 } [ new_string ] must-infer-as
-{ 1 1 } [ c_str ] must-infer-as
+{ 1 1 } [ c_str_std__string ] must-infer-as
+[ t ] [ "abc" <std::string> std::string? ] unit-test
 [ "abc" ] [ "abc" <std::string> to-string ] unit-test
+
+
+DELETE-C-LIBRARY: inheritance
+C-LIBRARY: inheritance
+
+COMPILE-AS-C++
+
+C-INCLUDE: <cstring>
+
+RAW-C:
+class alpha {
+    public:
+    alpha(const char* s) {
+        str = s;
+    };
+    const char* render() {
+        return str;
+    };
+    virtual const char* chop() {
+        return str;
+    };
+    virtual int length() {
+        return strlen(str);
+    };
+    const char* str;
+};
+
+class beta : alpha {
+    public:
+    beta(const char* s) : alpha(s + 1) { };
+    const char* render() {
+        return str + 1;
+    };
+    virtual const char* chop() {
+        return str + 2;
+    };
+};
+;
+
+C++-CLASS: alpha c++-root
+C++-CLASS: beta alpha
+
+CM-FUNCTION: alpha* new_alpha ( const-char* s )
+    return new alpha(s);
+;
+
+CM-FUNCTION: beta* new_beta ( const-char* s )
+    return new beta(s);
+;
+
+ALIAS: <alpha> new_alpha
+ALIAS: <beta> new_beta
+
+GENERIC: render ( obj -- obj )
+GENERIC: chop ( obj -- obj )
+GENERIC: length ( obj -- n )
+
+C++-METHOD: alpha render const-char* render ( )
+C++-METHOD: beta render const-char* render ( )
+C++-VIRTUAL: alpha chop const-char* chop ( )
+C++-VIRTUAL: beta chop const-char* chop ( )
+C++-VIRTUAL: alpha length int length ( )
+
+;C-LIBRARY
+
+{ 1 1 } [ render_alpha ] must-infer-as
+{ 1 1 } [ chop_beta ] must-infer-as
+{ 1 1 } [ length_alpha ] must-infer-as
+[ t ] [ "x" <alpha> alpha#? ] unit-test
+[ t ] [ "x" <alpha> alpha? ] unit-test
+[ t ] [ "x" <beta> alpha? ] unit-test
+[ f ] [ "x" <beta> alpha#? ] unit-test
+[ 5 ] [ "hello" <alpha> length ] unit-test
+[ 4 ] [ "hello" <beta> length ] unit-test
+[ "hello" ] [ "hello" <alpha> render ] unit-test
+[ "llo" ] [ "hello" <beta> render ] unit-test
+[ "ello" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying render ] unit-test
+[ "hello" ] [ "hello" <alpha> chop ] unit-test
+[ "lo" ] [ "hello" <beta> chop ] unit-test
+[ "lo" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying chop ] unit-test

extra/alien/cxx/syntax/syntax.factor

@@ -7,4 +7,7 @@ SYNTAX: C++-CLASS:
     parse-c++-class-definition define-c++-class ;
 
 SYNTAX: C++-METHOD:
-    parse-c++-method-definition define-c++-method ;
+    parse-c++-method-definition f define-c++-method ;
+
+SYNTAX: C++-VIRTUAL:
+    parse-c++-method-definition t define-c++-method ;