/*
Input:
Arg1: +Substr
Arg2: + String
Arg3: +forward/reverse (checks only f/r)
f means the first match from the start of String
r means the first match from the end of String
Output:
Arg4: Beg
Beg is the offset where Substr matches. Must be a variable or an
integer
Arg5: End
End is the offset of the next character after the end of Substr
Must be a variable or an integer.
Both Beg and End can be negative, in which case they represent the offset
from the 2nd character past the end of String.
For instance, -1 means the next character past the end of String,
so End = -1 means that Substr must be a suffix of String..
The meaning of End and of negative offsets is consistent with substring
and string_substitute predicates.
*/
xsbBool str_match(CTXTdecl)
{
static char *subptr, *stringptr, *direction, *matchptr;
static size_t substr_beg, substr_end;
int reverse=TRUE; /* search in reverse */
int beg_bos_offset=TRUE; /* measure beg offset from the beg of string */
int end_bos_offset=TRUE; /* measure end offset from the beg of string */
Integer str_len, sub_len; /* length of string and substring */
Cell beg_offset_term, end_offset_term;
term = ptoc_tag(CTXTc 1);
term2 = ptoc_tag(CTXTc 2);
term3 = ptoc_tag(CTXTc 3);
beg_offset_term = ptoc_tag(CTXTc 4);
end_offset_term = ptoc_tag(CTXTc 5);
if (!isatom(term) || !isatom(term2) || !isatom(term3)) {
xsb_abort("STR_MATCH: Arguments 1,2,3 must be bound to strings");
}
subptr = string_val(term);
stringptr = string_val(term2);
direction = string_val(term3);
if (*direction == 'f')
reverse=FALSE;
else if (*direction != 'r')
xsb_abort("STR_MATCH: Argument 3 must be bound to forward/reverse");
str_len=strlen(stringptr);
sub_len=strlen(subptr);
if (isointeger(beg_offset_term)) {
if (oint_val(beg_offset_term) < 0) {
beg_bos_offset = FALSE;
}
}
if (isointeger(end_offset_term)) {
if (oint_val(end_offset_term) < 0) {
end_bos_offset = FALSE;
}
}
if (reverse)
matchptr = xsb_strrstr(stringptr, subptr);
else
matchptr = strstr(stringptr, subptr);
if (matchptr == NULL) return FALSE;
substr_beg = (beg_bos_offset?
matchptr - stringptr : -(str_len - (matchptr - stringptr))
);
substr_end = (end_bos_offset?
(matchptr - stringptr) + sub_len
: -(str_len + 1 - (matchptr - stringptr) - sub_len)
);
return
(p2p_unify(CTXTc beg_offset_term, makeint(substr_beg))
&& p2p_unify(CTXTc end_offset_term, makeint(substr_end)));
}
int return_to_prolog(PyObject *pValue)
{
if(pValue == Py_None){
return 1;
}
if(PyInt_Check(pValue))
{
int result = PyInt_AS_LONG(pValue);
extern_ctop_int(3, result);
return 1;
}
else if(PyFloat_Check(pValue))
{
float result = PyFloat_AS_DOUBLE(pValue);
extern_ctop_float(3, result);
return 1;
}else if(PyString_Check(pValue))
{
char *result = PyString_AS_STRING(pValue);
extern_ctop_string(3, result);
return 1;
}else if(PyList_Check(pValue))
{
size_t size = PyList_Size(pValue);
size_t i = 0;
prolog_term head, tail;
prolog_term P = p2p_new();
tail = P;
for(i = 0; i < size; i++)
{
c2p_list(CTXTc tail);
head = p2p_car(CTXTc tail);
PyObject *pyObj = PyList_GetItem(pValue, i);
int temp = PyInt_AS_LONG(pyObj);
c2p_int(temp, head);
//convert_pyObj_prObj(pyObj, &head);
tail = p2p_cdr(tail);
}
c2p_nil(CTXTc tail);
p2p_unify(P, reg_term(CTXTc 3));
return 1;
}else
{
//returns an object refernce to prolog side.
pyobj_ref_node *node = add_pyobj_ref_list(pValue);
//printf("node : %p", node);
char str[30];
sprintf(str, "%p", node);
//extern_ctop_string(3,str);
prolog_term ref = p2p_new();
c2p_functor("pyObject", 1, ref);
prolog_term ref_inner = p2p_arg(ref, 1);
c2p_string(str, ref_inner);
p2p_unify(ref, reg_term(CTXTc 3));
return 1;
}
return 0;
}
static xsbBool set_error_code(CTXTdeclc int ErrCode, int ErrCodeArgNumber, char *Where)
{
prolog_term ecode_value_term, ecode_arg_term = p2p_new(CTXT);
ecode_value_term = reg_term(CTXTc ErrCodeArgNumber);
if (!isref(ecode_value_term) &&
!(isointeger(ecode_value_term)))
xsb_abort("[%s] Arg %d (the error code) must be a variable or an integer!",
Where, ErrCodeArgNumber);
c2p_int(CTXTc ErrCode, ecode_arg_term);
return p2p_unify(CTXTc ecode_arg_term, ecode_value_term);
}
/* XSB regular expression matcher entry point
In:
Arg1: regexp
Arg2: string
Arg3: offset
Arg4: match_flags: Var means case-sensitive/extended;
number: ignorecase/extended
List: [{extended|ignorecase},...]
Out:
Arg5: list of the form [match(bo0,eo0), match(bo1,eo1),...]
where bo*,eo* specify the beginning and ending offsets of the
matched substrings.
All matched substrings are returned. Parenthesized expressions are
ignored.
*/
int do_bulkmatch__(void)
{
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
prolog_term listHead, listTail;
/* Prolog args are first assigned to these, so we could examine the types
of these objects to determine if we got strings or atoms. */
prolog_term regexp_term, input_term, offset_term;
prolog_term output_term = p2p_new(CTXT);
char *regexp_ptr=NULL; /* regular expression ptr */
char *input_string=NULL; /* string where matches are to be found */
int match_flags=FALSE;
int return_code, paren_number, offset;
regmatch_t *match_array;
int last_pos=0, input_len;
if (first_call)
initialize_regexp_tbl();
regexp_term = reg_term(CTXTc 1); /* Arg1: regexp */
if (is_string(regexp_term)) /* check it */
regexp_ptr = string_val(regexp_term);
else if (is_list(regexp_term))
regexp_ptr = p_charlist_to_c_string(CTXTc regexp_term, ®exp_buffer,
"RE_BULKMATCH", "regular expression");
else
xsb_abort("[RE_BULKMATCH] Arg 1 (the regular expression) must be an atom or a character list");
input_term = reg_term(CTXTc 2); /* Arg2: string to find matches in */
if (is_string(input_term)) /* check it */
input_string = string_val(input_term);
else if (is_list(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"RE_BULKMATCH", "input string");
} else
xsb_abort("[RE_BULKMATCH] Arg 2 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
offset_term = reg_term(CTXTc 3); /* arg3: offset within the string */
if (! is_int(offset_term))
xsb_abort("[RE_BULKMATCH] Arg 3 (the offset) must be an integer");
offset = int_val(offset_term);
if (offset < 0 || offset > input_len)
xsb_abort("[RE_BULKMATCH] Arg 3 (=%d) must be between 0 and %d", input_len);
/* arg 4 specifies flags: _, number, list [extended,ignorecase] */
match_flags = make_flags(reg_term(CTXTc 4), "RE_BULKMATCH");
last_pos = offset;
/* returned result */
listTail = output_term;
while (last_pos < input_len) {
return_code = xsb_re_match(regexp_ptr, input_string+last_pos, match_flags,
&match_array, &paren_number, "RE_BULKMATCH");
/* exit on no match */
if (! return_code) break;
c2p_list(CTXTc listTail); /* make it into a list */
listHead = p2p_car(listTail); /* get head of the list */
/* bind i-th match to listHead as match(beg,end) */
c2p_functor(CTXTc "match", 2, listHead);
c2p_int(CTXTc match_array[0].rm_so+last_pos, p2p_arg(listHead,1));
c2p_int(CTXTc match_array[0].rm_eo+last_pos, p2p_arg(listHead,2));
listTail = p2p_cdr(listTail);
if (match_array[0].rm_eo > 0)
last_pos = match_array[0].rm_eo+last_pos;
else
last_pos++;
}
c2p_nil(CTXTc listTail); /* bind tail to nil */
return p2p_unify(CTXTc output_term, reg_term(CTXTc 5));
}
DllExport int call_conv get_next_result(CTXTdecl)
{
if(head == NULL) return 0;
// process the head raptor-term and build a term
prolog_term return_term = reg_term(CTXTdecl 1);
prolog_term t = p2p_new();
c2p_functor(CTXTdecl prefix, 4, t);
c2p_raptor_term(CTXTdecl head->subject, p2p_arg(CTXTdecl t, 1));
c2p_raptor_term(CTXTdecl head->predicate, p2p_arg(CTXTdecl t, 2));
c2p_raptor_term(CTXTdecl head->object, p2p_arg(CTXTdecl t, 3));
c2p_raptor_term(CTXTdecl head->graph, p2p_arg(CTXTdecl t, 4));
p2p_unify(return_term, t);
// pop the head off the queue
struct raptor_node *old_head = head;
if(tail == head)
{
tail = NULL;
head = NULL;
}
else
head = head->prev;
// free up the strings
//printf("1");
if(old_head->subject.arg1 != NULL)
free(old_head->subject.arg1);
if(old_head->subject.arg2 != NULL)
free(old_head->subject.arg2);
if(old_head->subject.arg3 != NULL)
free(old_head->subject.arg3);
//printf("2");
if(old_head->predicate.arg1 != NULL)
free(old_head->predicate.arg1);
if(old_head->predicate.arg2 != NULL)
free(old_head->predicate.arg2);
if(old_head->predicate.arg3 != NULL)
free(old_head->predicate.arg3);
//printf("3");
if(old_head->object.arg1 != NULL)
free(old_head->object.arg1);
if(old_head->object.arg2 != NULL)
free(old_head->object.arg2);
if(old_head->object.arg3 != NULL)
free(old_head->object.arg3);
//printf("4");
if(old_head->graph.arg1 != NULL)
free(old_head->graph.arg1);
if(old_head->graph.arg2 != NULL)
free(old_head->graph.arg2);
if(old_head->graph.arg3 != NULL)
free(old_head->graph.arg3);
//printf("5");
free(old_head);
// return
return 1;
}
/* TLS: making a conservative guess at which system calls need to be
mutexed. I'm doing it whenever I see the process table altered or
affected, so this is the data structure that its protecting.
At some point, the SET_FILEPTRs should be protected against other
threads closing that stream. Perhaps for such things a
thread-specific stream table should be used.
*/
xsbBool sys_system(CTXTdeclc int callno)
{
// int pid;
Integer pid;
switch (callno) {
case PLAIN_SYSTEM_CALL: /* dumb system call: no communication with XSB */
/* this call is superseded by shell and isn't used */
ctop_int(CTXTc 3, system(ptoc_string(CTXTc 2)));
return TRUE;
case SLEEP_FOR_SECS:
#ifdef WIN_NT
Sleep((int)iso_ptoc_int_arg(CTXTc 2,"sleep/1",1) * 1000);
#else
sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1));
#endif
return TRUE;
case GET_TMP_FILENAME:
ctop_string(CTXTc 2,tempnam(NULL,NULL));
return TRUE;
case IS_PLAIN_FILE:
case IS_DIRECTORY:
case STAT_FILE_TIME:
case STAT_FILE_SIZE:
return file_stat(CTXTc callno, ptoc_longstring(CTXTc 2));
case EXEC: {
#ifdef HAVE_EXECVP
/* execs a new process in place of XSB */
char *params[MAX_SUBPROC_PARAMS+2];
prolog_term cmdspec_term;
int index = 0;
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term)) {
prolog_term temp, head;
char *string_head=NULL;
if (isnil(cmdspec_term))
xsb_abort("[exec] Arg 1 must not be an empty list.");
temp = cmdspec_term;
do {
head = p2p_car(temp);
temp = p2p_cdr(temp);
if (isstring(head))
string_head = string_val(head);
else
xsb_abort("[exec] non-string argument passed in list.");
params[index++] = string_head;
if (index > MAX_SUBPROC_PARAMS)
xsb_abort("[exec] Too many arguments.");
} while (!isnil(temp));
params[index] = NULL;
} else if (isstring(cmdspec_term)) {
char *string = string_val(cmdspec_term);
split_command_arguments(string, params, "exec");
} else
xsb_abort("[exec] 1st argument should be term or list of strings.");
if (execvp(params[0], params))
xsb_abort("[exec] Exec call failed.");
#else
xsb_abort("[exec] builtin not supported in this architecture.");
#endif
}
case SHELL: /* smart system call: like SPAWN_PROCESS, but returns error code
instead of PID. Uses system() rather than execvp.
Advantage: can pass arbitrary shell command. */
case SPAWN_PROCESS: { /* spawn new process, reroute stdin/out/err to XSB */
/* +CallNo=2, +ProcAndArgsList,
-StreamToProc, -StreamFromProc, -StreamFromProcStderr,
-Pid */
static int pipe_to_proc[2], pipe_from_proc[2], pipe_from_stderr[2];
int toproc_stream=-1, fromproc_stream=-1, fromproc_stderr_stream=-1;
int pid_or_status;
FILE *toprocess_fptr=NULL,
*fromprocess_fptr=NULL, *fromproc_stderr_fptr=NULL;
char *params[MAX_SUBPROC_PARAMS+2]; /* one for progname--0th member,
one for NULL termination*/
prolog_term cmdspec_term, cmdlist_temp_term;
prolog_term cmd_or_arg_term;
xsbBool toproc_needed=FALSE, fromproc_needed=FALSE, fromstderr_needed=FALSE;
char *cmd_or_arg=NULL, *shell_cmd=NULL;
int idx = 0, tbl_pos;
char *callname=NULL;
xsbBool params_are_in_a_list=FALSE;
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (callno == SPAWN_PROCESS)
callname = "spawn_process/5";
else
callname = "shell/[1,2,5]";
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term))
params_are_in_a_list = TRUE;
else if (isstring(cmdspec_term))
shell_cmd = string_val(cmdspec_term);
else if (isref(cmdspec_term))
xsb_instantiation_error(CTXTc callname,1);
else
xsb_type_error(CTXTc "atom or list e.g. [command, arg, ...]",cmdspec_term,callname,1);
// xsb_abort("[%s] Arg 1 must be an atom or a list [command, arg, ...]",
// callname);
/* the user can indicate that he doesn't want either of the streams created
by putting an atom in the corresponding argument position */
if (isref(reg_term(CTXTc 3)))
toproc_needed = TRUE;
if (isref(reg_term(CTXTc 4)))
fromproc_needed = TRUE;
if (isref(reg_term(CTXTc 5)))
fromstderr_needed = TRUE;
/* if any of the arg streams is already used by XSB, then don't create
pipes --- use these streams instead. */
if (isointeger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, oint_val(reg_term(CTXTc 3)));
}
if (isointeger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, oint_val(reg_term(CTXTc 4)));
}
if (isointeger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, oint_val(reg_term(CTXTc 5)));
}
if (!isref(reg_term(CTXTc 6)))
xsb_type_error(CTXTc "variable (to return process id)",reg_term(CTXTc 6),callname,5);
// xsb_abort("[%s] Arg 5 (process id) must be a variable", callname);
if (params_are_in_a_list) {
/* fill in the params[] array */
if (isnil(cmdspec_term))
xsb_abort("[%s] Arg 1 must not be an empty list", callname);
cmdlist_temp_term = cmdspec_term;
do {
cmd_or_arg_term = p2p_car(cmdlist_temp_term);
cmdlist_temp_term = p2p_cdr(cmdlist_temp_term);
if (isstring(cmd_or_arg_term)) {
cmd_or_arg = string_val(cmd_or_arg_term);
}
else
xsb_abort("[%s] Non string list member in the Arg",
callname);
params[idx++] = cmd_or_arg;
if (idx > MAX_SUBPROC_PARAMS)
xsb_abort("[%s] Too many arguments passed to subprocess",
callname);
} while (!isnil(cmdlist_temp_term));
params[idx] = NULL; /* null termination */
} else { /* params are in a string */
if (callno == SPAWN_PROCESS)
split_command_arguments(shell_cmd, params, callname);
else {
/* if callno==SHELL => call system() => don't split shell_cmd */
params[0] = shell_cmd;
params[1] = NULL;
}
}
/* -1 means: no space left */
if ((tbl_pos = get_free_process_cell()) < 0) {
xsb_warn(CTXTc "Can't create subprocess because XSB process table is full");
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
/* params[0] is the progname */
pid_or_status = xsb_spawn(CTXTc params[0], params, callno,
(toproc_needed ? pipe_to_proc : NULL),
(fromproc_needed ? pipe_from_proc : NULL),
(fromstderr_needed ? pipe_from_stderr : NULL),
toprocess_fptr, fromprocess_fptr,
fromproc_stderr_fptr);
if (pid_or_status < 0) {
xsb_warn(CTXTc "[%s] Subprocess creation failed, Error: %d, errno: %d, Cmd: %s", callname,pid_or_status,errno,params[0]);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(CTXTc toprocess_fptr,callname,"pipe","w",CURRENT_CHARSET);
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(CTXTc fromprocess_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(CTXTc fromproc_stderr_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 5, fromproc_stderr_stream);
}
ctop_int(CTXTc 6, pid_or_status);
xsb_process_table.process[tbl_pos].pid = pid_or_status;
xsb_process_table.process[tbl_pos].to_stream = toproc_stream;
xsb_process_table.process[tbl_pos].from_stream = fromproc_stream;
xsb_process_table.process[tbl_pos].stderr_stream = fromproc_stderr_stream;
concat_array(CTXTc params, " ",
xsb_process_table.process[tbl_pos].cmdline,MAX_CMD_LEN);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case GET_PROCESS_TABLE: { /* sys_system(3, X). X is bound to the list
of the form [process(Pid,To,From,Stderr,Cmdline), ...] */
int i;
prolog_term table_term_tail, listHead;
prolog_term table_term=reg_term(CTXTc 2);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!isref(table_term))
xsb_abort("[GET_PROCESS_TABLE] Arg 1 must be a variable");
table_term_tail = table_term;
for (i=0; i<MAX_SUBPROC_NUMBER; i++) {
if (!FREE_PROC_TABLE_CELL(xsb_process_table.process[i].pid)) {
c2p_list(CTXTc table_term_tail); /* make it into a list */
listHead = p2p_car(table_term_tail);
c2p_functor(CTXTc "process", 5, listHead);
c2p_int(CTXTc xsb_process_table.process[i].pid, p2p_arg(listHead,1));
c2p_int(CTXTc xsb_process_table.process[i].to_stream, p2p_arg(listHead,2));
c2p_int(CTXTc xsb_process_table.process[i].from_stream, p2p_arg(listHead,3));
c2p_int(CTXTc xsb_process_table.process[i].stderr_stream,
p2p_arg(listHead,4));
c2p_string(CTXTc xsb_process_table.process[i].cmdline, p2p_arg(listHead,5));
table_term_tail = p2p_cdr(table_term_tail);
}
}
c2p_nil(CTXTc table_term_tail); /* bind tail to nil */
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return p2p_unify(CTXTc table_term, reg_term(CTXTc 2));
}
case PROCESS_STATUS: {
prolog_term pid_term=reg_term(CTXTc 2), status_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (!isref(status_term))
xsb_abort("[PROCESS_STATUS] Arg 2 (process status) must be a variable");
switch (process_status(pid)) {
case RUNNING:
c2p_string(CTXTc "running", status_term);
break;
case STOPPED:
c2p_string(CTXTc "stopped", status_term);
break;
case EXITED_NORMALLY:
c2p_string(CTXTc "exited_normally", status_term);
break;
case EXITED_ABNORMALLY:
c2p_string(CTXTc "exited_abnormally", status_term);
break;
case ABORTED:
c2p_string(CTXTc "aborted", status_term);
break;
case INVALID:
c2p_string(CTXTc "invalid", status_term);
break;
default:
c2p_string(CTXTc "unknown", status_term);
}
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case PROCESS_CONTROL: {
/* sys_system(PROCESS_CONTROL, +Pid, +Signal). Signal: wait, kill */
int status;
prolog_term pid_term=reg_term(CTXTc 2), signal_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (isstring(signal_term) && strcmp(string_val(signal_term), "kill")==0) {
if (KILL_FAILED(pid)) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
CloseHandle((HANDLE) pid);
#endif
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
if (isconstr(signal_term)
&& strcmp(p2c_functor(signal_term),"wait") == 0
&& p2c_arity(signal_term)==1) {
int exit_status;
if (WAIT(pid, status) < 0) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
exit_status = status;
#else
if (WIFEXITED(status))
exit_status = WEXITSTATUS(status);
else
exit_status = -1;
#endif
p2p_unify(CTXTc p2p_arg(signal_term,1), makeint(exit_status));
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
xsb_warn(CTXTc "[PROCESS_CONTROL] Arg 2: Invalid signal specification. Must be `kill' or `wait(Var)'");
return FALSE;
}
case LIST_DIRECTORY: {
/* assume all type- and mode-checking is done in Prolog */
prolog_term handle = reg_term(CTXTc 2); /* ref for handle */
char *dir_name = ptoc_longstring(CTXTc 3); /* +directory name */
prolog_term filename = reg_term(CTXTc 4); /* reference for name of file */
if (is_var(handle))
return xsb_find_first_file(CTXTc handle,dir_name,filename);
else
return xsb_find_next_file(CTXTc handle,dir_name,filename);
}
default:
xsb_abort("[SYS_SYSTEM] Wrong call number (an XSB bug)");
} /* end case */
return TRUE;
}
int convert_pyObj_prObj(PyObject *pyObj, prolog_term *prTerm)
{
if(pyObj == Py_None){
return 1;// todo: check this case for a list with a none in the list. how does prolog side react
}
if(PyInt_Check(pyObj))
{
int result = PyInt_AS_LONG(pyObj);
//extern_ctop_int(3, result);
c2p_int(result, *prTerm);
return 1;
}
else if(PyFloat_Check(pyObj))
{
float result = PyFloat_AS_DOUBLE(pyObj);
//extern_ctop_float(3, result);
c2p_float(result, *prTerm);
return 1;
}else if(PyString_Check(pyObj))
{
char *result = PyString_AS_STRING(pyObj);
//extern_ctop_string(3, result);
c2p_string(result, *prTerm);
return 1;
}else if(PyList_Check(pyObj))
{
size_t size = PyList_Size(pyObj);
size_t i = 0;
prolog_term head, tail;
prolog_term P = p2p_new();
tail = P;
for(i = 0; i < size; i++)
{
c2p_list(CTXTc tail);
head = p2p_car(CTXTc tail);
PyObject *pyObjInner = PyList_GetItem(pyObj, i);
//int temp = PyInt_AS_LONG(pyObj);
//c2p_int(temp, head);
convert_pyObj_prObj(pyObjInner, &head);
tail = p2p_cdr(tail);
}
c2p_nil(CTXTc tail);
//p2p_unify(P, reg_term(CTXTc 3));
return 1;
}else
{
//returns an object refernce to prolog side.
pyobj_ref_node *node = add_pyobj_ref_list(pyObj);
//printf("node : %p", node);
char str[30];
sprintf(str, "%p", node);
//extern_ctop_string(3,str);
prolog_term ref = p2p_new();
c2p_functor("pyObject", 1, ref);
prolog_term ref_inner = p2p_arg(ref, 1);
c2p_string(str, ref_inner);
p2p_unify(ref, *prTerm);
return 1;
}
}
/**
* Function to handle the errors. It creates an appropriate error term
* for the prolog side to throw.
* Input : type of error
* Output : TRUE on success, FALSE on failure
**/
int
sgml2pl_error(plerrorid id, ...)
{
prolog_term except = p2p_new();
prolog_term formal = p2p_new();
prolog_term swi = p2p_new();
prolog_term tmp1 = p2p_new();
prolog_term tmp;
va_list args;
char msgbuf[1024];
char *msg = NULL;
va_start(args, id);
/*Create the appropriate error term based on the type of error*/
switch(id)
{
case ERR_ERRNO: /*Standard unix errors*/
{
int err = va_arg(args, int);
msg = strerror(err);
switch(err)
{
/*Not enough memory error*/
case ENOMEM:
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "resource_error", 1, tmp);
c2p_string( "no_memory", p2p_arg( tmp, 1));
p2p_unify( tmp1, formal);
break;
/*No access error*/
case EACCES:
{
const char *file = va_arg(args, const char *);
const char *action = va_arg(args, const char *);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "permission_error", 3, tmp);
c2p_string( (char*)action, p2p_arg(tmp, 1));
c2p_string( "file", p2p_arg(tmp, 2));
c2p_string ( (char*)file, p2p_arg(tmp, 3));
p2p_unify( tmp1, formal);
break;
}
/*Entity not found error*/
case ENOENT:
{
const char *file = va_arg(args, const char *);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "permission_error", 2, tmp);
c2p_string( "file", p2p_arg(tmp, 1));
c2p_string ( (char*)file, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
break;
}
/*Defaults to system error*/
default:
{
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_string("system_error", tmp);
p2p_unify( tmp1, formal);
break;
}
}
break;
}
case ERR_TYPE:
{
const char *expected = va_arg(args, const char*);
prolog_term actual = va_arg(args, prolog_term);
/*Type error*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
if( is_attv( actual) && strcmp(expected, "variable") != 0 )
{
c2p_string( "instantiation_error", tmp);
p2p_unify( tmp1, formal);
}
else
{
c2p_functor( "type_error", 2, tmp);
c2p_string( (char*)expected, p2p_arg(tmp, 1));
p2p_unify ( actual, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
}
break;
}
case ERR_DOMAIN: /*Domain error*/
{
const char *expected = va_arg(args, const char*);
prolog_term actual = va_arg(args, prolog_term);
/*Improper domain of functor*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
if( is_attv( actual) && strcmp(expected, "variable") != 0 )
{
c2p_string( "instantiation_error", tmp);
p2p_unify( tmp1, formal);
}
else
{
c2p_functor( "domain_error", 2, tmp);
c2p_string( (char*)expected, p2p_arg(tmp, 1));
p2p_unify( actual, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
}
break;
}
case ERR_EXISTENCE: /*Existence error*/
{
const char *type = va_arg(args, const char *);
prolog_term obj = va_arg(args, prolog_term);
/*Resource not found*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "existence_error", 2, tmp);
c2p_string( (char*)type, p2p_arg(tmp, 1));
p2p_unify ( obj, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
break;
}
case ERR_FAIL:
{
/*Goal failed error*/
prolog_term goal = va_arg(args, prolog_term);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "goal_failed", 1, tmp);
p2p_unify( p2p_arg( tmp,1), goal);
p2p_unify( tmp1, formal);
break;
}
case ERR_LIMIT:
{
/*Limit exceeded error*/
const char *limit = va_arg(args, const char *);
long maxval = va_arg(args, long);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "limit_exceeded", 2, tmp);
c2p_string( (char*)limit, p2p_arg( tmp,1));
c2p_int( maxval, p2p_arg( tmp, 2));
p2p_unify( tmp1, formal);
break;
}
case ERR_MISC:
{
/*Miscellaneous error*/
const char *id = va_arg(args, const char *);
const char *fmt = va_arg(args, const char *);
vsprintf(msgbuf, fmt, args);
msg = msgbuf;
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "miscellaneous", 1, tmp);
c2p_string( (char*)id, p2p_arg( tmp, 1));
p2p_unify( tmp1, formal);
break;
}
default:
assert(0);
}
va_end(args);
if ( msg )
{
prolog_term msgterm = p2p_new();
if ( msg )
{
c2p_string( msg, msgterm);
}
tmp = p2p_new();
c2p_functor( "context", 1, tmp);
p2p_unify( p2p_arg( tmp, 1), msgterm);
p2p_unify( tmp, swi);
}
/*Create the error term to throw*/
tmp = p2p_new();
c2p_functor( "error", 2, tmp);
p2p_unify( p2p_arg( tmp, 1), formal);
p2p_unify( p2p_arg( tmp, 2), swi);
p2p_unify( tmp, except);
return p2p_unify( global_error_term, except);
}
