From 59091c6cf286764b4d94b1e18bd90e98f19b83d6 Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Tue, 21 Jul 2009 17:09:32 +1200
Subject: [PATCH 1/8] alien.marshall: refactored unmarshalling words
---
extra/alien/marshall/marshall-docs.factor | 2 +-
extra/alien/marshall/marshall.factor | 65 +++++++++++++++--------
2 files changed, 43 insertions(+), 24 deletions(-)
diff --git a/extra/alien/marshall/marshall-docs.factor b/extra/alien/marshall/marshall-docs.factor
index 6002b0c1c3..deac9fd186 100644
--- a/extra/alien/marshall/marshall-docs.factor
+++ b/extra/alien/marshall/marshall-docs.factor
@@ -327,7 +327,7 @@ HELP: out-arg-unmarshaller
"for all types except pointers to non-const primitives."
} ;
-HELP: pointer-unmarshaller
+HELP: class-unmarshaller
{ $values
{ "type" " a C type string" }
{ "quot" quotation }
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index 85b157e4a0..deef94dc9b 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -11,7 +11,8 @@ specialized-arrays.long specialized-arrays.longlong
specialized-arrays.short specialized-arrays.uchar
specialized-arrays.uint specialized-arrays.ulong
specialized-arrays.ulonglong specialized-arrays.ushort strings
-unix.utilities vocabs.parser words libc.private struct-arrays ;
+unix.utilities vocabs.parser words libc.private struct-arrays
+locals generalizations ;
IN: alien.marshall
<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
@@ -269,33 +270,51 @@ ALIAS: marshall-void* marshall-pointer
: ?malloc-byte-array ( c-type -- alien )
dup alien? [ malloc-byte-array ] unless ;
-: struct-unmarshaller ( type -- quot )
- current-vocab lookup [
- dup superclasses [ \ struct-wrapper = ] any? [
- '[ ?malloc-byte-array _ new swap >>underlying ]
- ] [ drop [ ] ] if
- ] [ [ ] ] if* ;
+:: x-unmarshaller ( type type-quot wrapper-test def clean -- quot/f )
+ type type-quot call current-vocab lookup [
+ dup superclasses wrapper-test any?
+ [ def call ] [ drop clean call f ] if
+ ] [ clean call f ] if* ; inline
-: pointer-unmarshaller ( type -- quot )
- type-sans-pointer current-vocab lookup [
- dup superclasses [ \ alien-wrapper = ] any? [
- '[ _ new swap >>underlying unmarshall-cast ]
- ] [ drop [ ] ] if
- ] [ [ ] ] if* ;
+: struct-unmarshaller ( type -- quot/f )
+ [ ] [ \ struct-wrapper = ]
+ [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
+ [ ]
+ x-unmarshaller ;
+
+: class-unmarshaller ( type -- quot/f )
+ [ type-sans-pointer ] [ \ alien-wrapper = ]
+ [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
+ [ ]
+ x-unmarshaller ;
+
+: template-class-unmarshaller ( type -- quot/f )
+ [ parse-c++-type [ name>> ] keep swap ] [ \ template-wrapper = ]
+ [ '[ _ _ new swap >>type swap >>underlying unmarshall-cast ] ]
+ [ drop ]
+ x-unmarshaller ;
+
+: non-primitive-unmarshaller ( type -- quot/f )
+ {
+ { [ dup template-class? ]
+ [ template-class-unmarshaller ] }
+ { [ dup pointer? ] [ class-unmarshaller ] }
+ [ struct-unmarshaller ]
+ } cond ;
: unmarshaller ( type -- quot )
- factorize-type dup primitive-unmarshaller [ nip ] [
- dup pointer?
- [ pointer-unmarshaller ]
- [ struct-unmarshaller ] if
- ] if* ;
+ factorize-type {
+ [ primitive-unmarshaller ]
+ [ non-primitive-unmarshaller ]
+ [ drop [ ] ]
+ } 1|| ;
: struct-field-unmarshaller ( type -- quot )
- factorize-type dup struct-primitive-unmarshaller [ nip ] [
- dup pointer?
- [ pointer-unmarshaller ]
- [ struct-unmarshaller ] if
- ] if* ;
+ factorize-type {
+ [ struct-primitive-unmarshaller ]
+ [ non-primitive-unmarshaller ]
+ [ drop [ ] ]
+ } 1|| ;
: out-arg-unmarshaller ( type -- quot )
dup pointer-to-non-const-primitive?
From c780bb724d368a3e9cb82667efbb26089f2e27ad Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 12:25:45 +1200
Subject: [PATCH 2/8] alien.marshall: C++ type parsing
---
extra/alien/inline/types/types.factor | 44 ++++++++++++++++++++++++++-
extra/alien/marshall/marshall.factor | 13 +++-----
2 files changed, 47 insertions(+), 10 deletions(-)
diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor
index 94b98d1eb5..fe4f6a4180 100644
--- a/extra/alien/inline/types/types.factor
+++ b/extra/alien/inline/types/types.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators.short-circuit
continuations effects fry kernel math memoize sequences
-splitting ;
+splitting strings peg.ebnf make alien.c-types ;
IN: alien.inline.types
: cify-type ( str -- str' )
@@ -21,6 +21,9 @@ IN: alien.inline.types
: pointer-to-const? ( str -- ? )
cify-type "const " head? ;
+: template-class? ( str -- ? )
+ [ CHAR: < = ] any? ;
+
MEMO: resolved-primitives ( -- seq )
primitive-types [ resolve-typedef ] map ;
@@ -57,3 +60,42 @@ MEMO: resolved-primitives ( -- seq )
[ over pointer-to-primitive? [ ">" prepend ] when ]
assoc-map unzip
] dip <effect> ;
+
+TUPLE: c++-type name params ptr ;
+C: <c++-type> c++-type
+
+EBNF: (parse-c++-type)
+dig = [0-9]
+alpha = [a-zA-Z]
+alphanum = [1-9a-zA-Z]
+name = [_a-zA-Z] [_a-zA-Z1-9]* => [[ first2 swap prefix >string ]]
+ptr = [*&] => [[ empty? not ]]
+
+param = "," " "* type " "* => [[ third ]]
+
+params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]]
+
+type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 <c++-type> ]]
+;EBNF
+
+: parse-c++-type ( str -- c++-type )
+ factorize-type parse-c++-type ;
+
+DEFER: c++-type>string
+
+: params>string ( params -- str )
+ [ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ;
+
+: c++-type>string ( c++-type -- str )
+ [
+ [ name>> % ]
+ [ params>> [ params>string % ] when* ]
+ [ ptr>> [ "*" % ] when ]
+ tri
+ ] "" make ;
+
+GENERIC: c++-type ( obj -- c++-type/f )
+
+M: object c++-type drop f ;
+
+M: c++-type c-type ;
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index deef94dc9b..2aede320aa 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -12,7 +12,7 @@ specialized-arrays.short specialized-arrays.uchar
specialized-arrays.uint specialized-arrays.ulong
specialized-arrays.ulonglong specialized-arrays.ushort strings
unix.utilities vocabs.parser words libc.private struct-arrays
-locals generalizations ;
+locals generalizations math ;
IN: alien.marshall
<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
@@ -20,6 +20,7 @@ filter [ define-primitive-marshallers ] each >>
TUPLE: alien-wrapper { underlying alien } ;
TUPLE: struct-wrapper < alien-wrapper disposed ;
+TUPLE: class-wrapper < alien-wrapper disposed ;
GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' )
@@ -28,6 +29,8 @@ M: struct-wrapper unmarshall-cast ;
M: struct-wrapper dispose* underlying>> free ;
+M: class-wrapper c++-type class name>> parse-c++-type ;
+
: marshall-pointer ( obj -- alien )
{
{ [ dup alien? ] [ ] }
@@ -288,16 +291,8 @@ ALIAS: marshall-void* marshall-pointer
[ ]
x-unmarshaller ;
-: template-class-unmarshaller ( type -- quot/f )
- [ parse-c++-type [ name>> ] keep swap ] [ \ template-wrapper = ]
- [ '[ _ _ new swap >>type swap >>underlying unmarshall-cast ] ]
- [ drop ]
- x-unmarshaller ;
-
: non-primitive-unmarshaller ( type -- quot/f )
{
- { [ dup template-class? ]
- [ template-class-unmarshaller ] }
{ [ dup pointer? ] [ class-unmarshaller ] }
[ struct-unmarshaller ]
} cond ;
From 8ae1fb66a3d9c6abf5ab16cfa882566c07acd2c8 Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 15:57:29 +1200
Subject: [PATCH 3/8] alien.inline.types: fix parse-c++-type
---
extra/alien/inline/types/types.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor
index fe4f6a4180..34162f422e 100644
--- a/extra/alien/inline/types/types.factor
+++ b/extra/alien/inline/types/types.factor
@@ -68,7 +68,7 @@ EBNF: (parse-c++-type)
dig = [0-9]
alpha = [a-zA-Z]
alphanum = [1-9a-zA-Z]
-name = [_a-zA-Z] [_a-zA-Z1-9]* => [[ first2 swap prefix >string ]]
+name = [_a-zA-Z] [_a-zA-Z1-9:]* => [[ first2 swap prefix >string ]]
ptr = [*&] => [[ empty? not ]]
param = "," " "* type " "* => [[ third ]]
@@ -79,7 +79,7 @@ type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3
;EBNF
: parse-c++-type ( str -- c++-type )
- factorize-type parse-c++-type ;
+ factorize-type (parse-c++-type) ;
DEFER: c++-type>string
From 186cc7edb3476dd65351de484aca24932d58d8d5 Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 16:00:38 +1200
Subject: [PATCH 4/8] added alien.cxx
---
extra/alien/cxx/authors.txt | 1 +
extra/alien/cxx/cxx.factor | 22 ++++++++++++++++++++
extra/alien/cxx/parser/authors.txt | 1 +
extra/alien/cxx/parser/parser.factor | 7 +++++++
extra/alien/cxx/syntax/authors.txt | 1 +
extra/alien/cxx/syntax/syntax-tests.factor | 24 ++++++++++++++++++++++
extra/alien/cxx/syntax/syntax.factor | 6 ++++++
extra/alien/marshall/marshall.factor | 2 ++
8 files changed, 64 insertions(+)
create mode 100644 extra/alien/cxx/authors.txt
create mode 100644 extra/alien/cxx/cxx.factor
create mode 100644 extra/alien/cxx/parser/authors.txt
create mode 100644 extra/alien/cxx/parser/parser.factor
create mode 100644 extra/alien/cxx/syntax/authors.txt
create mode 100644 extra/alien/cxx/syntax/syntax-tests.factor
create mode 100644 extra/alien/cxx/syntax/syntax.factor
diff --git a/extra/alien/cxx/authors.txt b/extra/alien/cxx/authors.txt
new file mode 100644
index 0000000000..c45c6f3279
--- /dev/null
+++ b/extra/alien/cxx/authors.txt
@@ -0,0 +1 @@
+Jeremy Hughes
\ No newline at end of file
diff --git a/extra/alien/cxx/cxx.factor b/extra/alien/cxx/cxx.factor
new file mode 100644
index 0000000000..71144e6450
--- /dev/null
+++ b/extra/alien/cxx/cxx.factor
@@ -0,0 +1,22 @@
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.cxx.parser alien.marshall
+alien.inline.types classes.mixin classes.tuple kernel namespaces
+assocs sequences parser classes.parser ;
+IN: alien.cxx
+
+<PRIVATE
+: class-mixin ( str -- word )
+ create-class-in [ define-mixin-class ] keep ;
+
+: class-tuple-word ( word -- word' )
+ "#" append create-in ;
+
+: define-class-tuple ( word mixin -- )
+ [ drop class-wrapper { } define-tuple-class ]
+ [ add-mixin-instance ] 2bi ;
+PRIVATE>
+
+: define-c++-class ( str superclass-mixin -- )
+ [ [ class-tuple-word ] [ class-mixin ] bi dup ] dip
+ add-mixin-instance define-class-tuple ;
diff --git a/extra/alien/cxx/parser/authors.txt b/extra/alien/cxx/parser/authors.txt
new file mode 100644
index 0000000000..c45c6f3279
--- /dev/null
+++ b/extra/alien/cxx/parser/authors.txt
@@ -0,0 +1 @@
+Jeremy Hughes
\ No newline at end of file
diff --git a/extra/alien/cxx/parser/parser.factor b/extra/alien/cxx/parser/parser.factor
new file mode 100644
index 0000000000..4614a4a7b5
--- /dev/null
+++ b/extra/alien/cxx/parser/parser.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser lexer ;
+IN: alien.cxx.parser
+
+: parse-c++-class-definition ( -- class superclass-mixin )
+ scan scan-word ;
diff --git a/extra/alien/cxx/syntax/authors.txt b/extra/alien/cxx/syntax/authors.txt
new file mode 100644
index 0000000000..c45c6f3279
--- /dev/null
+++ b/extra/alien/cxx/syntax/authors.txt
@@ -0,0 +1 @@
+Jeremy Hughes
\ No newline at end of file
diff --git a/extra/alien/cxx/syntax/syntax-tests.factor b/extra/alien/cxx/syntax/syntax-tests.factor
new file mode 100644
index 0000000000..f9fb9a218f
--- /dev/null
+++ b/extra/alien/cxx/syntax/syntax-tests.factor
@@ -0,0 +1,24 @@
+! 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 ;
+IN: alien.cxx.syntax.tests
+
+DELETE-C-LIBRARY: test
+C-LIBRARY: test
+
+COMPILE-AS-C++
+
+C-INCLUDE: <string>
+
+C-TYPEDEF: std::string string
+
+C++-CLASS: std::string c++-root
+
+CM-FUNCTION: std::string* new_string ( const-char* s )
+ return new std::string(s);
+;
+
+;C-LIBRARY
+
+{ 1 1 } [ new_string ] must-infer-as
diff --git a/extra/alien/cxx/syntax/syntax.factor b/extra/alien/cxx/syntax/syntax.factor
new file mode 100644
index 0000000000..741950f79b
--- /dev/null
+++ b/extra/alien/cxx/syntax/syntax.factor
@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.cxx alien.cxx.parser ;
+IN: alien.cxx.syntax
+
+SYNTAX: C++-CLASS: parse-c++-class-definition define-c++-class ;
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index 2aede320aa..eec0cadcbb 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -22,6 +22,8 @@ TUPLE: alien-wrapper { underlying alien } ;
TUPLE: struct-wrapper < alien-wrapper disposed ;
TUPLE: class-wrapper < alien-wrapper disposed ;
+MIXIN: c++-root
+
GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' )
M: alien-wrapper unmarshall-cast ;
From 1218d3fa9d28e5ec4098f2cae7268d24a6ebccea Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 17:21:07 +1200
Subject: [PATCH 5/8] alien.cxx: C++ methods
---
extra/alien/cxx/cxx.factor | 12 ++++++++++--
extra/alien/cxx/parser/parser.factor | 5 ++++-
extra/alien/cxx/syntax/syntax-tests.factor | 8 ++++++++
extra/alien/cxx/syntax/syntax.factor | 6 +++++-
4 files changed, 27 insertions(+), 4 deletions(-)
diff --git a/extra/alien/cxx/cxx.factor b/extra/alien/cxx/cxx.factor
index 71144e6450..ab7ff416fa 100644
--- a/extra/alien/cxx/cxx.factor
+++ b/extra/alien/cxx/cxx.factor
@@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.cxx.parser alien.marshall
alien.inline.types classes.mixin classes.tuple kernel namespaces
-assocs sequences parser classes.parser ;
+assocs sequences parser classes.parser alien.marshall.syntax
+interpolate locals effects io strings ;
IN: alien.cxx
<PRIVATE
@@ -17,6 +18,13 @@ IN: alien.cxx
[ add-mixin-instance ] 2bi ;
PRIVATE>
-: define-c++-class ( str superclass-mixin -- )
+: define-c++-class ( name superclass-mixin -- )
[ [ class-tuple-word ] [ class-mixin ] bi dup ] dip
add-mixin-instance define-class-tuple ;
+
+:: define-c++-method ( class-name name types effect -- )
+ 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 ;
diff --git a/extra/alien/cxx/parser/parser.factor b/extra/alien/cxx/parser/parser.factor
index 4614a4a7b5..84425649da 100644
--- a/extra/alien/cxx/parser/parser.factor
+++ b/extra/alien/cxx/parser/parser.factor
@@ -1,7 +1,10 @@
! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
-USING: parser lexer ;
+USING: parser lexer alien.inline ;
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 ;
diff --git a/extra/alien/cxx/syntax/syntax-tests.factor b/extra/alien/cxx/syntax/syntax-tests.factor
index f9fb9a218f..4b853770c2 100644
--- a/extra/alien/cxx/syntax/syntax-tests.factor
+++ b/extra/alien/cxx/syntax/syntax-tests.factor
@@ -15,10 +15,18 @@ C-TYPEDEF: std::string string
C++-CLASS: std::string c++-root
+C++-METHOD: std::string const-char* c_str ( )
+
CM-FUNCTION: std::string* new_string ( const-char* s )
return new std::string(s);
;
;C-LIBRARY
+ALIAS: <std::string> new_string
+
+ALIAS: to-string c_str
+
{ 1 1 } [ new_string ] must-infer-as
+{ 1 1 } [ c_str ] must-infer-as
+[ "abc" ] [ "abc" <std::string> to-string ] unit-test
diff --git a/extra/alien/cxx/syntax/syntax.factor b/extra/alien/cxx/syntax/syntax.factor
index 741950f79b..59cf10e7de 100644
--- a/extra/alien/cxx/syntax/syntax.factor
+++ b/extra/alien/cxx/syntax/syntax.factor
@@ -3,4 +3,8 @@
USING: alien.cxx alien.cxx.parser ;
IN: alien.cxx.syntax
-SYNTAX: C++-CLASS: parse-c++-class-definition define-c++-class ;
+SYNTAX: C++-CLASS:
+ parse-c++-class-definition define-c++-class ;
+
+SYNTAX: C++-METHOD:
+ parse-c++-method-definition define-c++-method ;
From 8d4585edefb2b6a32273af62f8bff9de1dd984ca Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 19:20:01 +1200
Subject: [PATCH 6/8] alien.marshall: tidy unmarshallers
---
extra/alien/marshall/marshall.factor | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index eec0cadcbb..547e37f78a 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -275,21 +275,21 @@ ALIAS: marshall-void* marshall-pointer
: ?malloc-byte-array ( c-type -- alien )
dup alien? [ malloc-byte-array ] unless ;
-:: x-unmarshaller ( type type-quot wrapper-test def clean -- quot/f )
+:: x-unmarshaller ( type type-quot superclass def clean -- quot/f )
type type-quot call current-vocab lookup [
- dup superclasses wrapper-test any?
+ dup superclasses superclass swap member?
[ def call ] [ drop clean call f ] if
] [ clean call f ] if* ; inline
: struct-unmarshaller ( type -- quot/f )
- [ ] [ \ struct-wrapper = ]
+ [ ] \ struct-wrapper
[ '[ ?malloc-byte-array _ new swap >>underlying ] ]
[ ]
x-unmarshaller ;
: class-unmarshaller ( type -- quot/f )
- [ type-sans-pointer ] [ \ alien-wrapper = ]
- [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
+ [ type-sans-pointer "#" append ] \ class-wrapper
+ [ '[ _ new swap >>underlying ] ]
[ ]
x-unmarshaller ;
From 7ad0924df27d47fdf87f18e72e809e1f482d944b Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 19:20:26 +1200
Subject: [PATCH 7/8] 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
<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 ;
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: <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
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 ;
From f261752dd1059ed115c9cfe2f12f16348285036a Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Wed, 22 Jul 2009 19:30:55 +1200
Subject: [PATCH 8/8] alien.inline.types: a trifling matter
---
extra/alien/inline/types/types.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor
index 34162f422e..070febc324 100644
--- a/extra/alien/inline/types/types.factor
+++ b/extra/alien/inline/types/types.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types assocs combinators.short-circuit
continuations effects fry kernel math memoize sequences
-splitting strings peg.ebnf make alien.c-types ;
+splitting strings peg.ebnf make ;
IN: alien.inline.types
: cify-type ( str -- str' )