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

Native Objects

Objects in Prolog

Objects in Prolog

Let's give an example first

Objects - examples


  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

The midi Prolog object realization


  
  // 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

Object realization in Prolog -- method call


  
  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).

Eval and its abbreviation


  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>