diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

sub_atom/5 in C.

This commit is contained in:
Vitor Santos Costa 2013-05-15 17:12:01 -05:00
parent 3b2b4b03c8
commit 639247b4c3
3 changed files with 389 additions and 313 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

555
C/atoms.c
View File

@ -1924,202 +1924,416 @@ p_atom_number( USES_REGS1 )
}
}
/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/
static Int
p_sub_atom_extract( USES_REGS1 )
{
Atom at = AtomOfTerm(Deref(ARG1)), nat;
Int start = IntegerOfTerm(Deref(ARG2));
Int len = IntegerOfTerm(Deref(ARG3));
Int leftover;
if (start < 0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ARG2,"sub_atom/5");
if (len < 0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ARG3,"sub_atom/5");
start:
if (IsWideAtom(at)) {
wchar_t *s = RepAtom(at)->WStrOfAE;
int max = wcslen(s);
Int i;
#define SUB_ATOM_HAS_MIN 1
#define SUB_ATOM_HAS_SIZE 2
#define SUB_ATOM_HAS_AFTER 4
#define SUB_ATOM_HAS_VAL 8
#define SUB_ATOM_HAS_WIDE 16
leftover = max-(start+len);
if (leftover < 0)
return FALSE;
for (i=0;i<len;i++) {
if ((s+start)[i] > 255) break;
}
if (i == len) {
char *String = Yap_PreAllocCodeSpace();
if (String + (len+1024) >= (char *)AuxSp)
goto expand_auxsp;
for (i=0;i<len;i++) {
String[i] = (s+start)[i];
}
String[len] = '\0';
nat = Yap_LookupAtom(String);
} else {
wchar_t *String = (wchar_t *)Yap_PreAllocCodeSpace();
if (String + (len+1024) >= (wchar_t *)AuxSp)
goto expand_auxsp;
wcsncpy(String, s+start, len);
String[len] = '\0';
nat = Yap_LookupWideAtom(String);
}
} else {
char *s = RepAtom(at)->StrOfAE, *String;
int max = strlen(s);
leftover = max-(start+len);
if (leftover < 0)
return FALSE;
String = Yap_PreAllocCodeSpace();
if (String + (len+1024) >= (char *)AuxSp)
goto expand_auxsp;
strncpy(String, s+start, len);
String[len] = '\0';
nat = Yap_LookupAtom(String);
}
return Yap_unify(ARG5,MkAtomTerm(nat)) &&
Yap_unify(ARG4,MkIntegerTerm(leftover));
expand_auxsp:
{
char *String = Yap_ExpandPreAllocCodeSpace(len, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in sub_atom/5");
return FALSE;
static void *
alloc_tmp_stack(size_t sz) {
void *pt = (void *)H;
while (H > ASP-(1044+sz/sizeof(CELL))) {
if (!Yap_gc(5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "sub_atom/5");
return(NULL);
}
}
goto start;
return pt;
}
/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/
static Int
cont_sub_atom_fetch( USES_REGS1 )
static Atom
build_new_atom(int mask, wchar_t *wp, char *p, size_t min, size_t len)
{
Atom at = AtomOfTerm(EXTRA_CBACK_ARG(5,1));
Atom subatom = AtomOfTerm(EXTRA_CBACK_ARG(5,2));
Int offset = IntegerOfTerm(EXTRA_CBACK_ARG(5,3));
Int sb = IntegerOfTerm(EXTRA_CBACK_ARG(5,4));
Int sz = IntegerOfTerm(EXTRA_CBACK_ARG(5,5));
if (IsWideAtom(at)) {
wchar_t *s = RepAtom(at)->WStrOfAE;
wchar_t *ins, *where;
Int start, after;
Int res;
Atom nat;
if (mask & SUB_ATOM_HAS_WIDE) {
wchar_t *src = wp+min;
wchar_t *d = alloc_tmp_stack((len+1)*sizeof(wchar_t));
if (!d) return NIL;
if (!IsWideAtom(subatom)) {
/* first convert to wchar_t */
char *inschars = RepAtom(subatom)->StrOfAE;
Int i;
wcsncpy(d, src, len);
d[len] = '\0';
nat = Yap_LookupMaybeWideAtom(d);
} else {
char *src = p+min;
char *d = alloc_tmp_stack((len+1)*sizeof(char));
if (!d) return NIL;
strncpy(d, src, len);
d[len] = '\0';
nat = Yap_LookupAtom(d);
}
return nat;
}
if (offset+sz > sb)
cut_fail();
ins = (wchar_t *)Yap_PreAllocCodeSpace();
while ((ins = (wchar_t *)Yap_PreAllocCodeSpace()) + (sz+1) > (wchar_t *)AuxSp) {
if (!Yap_ExpandPreAllocCodeSpace(sizeof(wchar_t)*(sz+1), NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG5, "allocating temp space in sub_atom/2");
return FALSE;
static Int wcsstrcmp(wchar_t *p, char *p2, size_t len)
{
while (len--) {
Int d = *p++-*p2++;
if (d) return d;
}
return 0;
}
static int
check_sub_atom_at(int min, Atom at, Atom nat)
{
if (IsWideAtom(nat)) {
wchar_t *p1, *p2;
wchar_t c1;
if (!IsWideAtom(at)) return FALSE;
p1 = RepAtom(at)->WStrOfAE+min;
p2 = RepAtom(nat)->WStrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
} else {
if (IsWideAtom(at)) {
wchar_t *p1;
char *p2;
wchar_t c1;
p1 = RepAtom(at)->WStrOfAE+min;
p2 = RepAtom(nat)->StrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
} else {
char *p1, *p2;
char c1;
p1 = RepAtom(at)->StrOfAE+min;
p2 = RepAtom(nat)->StrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
}
}
}
static int
check_sub_atom_bef(int max, Atom at, Atom nat)
{
if (IsWideAtom(nat)) {
wchar_t *p1, *p2;
wchar_t c1;
size_t len = wcslen(RepAtom(nat)->WStrOfAE);
int min = max- len;
if (min < 0) return FALSE;
if (!IsWideAtom(at)) return FALSE;
p1 = RepAtom(at)->WStrOfAE+min;
p2 = RepAtom(nat)->WStrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
} else {
size_t len = strlen(RepAtom(nat)->StrOfAE);
int min = max- len;
if (min - len < 0) return FALSE;
if (IsWideAtom(at)) {
wchar_t *p1;
char *p2;
wchar_t c1;
p1 = RepAtom(at)->WStrOfAE+min;
p2 = RepAtom(nat)->StrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
} else {
char *p1, *p2;
char c1;
p1 = RepAtom(at)->StrOfAE+min;
p2 = RepAtom(nat)->StrOfAE;
while ( (c1 = *p1++) == *p2++ && c1);
return c1 == 0;
}
}
}
static Int
cont_sub_atom( USES_REGS1 )
{
Term tat1= Deref(ARG1);
Atom at = AtomOfTerm(tat1);
int mask;
size_t min, len, after, sz;
wchar_t *wp = NULL;
char *p = NULL;
Atom nat;
mask = IntegerOfTerm(EXTRA_CBACK_ARG(5,1));
min = IntegerOfTerm(EXTRA_CBACK_ARG(5,2));
len = IntegerOfTerm(EXTRA_CBACK_ARG(5,3));
after = IntegerOfTerm(EXTRA_CBACK_ARG(5,4));
sz = IntegerOfTerm(EXTRA_CBACK_ARG(5,5));
if (mask & SUB_ATOM_HAS_WIDE) {
wp = RepAtom(at)->WStrOfAE;
} else {
p = RepAtom(at)->StrOfAE;
}
/* we can have one of two cases: A5 bound or unbound */
if (mask & SUB_ATOM_HAS_VAL) {
int found = FALSE;
nat = AtomOfTerm(Deref(ARG5));
if (mask & SUB_ATOM_HAS_WIDE) {
wp = RepAtom(at)->WStrOfAE;
if (IsWideAtom(nat)) {
while (!found) {
if (wcsncmp(wp+min, nat->WStrOfAE, len) == 0) {
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
found = TRUE;
/* found one, check if there is any left */
while (min <= sz-len) {
after--;
min++;
if (wcsncmp(wp+min, nat->WStrOfAE, len) == 0)
break;
}
} else {
if (min == sz-len) break;
after--;
min++;
}
}
} else {
while (!found) {
if (wcsstrcmp(wp+min, nat->StrOfAE, len) == 0) {
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
found = TRUE;
/* found one, check if there is any left */
while (min <= sz-len) {
after--;
min++;
if (wcsstrcmp(wp+min, nat->StrOfAE, len) == 0)
break;
}
} else {
if (min == sz-len) break;
after--;
min++;
}
}
}
} else {
p = RepAtom(at)->StrOfAE;
while (!found) {
if (strncmp(p+min, nat->StrOfAE, len) == 0) {
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
found = TRUE;
/* found one, check if there is any left */
while (min <= sz-len) {
after--;
min++;
if (strncmp(p+min, nat->StrOfAE, len) == 0)
break;
}
} else {
if (min == sz-len) break;
after--;
min++;
}
}
for (i=0;i<=sz;i++)
ins[i] = inschars[i];
} else {
ins = RepAtom(subatom)->WStrOfAE;
}
if (!(where = wcsstr(s+offset, ins))) {
if (found) {
if (min > sz-len) cut_succeed();
} else {
cut_fail();
}
if (!Yap_unify(EXTRA_CBACK_ARG(5,5), ARG3)) {
cut_fail();
}
start = where-s;
after = sb-(start+sz);
res = (Yap_unify(MkIntegerTerm(start), ARG2) &&
Yap_unify(MkIntegerTerm(after), ARG4));
if (!res) {
if (!after) {
cut_fail();
} else {
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1);
return FALSE;
}
}
if (!after) {
cut_succeed();
} else {
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1);
return TRUE;
}
} else if (mask & SUB_ATOM_HAS_SIZE) {
nat = build_new_atom(mask, wp, p, min, len);
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, MkAtomTerm(nat));
min++;
if (after-- == 0) cut_succeed();
} else if (mask & SUB_ATOM_HAS_MIN) {
after = sz-(min+len);
nat = build_new_atom(mask, wp, p, min, len);
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, MkAtomTerm(nat));
len++;
if (after-- == 0) cut_succeed();
} else if (mask & SUB_ATOM_HAS_AFTER) {
len = sz-(min+after);
nat = build_new_atom(mask, wp, p, min, len);
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG5, MkAtomTerm(nat));
min++;
if (len-- == 0) cut_succeed();
} else {
char *s = RepAtom(at)->StrOfAE;
char *ins, *where;
Int start, after;
Int res;
ins = subatom->StrOfAE;
if (offset+sz > sb) {
cut_fail();
}
if (!(where = strstr(s+offset, ins))) {
cut_fail();
}
if (!Yap_unify(EXTRA_CBACK_ARG(5,5), ARG3)) {
cut_fail();
}
start = where-s;
after = sb-(start+sz);
res = (Yap_unify(MkIntegerTerm(start), ARG2) &&
Yap_unify(MkIntegerTerm(after), ARG4));
if (!res) {
if (!after) {
cut_fail();
} else {
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1);
return FALSE;
}
}
if (!after) {
cut_succeed();
} else {
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1);
return TRUE;
nat = build_new_atom(mask, wp, p, min, len);
Yap_unify(ARG2, MkIntegerTerm(min));
Yap_unify(ARG3, MkIntegerTerm(len));
Yap_unify(ARG4, MkIntegerTerm(after));
Yap_unify(ARG5, MkAtomTerm(nat));
len++;
if (after-- == 0) {
if (min == sz) cut_succeed();
min++;
len = 0;
after = sz-min;
}
}
EXTRA_CBACK_ARG(5,1) = MkIntegerTerm(mask);
EXTRA_CBACK_ARG(5,2) = MkIntegerTerm(min);
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(len);
EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(after);
EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(sz);
return TRUE;
}
/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/
static Int
init_sub_atom_fetch( USES_REGS1 )
init_sub_atom( USES_REGS1 )
{
Term tat1, tat2;
Atom at1, at2;
Term tat1, tbef, tsize, tafter, tout;
int mask = 0;
size_t min, len, after, sz;
wchar_t *wp = NULL;
char *p = NULL;
int bnds = 0;
Atom nat = NIL, at;
EXTRA_CBACK_ARG(5,1) = tat1 = Deref(ARG1);
EXTRA_CBACK_ARG(5,2) = tat2 = Deref(ARG5);
tat1 = Deref(ARG1);
tbef = Deref(ARG5);
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(0);
at1 = AtomOfTerm(tat1);
at2 = AtomOfTerm(tat2);
if (IsWideAtom(at1)) {
EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(wcslen(at1->WStrOfAE));
if (IsWideAtom(at2)) {
EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(wcslen(at2->WStrOfAE));
} else {
EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(strlen(at2->StrOfAE));
}
if (IsVarTerm(tat1)) {
Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first argument");
return FALSE;
} else if (!IsAtomTerm(tat1)) {
Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5");
return FALSE;
}
if (IsVarTerm(tbef = Deref(ARG2))) {
min = 0;
} else if (!IsIntegerTerm(tbef)) {
Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_atom/5");
return FALSE;
} else {
EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(strlen(at1->StrOfAE));
if (IsWideAtom(at2)) {
cut_fail();
min = IntegerOfTerm(tbef);
mask |= SUB_ATOM_HAS_MIN;
bnds++;
}
if (IsVarTerm(tsize = Deref(ARG3))) {
len = 0;
} else if (!IsIntegerTerm(tsize)) {
Yap_Error(TYPE_ERROR_INTEGER, tsize, "sub_atom/5");
return FALSE;
} else {
len = IntegerOfTerm(tsize);
mask |= SUB_ATOM_HAS_SIZE;
bnds++;
}
if (IsVarTerm(tafter = Deref(ARG4))) {
after = 0;
} else if (!IsIntegerTerm(tafter)) {
Yap_Error(TYPE_ERROR_INTEGER, tafter, "sub_atom/5");
return FALSE;
} else {
after = IntegerOfTerm(tafter);
mask |= SUB_ATOM_HAS_AFTER;
bnds++;
}
if (!IsVarTerm(tout = Deref(ARG5))) {
if (!IsAtomTerm(tout)) {
Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5");
return FALSE;
} else {
EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(strlen(at2->StrOfAE));
mask |= SUB_ATOM_HAS_VAL|SUB_ATOM_HAS_SIZE;
nat = AtomOfTerm(tout);
if (IsWideAtom(nat))
len = wcslen(RepAtom(nat)->WStrOfAE);
else
len = strlen(RepAtom(nat)->StrOfAE);
if (!Yap_unify(ARG3, MkIntegerTerm(len)))
cut_fail();
bnds+=2;
}
}
return cont_sub_atom_fetch( PASS_REGS1 );
at = AtomOfTerm(tat1);
if (IsWideAtom(at)) {
mask |= SUB_ATOM_HAS_WIDE;
wp = RepAtom(at)->WStrOfAE;
sz = wcslen(wp);
} else {
p = RepAtom(at)->StrOfAE;
sz = strlen(p);
}
/* the problem is deterministic if we have two cases */
if (bnds > 1) {
int out = FALSE;
if ((mask & (SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_SIZE)) ==
(SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_SIZE)) {
if (min+len > sz) cut_fail();
if ((after = (sz-(min+len))) < 0) cut_fail();
nat = build_new_atom(mask, wp, p, min, len);
if (!nat) cut_fail();
out = Yap_unify(ARG4,MkIntegerTerm(after)) &&
Yap_unify(ARG5, MkAtomTerm(nat));
} else if ((mask & (SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_AFTER)) ==
(SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_AFTER)) {
if (sz < min+after) cut_fail();
len = sz-(min+after);
nat = build_new_atom(mask, wp, p, min, len);
if (!nat) cut_fail();
out = Yap_unify(ARG3,MkIntegerTerm(len)) &&
Yap_unify(ARG5, MkAtomTerm(nat));
} else if ((mask & (SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_AFTER)) ==
(SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_AFTER) ) {
if (len+after > sz) cut_fail();
min = sz-(len+after);
nat = build_new_atom(mask, wp, p, min, len);
if (!nat) cut_fail();
out = Yap_unify(ARG2,MkIntegerTerm(min)) &&
Yap_unify(ARG5, MkAtomTerm(nat));
} else if ((mask & (SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_VAL)) ==
(SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_VAL)) {
out = check_sub_atom_at(min, at, nat);
} else if ((mask & (SUB_ATOM_HAS_AFTER|SUB_ATOM_HAS_VAL)) ==
(SUB_ATOM_HAS_AFTER|SUB_ATOM_HAS_VAL)) {
out = check_sub_atom_bef(sz - after, at, nat);
} else if ((mask & (SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_VAL)) ==
(SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_VAL)) {
if (IsWideAtom(nat)) {
if (!(mask & SUB_ATOM_HAS_VAL)) {
cut_fail();
}
/* just check length, they may still be several occurrences :( */
out = (wcslen(RepAtom(nat)->WStrOfAE) == len);
} else {
out = (strlen(RepAtom(nat)->StrOfAE) == len);
if (!out) cut_fail();
}
if (len == sz) {
out = out &&
Yap_unify(ARG1, ARG5) &&
Yap_unify(ARG2, MkIntegerTerm(0)) &&
Yap_unify(ARG4, MkIntegerTerm(0));
} else {
mask |= SUB_ATOM_HAS_SIZE;
min = 0;
after = sz-len;
goto backtrackable;
}
}
if (out) cut_succeed();
cut_fail();
} else {
if (!(mask & SUB_ATOM_HAS_MIN)) min = 0;
if (!(mask & SUB_ATOM_HAS_SIZE)) len = 0;
if (!(mask & SUB_ATOM_HAS_AFTER)) after = sz-(len+min);
}
backtrackable:
EXTRA_CBACK_ARG(5,1) = MkIntegerTerm(mask);
EXTRA_CBACK_ARG(5,2) = MkIntegerTerm(min);
EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(len);
EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(after);
EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(sz);
return cont_sub_atom( PASS_REGS1 );
}
@ -2292,7 +2506,7 @@ Yap_InitBackAtoms(void)
Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,
cont_current_wide_atom,
SafePredFlag|SyncPredFlag);
Yap_InitCPredBack("$sub_atom_fetch", 5, 5, init_sub_atom_fetch, cont_sub_atom_fetch, 0);
Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atom, 0);
}
@ -2307,7 +2521,6 @@ Yap_InitAtomPreds(void)
Yap_InitCPred("atom_codes", 2, p_atom_codes, 0);
Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag);
Yap_InitCPred("$sub_atom_extract", 5, p_sub_atom_extract, 0);
Yap_InitCPred("number_chars", 2, p_number_chars, 0);
Yap_InitCPred("number_atom", 2, p_number_atom, 0);
Yap_InitCPred("number_codes", 2, p_number_codes, 0);

5
H/Yapproto.h
View File

@ -100,6 +100,11 @@ void Yap_InitAnalystPreds(void);
/* arrays.c */
void Yap_InitArrayPreds(void);
/* atoms.c */
void Yap_InitBackAtoms(void);
void Yap_InitAtomPreds(void);
/* attvar.c */
void Yap_InitAttVarPreds(void);
void Yap_MkEmptyWakeUp(Atom mod);

142
pl/utils.yap
View File

@ -460,148 +460,6 @@ sub_string(String, Bef, Size, After, SubStr) :-
catch(string_to_atom(String, A), _, true),
catch(string_to_atom(SubStr, SubA), _, true).
sub_atom(At, Bef, Size, After, SubAt) :-
% extract something from an atom
atom(At), integer(Bef), integer(Size), !,
'$sub_atom_extract'(At, Bef, Size, After, SubAt).
sub_atom(At, Bef, Size, After, SubAt) :-
% extract subatom from an atom
atom(At), atom(SubAt), !,
'$sub_atom_fetch'(At, Bef, Size, After, SubAt).
sub_atom(At, Bef, Size, After, SubAt) :-
atom(At), !,
atom_codes(At, Atl),
'$sub_atom2'(Bef, Atl, Size, After, SubAt, sub_atom(At, Bef, Size, After, SubAt)).
sub_atom(At, Bef, Size, After, SubAt) :-
var(At), !,
'$do_error'(instantiation_error,sub_atom(At, Bef, Size,After, SubAt)).
sub_atom(At, Bef, Size, After, SubAt) :-
\+ atom(At), !,
'$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)).
'$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :-
var(Bef), !,
'$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm).
'$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :-
'$sub_atom_get_subchars'(Bef, Atl, NewAtl),
'$sub_atom3'(Size, After, SubAt, NewAtl, ErrorTerm).
% if SubAt is bound, the rest is deterministic.
'$sub_atom3'(Size, After, SubAt, Atl, ErrorTerm) :-
nonvar(SubAt), !,
'$sub_atom_needs_atom'(SubAt,ErrorTerm),
'$sub_atom_needs_int'(Size,ErrorTerm),
'$sub_atom_needs_int'(After,ErrorTerm),
atom_codes(SubAt,Atls),
length(Atls, 0, Size),
'$sub_atom_get_subchars_and_match'(Size, Atl, Atls, NAtl),
length(NAtl,0,After).
% SubAt is unbound, but Size is bound
'$sub_atom3'(Size, After, SubAt, Atl, ErrorTerm) :-
nonvar(Size), !,
'$sub_atom_needs_int'(Size,ErrorTerm),
'$sub_atom_needs_int'(After,ErrorTerm),
'$sub_atom_get_subchars_and_match'(Size, Atl, SubAts, NAtl),
length(NAtl,After),
atom_codes(SubAt,SubAts).
% SubAt and Size are unbound, but After is bound.
'$sub_atom3'(Size, After, SubAt, Atl, ErrorTerm) :-
nonvar(After), !,
'$sub_atom_needs_int'(After,ErrorTerm),
'$sub_atom_get_last_subchars'(Atl,SubAts,After,Total,Size),
Total >= After,
atom_codes(SubAt,SubAts).
% SubAt, Size, and After are unbound.
'$sub_atom3'(Size, After, SubAt, Atl, _) :-
length(Atl,Len),
'$sub_atom_split'(Atl,Len,SubAts,Size,_,After),
atom_codes(SubAt,SubAts).
% Bef is unbound, so we've got three hypothesis
% ok: in the best case we just try to find SubAt in the original atom.
'$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm) :-
nonvar(SubAt), !,
'$sub_atom_needs_atom'(SubAt, ErrorTerm),
atom_codes(SubAt,SubAts),
'$sub_atom_search'(SubAts, Atl, 0, Bef, AfterS),
length(SubAts, Size),
length(AfterS, After).
% ok: in the second best case we just get rid of the tail
'$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm) :-
nonvar(After), !,
'$sub_atom_needs_int'(After, ErrorTerm),
'$sub_atom_get_last_subchars'(Atl,SubAt0,After,Total,Size0),
Total >= After,
'$sub_atom_split'(SubAt0,Size0,_,Bef,SubAts,Size),
atom_codes(SubAt,SubAts).
% ok: just do everything
'$sub_atombv'(Bef, Size, After, SubAt, Atl, _) :-
length(Atl, Len),
'$sub_atom_split'(Atl,Len,_,Bef,Atls2,Len2),
'$sub_atom_split'(Atls2,Len2,SubAts,Size,_,After),
atom_codes(SubAt,SubAts).
'$sub_atom_search'([], AfterS, BefSize, BefSize, AfterS).
'$sub_atom_search'([C|SubAts], [C|Atl], BefSize, BefSize, AfterS) :-
'$sub_atom_search2'(SubAts, Atl, AfterS).
'$sub_atom_search'([C|SubAts], [_|Atl], BefSize, BefSizeF, AfterS) :-
NBefSize is BefSize+1,
'$sub_atom_search'([C|SubAts], Atl, NBefSize, BefSizeF, AfterS).
'$sub_atom_search2'([], AfterS, AfterS).
'$sub_atom_search2'([C|SubAts], [C|Atl], AfterS) :-
'$sub_atom_search2'(SubAts, Atl, AfterS).
'$sub_atom_get_subchars'(0, Atl, Atl) :- !.
'$sub_atom_get_subchars'(I0, [_|Atl], NAtl) :-
I is I0-1,
'$sub_atom_get_subchars'(I, Atl, NAtl).
'$sub_atom_get_subchars'(0, Atl, [], Atl) :- !.
'$sub_atom_get_subchars'(I0, [C|Atl], [C|L], NAtl) :-
I is I0-1,
'$sub_atom_get_subchars'(I, Atl, L, NAtl).
'$sub_atom_get_subchars_and_match'(0, Atl, [], Atl) :- !.
'$sub_atom_get_subchars_and_match'(I0, [C|Atl], [C|Match], NAtl) :-
I is I0-1,
'$sub_atom_get_subchars_and_match'(I, Atl, Match, NAtl).
'$sub_atom_check_length'([],0).
'$sub_atom_check_length'([_|L],N1) :-
N1 > 0,
N is N1-1,
'$sub_atom_check_length'(L,N).
'$sub_atom_get_last_subchars'([],[],_,0,0).
'$sub_atom_get_last_subchars'([C|Atl],SubAt,After,Total,Size) :-
'$sub_atom_get_last_subchars'(Atl,SubAt0,After,Total0,Size0),
Total is Total0+1,
( Total > After ->
Size is Size0+1, SubAt = [C|SubAt0]
;
Size = Size0, SubAt = SubAt0
).
'$sub_atom_split'(Atl,After,[],0,Atl,After).
'$sub_atom_split'([C|Atl],Len,[C|Atls],Size,NAtl,After) :-
Len1 is Len-1,
'$sub_atom_split'(Atl,Len1,Atls,Size0,NAtl,After),
Size is Size0+1.
'$sub_atom_needs_int'(V,_) :- var(V), !.
'$sub_atom_needs_int'(I,_) :- integer(I), I >= 0, !.
'$sub_atom_needs_int'(I,ErrorTerm) :- integer(I), !,
'$do_error'(domain_error(not_less_than_zero,I),ErrorTerm).
'$sub_atom_needs_int'(I,ErrorTerm) :-
'$do_error'(type_error(integer,I),ErrorTerm).
'$sub_atom_needs_atom'(V,_) :- var(V), !.
'$sub_atom_needs_atom'(A,_) :- atom(A), !.
'$sub_atom_needs_atom'(A,ErrorTerm) :-
'$do_error'(type_error(atom,A),ErrorTerm).
'$singletons_in_term'(T,VL) :-
'$variables_in_term'(T,[],V10),
'$sort'(V10, V1),