Native Objects in Prolog
Anton Eliëns
VU/CWI, Amsterdam
2/11/98
www.cs.vu.nl/~eliens/online/experiments/native
Introduction
Objects in Prolog
- Many flavors: Sicstus, ...
- Modules do not suffice - ...
- Requirements: low overhead, natural syntax
- Additional requirements:
binding with native objects
Native Objects
- native bindings are mostly for functions only
- Java, however, provides an example
- Let's first look at objects in Prolog,
and then their possibly native realization
Objects in Prolog
Objects in Prolog
- representation -- object(Handler,Class,ID,REF,Anc,Attr,Qual)
- object creation -- class_method(This,...)
- object invocation -- self(This):method(...)
- state variables representation -- value(ID,Key,Value)
- state variables access -- assign(key,Value), value(Key,Value)
- operator overloading -- var(Key) = Value, Var = value(key)
- operator overloading -- =, <, <=, >, >=
- native binding - native(Handler,Method,Result)
Let's give an example first
run(4):-
cerr(start(4)),
midi(This):midi, create midi object
Self = midi(This),
Self:open('a.mid'),
Self:header(0,1,480),
Self:track(start),
Self:melody([48,50,51,53,55]), // c d es f g, minor indeed
Self:track(end), end track
cerr(end(4)).
The midi object, naturally has a native realization
that complements its prolog definition
// from midi.pl
:- use(library(midi:[midi,lily,music,process])).
:- declare(midi:object,class(midi),[handler],[]). again, almost everything is a handler
midi_midi(This) :- constructor
midi(This):handler(H), %% gets Handler from class
declare(H,new(midi(This)),[],[],_).
midi_read(This,F) :- native(_,This,read(F),_). natice methods
midi_analyse(This,I,O) :- native(_,This,analyse(I,O),_).
midi_open(This,F) :- native(_,This,open(F),_).
midi_header(This,M) :- native(_,This,header(M,0,480),_).
midi_track(This,X) :- native(_,This,track(X),_).
midi_tempo(This,X) :- native(_,This,tempo(X),_).
midi_event(This,D,C,M,T,V) :- native(_,This,event(D,C,M,T,V),_).
midi_note(This,D,C,T,V) :- other methods
Self = midi(This),
Self:event(D,C,note_on,T,V),
Self:event(D,C,note_off,T,V).
midi_melody(This,L) :- midi(This):melody(480,1,L,64).
midi_melody(_This,_,_,[],_).
midi_melody(This,D,C,[X|R],V) :-
Self = self(This),
Self:note(D,C,X,V), %% possibly virtual
midi_melody(This,D,C,R,V). %% direct invocation, not virtual
method(self(ID),M,C) :- get real self
atom(ID),
(object(_,Class,ID,_,_,_,_);
object(_,Class,_,ID,_,_,_)),!, ID is a REF !
O =.. [Class,ID],
method(O,M,C).
method(O,M,C):- yes, it is an object
object(O),
O =.. [Class,N],
method_translate(M,Fun),
method(Class,N,Fun,C).
method(O,M,C) :- there is no object, but
not object(O),
O =.. [F,ID|_],
method_translate(M,Fun),
method(F,ID,Fun,C).
method(Class,ID,M,C):- try Class_Method(ID,...
M =.. [Method|Args],
list_concat([Class,'_',Method],Predicate),
(Args = [] -> C =.. [Predicate,ID];
append([Predicate,ID],Args,L), C =.. L),
(not clause(C,_) -> fail; true,! ).
method(Class,ID,M,C):- look for Ancestor, go up
(object(_,Class,ID,_,Anc,_,_);
object(_,Class,nil,_,Anc,_,_)),!,
member(Type,Anc),
method(Type,ID,M,C).
O:G :-
eval(O:G).
eval(_:[]) :- !.
eval(O:H),
eval(O:T).
eval(O:G) :-
not G = [],
not G = [_|_],
method(O,G,B),
call(B).
Native Objects in Prolog
Native Objects in Prolog
- method call - check ID is a REF
- declaration - call (native) constructor
- mapping creation and method calls -- through native support
- native support -- binding: object_handler and query_event
- native support -- classes: the usual (hush) hierarchy
e.g. obscure
and kit
Object declarations
declare(H,new(O),R) :- declare(H,new(O),[],[],[],R).
declare(H,new(O),I,R) :- declare(H,new(O),I,[],[],R).
declare(H,new(O),I,P,R) :- declare(H,new(O),I,P,[],R).
declare(H,new(O),I,P,Q,R) :-
O =.. [F,A|Args],
objectname(F,A,N),
ancestors(F,I,Anc),
attributes(F,P,Att),
qualifiers(F,Q,Qual),
(not var(H), var(R) ->
native(H,N,F:Args,R);R=R), possibly native
assert(object(H,F,N,R,Anc,Att,Qual)),
cerr(asserted((object(H,F,N,R,Anc,Att,Qual)))).
Native support
native(H,X) :- hush provides principal handler
unwrap(X,C),
hush(H,C). // H is secondary handler
native(H,X,R) :- with result R
unwrap(X,C),
hush(H,C,R). // H is secondary handler
native(H,ID,Q,R) :- we know the ID
atom(ID),
(Q = (C:A) -> G =.. [C|A]; G = Q),
object(H,Class,ID,REF,_,_,_),
native(H,[class=Class,objectid=ID,ref=REF,method=G],R).
native(H,REF,Q,R) :- we know the REF
atom(REF),
(Q = (C:A) -> G =.. [C|A]; G = Q),
object(H,Class,ID,REF,_,_,_),
native(H,[class=Class,objectid=ID,ref=REF,method=G],R).
native(H,X,Q,R) :- we know the handler
var(X),
not var(H),
(Q = (C:A) -> G =.. [C|A]; G = Q),
native(H,[method=G],R).
native(H,X,Q,R) :- there is an unidentified REF
not var(H),
X = [Class,REF|_],
(Q = (C:A) -> G =.. [C|A]; G = Q),
native(H,[class=Class, ref=REF, method=G],R).
native(H,X,Q,R) :- we know the handler and the ID
not var(H),
atom(X),
not object(H,_,X,_,_,_,_),
(Q = (C:A) -> G =.. [C|A]; G = Q),
native(H,[objectid=X, method=G],R).
Argument unwrapping -- key-value pairs
unwrap(method=G,S) :- method=F 1=Arg1 2=Arg2 ...
G =.. [F|Args],
not (Args = []),!,
optify(1,Args,L),
unwrap([method=F,L],S).
unwrap(X=Y,X=Y):- !.
unwrap(ID:G,ID:C) :- atomic(ID), not atomic(G), unwrap(G,C).
unwrap([H|T],S) :- list_stringify([H|T],S).
unwrap(X,X) :- not X = (_=_), not X = [_|_], not X = [].
optify(_,[],[]).
optify(N,[H|T],[N=X|R]) :- 1=Arg1 2=Arg2 ...
term_to_atom(H,A),
list_concat(['"',A,'"'],X),
N1 is N + 1,
optify(N1,T,R).
list_stringify([],''). create a space delimited string
list_stringify([H|T],R) :-
list_stringify(T,C),
head_stringify(H,C,R).
head_stringify(H,L,R) :-
unwrap(H,T),
term_to_atom(T,A),
list_concat([A,' ',L],R).
C++ bindings
C++ bindings -- objects
- generic binding for (pl) kit - with secondary handler dictionary
- handler hierarchy -- obscure, handler, event, kit, query
- downcall - via smart pointer vm
- upcall - via embedded vm in handler
>
class query_object : public kit_object {
public:
query_object(kit* q, char* n = "query:object") : kit_object(q,n) { }
object_handler* _create(query* q, char* n = "query:object") {
return new query_object(q,n);
}
int operator()();
};
The kit implementation
int kit_object::operator()() {
event* e = _event;
vm self(e); smart pointer
string method = e->_method();
if (method == "kit") { constructor
kit* q = new kit(e->arg(1));
_register(q);
result( reference((void*)q) );
} else if (method == "eval") {
long res = self->eval(e->arg(1));
result( itoa(res) );
} else if (method == "result") {
char* res = self->result( atoi(e->arg(1)) );
result(res);
} else if (method == "evaluate") {
char* res = self->evaluate(e->arg(1));
result( res );
} else { dispatch up in the hierarchy
return handler_object::operator()();
}
return 0;
}
Up calls through VM
// in handler.c
event* handler::dispatch(event* e) {
_event = e;
if (_vmp) {
return ((vm*)_vmp)->dispatch(e);
} else {
if (e->thekit()) tk = e->thekit(); // AE
int result = this->operator()();
if (result != OK) return 0; // jrvosse
else return _event;
}
}
The native object VM
template < class T >
class vm : public vm_type {
public:
vm(event* e) {
int p = 0;
char* id = e->option("ref");
if (id) {
p = atoi(id);
}
kit* k = e?e->thekit():0;
_pointer = p;
_self = (T*) _pointer;
}
event* dispatch(event* e) { upcall - refined in java_vm
char buf[512];
sprintf(buf,":handler(\%d):dispatch(event(\%d))",
(int)_pointer,(int)e);
eval(buf);
return e;
}
virtual int call(const char* cmd) { upcall - refined in java_vm
char buf[512]; int n = 0;
sprintf(buf,"some(X):event(\%d):\%s(X)",(int)_pointer,cmd);
char* res = evaluate(buf);
sscanf(res,"\%d",&n);
return n;
}
virtual inline T* operator->() { return self(); }
virtual inline T* self() { return _self; }
private:
T* _self;
long _pointer;
kit* _kit;
};
Native C++ Objects in Java
Native Objects in Java
- representation if C++ peer: self pointer
- object/method function call: native functions
- cast self pointer to object: smart vm
Peer Object Pointer
package hush.dv.api;
class obscure {
public int _self;
...
};
public class handler extends obscure {
public static kit tk;
protected Event _event;
public Event dispatch(event ev) {
_event = (Event) ev;
operator();
return _event;
}
public int operator() {
...
return OK;
}
};
Example
package hush.dv.api;
public class kit extends handler {
public kit() { _self = init(); }
protected kit(int x) { }
private native int init();
public native void trace();
public native int load(String cmd);
public native void source(String cmd);
public native void eval(String cmd);
public native String evaluate(String cmd);
public String result() {
String _result = getresult();
if (_result.equals("-")) return null;
else return _result;
}
public void result(String res) { setresult(res); }
private native String getresult();
private native void setresult(String res);
public void assert(String cl) { assertz(cl); }
public void asserta(String cl) { nativeassert(cl,"a"); }
public void assertz(String cl) { nativeassert(cl,"z"); }
public void retract(String cl) { nativeretract(cl,""); }
public void retractall(String cl) { nativeretract(cl,"all"); }
private native void nativeassert(String res, String opts);
private native void nativeretract(String res, String opts);
public native void bind(String cmd, handler h);
public native void wait(int msecs);
public native void after(int msecs, handler h);
public native void update();
public Widget root() { return new Widget(rootid()); }
public native void pack(String s);
public native void quit();
private native int rootid();
};
Native Functions
#include <hush/java.h>
#include <hush/kit.h>
#include <hush/session.h>
#include <native/hush_dv_api_kit.h>
#define method(X) Java_hush_dv_api_kit_##X
JNIEXPORT jint JNICALL method(init)(JNIEnv *env, jobject obj)
{
if (env && obj); // Wall
jint result = (jint) kit::_default; // (jint) new kit();
if (!result) {
kit* x = new kit("tk");
session::_default->_register(x);
result = (jint) x;
}
return result;
}
JNIEXPORT void JNICALL method(eval)(JNIEnv *env, jobject obj, jstring s)
{
java_vm vm(env,obj);
const char *str = vm.get(s);
vm->eval(str);
vm.release(s);
}
JNIEXPORT jstring JNICALL method(getresult)(JNIEnv *env, jobject obj)
{
java_vm vm(env,obj);
char *s = vm->result();
if (s) return vm.string(s);
else return vm.string("-");
}
JNIEXPORT void JNICALL method(setresult)(JNIEnv *env, jobject obj, jstring s)
{
char str[1024];
java_vm vm(env,obj);
char *p = vm.get(s);
strcpy(str,p);
vm->result(p);
//vm.release(s);
}
JNIEXPORT void JNICALL method(bind)(JNIEnv *env, jobject obj,
jstring s, jobject o)
{
java_vm vm(env,obj);
java_vm* vmp = new java_vm(env,o,"Handler");
const char *str = vm.get(s);
handler* h = vmp->self();
if (h) {
cerr << "Setting (kit) VM" << endl;
if (!h->_vmp) h->_vmp = vmp;
} else {
cerr << "Creating (kit) VM" << endl;
h = new handler();
session::_default->_register(h);
h->_vmp = vmp;
}
h->_register(vmp);
vm->bind(str,h);
vm.release(s, str);
}
Java Smart Pointer
#include <hush/vm.h>
#include
template
class java_vm : public vm {
public:
java_vm(JNIEnv* env_, jobject obj_, char* clazz_ = 0) {
_jvm = 0;
_global = 0;
_env = env_;
_obj = obj_;
_cls = _env->GetObjectClass(_obj);
if (clazz_) {
strcpy(_clazz,clazz_);
_global = 1;
_obj = _env->NewGlobalRef(_obj);
}
else _clazz[0]='\0';
_self = self();
}
~java_vm() {
if (_global && _obj)
env()->DeleteGlobalRef(_obj);
}
JNIEnv* env() { return _env?_env:((JNIEnv*)vm_type::env); }
JavaVM* jvm() { return _jvm?_jvm:((JavaVM*)vm_type::jvm); }
event* dispatch(event* e) { java dispatch
callIV("dispatch",(int)e);
return e;
}
public: self
T* operator->() { return _global?self():_self; }
T* self() {
jfieldID fid = fieldID("_self","I");
return (T*) env()->GetIntField( object(), fid);
}
public: ID
jfieldID fieldID(const char* fd, const char* sig) {
if (_global) _cls = env()->GetObjectClass(object());
return env()->GetFieldID( _jclass(), fd, sig);
}
jmethodID methodID(const char* md, const char* sig) {
//cerr << "methodID " << md << " " << sig << endl;
if (_global) _cls = env()->GetObjectClass(object());
return env()->GetMethodID( _jclass(), md, sig);
}
public: method call
void callV(const char* md) { // void (*)()
jmethodID mid = methodID(md,"()V");
env()->CallVoidMethod(object(), mid);
}
void callIV(const char* md, int i) { // void (*)(int)
jmethodID mid = methodID(md,"(I)V");
env()->CallVoidMethod(object(), mid, i);
}
int callVI(const char* md) { int (*)()
jmethodID mid = methodID(md,"()I");
return env()->CallIntMethod(object(), mid);
}
int call(const char* md) { return callVI(md); }
// convenience functions
jstring string(const char* s) {
return env()->NewStringUTF(s);
}
char* get(jstring js) {
return hstr = (char*) env()->GetStringUTFChars(js, 0);
}
void release(jstring js, const char* str = 0) {
char* p = str?(char*)str:hstr;
env()->ReleaseStringUTFChars(js, p);
}
private: //@ ...
char* hstr; // to hold a string
int _global;
char _clazz[128];
JNIEnv* _env;
jobject _obj;
jclass _cls;
JavaVM* _jvm;
T* _self;
};
<so con>
<so appendix>