From 8f9f1223e7385f0f024322da9fde9eb6cf7baf97 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 17 Jan 2010 00:04:17 +0000 Subject: [PATCH] fix sub_atom(xxx,_,_,_,'') (obs from David Vaz). --- C/stdpreds.c | 73 ++++++++++++++++++++++++++++++++++++-------------- packages/clpqr | 2 +- packages/jpl | 2 +- pl/utils.yap | 13 +-------- 4 files changed, 56 insertions(+), 34 deletions(-) diff --git a/C/stdpreds.c b/C/stdpreds.c index ff668d767..eb43a6022 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2507,16 +2507,18 @@ p_sub_atom_extract(void) /* $sub_atom_extract(A,Bef,Size,After,SubAt).*/ static Int -p_sub_atom_fetch(void) +cont_sub_atom_fetch(void) { - Atom at = AtomOfTerm(Deref(ARG1)); - Atom subatom = AtomOfTerm(Deref(ARG5)); - Int offset = IntegerOfTerm(Deref(ARG6)); + Atom at = AtomOfTerm(EXTRA_CBACK_ARG(5,1)); + Atom subatom = AtomOfTerm(EXTRA_CBACK_ARG(5,2)); + Int offset = IntegerOfTerm(EXTRA_CBACK_ARG(5,3)); if (IsWideAtom(at)) { wchar_t *s = RepAtom(at)->WStrOfAE; wchar_t *ins, *where; Int start, sz, after; + Int sb = wcslen(s); + Int res; if (!IsWideAtom(subatom)) { @@ -2525,6 +2527,8 @@ p_sub_atom_fetch(void) Int i; sz = strlen(inschars); + 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)) { @@ -2538,37 +2542,66 @@ p_sub_atom_fetch(void) ins = RepAtom(subatom)->WStrOfAE; sz = wcslen(ins); } - if (!Yap_unify(MkIntegerTerm(sz), ARG3)) - return FALSE; if (!(where = wcsstr(s+offset, ins))) { - return FALSE; + cut_fail(); + } + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) { + cut_fail(); + } + start = where-s; + after = sb-(start+sz); + res = (Yap_unify(MkIntegerTerm(start), ARG2) && + Yap_unify(MkIntegerTerm(after), ARG4)); + if (after < sz) { + cut_succeed(); + } else { + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1); + return TRUE; } - 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; + Int sb = strlen(s); + Int res; 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 (offset+sz > sb) { + cut_fail(); + } + if (!(where = strstr(s+offset, ins))) { + cut_fail(); + } + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) { + cut_fail(); + } + start = where-s; + after = sb-(start+sz); + res = (Yap_unify(MkIntegerTerm(start), ARG2) && + Yap_unify(MkIntegerTerm(after), ARG4)); + if (after < sz) { + cut_succeed(); + } else { + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(start+1); + return TRUE; } - if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2)) - return FALSE; - after = strlen(s)-(start+sz); - return Yap_unify(MkIntegerTerm(after), ARG4); } } +/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/ +static Int +init_sub_atom_fetch(void) +{ + EXTRA_CBACK_ARG(5,1) = Deref(ARG1); + EXTRA_CBACK_ARG(5,2) = Deref(ARG5); + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(0); + return cont_sub_atom_fetch(); +} + static Int p_abort(void) @@ -3926,6 +3959,7 @@ Yap_InitBackCPreds(void) SafePredFlag|SyncPredFlag); Yap_InitCPredBack("$current_atom_op", 5, 1, init_current_atom_op, cont_current_atom_op, SafePredFlag|SyncPredFlag); + Yap_InitCPredBack("$sub_atom_fetch", 5, 3, init_sub_atom_fetch, cont_sub_atom_fetch, HiddenPredFlag); #ifdef BEAM Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam, SafePredFlag); @@ -3973,7 +4007,6 @@ 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/packages/clpqr b/packages/clpqr index e3ee70d59..0072deb51 160000 --- a/packages/clpqr +++ b/packages/clpqr @@ -1 +1 @@ -Subproject commit e3ee70d5971a5af8c9a2a3a5fe8a1892c3777f2b +Subproject commit 0072deb511e839a2f2df6bfa170076f9c8ecb6bb diff --git a/packages/jpl b/packages/jpl index d661852f7..8192d5f9b 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit d661852f76fe24441d983ef6f4e60ba90cfe17c4 +Subproject commit 8192d5f9ba0bba55fdd96b4473d68d8cf57f51aa diff --git a/pl/utils.yap b/pl/utils.yap index 1c118608b..dec5ced68 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -388,7 +388,7 @@ sub_atom(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_fetch'(At, Bef, Size, After, SubAt). sub_atom(At, Bef, Size, After, SubAt) :- atom(At), !, atom_codes(At, Atl), @@ -401,17 +401,6 @@ 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).