90 lines
2.0 KiB
C
90 lines
2.0 KiB
C
/*-----------------------------------------------------------------------------
|
|
|
|
This trivial Elk extension demonstrates encapsulation of a C++ class in
|
|
a first-class Scheme type, and encapsulation of member functions in
|
|
Scheme primitives.
|
|
|
|
See constructor.c in this directory for compilation instructions.
|
|
|
|
Here is a transcript showing a test run under Solaris 2.4 using the
|
|
GNU g++ compiler:
|
|
|
|
% g++ -fpic -I/usr/elk/include -c class.c
|
|
%
|
|
% scheme
|
|
> (load 'class.o)
|
|
|
|
> (define x (make-foo))
|
|
x
|
|
> (read-val x)
|
|
1234
|
|
> (write-val! x 11)
|
|
|
|
> (read-val x)
|
|
11
|
|
> (exit)
|
|
%
|
|
|
|
-----------------------------------------------------------------------------*/
|
|
|
|
class foo {
|
|
int val;
|
|
public:
|
|
int read_val(void);
|
|
void write_val(int);
|
|
foo() { val = 1234; };
|
|
};
|
|
|
|
int foo::read_val(void) {
|
|
return val;
|
|
}
|
|
|
|
void foo::write_val(int newval) {
|
|
val = newval;
|
|
}
|
|
|
|
/* ---------------------------------- */
|
|
|
|
#include "scheme.h"
|
|
|
|
struct S_Foo {
|
|
Object tag; class foo foo;
|
|
};
|
|
|
|
int T_Foo;
|
|
|
|
#define FOO(x) ((struct S_Foo *)POINTER(x))
|
|
|
|
Object P_Make_Foo(void) {
|
|
Object f = Alloc_Object(sizeof (struct S_Foo), T_Foo, 0);
|
|
FOO(f)->foo.write_val(1234); /* FOO(f)->foo.foo() is not allowed?! */
|
|
return f;
|
|
}
|
|
|
|
Object P_Read_Val(Object x) {
|
|
Check_Type(x, T_Foo);
|
|
return Make_Integer(FOO(x)->foo.read_val());
|
|
}
|
|
|
|
Object P_Write_Val(Object x, Object y) {
|
|
Check_Type(x, T_Foo);
|
|
FOO(x)->foo.write_val(Get_Integer(y));
|
|
return Void;
|
|
}
|
|
|
|
Foo_Print(Object h, Object port, int raw, int depth, int length) {
|
|
Printf(port, "#[foo %d]", FOO(h)->foo.read_val());
|
|
}
|
|
|
|
int Foo_Equal(Object x, Object y) {
|
|
return FOO(x)->foo.read_val() == FOO(y)->foo.read_val();
|
|
}
|
|
|
|
void elk_init_foo() {
|
|
T_Foo = Define_Type(0, "foo", NOFUNC, sizeof(struct S_Foo),
|
|
Foo_Equal, Foo_Equal, Foo_Print, NOFUNC);
|
|
Define_Primitive((Object(*)(...))P_Make_Foo, "make-foo", 0, 0, EVAL);
|
|
Define_Primitive((Object(*)(...))P_Read_Val, "read-val", 1, 1, EVAL);
|
|
Define_Primitive((Object(*)(...))P_Write_Val, "write-val!", 2, 2, EVAL);
|
|
}
|