alien.cxx: methods and virtual methods
parent
8d4585edef
commit
7ad0924df2
extra/alien/cxx
|
@ -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
|
||||
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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue