/*************************
* list_length
*************************/
static int
list_length(term_t pl_list)
{
predicate_t pr_length;
term_t pl_args, pl_length;
int length;
pr_length = PL_predicate("length", 2, NULL);
pl_args = PL_new_term_refs(2);
pl_length = pl_args + 1;
if (!PL_unify(pl_args, pl_list) ||
!PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args))
length = -1;
else
PL_get_integer(pl_length, &length);
return length;
}
int
main(int argc, char **argv)
{ char expression[MAXLINE];
char *e = expression;
char *program = argv[0];
char *plav[2];
int n;
/* combine all the arguments in a single string */
for(n=1; n<argc; n++)
{ if ( n != 1 )
*e++ = ' ';
strcpy(e, argv[n]);
e += strlen(e);
}
/* make the argument vector for Prolog */
plav[0] = program;
plav[1] = NULL;
/* initialise Prolog */
if ( !PL_initialise(1, plav) )
PL_halt(1);
/* Lookup calc/1 and make the arguments and call */
{ predicate_t pred = PL_predicate("calc", 1, "user");
term_t h0 = PL_new_term_refs(1);
int rval;
PL_put_atom_chars(h0, expression);
rval = PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0);
PL_halt(rval ? 0 : 1);
}
return 0;
}
static bool
clearSourceAdmin(SourceFile sf)
{ GET_LD
int rc = FALSE;
if ( sf->magic == SF_MAGIC )
{ fid_t fid = PL_open_foreign_frame();
term_t name = PL_new_term_ref();
static predicate_t pred = NULL;
if ( !pred )
pred = PL_predicate("$clear_source_admin", 1, "system");
PL_put_atom(name, sf->name);
rc = PL_call_predicate(MODULE_system, PL_Q_NORMAL, pred, name);
PL_discard_foreign_frame(fid);
}
return rc;
}
int main()
{
char *ancestor(const char *me)
term_t a0 = PL_new_term_refs(3);
term_t a1 = PL_new_term_refs(3);
term_t a2 = PL_new_term_refs(3);
static predicate_t p;
if ( !p )
p = PL_predicate("pere", 3, "teste.pl");
PL_put_atom_chars(a0, me);
PL_open_query(NULL, PL_Q_NORMAL, p, a0);
PL_open_query(NULL, PL_Q_NORMAL, p, a1);
printf("%s", me);
return 0;
}
// ######################################################################
bool SWIProlog::query(const char *predicate, std::vector<std::string> &args)
{
bool ret=false;
#ifdef HAVE_SWI_PROLOG_H
term_t a0 = PL_new_term_refs(args.size());
predicate_t p = NULL;
p = PL_predicate(predicate, args.size(), NULL);
for(uint i=0; i<args.size(); i++)
{
if (args[i].size() != 0)
PL_put_atom_chars(a0+i, args[i].c_str());
}
qid_t query_id= PL_open_query(NULL, (PL_Q_NORMAL|PL_Q_CATCH_EXCEPTION), p, a0);
ret = PL_next_solution(query_id);
if (ret)
{
//fill in the results in the place holdes
for(uint i=0; i<args.size(); i++)
{
if (args[i].size() == 0)
{
char *data;
PL_get_atom_chars(a0+i, &data);
args[i] = std::string(data);
}
}
}
PL_close_query(query_id);
#else
LINFO("SWI prolog not found");
#endif
return ret;
}
// ######################################################################
bool SWIProlog::consult(const char *filename)
{
bool ret = false;
#ifdef HAVE_SWI_PROLOG_H
term_t a0 = PL_new_term_refs(1);
predicate_t p = NULL;
p = PL_predicate("consult", 1, NULL);
PL_put_atom_chars(a0, filename);
qid_t query_id= PL_open_query(NULL, (PL_Q_NORMAL|PL_Q_CATCH_EXCEPTION), p, a0);
ret = PL_next_solution(query_id);
PL_close_query(query_id);
#else
LINFO("SWI prolog not found");
#endif
return ret;
}
int main(int argc, char **argv)
{
char *program = argv[0];
char *plav[2];
char problem[MAXLINE];
char *p = problem;
/* make the argument vector for Prolog */
plav[0] = program;
plav[1] = NULL;
/* initialize Prolog */
if ( !PL_initialise(1, plav) )
PL_halt(1);
/* initialize the input planning problem */
strcpy(p, argv[1]);
printf("%s\n", p);
/* Lookup solve/1 and make the arguments and call */
predicate_t pred = PL_predicate("solve", 1, "user");
term_t h0 = PL_new_term_refs(1);
int rval;
PL_put_atom_chars(h0, problem);
rval = PL_call_predicate(NULL, PL_Q_NORMAL, pred, h0);
PL_halt(rval ? 0 : 1);
return 0;
}
static PyObject* pyswipl_run(PyObject* self_Py, PyObject* args_Py) {
char* goalString;
char* answer;
int answerCount;
PyObject* answerList_Py;
PyObject* answerString_Py;
PyObject* bindingList_Py;
PyObject* binding_Py;
term_t swipl_args;
term_t swipl_goalCharList;
term_t swipl_bindingList;
term_t swipl_head;
term_t swipl_list;
predicate_t swipl_predicate;
qid_t swipl_qid;
fid_t swipl_fid;
/**********************************************************/
/* The queryString_C should be a python string represting */
/* the query to be executed on the prolog system. */
/**********************************************************/
if(!PyArg_ParseTuple(args_Py, "s", &goalString))
return NULL;
else {
/**********************************************************/
/* Create a Python list to hold the lists of bindings. */
/**********************************************************/
//if ( answerList_Py != NULL )
// Py_DECREF(answerList_Py);
answerList_Py=PyList_New(0);
/**********************************************************/
/* Open a foreign frame and initialize the term refs. */
/**********************************************************/
swipl_fid=PL_open_foreign_frame();
swipl_head=PL_new_term_ref(); /* Used in unpacking the binding List */
swipl_args=PL_new_term_refs(2); /* The compound term for arguments to run/2 */
swipl_goalCharList=swipl_args; /* Alias for arg 1 */
swipl_bindingList=swipl_args+1; /* Alias for arg 2 */
/**********************************************************/
/* Pack the query string into the argument compund term. */
/**********************************************************/
PL_put_list_chars(swipl_goalCharList,goalString);
/**********************************************************/
/* Generate a predicate to pyrun/2 */
/**********************************************************/
swipl_predicate=PL_predicate("pyrun",2,NULL);
/**********************************************************/
/* Open the query, and iterate through the solutions. */
/**********************************************************/
swipl_qid=PL_open_query(NULL,PL_Q_NORMAL,swipl_predicate, swipl_args);
while(PL_next_solution(swipl_qid)) {
/**********************************************************/
/* Create a Python list to hold the bindings. */
/**********************************************************/
bindingList_Py=PyList_New(0);
/**********************************************************/
/* Step through the bindings and add each to the list. */
/**********************************************************/
swipl_list=PL_copy_term_ref(swipl_bindingList);
while(PL_get_list(swipl_list, swipl_head, swipl_list)) {
PL_get_chars(swipl_head, &answer, CVT_ALL|CVT_WRITE|BUF_RING);
answerString_Py = PyString_FromString(answer);
PyList_Append(bindingList_Py, answerString_Py);
Py_DECREF(answerString_Py);
}
/**********************************************************/
/* Add this binding list to the list of all solutions. */
/**********************************************************/
PyList_Append(answerList_Py, bindingList_Py);
Py_DECREF(bindingList_Py);
}
/**********************************************************/
/* Free this foreign frame... */
/* Added by Nathan Denny, July 18, 2001. */
/* Fixes a bug with running out of global stack when */
/* asserting _lots_ of facts. */
/**********************************************************/
PL_close_query(swipl_qid);
PL_discard_foreign_frame(swipl_fid);
/**********************************************************/
/* Return the list of solutions. */
/**********************************************************/
return answerList_Py;
}
}
/*************************
* libprolog_load_file
*************************/
int
libprolog_load_file(char *path, int extension)
{
char *loader = extension ? "load_foreign_library" : "consult";
predicate_t pr_loader;
fid_t frame;
qid_t qid;
term_t pl_path;
int success;
/*
* load the given file (native prolog or foreign library)
*
* Notes:
* The prolog predicate consult/1 does not seem to fail or raise an
* exception upon errors. It merely produces an error message and
* tries to continue or gives up processing the input file. In either
* case it succeeds (ie. the goal consult(path) is always proven in
* the prolog sense).
*
* This default behaviour is not acceptable for us. As a library we
* want to let our caller know whether loading was successful or not.
* Otherwise it would be impossible to write even remotely reliable
* applications using this library.
*
* To detect errors we have special prolog glue code that hooks into
* SWI Prologs user:message_hook and lets us know about errors
* (libprolog:mark_error) if loading is active (libprolog:loading).
* Currently the glue code prints an error message but it would be
* fairly easy to collect the errors here and let our caller print
* them if needed. For the time being this glue code lives in policy.pl
* but will eventually be separated out (to libprolog.pl ?).
*/
libprolog_clear_errors();
libprolog_load_start();
frame = PL_open_foreign_frame();
pr_loader = PL_predicate(loader, 1, NULL);
pl_path = PL_new_term_ref();
PL_put_atom_chars(pl_path, path);
qid = PL_open_query(NULL, NORMAL_QUERY_FLAGS, pr_loader, pl_path);
success = PL_next_solution(qid);
if (PL_exception(qid)) {
#if 0
char **exception = collect_exception(qid, &exception);
libprolog_dump_exception(exception);
#endif
success = FALSE;
}
PL_close_query(qid);
PL_discard_foreign_frame(frame);
libprolog_load_done();
if (libprolog_has_errors())
return FALSE;
else
return success;
}
void
initBuildIns(void)
{ ExtensionCell ecell;
Module m = MODULE_system;
GD->procedures.dirty = newHTable(32);
registerBuiltins(foreigns);
REG_PLIST(alloc);
REG_PLIST(atom);
REG_PLIST(arith);
REG_PLIST(bag);
REG_PLIST(comp);
REG_PLIST(flag);
REG_PLIST(index);
REG_PLIST(list);
REG_PLIST(module);
REG_PLIST(prims);
REG_PLIST(strings);
REG_PLIST(variant);
REG_PLIST(copyterm);
REG_PLIST(prologflag);
REG_PLIST(trace);
REG_PLIST(pro);
REG_PLIST(read);
REG_PLIST(thread);
REG_PLIST(profile);
REG_PLIST(wic);
REG_PLIST(file);
REG_PLIST(files);
REG_PLIST(glob);
REG_PLIST(btree);
REG_PLIST(ctype);
REG_PLIST(tai);
REG_PLIST(setup);
REG_PLIST(gc);
REG_PLIST(proc);
REG_PLIST(srcfile);
REG_PLIST(write);
REG_PLIST(dlopen);
REG_PLIST(system);
REG_PLIST(op);
REG_PLIST(rec);
REG_PLIST(term);
REG_PLIST(termhash);
#ifdef O_ATTVAR
REG_PLIST(attvar);
#endif
#ifdef O_GVAR
REG_PLIST(gvar);
#endif
#ifdef __WINDOWS__
REG_PLIST(win);
REG_PLIST(dde);
#endif
#ifdef O_LOCALE
REG_PLIST(locale);
#endif
REG_PLIST(debug);
REG_PLIST(dict);
REG_PLIST(cont);
REG_PLIST(trie);
REG_PLIST(tabling);
REG_PLIST(mutex);
REG_PLIST(zip);
REG_PLIST(cbtrace);
#define LOOKUPPROC(name) \
{ GD->procedures.name = lookupProcedure(FUNCTOR_ ## name, m); \
DEBUG(CHK_SECURE, assert(GD->procedures.name)); \
}
LOOKUPPROC(dgarbage_collect1);
LOOKUPPROC(catch3);
LOOKUPPROC(reset3);
LOOKUPPROC(dmeta_call1);
LOOKUPPROC(true0);
LOOKUPPROC(fail0);
LOOKUPPROC(equals2);
LOOKUPPROC(is2);
LOOKUPPROC(strict_equal2);
LOOKUPPROC(not_strict_equal2);
LOOKUPPROC(print_message2);
LOOKUPPROC(dcall1);
LOOKUPPROC(setup_call_catcher_cleanup4);
LOOKUPPROC(dthread_init0);
LOOKUPPROC(dc_call_prolog0);
LOOKUPPROC(dinit_goal3);
#ifdef O_ATTVAR
LOOKUPPROC(dwakeup1);
#endif
#if O_DEBUGGER
PROCEDURE_event_hook1 =
PL_predicate("prolog_event_hook", 1, "user");
#endif
PROCEDURE_exception_hook4 =
PL_predicate("prolog_exception_hook", 4, "user");
/* allow debugging in call/1 */
clear(PROCEDURE_dcall1->definition, HIDE_CHILDS|TRACE_ME);
set(PROCEDURE_dcall1->definition, P_DYNAMIC|P_LOCKED);
PL_meta_predicate(PL_predicate("assert", 1, "system"), ":");
PL_meta_predicate(PL_predicate("asserta", 1, "system"), ":");
PL_meta_predicate(PL_predicate("assertz", 1, "system"), ":");
PL_meta_predicate(PL_predicate("assert", 2, "system"), ":-");
PL_meta_predicate(PL_predicate("asserta", 2, "system"), ":-");
PL_meta_predicate(PL_predicate("assertz", 2, "system"), ":-");
PL_meta_predicate(PL_predicate("retract", 1, "system"), ":");
PL_meta_predicate(PL_predicate("retractall", 1, "system"), ":");
PL_meta_predicate(PL_predicate("clause", 2, "system"), ":?");
PL_meta_predicate(PL_predicate("format", 2, "system"), "+:");
PL_meta_predicate(PL_predicate("format", 3, "system"), "++:");
PL_meta_predicate(PL_predicate("format_predicate", 2, "system"), "+0");
PL_meta_predicate(PL_predicate("notrace", 1, "system"), "0");
PL_meta_predicate(PL_predicate("with_mutex", 2, "system"), "+0");
PL_meta_predicate(PL_predicate("with_output_to", 2, "system"), "+0");
#ifdef O_PLMT
PL_meta_predicate(PL_predicate("thread_create", 3, "system"), "0?+");
PL_meta_predicate(PL_predicate("thread_at_exit", 1, "system"), "0");
PL_meta_predicate(PL_predicate("thread_signal", 2, "system"), "+0");
#endif
PL_meta_predicate(PL_predicate("prolog_frame_attribute", 3, "system"), "++:");
PL_meta_predicate(PL_predicate("compile_predicates", 1, "system"), ":");
PL_meta_predicate(PL_predicate("op", 3, "system"), "++:");
PL_meta_predicate(PL_predicate("current_op", 3, "system"), "++:");
for( ecell = ext_head; ecell; ecell = ecell->next )
bindExtensions(ecell->module, ecell->extensions);
extensions_loaded = TRUE;
}
/* compile all rules */
EtalisExecTree* buildExecTree()
{
printf("--- Generating Rule Tree ...\n");
EtalisExecTree* tree = calloc(1,sizeof(EtalisExecTree));
tree->size=3; /* TODO (hafsi#4#): fixme */ /*if more than one rule, find out how many complex events*/
tree->exec=print_event;
tree->complexEvents = (EtalisExecNode*)calloc(tree->size,sizeof(EtalisExecNode));
EtalisBatch* temp_batch = (EtalisBatch*)malloc(sizeof(EtalisBatch));
int i=0;
static predicate_t p;
term_t _args_binary_event_rule = PL_new_term_refs(3);
atom_t name;
int temp_arity;
if ( !p )
p = PL_predicate("binary_event_rule", 3, NULL);
qid_t qid = PL_open_query(NULL, PL_Q_NORMAL, p, _args_binary_event_rule);
while(PL_next_solution(qid) != FALSE)
{
EtalisEventNode* temp_event = tree->complexEvents+i; /* next complex event */
EtalisExecNode* temp_operator =(EtalisExecNode*)malloc(sizeof(EtalisExecNode));
memset(temp_operator,0,sizeof(EtalisExecNode));
assert( temp_event != NULL && temp_operator != NULL);
temp_event->parentNode=NULL; /*a complex event does not have a parent*/
temp_event->childNode=temp_operator;
temp_event->trigger=_cep_print_event; /* by default, triggering a complx event would print it */
temp_operator->parentEvent=temp_event;
temp_batch->batchSize=1;
temp_batch->nodes=temp_operator;
/*get label*/
PL_get_name_arity(_args_binary_event_rule, &name, &temp_arity);
strcpy(temp_batch->label,PL_atom_chars(name));
/*get complex event*/
PL_get_name_arity(_args_binary_event_rule+1, &name, &temp_arity);
strcpy(temp_event->event.name,PL_atom_chars(name));
temp_event->event.arity = temp_arity;
/*get rule*/
construct_rule(temp_batch,_args_binary_event_rule+2);
/* init a stack for each event*/
/* query the tree in the depth */
EtalisEventNode* temp_event_index = temp_operator->leftChild;
for (temp_event_index = temp_operator->leftChild;temp_event_index->childNode != NULL;temp_event_index = temp_event_index->childNode->leftChild)
{
temp_event_index->eventStack = StackCreate();
if(temp_event_index->parentNode->op_type == binary)
temp_event_index->parentNode->rightChild->eventStack = StackCreate();
}
/* Create stack for leaf nodes*/
temp_event_index->eventStack = StackCreate();
if(temp_event_index->parentNode->op_type == binary)
temp_event_index->parentNode->rightChild->eventStack = StackCreate();
/* build argument logical models */
/*
if(temp_operator->has_condition == ETALIS_TRUE)
{
;
build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2);
}
else
{
build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2);
}
*/
/*print the rule*/ /* only if debugging */
#ifdef DEBUG
/*print_rule(temp_event);*/
#endif
/*add to event hash*/
addToEventHash(temp_operator);
i++; /*next rule*/
};
PL_close_query(qid);
/*from the rules build the tree*/
printf("--- Done!\n");
return tree;
}
