/*
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 int 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 */
int 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 (isinteger(beg_offset_term)|isboxedinteger(beg_offset_term)) {
if (int_val(beg_offset_term) < 0) {
beg_bos_offset = FALSE;
}
}
if (isinteger(end_offset_term)|isboxedinteger(end_offset_term)) {
if (int_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)));
}
void printTrieSymbol(FILE *fp, Cell symbol) {
if ( symbol == ESCAPE_NODE_SYMBOL )
fprintf(fp, "%lu [ESCAPE_NODE_SYMBOL]", ESCAPE_NODE_SYMBOL);
else {
switch(TrieSymbolType(symbol)) {
case XSB_INT:
fprintf(fp, IntegerFormatString, int_val(symbol));
break;
case XSB_FLOAT:
fprintf(fp, "%f", float_val(symbol));
break;
case XSB_STRING:
fprintf(fp, "%s", string_val(symbol));
break;
case XSB_TrieVar:
fprintf(fp, "V" IntegerFormatString, DecodeTrieVar(symbol));
break;
case XSB_STRUCT:
{
Psc psc = DecodeTrieFunctor(symbol);
fprintf(fp, "%s/%d", get_name(psc), get_arity(psc));
}
break;
case XSB_LIST:
fprintf(fp, "LIST");
break;
default:
fprintf(fp, "Unknown symbol (tag = %ld)", cell_tag(symbol));
break;
}
}
}
/* Creates an instance of the ADT
*
* PARAMETERS: n ---> input dimension
* t ---> # of branches the network will have
* mf --> membership functions. This must be a vector
* of length [t]x[n], simulating a [t][n] matrix
*
* PRE: mf != NULL
* POS: result != NULL
*/
anfis_t
anfis_create (unsigned long n, unsigned long t, const MF_t *mf)
{
anfis_t net = NULL;
long i = 0, j = 0;
assert (mf != NULL);
net = (anfis_t) malloc (sizeof (struct _anfis_s));
assert (net != NULL);
net->n = int_val(n);
net->t = int_val(t);
net->etha = INIT_ETHA;
net->old_err1 = 0.0;
net->old_err2 = 0.0;
net->trend = FIXED;
net->trend_st = 0;
net->b = (branch *) malloc (t * sizeof (branch));
assert (net->b != NULL);
for (i=0 ; i < t ; i++) {
net->b[i].MF = (MF_t *) malloc (n * sizeof (MF_t));
assert (net->b[i].MF != NULL);
net->b[i].P = gsl_vector_alloc (n+1);
assert (net->b[i].P != NULL);
}
#pragma omp parallel for default(shared) private(i,j)
for (i=0 ; i < t*n ; i++) {
net->b[i/n] . MF[i%n] . k = mf[i].k;
for (j=0 ; j < MAX_PARAM ; j++) {
net->b[i/n] . MF[i%n] . p[j] = mf[i].p[j];
}
}
net->tau = (double *) malloc (net->t * sizeof (double));
assert (net->tau != NULL);
return net;
}
static int convert_to_int(const char* start, int length, int* result)
{
int extracted_ok = 1;
int base = 10;
int value = 0;
int sign = 1;
int val_start = 0;
int i = 0;
if(length > 0 && start[0] == '-')
{
sign = -1;
val_start++;
}
// find base: 0x: hex(16), 0:octal(8)
if(length > val_start+2 &&
start[val_start] == '0')
{
if(start[val_start+1] == 'x')
{
base = 16;
val_start += 2;
}
else
{
base = 8;
val_start += 1;
}
}
*result = 0;
for(i = val_start; i < length; i++)
{
if(i > val_start)
{
*result *= base;
}
if(!int_val(start[i], &value) ||
value > base)
{
extracted_ok = 0;
break;
}
*result += value;
}
*result *= sign;
return extracted_ok;
}
int sprintTrieSymbol(char * buffer, Cell symbol) {
int ctr;
if ( symbol == ESCAPE_NODE_SYMBOL )
return sprintf(buffer, "%lu [ESCAPE_NODE_SYMBOL]", ESCAPE_NODE_SYMBOL);
else {
switch(TrieSymbolType(symbol)) {
case XSB_INT:
return sprintf(buffer, IntegerFormatString, int_val(symbol));
break;
case XSB_FLOAT:
return sprintf(buffer, "%f", float_val(symbol));
break;
case XSB_STRING:
return sprintf(buffer, "%s", string_val(symbol));
break;
case XSB_TrieVar:
return sprintf(buffer, "_V" IntegerFormatString, DecodeTrieVar(symbol));
break;
case XSB_STRUCT:
{
Psc psc;
if (isboxedfloat(symbol))
{
return sprintf(buffer, "%lf", boxedfloat_val(symbol));
break;
}
psc = DecodeTrieFunctor(symbol);
ctr = sprint_quotedname(buffer, 0, get_name(psc));
return sprintf(buffer+ctr, "/%d", get_arity(psc));
}
break;
case XSB_LIST:
return sprintf(buffer, "LIST");
break;
default:
return sprintf(buffer, "Unknown symbol (tag = %" Intfmt")", cell_tag(symbol));
break;
}
}
}
/* 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;
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(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,tmpnam(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 (isinteger(reg_term(CTXTc 3))|isboxedinteger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, int_val(reg_term(CTXTc 3)));
}
if (isinteger(reg_term(CTXTc 4))|isboxedinteger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, int_val(reg_term(CTXTc 4)));
}
if (isinteger(reg_term(CTXTc 5))|isboxedinteger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, int_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("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("[%s] Subprocess creation failed", callname);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(toprocess_fptr,callname,"pipe","w");
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(fromprocess_fptr,callname,"pipe","r");
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(fromproc_stderr_fptr,callname,"pipe","r");
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 (!(isinteger(pid_term)|isboxedinteger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = int_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 (!(isinteger(pid_term)|isboxedinteger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = int_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("[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;
}
void feat_set_int(cst_features *f, const char *name, int v)
{
feat_set(f,name,int_val(v));
}
int compare(CTXTdeclc const void * v1, const void * v2)
{
int comp;
CPtr cptr1, cptr2;
Cell val1 = (Cell) v1 ;
Cell val2 = (Cell) v2 ;
XSB_Deref(val2); /* val2 is not in register! */
XSB_Deref(val1); /* val1 is not in register! */
if (val1 == val2) return 0;
switch(cell_tag(val1)) {
case XSB_FREE:
case XSB_REF1:
if (isattv(val2))
return vptr(val1) - (CPtr)dec_addr(val2);
else if (isnonvar(val2)) return -1;
else { /* in case there exist local stack variables in the */
/* comparison, globalize them to guarantee that their */
/* order is retained as long as nobody "touches" them */
/* in the future -- without copying garbage collection */
if ((top_of_localstk <= vptr(val1)) &&
(vptr(val1) <= (CPtr)glstack.high-1)) {
bld_free(hreg);
bind_ref(vptr(val1), hreg);
hreg++;
val1 = follow(val1); /* deref again */
}
if ((top_of_localstk <= vptr(val2)) &&
(vptr(val2) <= (CPtr)glstack.high-1)) {
bld_free(hreg);
bind_ref(vptr(val2), hreg);
hreg++;
val2 = follow(val2); /* deref again */
}
return vptr(val1) - vptr(val2);
}
case XSB_FLOAT:
if (isref(val2) || isattv(val2)) return 1;
else if (isofloat(val2))
return sign(float_val(val1) - ofloat_val(val2));
else return -1;
case XSB_INT:
if (isref(val2) || isofloat(val2) || isattv(val2)) return 1;
else if (isinteger(val2))
return int_val(val1) - int_val(val2);
else if (isboxedinteger(val2))
return int_val(val1) - boxedint_val(val2);
else return -1;
case XSB_STRING:
if (isref(val2) || isofloat(val2) || isinteger(val2) || isattv(val2))
return 1;
else if (isstring(val2)) {
return strcmp(string_val(val1), string_val(val2));
}
else return -1;
case XSB_STRUCT:
// below, first 2 if-checks test to see if this struct is actually a number representation,
// (boxed float or boxed int) and if so, does what the number case would do, only with boxed_val
// macros.
if (isboxedinteger(val1)) {
if (isref(val2) || isofloat(val2) || isattv(val2)) return 1;
else if (isinteger(val2))
return boxedint_val(val1) - int_val(val2);
else if (isboxedinteger(val2))
return boxedint_val(val1) - boxedint_val(val2);
else return -1;
} else if (isboxedfloat(val1)) {
if (isref(val2) || isattv(val2)) return 1;
else if (isofloat(val2))
return sign(boxedfloat_val(val1) - ofloat_val(val2));
else return -1;
} else if (cell_tag(val2) != XSB_STRUCT && cell_tag(val2) != XSB_LIST) return 1;
else {
int arity1, arity2;
Psc ptr1 = get_str_psc(val1);
Psc ptr2 = get_str_psc(val2);
arity1 = get_arity(ptr1);
if (islist(val2)) arity2 = 2;
else arity2 = get_arity(ptr2);
if (arity1 != arity2) return arity1-arity2;
if (islist(val2)) comp = strcmp(get_name(ptr1), ".");
else comp = strcmp(get_name(ptr1), get_name(ptr2));
if (comp || (arity1 == 0)) return comp;
cptr1 = clref_val(val1);
cptr2 = clref_val(val2);
for (arity2 = 1; arity2 <= arity1; arity2++) {
if (islist(val2))
comp = compare(CTXTc (void*)cell(cptr1+arity2), (void*)cell(cptr2+arity2-1));
else
comp = compare(CTXTc (void*)cell(cptr1+arity2), (void*)cell(cptr2+arity2));
if (comp) break;
}
return comp;
}
break;
case XSB_LIST:
if (cell_tag(val2) != XSB_STRUCT && cell_tag(val2) != XSB_LIST) return 1;
else if (isconstr(val2)) return -(compare(CTXTc (void*)val2, (void*)val1));
else { /* Here we are comparing two list structures. */
cptr1 = clref_val(val1);
cptr2 = clref_val(val2);
comp = compare(CTXTc (void*)cell(cptr1), (void*)cell(cptr2));
if (comp) return comp;
return compare(CTXTc (void*)cell(cptr1+1), (void*)cell(cptr2+1));
}
break;
case XSB_ATTV:
if (isattv(val2))
return (CPtr)dec_addr(val1) - (CPtr)dec_addr(val2);
else if (isref(val2))
return (CPtr)dec_addr(val1) - vptr(val2);
else
return -1;
default:
xsb_abort("Compare (unknown tag %ld); returning 0", cell_tag(val1));
return 0;
}
}
void asl_cel_format::handle_atom(stream_type& os, bool is_push) {
const format_element_t& top(stack_top());
name_t parent(stack_depth() >= 2 ? stack_n(1).tag() : name_t());
name_t grandparent(stack_depth() >= 3 ? stack_n(2).tag() : name_t());
const any_regular_t& value(top.value());
bool outputting_bag(parent == seq_name_g && grandparent == bag_name_g);
std::size_t& num_out(outputting_bag ? stack_n(2).num_out_m : stack_n(1).num_out_m);
bool named_argument(outputting_bag && (num_out & 0x1) == 0);
if (is_push) {
// if this is not the first item in the element, add a comma and set up a newline
if (num_out > 0) {
if (!outputting_bag) {
os << ", ";
} else if (named_argument) {
os << ",\n" << indents(depth());
}
} else if (outputting_bag) {
os << '\n' << indents(depth());
}
if (value.type_info() == typeid(string)) {
bool escape(needs_entity_escape(value.cast<string>()));
if (escape_m && escape)
os << "xml_unescape(";
os << '\"'
<< (escape_m && escape ? entity_escape(value.cast<string>()) : value.cast<string>())
<< '\"';
if (escape_m && escape)
os << ")";
} else if (value.type_info() == typeid(name_t)) {
if (!named_argument)
os << '@';
os << value.cast<name_t>();
if (outputting_bag && named_argument)
os << ": ";
} else if (value.type_info() == typeid(bool)) {
os << (value.cast<bool>() ? "true" : "false");
} else if (value.type_info() == typeid(double)) {
double dbl_val(value.cast<double>());
boost::int64_t int_val(static_cast<boost::int64_t>(dbl_val));
if (dbl_val == int_val) {
os << int_val;
} else {
// For asl_cel, we want to output floating-point values in decimal-based
// fixed-point notation (asl_cel doesn't support any other format) with
// a very high precision for accceptable roundtrip values.
os.setf(std::ios_base::dec, std::ios_base::basefield);
os.setf(std::ios_base::fixed, std::ios_base::floatfield);
os.precision(16);
os << dbl_val;
}
} else if (value.type_info() == typeid(empty_t)) {
os << value.cast<empty_t>();
} else if (value.type_info() == typeid(dictionary_t)) {
os << value.cast<dictionary_t>();
} else if (value.type_info() == typeid(array_t)) {
os << value.cast<array_t>();
} else {
os << "'" << value.type_info().name() << "'";
}
} else {
// up the number of outputted items for the parent to this atom
++num_out;
}
}
static void symstkPrintNextTerm(FILE *fp, xsbBool list_recursion) {
Cell symbol;
if ( SymbolStack_IsEmpty ) {
fprintf(fp, "<no subterm>");
return;
}
SymbolStack_Pop(symbol);
switch ( TrieSymbolType(symbol) ) {
case XSB_INT:
if ( list_recursion )
fprintf(fp, "|" IntegerFormatString "]", int_val(symbol));
else
fprintf(fp, IntegerFormatString, int_val(symbol));
break;
case XSB_FLOAT:
if ( list_recursion )
fprintf(fp, "|%f]", float_val(symbol));
else
fprintf(fp, "%f", float_val(symbol));
break;
case XSB_STRING:
{
char *string = string_val(symbol);
if ( list_recursion ) {
if ( string == nil_sym )
fprintf(fp, "]");
else
fprintf(fp, "|%s]", string);
}
else
fprintf(fp, "%s", string);
}
break;
case XSB_TrieVar:
if ( list_recursion )
fprintf(fp, "|V" IntegerFormatString "]", DecodeTrieVar(symbol));
else
fprintf(fp, "V" IntegerFormatString, DecodeTrieVar(symbol));
break;
case XSB_STRUCT:
{
Psc psc;
int i;
if ( list_recursion )
fprintf(fp, "|");
psc = DecodeTrieFunctor(symbol);
fprintf(fp, "%s(", get_name(psc));
for (i = 1; i < (int)get_arity(psc); i++) {
symstkPrintNextTerm(fp,FALSE);
fprintf(fp, ",");
}
symstkPrintNextTerm(fp,FALSE);
fprintf(fp, ")");
if ( list_recursion )
fprintf(fp, "]");
}
break;
case XSB_LIST:
if ( list_recursion )
fprintf(fp, ",");
else
fprintf(fp, "[");
symstkPrintNextTerm(fp,FALSE);
symstkPrintNextTerm(fp,TRUE);
break;
default:
fprintf(fp, "<unknown symbol>");
break;
}
}
void _dv_weight_init(void)
{
double temp[64];
double temp_postsc[64];
int i, z, x;
#if ARCH_X86 || ARCH_X86_64
const double dv_weight_bias_factor = (double)(1UL << DV_WEIGHT_BIAS);
#endif
W[0] = 1.0;
W[1] = CS(4) / (4.0 * CS(7) * CS(2));
W[2] = CS(4) / (2.0 * CS(6));
W[3] = 1.0 / (2 * CS(5));
W[4] = 7.0 / 8.0;
W[5] = CS(4) / CS(3);
W[6] = CS(4) / CS(2);
W[7] = CS(4) / CS(1);
for (i = 0; i < 64; i++) {
temp[i] = 1.0;
}
weight_88_inverse_float(temp);
for (i=0;i<64;i++) {
#if (!ARCH_X86) && (!ARCH_X86_64)
dv_weight_inverse_88_matrix[i] = (dv_coeff_t)rint(temp[i]);
#else
/* If we're using MMX assembler, fold weights into the iDCT
prescale */
preSC[i] *= temp[i] * (16.0 / dv_weight_bias_factor);
#endif
}
postscale88_init(temp_postsc);
for (i = 0; i < 64; i++) {
temp[i] = 1.0;
}
weight_88_float(temp);
for (i=0;i<64;i++) {
#if BRUTE_FORCE_DCT_88
dv_weight_88_matrix[i] = temp[i];
#else
/* If we're not using brute force(tm),
fold weights into the DCT
postscale */
postSC88[i]= int_val(temp_postsc[i] * temp[i] * 32768.0 * 2.0);
#endif
}
postSC88[63] = temp[63] * 32768 * 2.0;
postscale248_init(temp_postsc);
for (i = 0; i < 64; i++) {
temp[i] = 1.0;
}
weight_248_float(temp);
for (i=0;i<64;i++) {
#if BRUTE_FORCE_DCT_248
dv_weight_248_matrix[i] = temp[i];
#else
/* If we're not using brute force(tm),
fold weights into the DCT
postscale */
postSC248[i]= int_val(temp_postsc[i]* temp[i] * 32768.0 * 2.0);
#endif
}
for (z=0;z<4;z++) {
for (x=0;x<8;x++) {
dv_weight_inverse_248_matrix[z*8+x] =
2.0 / (W[x] * W[2*z]);
dv_weight_inverse_248_matrix[(z+4)*8+x] =
2.0 / (W[x] * W[2*z]);
}
}
dv_weight_inverse_248_matrix[0] = 4.0;
}
/* XSB string substitution entry point
In:
Arg1: string
Arg2: beginning offset
Arg3: ending offset. < 0 means end of string
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
int do_regsubstring__(void)
{
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
/* 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 input_term, output_term;
prolog_term beg_offset_term, end_offset_term;
char *input_string=NULL; /* string where matches are to be found */
int beg_offset, end_offset, input_len, substring_len;
int conversion_required=FALSE;
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: 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_SUBSTRING", "input string");
conversion_required = TRUE;
} else
xsb_abort("[RE_SUBSTRING] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: beginning offset */
beg_offset_term = reg_term(CTXTc 2);
if (! is_int(beg_offset_term))
xsb_abort("[RE_SUBSTRING] Arg 2 (the beginning offset) must be an integer");
beg_offset = int_val(beg_offset_term);
if (beg_offset < 0 || beg_offset > input_len)
xsb_abort("[RE_SUBSTRING] Arg 2 (=%d) must be between 0 and %d",
beg_offset, input_len);
/* arg 3: ending offset */
end_offset_term = reg_term(CTXTc 3);
if (! is_int(end_offset_term))
xsb_abort("[RE_SUBSTRING] Arg 3 (the ending offset) must be an integer");
end_offset = int_val(end_offset_term);
if (end_offset < 0)
end_offset = input_len;
else if (end_offset > input_len || end_offset < beg_offset)
xsb_abort("[RE_SUBSTRING] Arg 3 (=%d) must be < 0 or between %d and %d",
end_offset, beg_offset, input_len);
output_term = reg_term(CTXTc 4);
if (! is_var(output_term))
xsb_abort("[RE_SUBSTRING] Arg 4 (the output string) must be an unbound variable");
/* do the actual replacement */
substring_len = end_offset-beg_offset;
XSB_StrAppendBlk(&output_buffer, input_string+beg_offset, substring_len);
XSB_StrNullTerminate(&output_buffer);
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term, 4,
"RE_SUBSTITUTE", "Arg 4");
else
/* DO NOT intern. When atom table garbage collection is in place, then
replace the instruction with this:
c2p_string(output_buffer, output_term);
The reason for not interning is that in Web page
manipulation it is often necessary to process the same string many
times. This can cause atom table overflow. Not interning allws us to
circumvent the problem. */
ctop_string(CTXTc 4, output_buffer.string);
return(TRUE);
}
int FunctionArguments::getInteger( const char *name )
{
Py::Int int_val( getArg( name ) );
return int_val;
}
/* XSB string substitution entry point: replace substrings specified in Arg2
with strings in Arg3.
In:
Arg1: string
Arg2: substring specification, a list [s(B1,E1),s(B2,E2),...]
Arg3: list of replacement strings
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool string_substitute(CTXTdecl)
{
/* 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 input_term, output_term;
prolog_term subst_reg_term, subst_spec_list_term, subst_spec_list_term1;
prolog_term subst_str_term=(prolog_term)0,
subst_str_list_term, subst_str_list_term1;
char *input_string=NULL; /* string where matches are to be found */
char *subst_string=NULL;
prolog_term beg_term, end_term;
int beg_offset=0, end_offset=0, input_len;
int last_pos = 0; /* last scanned pos in input string */
/* the output buffer is made large enough to include the input string and the
substitution string. */
int conversion_required=FALSE; /* from C string to Prolog char list */
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"STRING_SUBSTITUTE", "input string");
conversion_required = TRUE;
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: substring specification */
subst_spec_list_term = reg_term(CTXTc 2);
if (!islist(subst_spec_list_term) && !isnil(subst_spec_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 2 must be a list [s(B1,E1),s(B2,E2),...]");
/* handle substitution string */
subst_str_list_term = reg_term(CTXTc 3);
if (! islist(subst_str_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 4 (the output) must be an unbound variable");
subst_spec_list_term1 = subst_spec_list_term;
subst_str_list_term1 = subst_str_list_term;
if (isnil(subst_spec_list_term1)) {
XSB_StrSet(&output_buffer, input_string);
goto EXIT;
}
if (isnil(subst_str_list_term1))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must not be an empty list");
do {
subst_reg_term = p2p_car(subst_spec_list_term1);
subst_spec_list_term1 = p2p_cdr(subst_spec_list_term1);
if (!isnil(subst_str_list_term1)) {
subst_str_term = p2p_car(subst_str_list_term1);
subst_str_list_term1 = p2p_cdr(subst_str_list_term1);
if (isatom(subst_str_term)) {
subst_string = string_val(subst_str_term);
} else if (islist(subst_str_term)) {
subst_string = p_charlist_to_c_string(CTXTc subst_str_term, &subst_buf,
"STRING_SUBSTITUTE",
"substitution string");
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
}
beg_term = p2p_arg(subst_reg_term,1);
end_term = p2p_arg(subst_reg_term,2);
if (!(isinteger(beg_term)|isboxedinteger(beg_term)) ||
!(isinteger(end_term)|isboxedinteger(end_term)))
xsb_abort("[STRING_SUBSTITUTE] Non-integer in Arg 2");
else{
beg_offset = int_val(beg_term);
end_offset = int_val(end_term);
}
/* -1 means end of string */
if (end_offset < 0)
end_offset = input_len;
if ((end_offset < beg_offset) || (beg_offset < last_pos))
xsb_abort("[STRING_SUBSTITUTE] Substitution regions in Arg 2 not sorted");
/* do the actual replacement */
XSB_StrAppendBlk(&output_buffer,input_string+last_pos,beg_offset-last_pos);
XSB_StrAppend(&output_buffer, subst_string);
last_pos = end_offset;
} while (!isnil(subst_spec_list_term1));
XSB_StrAppend(&output_buffer, input_string+end_offset);
EXIT:
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "STRING_SUBSTITUTE", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
/* XSB string substitution entry point
In:
Arg1: string
Arg2: beginning offset
Arg3: ending offset. `_' or -1: end of string, -2: char before last, etc.
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool substring(CTXTdecl)
{
/* 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 input_term, output_term;
prolog_term beg_offset_term, end_offset_term;
char *input_string=NULL; /* string where matches are to be found */
int beg_offset=0, end_offset=0, input_len=0, substring_len=0;
int conversion_required=FALSE;
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"SUBSTRING", "input string");
conversion_required = TRUE;
} else
xsb_abort("[SUBSTRING] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: beginning offset */
beg_offset_term = reg_term(CTXTc 2);
if (! (isinteger(beg_offset_term)|isboxedinteger(beg_offset_term)))
xsb_abort("[SUBSTRING] Arg 2 (the beginning offset) must be an integer");
beg_offset = int_val(beg_offset_term);
if (beg_offset < 0)
beg_offset = 0;
else if (beg_offset > input_len)
beg_offset = input_len;
/* arg 3: ending offset */
end_offset_term = reg_term(CTXTc 3);
if (isref(end_offset_term))
end_offset = input_len;
else if (! (isinteger(end_offset_term)|isboxedinteger(end_offset_term)))
xsb_abort("[SUBSTRING] Arg 3 (the end offset) must be integer or _");
else end_offset = int_val(end_offset_term);
if (end_offset < 0)
end_offset = input_len + 1 + end_offset;
else if (end_offset > input_len)
end_offset = input_len;
else if (end_offset < beg_offset)
end_offset = beg_offset;
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[SUBSTRING] Arg 4 (the output string) must be an unbound variable");
/* do the actual replacement */
substring_len = end_offset-beg_offset;
XSB_StrAppendBlk(&output_buffer, input_string+beg_offset, substring_len);
XSB_StrNullTerminate(&output_buffer);
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "SUBSTRING", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
/* 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));
}
/* XSB string substitution entry point: replace substrings specified in Arg2
with strings in Arg3.
In:
Arg1: string
Arg2: substring specification, a list [s(B1,E1),s(B2,E2),...]
Arg3: list of replacement string
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
int do_regsubstitute__(void)
{
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
/* 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 input_term, output_term;
prolog_term subst_reg_term, subst_spec_list_term, subst_spec_list_term1;
prolog_term subst_str_term=(prolog_term)0,
subst_str_list_term, subst_str_list_term1;
char *input_string=NULL; /* string where matches are to be found */
char *subst_string=NULL;
prolog_term beg_term, end_term;
int beg_offset=0, end_offset=0, input_len;
int last_pos = 0; /* last scanned pos in input string */
/* the output buffer is made large enough to include the input string and the
substitution string. */
int conversion_required=FALSE; /* from C string to Prolog char list */
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: 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_SUBSTITUTE", "input string");
conversion_required = TRUE;
} else
xsb_abort("[RE_SUBSTITUTE] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: substring specification */
subst_spec_list_term = reg_term(CTXTc 2);
if (!is_list(subst_spec_list_term) && !is_nil(subst_spec_list_term))
xsb_abort("[RE_SUBSTITUTE] Arg 2 must be a list [s(B1,E1),s(B2,E2),...]");
/* handle substitution string */
subst_str_list_term = reg_term(CTXTc 3);
if (! is_list(subst_str_list_term))
xsb_abort("[RE_SUBSTITUTE] Arg 3 must be a list of strings");
output_term = reg_term(CTXTc 4);
if (! is_var(output_term))
xsb_abort("[RE_SUBSTITUTE] Arg 4 (the output) must be an unbound variable");
subst_spec_list_term1 = subst_spec_list_term;
subst_str_list_term1 = subst_str_list_term;
if (is_nil(subst_spec_list_term1)) {
XSB_StrSet(&output_buffer, input_string);
goto EXIT;
}
if (is_nil(subst_str_list_term1))
xsb_abort("[RE_SUBSTITUTE] Arg 3 must not be an empty list");
do {
subst_reg_term = p2p_car(subst_spec_list_term1);
subst_spec_list_term1 = p2p_cdr(subst_spec_list_term1);
if (!is_nil(subst_str_list_term1)) {
subst_str_term = p2p_car(subst_str_list_term1);
subst_str_list_term1 = p2p_cdr(subst_str_list_term1);
if (is_string(subst_str_term)) {
subst_string = string_val(subst_str_term);
} else if (is_list(subst_str_term)) {
subst_string = p_charlist_to_c_string(CTXTc subst_str_term, &subst_buf,
"RE_SUBSTITUTE",
"substitution string");
} else
xsb_abort("[RE_SUBSTITUTE] Arg 3 must be a list of strings");
}
beg_term = p2p_arg(subst_reg_term,1);
end_term = p2p_arg(subst_reg_term,2);
if (!is_int(beg_term) || !is_int(end_term))
xsb_abort("[RE_SUBSTITUTE] Non-integer in Arg 2");
else{
beg_offset = int_val(beg_term);
end_offset = int_val(end_term);
}
/* -1 means end of string */
if (end_offset < 0)
end_offset = input_len;
if ((end_offset < beg_offset) || (beg_offset < last_pos))
xsb_abort("[RE_SUBSTITUTE] Substitution regions in Arg 2 not sorted");
/* do the actual replacement */
XSB_StrAppendBlk(&output_buffer,input_string+last_pos,beg_offset-last_pos);
XSB_StrAppend(&output_buffer, subst_string);
last_pos = end_offset;
} while (!is_nil(subst_spec_list_term1));
XSB_StrAppend(&output_buffer, input_string+end_offset);
EXIT:
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term, 4,
"RE_SUBSTITUTE", "Arg 4");
else
/* DO NOT intern. When atom table garbage collection is in place, then
replace the instruction with this:
c2p_string(output_buffer, output_term);
The reason for not interning is that in Web page
manipulation it is often necessary to process the same string many
times. This can cause atom table overflow. Not interning allws us to
circumvent the problem. */
ctop_string(CTXTc 4, output_buffer.string);
return(TRUE);
}
static int symstkSPrintNextTerm(CTXTdeclc char * buffer, xsbBool list_recursion) {
int ctr = 0;
Cell symbol;
if ( SymbolStack_IsEmpty ) {
// fprintf(fp, "<no subterm>");
return 0;
}
SymbolStack_Pop(symbol);
switch ( TrieSymbolType(symbol) ) {
case XSB_INT:
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "|" IntegerFormatString "]", int_val(symbol));
else
ctr = ctr + sprintf(buffer+ctr, IntegerFormatString, int_val(symbol));
break;
case XSB_FLOAT:
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "|%f]", float_val(symbol));
else
ctr = ctr + sprintf(buffer+ctr, "%f", float_val(symbol));
break;
case XSB_STRING:
{
char *string = string_val(symbol);
if ( list_recursion ) {
if ( string == nil_string )
ctr = ctr + sprintf(buffer+ctr, "]");
else {
// ctr = ctr + sprintf(buffer+ctr, "|%s]", string);
ctr = ctr + sprintf(buffer+ctr, "|");
ctr = sprint_quotedname(buffer, ctr, string);
ctr = ctr + sprintf(buffer+ctr, "]");
}
}
else
// ctr = ctr + sprintf(buffer+ctr, "%s", string);
ctr = sprint_quotedname(buffer, ctr, string);
}
break;
case XSB_TrieVar:
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "|V" IntegerFormatString "]", DecodeTrieVar(symbol));
else
ctr = ctr + sprintf(buffer+ctr, "_V" IntegerFormatString, DecodeTrieVar(symbol));
break;
case XSB_STRUCT:
{
Psc psc;
int i;
if (isboxedfloat(symbol))
{
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "|%lf]", boxedfloat_val(symbol));
else
ctr = ctr + sprintf(buffer+ctr, "%lf", boxedfloat_val(symbol));
break;
}
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "|");
psc = DecodeTrieFunctor(symbol);
// ctr = ctr + sprintf(buffer+ctr, "%s(", get_name(psc));
ctr = sprint_quotedname(buffer, ctr, get_name(psc));
ctr = ctr + sprintf(buffer+ctr, "(");
for (i = 1; i < (int)get_arity(psc); i++) {
ctr = ctr + symstkSPrintNextTerm(CTXTc buffer+ctr,FALSE);
ctr = ctr + sprintf(buffer+ctr, ",");
}
ctr = ctr + symstkSPrintNextTerm(CTXTc buffer+ctr,FALSE);
ctr = ctr + sprintf(buffer+ctr, ")");
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, "]");
}
break;
case XSB_LIST:
if ( list_recursion )
ctr = ctr + sprintf(buffer+ctr, ",");
else
ctr = ctr + sprintf(buffer+ctr, "[");
ctr = ctr + symstkSPrintNextTerm(CTXTc buffer+ctr,FALSE);
ctr = ctr + symstkSPrintNextTerm(CTXTc buffer+ctr,TRUE);
break;
default:
ctr = ctr + sprintf(buffer+ctr, "<unknown symbol>");
break;
}
return ctr;
}
void find_the_visitors(CTXTdeclc VariantSF subgoal) {
CPtr cp_top1,cp_bot1 ; CPtr cp_root; CPtr cp_first;
byte cp_inst; Cell listHead;
int ans_subst_num, i, attv_num;
BTNptr trieNode;
ALNptr ALNlist;
// printf("find the visitors: subg %p trie root %p\n",subgoal,subg_ans_root_ptr(subgoal));
cp_top1 = breg ;
cp_bot1 = (CPtr)(tcpstack.high) - CP_SIZE;
if (xwammode && hreg < hfreg) {
printf("uh-oh! hreg was less than hfreg in in find the visitors\n");
hreg = hfreg;
}
while ( cp_top1 < cp_bot1 ) {
// printf("1 cp_top1 %p cp_bot1 %p prev %p\n",cp_top1,cp_bot1,cp_prevtop(cp_top1));
cp_inst = *(byte *)*cp_top1;
// Want trie insts, but need to distinguish from asserted and interned tries
// printf("cp_inst %x\n",cp_inst);
if ( is_trie_instruction(cp_inst) ) {
// printf("found trie instr\n");
// Below we want basic_answer_trie_tt, ts_answer_trie_tt
trieNode = TrieNodeFromCP(cp_top1);
if (IsInAnswerTrie(trieNode)) {
// printf("in answer trie\n");
if (subgoal == get_subgoal_frame_for_answer_trie_cp(CTXTc trieNode)) {
// printf("found top of run %p \n",cp_top1);
// print_subgoal(CTXTc stdout, subgoal); printf("\n");
cp_root = cp_top1; cp_first = cp_top1;
while (*cp_pcreg(cp_root) != trie_fail) {
cp_first = cp_root;
cp_root = cp_prevbreg(cp_root);
if (*cp_pcreg(cp_root) != trie_fail && subgoal != get_subgoal_frame_for_answer_trie_cp(CTXTc TrieNodeFromCP(cp_root)))
printf(" couldn't find incr trie root -- whoa, whu? (%p\n",cp_root);
}
ALNlist = traverse_variant_answer_trie(subgoal, cp_root,cp_top1);
ans_subst_num = (int)int_val(cell(cp_root + CP_SIZE + 1)) ; // account for sf ptr of trie root cp
attv_num = (int)int_val(cell(breg+CP_SIZE+1+ans_subst_num)) + 1;;
// printf("found root %p first %p top %p ans_subst_num %d & %p attv_num %d\n",cp_root,cp_first,cp_top1,ans_subst_num,breg+CP_SIZE, attv_num);
listHead = list_of_answers_from_answer_list(subgoal,ans_subst_num,attv_num,ALNlist);
// Free ALNlist;
cp_pcreg(cp_top1) = (byte *) &completed_trie_member_inst;
cp_ebreg(cp_top1) = cp_ebreg(cp_root);
cp_hreg(cp_top1) = hreg;
cp_ereg(cp_top1) = cp_ereg(cp_root);
cp_trreg(cp_top1) = cp_trreg(cp_root);
cp_prevbreg(cp_top1) = cp_prevbreg(cp_root); cp_prevtop(cp_top1) = cp_prevtop(cp_root);
// cpreg, ereg, pdreg, ptcpreg should not need to be reset (prob not ebreg?)
// printf("sf %p\n",* (cp_root + CP_SIZE + 2));
* (cp_top1 + CP_SIZE) = makeint(ans_subst_num);
for (i = 0;i < ans_subst_num ;i++) { // Use registers for root of trie, not leaf (top)
* (cp_top1 + CP_SIZE + 1 + i) = * (cp_root + CP_SIZE + 2 +i); // account for sf ptr or root
}
* (cp_top1 + CP_SIZE + 1+ ans_subst_num) = listHead;
* (cp_top1 + CP_SIZE + 2+ ans_subst_num) = (Cell)hfreg;
// printf("4 cp_root %p prev %p\n",cp_root,cp_prevtop(cp_root));
// printf("constructed listhead hreg %x\n",hreg);
// cp_top1 = cp_root; // next iteration
// printf("7 cp_top1 %p cp_bot1 %p prev %p\n",cp_top1,cp_bot1,cp_prevtop(cp_top1));
}
}
}
cp_top1 = cp_prevtop(cp_top1);
}
if (xwammode) hfreg = hreg;
// printf("constructed listhead hreg %x hfreg %x\n",hreg,hfreg);
subg_visitors(subgoal) = 0;
// instr_flag = 1; printf("setting instr_flag\n"); hreg_pos = hreg;
}
void pdf_format::handle_atom(stream_type& os, bool is_push)
{
const format_element_t& top(stack_top());
name_t self(top.tag());
name_t parent(stack_depth() >= 2 ? stack_n(1).tag() : name_t());
name_t grandparent(stack_depth() >= 3 ? stack_n(2).tag() : name_t());
const any_regular_t& value(top.value());
bool outputting_bag(parent == seq_name_g && grandparent == bag_name_g);
std::size_t& num_out(outputting_bag ? stack_n(2).num_out_m : stack_n(1).num_out_m);
bool named_argument(outputting_bag && num_out % 2 == 0);
if (is_push)
{
// if this is not the first item in the element, add a comma and set up a newline
if (num_out > 0)
{
if (!outputting_bag)
{
os << ' ';
}
else if (named_argument)
{
os << '\n' << indents(depth());
}
}
else if (outputting_bag)
{
os << '\n' << indents(depth());
}
if (value.type_info() == adobe::type_info<string_t>())
{
os << '(' << value.cast<string_t>() << ')';
}
else if (value.type_info() == adobe::type_info<name_t>())
{
os << '/' << value.cast<name_t>();
if (outputting_bag && named_argument)
os << " ";
}
else if (value.type_info() == adobe::type_info<bool>())
{
os << (value.cast<bool>() ? "true" : "false");
}
else if (value.type_info() == adobe::type_info<double>())
{
double dbl_val(value.cast<double>());
boost::int64_t int_val(static_cast<boost::int64_t>(dbl_val));
if (dbl_val == int_val)
{
os << int_val;
}
else
{
// For pdf, we want to output floating-point values in decimal-based
// fixed-point notation (asl_cel doesn't support any other format) with
// a very high precision for accceptable roundtrip values.
os.setf(std::ios_base::dec, std::ios_base::basefield);
os.setf(std::ios_base::fixed, std::ios_base::floatfield);
os.precision(16);
os << dbl_val;
}
}
else if (value.type_info() == adobe::type_info<empty_t>())
{
os << "null";
}
else if (value.type_info() == adobe::type_info<dictionary_t>())
{
os << value.cast<dictionary_t>();
}
else if (value.type_info() == adobe::type_info<array_t>())
{
os << value.cast<array_t>();
}
else
{
os << "(pdf_unknown: " << value.type_info().name() << ")";
}
}
else
{
// up the number of outputted items for the parent to this atom
++num_out;
}
}
