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

Fix some possible errors in name/2 and friends, and cleanup code a bit

Browse Source 
YAP_Error changed.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1256 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-03-02 19:48:03 +00:00
parent 8a03474632
commit 81b4413a33
2 changed files with 75 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

161
C/stdpreds.c
View File

@ -11,8 +11,12 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * comments: General-purpose C implemented system predicates *
* * * *
* Last rev: $Date: 2005-03-02 18:35:46 $,$Author: vsc $ * * Last rev: $Date: 2005-03-02 19:48:02 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.84 2005/03/02 18:35:46 vsc
* try to make initialisation process more robust
* try to make name more robust (in case Lookup new atom fails)
*
* Revision 1.83 2005/03/01 22:25:09 vsc * Revision 1.83 2005/03/01 22:25:09 vsc
* fix pruning bug * fix pruning bug
* make DL_MALLOC less enthusiastic about walking through buckets. * make DL_MALLOC less enthusiastic about walking through buckets.
@ -971,55 +975,42 @@ p_name(void)
t = Deref(ARG2); t = Deref(ARG2);
if (!IsVarTerm(AtomNameT)) { if (!IsVarTerm(AtomNameT)) {
if (IsAtomTerm(AtomNameT)) { if (IsAtomTerm(AtomNameT)) {
s = RepAtom(AtomOfTerm(AtomNameT))->StrOfAE; String = RepAtom(AtomOfTerm(AtomNameT))->StrOfAE;
NewT = Yap_StringToList(s);
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,
"name/2");
return FALSE;
}
return Yap_unify(NewT, ARG2);
} else if (IsIntTerm(AtomNameT)) { } else if (IsIntTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace(); String = Yap_PreAllocCodeSpace();
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", IntOfTerm(AtomNameT)); sprintf(String, "%ld", IntOfTerm(AtomNameT));
#else #else
sprintf(String, "%d", IntOfTerm(AtomNameT)); sprintf(String, "%d", IntOfTerm(AtomNameT));
#endif #endif
NewT = Yap_StringToList(String);
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2");
return(FALSE);
}
return (Yap_unify(NewT, ARG2));
} else if (IsFloatTerm(AtomNameT)) { } else if (IsFloatTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace(); String = Yap_PreAllocCodeSpace();
sprintf(String, "%f", FloatOfTerm(AtomNameT)); sprintf(String, "%f", FloatOfTerm(AtomNameT));
NewT = Yap_StringToList(String);
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2");
return(FALSE);
}
return (Yap_unify(NewT, ARG2));
} else if (IsLongIntTerm(AtomNameT)) { } else if (IsLongIntTerm(AtomNameT)) {
char *String = Yap_PreAllocCodeSpace(); String = Yap_PreAllocCodeSpace();
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", LongIntOfTerm(AtomNameT)); sprintf(String, "%ld", LongIntOfTerm(AtomNameT));
#else #else
sprintf(String, "%d", LongIntOfTerm(AtomNameT)); sprintf(String, "%d", LongIntOfTerm(AtomNameT));
#endif #endif
NewT = Yap_StringToList(String); #if USE_GMP
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) { } else if (IsBigIntTerm(AtomNameT)) {
Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2"); String = Yap_PreAllocCodeSpace();
return FALSE; mpz_get_str(String, 10, Yap_BigIntOfTerm(AtomNameT));
} #endif
return Yap_unify(NewT, ARG2);
} else { } else {
Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2"); Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2");
return(FALSE); return FALSE;
} }
NewT = Yap_StringToList(String);
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,
"name/2");
return FALSE;
}
return Yap_unify(NewT, ARG2);
} }
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (s == NULL) { if (s == NULL) {
@ -1071,7 +1062,7 @@ p_name(void)
while ((at = Yap_LookupAtom(String)) == NIL) { while ((at = Yap_LookupAtom(String)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) { if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return FALSE;
} }
} }
NewT = MkAtomTerm(at); NewT = MkAtomTerm(at);
@ -1087,6 +1078,7 @@ static Int
p_atom_chars(void) p_atom_chars(void)
{ {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) { if (!IsVarTerm(t1)) {
Term NewT; Term NewT;
if (!IsAtomTerm(t1)) { if (!IsAtomTerm(t1)) {
@ -1098,12 +1090,13 @@ p_atom_chars(void)
} else { } else {
NewT = Yap_StringToListOfAtoms(RepAtom(AtomOfTerm(t1))->StrOfAE); NewT = Yap_StringToListOfAtoms(RepAtom(AtomOfTerm(t1))->StrOfAE);
} }
return (Yap_unify(NewT, ARG2)); return Yap_unify(NewT, ARG2);
} else { } else {
/* ARG1 unbound */ /* ARG1 unbound */
char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; /* alloc temp space on trail */ char *String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; /* alloc temp space on trail */
register Term t = Deref(ARG2); register Term t = Deref(ARG2);
register char *s = String; register char *s = String;
Atom at;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t1, "atom_chars/2"); Yap_Error(INSTANTIATION_ERROR, t1, "atom_chars/2");
@ -1192,7 +1185,13 @@ p_atom_chars(void)
} }
} }
*s++ = '\0'; *s++ = '\0';
return (Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(String)))); while ((at = Yap_LookupAtom(String)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
return Yap_unify_constant(ARG1, MkAtomTerm(at));
} }
} }
@ -1246,11 +1245,17 @@ p_atom_concat(void)
} }
} }
if (t1 == TermNil) { if (t1 == TermNil) {
Term tout; Atom at;
cptr[0] = '\0'; cptr[0] = '\0';
tout = MkAtomTerm(Yap_LookupAtom(cpt0)); while ((at = Yap_LookupAtom(cpt0)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
return(Yap_unify(ARG2, tout)); return Yap_unify(ARG2, MkAtomTerm(at));
} }
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
Yap_Error(TYPE_ERROR_LIST, ARG1, "atom_concat/2"); Yap_Error(TYPE_ERROR_LIST, ARG1, "atom_concat/2");
@ -1339,11 +1344,17 @@ p_atomic_concat(void)
} }
} }
if (t1 == TermNil) { if (t1 == TermNil) {
Term tout; Atom at;
cptr[0] = '\0'; cptr[0] = '\0';
tout = MkAtomTerm(Yap_LookupAtom(cpt0)); while ((at = Yap_LookupAtom(cpt0)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
return(Yap_unify(ARG2, tout)); return Yap_unify(ARG2, MkAtomTerm(at));
} }
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0); Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
Yap_Error(TYPE_ERROR_LIST, ARG1, "atom_concat/2"); Yap_Error(TYPE_ERROR_LIST, ARG1, "atom_concat/2");
@ -1446,7 +1457,7 @@ p_atom_length(void)
return((Int)strlen(RepAtom(AtomOfTerm(t1))->StrOfAE) == len); return((Int)strlen(RepAtom(AtomOfTerm(t1))->StrOfAE) == len);
} else { } else {
Term tj = MkIntTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE)); Term tj = MkIntTerm(strlen(RepAtom(AtomOfTerm(t1))->StrOfAE));
return(Yap_unify_constant(t2,tj)); return Yap_unify_constant(t2,tj);
} }
} }
@ -1529,43 +1540,25 @@ p_number_chars(void)
#else #else
sprintf(String, "%d", IntOfTerm(t1)); sprintf(String, "%d", IntOfTerm(t1));
#endif #endif
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
NewT = Yap_StringToList(String);
} else {
NewT = Yap_StringToListOfAtoms(String);
}
return (Yap_unify(NewT, ARG2));
} else if (IsFloatTerm(t1)) { } else if (IsFloatTerm(t1)) {
sprintf(String, "%f", FloatOfTerm(t1)); sprintf(String, "%f", FloatOfTerm(t1));
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
NewT = Yap_StringToList(String);
} else {
NewT = Yap_StringToListOfAtoms(String);
}
return (Yap_unify(NewT, ARG2));
} else if (IsLongIntTerm(t1)) { } else if (IsLongIntTerm(t1)) {
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", LongIntOfTerm(t1)); sprintf(String, "%ld", LongIntOfTerm(t1));
#else #else
sprintf(String, "%d", LongIntOfTerm(t1)); sprintf(String, "%d", LongIntOfTerm(t1));
#endif #endif
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
NewT = Yap_StringToList(String);
} else {
NewT = Yap_StringToListOfAtoms(String);
}
return (Yap_unify(NewT, ARG2));
#if USE_GMP #if USE_GMP
} else if (IsBigIntTerm(t1)) { } else if (IsBigIntTerm(t1)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1)); mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
NewT = Yap_StringToList(String);
} else {
NewT = Yap_StringToListOfAtoms(String);
}
return (Yap_unify(NewT, ARG2));
#endif #endif
} }
if (yap_flags[YAP_TO_CHARS_FLAG] == QUINTUS_TO_CHARS) {
NewT = Yap_StringToList(String);
} else {
NewT = Yap_StringToListOfAtoms(String);
}
return Yap_unify(NewT, ARG2);
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t1, "number_chars/2"); Yap_Error(INSTANTIATION_ERROR, t1, "number_chars/2");
@ -1669,40 +1662,40 @@ p_number_atom(void)
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE; s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (IsNonVarTerm(t1)) { if (IsNonVarTerm(t1)) {
Atom at;
if (IsIntTerm(t1)) { if (IsIntTerm(t1)) {
Term NewT;
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", IntOfTerm(t1)); sprintf(String, "%ld", IntOfTerm(t1));
#else #else
sprintf(String, "%d", IntOfTerm(t1)); sprintf(String, "%d", IntOfTerm(t1));
#endif #endif
NewT = MkAtomTerm(Yap_LookupAtom(String));
return (Yap_unify(NewT, ARG2));
} else if (IsFloatTerm(t1)) { } else if (IsFloatTerm(t1)) {
Term NewT;
sprintf(String, "%f", FloatOfTerm(t1)); sprintf(String, "%f", FloatOfTerm(t1));
NewT = MkAtomTerm(Yap_LookupAtom(String));
return (Yap_unify(NewT, ARG2));
} else if (IsLongIntTerm(t1)) { } else if (IsLongIntTerm(t1)) {
Term NewT;
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", LongIntOfTerm(t1)); sprintf(String, "%ld", LongIntOfTerm(t1));
#else #else
sprintf(String, "%d", LongIntOfTerm(t1)); sprintf(String, "%d", LongIntOfTerm(t1));
#endif #endif
NewT = MkAtomTerm(Yap_LookupAtom(String));
return (Yap_unify(NewT, ARG2));
#if USE_GMP #if USE_GMP
} else if (IsBigIntTerm(t1)) { } else if (IsBigIntTerm(t1)) {
Term NewT;
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1)); mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
NewT = MkAtomTerm(Yap_LookupAtom(String));
return (Yap_unify(NewT, ARG2));
#endif #endif
} else { } else {
Yap_Error(TYPE_ERROR_NUMBER, t1, "number_atom/2"); Yap_Error(TYPE_ERROR_NUMBER, t1, "number_atom/2");
return(FALSE); return FALSE;
} }
while ((at = Yap_LookupAtom(String)) == NIL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
return Yap_unify(MkAtomTerm(at), ARG2);
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "number_chars/2"); Yap_Error(INSTANTIATION_ERROR, t, "number_chars/2");
@ -1736,30 +1729,24 @@ p_number_codes(void)
#else #else
sprintf(String, "%d", IntOfTerm(t1)); sprintf(String, "%d", IntOfTerm(t1));
#endif #endif
NewT = Yap_StringToList(String);
return (Yap_unify(NewT, ARG2));
} else if (IsFloatTerm(t1)) { } else if (IsFloatTerm(t1)) {
sprintf(String, "%f", FloatOfTerm(t1)); sprintf(String, "%f", FloatOfTerm(t1));
NewT = Yap_StringToList(String);
return (Yap_unify(NewT, ARG2));
} else if (IsLongIntTerm(t1)) { } else if (IsLongIntTerm(t1)) {
#if SHORT_INTS #if SHORT_INTS
sprintf(String, "%ld", LongIntOfTerm(t1)); sprintf(String, "%ld", LongIntOfTerm(t1));
#else #else
sprintf(String, "%d", LongIntOfTerm(t1)); sprintf(String, "%d", LongIntOfTerm(t1));
#endif #endif
NewT = Yap_StringToList(String);
return (Yap_unify(NewT, ARG2));
#if USE_GMP #if USE_GMP
} else if (IsBigIntTerm(t1)) { } else if (IsBigIntTerm(t1)) {
mpz_get_str(String, 10, Yap_BigIntOfTerm(t1)); mpz_get_str(String, 10, Yap_BigIntOfTerm(t1));
NewT = Yap_StringToList(String);
return (Yap_unify(NewT, ARG2));
#endif #endif
} else { } else {
Yap_Error(TYPE_ERROR_NUMBER, t1, "number_codes/2"); Yap_Error(TYPE_ERROR_NUMBER, t1, "number_codes/2");
return(FALSE); return FALSE;
} }
NewT = Yap_StringToList(String);
return Yap_unify(NewT, ARG2);
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "number_codes/2"); Yap_Error(INSTANTIATION_ERROR, t, "number_codes/2");

2
library/yap2swi/yap2swi.c
View File

@ -1105,7 +1105,7 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
/* ignore flags and module for now */ /* ignore flags and module for now */
if (execution.open != 0) { if (execution.open != 0) {
YAP_Error("only one query at a time allowed\n"); YAP_Error(0, 0L, "only one query at a time allowed\n");
} }
execution.open=1; execution.open=1;
execution.state=0; execution.state=0;