From 7ad0924df27d47fdf87f18e72e809e1f482d944b Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Wed, 22 Jul 2009 19:20:26 +1200 Subject: [PATCH] alien.cxx: methods and virtual methods --- extra/alien/cxx/cxx.factor | 16 ++-- extra/alien/cxx/parser/parser.factor | 4 +- extra/alien/cxx/syntax/syntax-tests.factor | 91 ++++++++++++++++++++-- extra/alien/cxx/syntax/syntax.factor | 5 +- 4 files changed, 102 insertions(+), 14 deletions(-) diff --git a/extra/alien/cxx/cxx.factor b/extra/alien/cxx/cxx.factor index ab7ff416fa..9d0ee24f50 100644 --- a/extra/alien/cxx/cxx.factor +++ b/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 [ [ 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' - types class-name "*" append suffix :> types' - effect in>> "," join :> args - SBUF" " dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body - name types' effect' body define-c-marshalled ; + types class-name "*" append suffix :> types' + effect in>> "," join :> args + class-name virtual [ "#" append ] unless current-vocab lookup :> class + 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 ; diff --git a/extra/alien/cxx/parser/parser.factor b/extra/alien/cxx/parser/parser.factor index 84425649da..5afaab29e0 100644 --- a/extra/alien/cxx/parser/parser.factor +++ b/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 ) - scan function-types-effect ; +: parse-c++-method-definition ( -- class-name generic name types effect ) + scan scan-word function-types-effect ; diff --git a/extra/alien/cxx/syntax/syntax-tests.factor b/extra/alien/cxx/syntax/syntax-tests.factor index 4b853770c2..24f685a197 100644 --- a/extra/alien/cxx/syntax/syntax-tests.factor +++ b/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: 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? ] unit-test [ "abc" ] [ "abc" to-string ] unit-test + + +DELETE-C-LIBRARY: inheritance +C-LIBRARY: inheritance + +COMPILE-AS-C++ + +C-INCLUDE: + +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: new_alpha +ALIAS: 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#? ] unit-test +[ t ] [ "x" alpha? ] unit-test +[ t ] [ "x" alpha? ] unit-test +[ f ] [ "x" alpha#? ] unit-test +[ 5 ] [ "hello" length ] unit-test +[ 4 ] [ "hello" length ] unit-test +[ "hello" ] [ "hello" render ] unit-test +[ "llo" ] [ "hello" render ] unit-test +[ "ello" ] [ "hello" underlying>> \ alpha# new swap >>underlying render ] unit-test +[ "hello" ] [ "hello" chop ] unit-test +[ "lo" ] [ "hello" chop ] unit-test +[ "lo" ] [ "hello" underlying>> \ alpha# new swap >>underlying chop ] unit-test diff --git a/extra/alien/cxx/syntax/syntax.factor b/extra/alien/cxx/syntax/syntax.factor index 59cf10e7de..66c72c1c2b 100644 --- a/extra/alien/cxx/syntax/syntax.factor +++ b/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 ;