diff --git a/C/stdpreds.c b/C/stdpreds.c index ced0083d4..0b7337603 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2503,6 +2503,70 @@ p_sub_atom_extract(void) goto start; } +/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/ +static Int +p_sub_atom_fetch(void) +{ + Atom at = AtomOfTerm(Deref(ARG1)); + Atom subatom = AtomOfTerm(Deref(ARG5)); + Int offset = IntegerOfTerm(Deref(ARG6)); + + if (IsWideAtom(at)) { + wchar_t *s = RepAtom(at)->WStrOfAE; + wchar_t *ins, *where; + Int start, sz, after; + + + if (!IsWideAtom(subatom)) { + /* first convert to wchar_t */ + char *inschars = RepAtom(subatom)->StrOfAE; + Int i; + + sz = strlen(inschars); + 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; + } + } + for (i=0;i<=sz;i++) + ins[i] = inschars[i]; + } else { + ins = RepAtom(subatom)->WStrOfAE; + sz = wcslen(ins); + } + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) + return FALSE; + if (!(where = wcsstr(s+offset, ins))) { + return FALSE; + } + if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2)) + return FALSE; + after = wcslen(s)-(start+sz); + return Yap_unify(MkIntegerTerm(after), ARG4); + } else { + char *s = RepAtom(at)->StrOfAE; + char *ins, *where; + Int start, sz, after; + + if (IsWideAtom(subatom)) { + return FALSE; + } + ins = subatom->StrOfAE; + sz = strlen(ins); + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) + return FALSE; + if (!(where = strstr(s+offset, ins))) { + return FALSE; + } + if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2)) + return FALSE; + after = strlen(s)-(start+sz); + return Yap_unify(MkIntegerTerm(after), ARG4); + } +} + static Int p_abort(void) @@ -3929,6 +3993,7 @@ Yap_InitCPreds(void) Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag); Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$sub_atom_extract", 5, p_sub_atom_extract, HiddenPredFlag); + Yap_InitCPred("$sub_atom_fetch", 6, p_sub_atom_fetch, HiddenPredFlag); 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); diff --git a/pl/utils.yap b/pl/utils.yap index 219790eec..8a274f2f3 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -520,6 +520,10 @@ 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), !, + '$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, 0). sub_atom(At, Bef, Size, After, SubAt) :- atom(At), !, atom_codes(At, Atl), @@ -532,6 +536,17 @@ sub_atom(At, Bef, Size, After, SubAt) :- '$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)). +'$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, I0) :- + '$sub_atom_fetch'(At, Bef1, Size, After1, SubAt, I0), + ( + Bef = Bef1, After = After1 + ; + Next is Bef1+1, + '$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, Next) + ). + + + '$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :- var(Bef), !, '$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm).