This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/CXX/yapi.cpp

415 lines
7.9 KiB
C++
Raw Normal View History

2014-04-28 11:47:09 +01:00
#define YAP_CPP_INTERFACE 1
#include "yapi.hh"
YAPAtomTerm::YAPAtomTerm(char *s) { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOM;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = MkAtomTerm(out.val.a);
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPAtomTerm::YAPAtomTerm(char *s, size_t len) { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_ATOM|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = MkAtomTerm(out.val.a);
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPAtomTerm::YAPAtomTerm(wchar_t *s): YAPTerm() { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOM;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = MkAtomTerm(out.val.a);
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPAtomTerm::YAPAtomTerm(wchar_t *s, size_t len) : YAPTerm() { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_ATOM|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = MkAtomTerm(out.val.a);
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPStringTerm::YAPStringTerm(char *s) { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_STRING;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = out.val.t;
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPStringTerm::YAPStringTerm(char *s, size_t len) { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.c = s;
inp.type = YAP_STRING_CHARS;
out.type = YAP_STRING_STRING|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = out.val.t;
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPStringTerm::YAPStringTerm(wchar_t *s): YAPTerm() { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_STRING;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = out.val.t;
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPStringTerm::YAPStringTerm(wchar_t *s, size_t len) : YAPTerm() { // build string
2014-05-04 22:31:22 +01:00
BACKUP_H();
CACHE_REGS
seq_tv_t inp, out;
inp.val.w = s;
inp.type = YAP_STRING_WCHARS;
out.type = YAP_STRING_STRING|YAP_STRING_NCHARS|YAP_STRING_TRUNC;
out.sz = len;
out.max = len;
if (Yap_CVT_Text(&inp, &out PASS_REGS))
t = out.val.t;
else t = 0L;
RECOVER_H();
2014-04-28 11:47:09 +01:00
}
YAPApplTerm::YAPApplTerm(YAPFunctor f, YAPTerm ts[]) : YAPTerm() {
2014-05-04 22:31:22 +01:00
UInt arity = ArityOfFunctor(f.f);
t = Yap_MkApplTerm( f.f, arity, (Term *)ts);
2014-04-28 11:47:09 +01:00
}
YAPApplTerm::YAPApplTerm(YAPFunctor f) : YAPTerm() {
2014-05-04 22:31:22 +01:00
UInt arity = ArityOfFunctor(f.f);
t = Yap_MkNewApplTerm( f.f, arity);
2014-04-28 11:47:09 +01:00
}
2014-04-29 11:45:19 +01:00
YAPTerm YAPApplTerm::getArg(unsigned int arg) {
2014-05-04 22:31:22 +01:00
return YAPTerm( ArgOfTerm(arg, t) );
2014-04-29 11:45:19 +01:00
}
YAPFunctor YAPApplTerm::getFunctor() {
2014-05-04 22:31:22 +01:00
return YAPFunctor( FunctorOfTerm(t) );
2014-04-29 11:45:19 +01:00
}
2014-04-28 11:47:09 +01:00
YAPPairTerm::YAPPairTerm(YAPTerm th, YAPTerm tl) : YAPTerm() {
2014-05-04 22:31:22 +01:00
CACHE_REGS
t = MkPairTerm( th.t, tl.t);
2014-04-28 11:47:09 +01:00
}
YAPPairTerm::YAPPairTerm() : YAPTerm() {
2014-05-04 22:31:22 +01:00
t = Yap_MkNewPairTerm( );
2014-04-28 11:47:09 +01:00
}
YAP_tag_t YAPTerm::tag() {
2014-05-04 22:31:22 +01:00
if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t);
if (IsUnboundVar(pt)) {
CACHE_REGS
if (IsAttVar(pt))
return YAP_TAG_ATT;
return YAP_TAG_UNBOUND;
}
return YAP_TAG_REF;
}
if (IsPairTerm(t))
return YAP_TAG_PAIR;
if (IsAtomOrIntTerm(t)) {
if (IsAtomTerm(t))
return YAP_TAG_ATOM;
return YAP_TAG_INT;
} else {
Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef) {
return YAP_TAG_DBREF;
}
if (f == FunctorLongInt) {
return YAP_TAG_LONG_INT;
}
if (f == FunctorBigInt) {
big_blob_type bt = (big_blob_type)RepAppl(t)[1];
switch (bt) {
case BIG_INT:
return YAP_TAG_BIG_INT;
case BIG_RATIONAL:
return YAP_TAG_RATIONAL;
default:
return YAP_TAG_OPAQUE;
}
}
}
return YAP_TAG_APPL;
2014-04-28 11:47:09 +01:00
}
}
YAPTerm YAPTerm::deepCopy() {
2014-05-04 22:31:22 +01:00
Term tn;
BACKUP_MACHINE_REGS();
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
tn = Yap_CopyTerm(t);
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return new YAPTerm( tn );
2014-04-28 11:47:09 +01:00
}
bool YAPTerm::exactlyEqual(YAPTerm t1) {
2014-05-04 22:31:22 +01:00
int out;
BACKUP_MACHINE_REGS();
out = Yap_eq(Deref(t), Deref(t1.t));
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return out;
2014-04-28 11:47:09 +01:00
}
2014-05-04 22:31:22 +01:00
2014-04-28 11:47:09 +01:00
bool YAPTerm::unify(YAPTerm t1) {
2014-05-04 22:31:22 +01:00
int out;
BACKUP_MACHINE_REGS();
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
out = Yap_unify(Deref(t), Deref(t1.t));
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return out;
2014-04-28 11:47:09 +01:00
}
bool YAPTerm::unifiable(YAPTerm t1) {
2014-05-04 22:31:22 +01:00
int out;
BACKUP_MACHINE_REGS();
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
out = Yap_Unifiable(Deref(t), Deref(t1.t));
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return out;
2014-04-28 11:47:09 +01:00
}
bool YAPTerm::variant(YAPTerm t1) {
2014-05-04 22:31:22 +01:00
int out;
BACKUP_MACHINE_REGS();
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
out = Yap_Variant(Deref(t), Deref(t1.t));
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return out;
2014-04-28 11:47:09 +01:00
}
intptr_t YAPTerm::hash(size_t sz, size_t depth, bool variant) {
2014-05-04 22:31:22 +01:00
Int out;
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
BACKUP_MACHINE_REGS();
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
out = Yap_TermHash(t, sz, depth, variant);
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
RECOVER_MACHINE_REGS();
return out;
2014-04-28 11:47:09 +01:00
}
char *YAPAtom::name(void) {
2014-05-04 22:31:22 +01:00
if (IsWideAtom(a)) {
// return an UTF-8 version
size_t sz = 512;
wchar_t * ptr = a->WStrOfAE;
int ch = -1;
char *s = new char[sz], *op = s;
while (ch) {
ch = *ptr++;
utf8_put_char( op, ch );
}
sz = strlen(s)+1;
char *os = new char[sz];
memcpy(os, s, sz);
delete s;
return os;
} else if (IsBlob(a)) {
PL_blob_t *type = RepBlobProp(a->PropsOfAE)->blob_t;
size_t sz = 512;
if (type->write) {
char *s = new char[sz];
IOSTREAM *stream = Sopenmem(&s, &sz, "w");
stream->encoding = ENC_UTF8;
atom_t at = YAP_SWIAtomFromAtom(AbsAtom(a));
type->write(stream, at, 0);
Sclose(stream);
popOutputContext();
sz = strlen(s)+1;
char *os = new char[sz];
memcpy(os, s, sz);
delete s;
return os;
} else {
char *s = new char[sz];
2014-04-28 11:47:09 +01:00
#if defined(__linux__) || defined(__APPLE__)
2014-05-04 22:31:22 +01:00
snprintf(s, sz, "'%s'(%p)", AtomSWIStream->StrOfAE, a);
2014-04-28 11:47:09 +01:00
#else
2014-05-04 22:31:22 +01:00
snprintf(s, sz, "'%s'(0x%p)", AtomSWIStream->StrOfAE, a);
2014-04-28 11:47:09 +01:00
#endif
2014-05-04 22:31:22 +01:00
char *os = new char[sz];
memcpy(os, s, sz);
delete s;
return os;
}
} else {
return a->StrOfAE;
}
2014-04-28 11:47:09 +01:00
}
2014-04-29 11:45:19 +01:00
void
YAPQuery::initQuery( Term *t )
2014-04-28 11:47:09 +01:00
{
2014-05-04 22:31:22 +01:00
CACHE_REGS
this->oq = (YAPQuery *)LOCAL_execution;
LOCAL_execution = (struct open_query_struct *)this;
this->q_open=1;
this->q_state=0;
this->q_flags = 0;
this->q_g = t;
2014-04-28 11:47:09 +01:00
}
2014-04-29 11:45:19 +01:00
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm t[]): YAPPredicate(f, mod)
2014-04-28 11:47:09 +01:00
{
2014-05-04 22:31:22 +01:00
/* ignore flags for now */
initQuery( (Term *)t );
2014-04-29 11:45:19 +01:00
}
2014-04-28 11:47:09 +01:00
2014-04-29 11:45:19 +01:00
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm t[]): YAPPredicate(f)
{
2014-05-04 22:31:22 +01:00
/* ignore flags for now */
initQuery( (Term *)t );
2014-04-28 11:47:09 +01:00
}
YAPQuery::YAPQuery(YAPPredicate p, YAPTerm t[]): YAPPredicate(p.ap)
{
2014-05-04 22:31:22 +01:00
initQuery( (Term *)t );
2014-04-29 11:45:19 +01:00
}
2014-04-28 11:47:09 +01:00
2014-04-29 11:45:19 +01:00
YAPQuery::YAPQuery(char *s): YAPPredicate(s, &this->q_g)
{
2014-05-04 22:31:22 +01:00
Term *t = this->q_g;
2014-04-29 11:45:19 +01:00
2014-05-04 22:31:22 +01:00
initQuery( t );
2014-04-28 11:47:09 +01:00
}
int YAPQuery::next()
{
2014-05-04 22:31:22 +01:00
CACHE_REGS
int result;
if (this->q_open != 1) return 0;
if (setjmp(((YAPQuery *)LOCAL_execution)->q_env))
return 0;
// don't forget, on success these guys must create slots
if (this->q_state == 0) {
result = YAP_EnterGoal((YAP_PredEntryPtr)this->ap, this->q_g, &this->q_h);
} else {
LOCAL_AllowRestart = this->q_open;
result = YAP_RetryGoal(&this->q_h);
}
this->q_state = 1;
if (result == 0) {
YAP_LeaveGoal(FALSE, &this->q_h);
this->q_open = 0;
}
return result;
2014-04-28 11:47:09 +01:00
}
void YAPQuery::cut()
{
2014-05-04 22:31:22 +01:00
CACHE_REGS
2014-04-28 11:47:09 +01:00
2014-05-04 22:31:22 +01:00
if (this->q_open != 1 || this->q_state == 0) return;
YAP_LeaveGoal(FALSE, &this->q_h);
this->q_open = 0;
LOCAL_execution = (struct open_query_struct *)this->oq;
2014-04-28 11:47:09 +01:00
}
void YAPQuery::close()
{
2014-05-04 22:31:22 +01:00
CACHE_REGS
if (EX && !(this->q_flags & (PL_Q_CATCH_EXCEPTION))) {
EX = NULL;
}
/* need to implement backtracking here */
if (this->q_open != 1 || this->q_state == 0) {
return;
}
YAP_LeaveGoal(FALSE, &this->q_h);
this->q_open = 0;
LOCAL_execution = (struct open_query_struct *)this->oq;
2014-04-28 11:47:09 +01:00
}
int YAPPredicate::call(YAPTerm t[])
{
2014-05-04 22:31:22 +01:00
YAPQuery q = YAPQuery(*this, t);
int ret = q.next();
q.cut();
q.close();
return ret;
2014-04-28 11:47:09 +01:00
}
2014-04-29 11:45:19 +01:00
2014-05-04 22:31:22 +01:00
YAPEngine::YAPEngine(YAPParams const& params)
2014-04-29 11:45:19 +01:00
{ YAP_Init( (YAP_init_args *)&params.init_args ); }