This commit is contained in:
Vitor Santos Costa 2018-07-06 23:29:31 +01:00
commit fb13a127b0
4 changed files with 59 additions and 35 deletions

View File

@ -588,13 +588,24 @@ restart_aux:
}
}
/** @pred atom_codes(?A, ?L) is iso
The predicate holds when at least one of the arguments is
ground (otherwise, YAP will generate an error event. _A_ must be unifiable with an atom, and the
argument _L_ with the list of the character codes for string _A_.
*/
static Int atom_codes(USES_REGS1) {
Term t1;
t1 = Deref(ARG1);
LOCAL_MAX_SIZE = 1024;
int l = push_text_stack();
restart_aux:
t1 = Deref(ARG1);
if (IsAtomTerm(t1)) {
Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS);
Term tf = Yap_AtomSWIToListOfCodes(t1 PASS_REGS);
if (tf) {
pop_text_stack(l);
return Yap_unify(ARG2, tf);
@ -602,17 +613,16 @@ restart_aux:
} else if (IsVarTerm(t1)) {
/* ARG1 unbound */
Term t = Deref(ARG2);
Atom af = Yap_ListToAtom(t PASS_REGS);
Atom af = Yap_ListOfCodesToAtom(t PASS_REGS);
if (af) {
pop_text_stack(l);
return Yap_unify(ARG1, MkAtomTerm(af));
}
} else if (IsVarTerm(t1)) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
/* error handling */
} else {
Yap_ThrowError( TYPE_ERROR_ATOM, t1, NULL);
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) {
t1 = Deref(ARG1);
goto restart_aux;
}
{

View File

@ -231,7 +231,7 @@ static Term Globalize(Term v USES_REGS) {
return v;
}
static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) {
static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) {
unsigned char *st0, *st, ar[16];
Term t = t0;
size_t length = 0;
@ -241,11 +241,18 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) {
st0[0] = 0;
return st0;
}
if (!IsPairTerm(t))
return NULL;
if (!IsPairTerm(t)) {
Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
return NULL;
}
bool codes = IsIntegerTerm(HeadOfTerm(t));
if (get_codes)
*get_codes = codes;
if (get_codes !=codes && fixed) {
if (codes) {
Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), "scanning list of codes");
} else {
Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms");
}
}
if (codes) {
while (IsPairTerm(t)) {
Term hd = HeadOfTerm(t);
@ -259,7 +266,7 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) {
}
Int code = IntegerOfTerm(hd);
if (code < 0) {
Yap_ThrowError(TYPE_ERROR_CHARACTER_CODE, hd, "scanning list of codes");
Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, "scanning list of character codes, found %d", code);
return NULL;
}
length += put_utf8(ar, code);
@ -368,26 +375,21 @@ static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS);
static unsigned char *Yap_ListOfCodesToBuffer(unsigned char *buf, Term t,
seq_tv_t *inp USES_REGS) {
bool codes;
unsigned char *nbuf = codes2buf(t, buf, &codes PASS_REGS);
if (!codes)
return NULL;
bool codes = true, fixed = true;
unsigned char *nbuf = codes2buf(t, buf, codes, fixed PASS_REGS);
return nbuf;
}
static unsigned char *Yap_ListOfAtomsToBuffer(unsigned char *buf, Term t,
seq_tv_t *inp USES_REGS) {
bool codes;
unsigned char *nbuf = codes2buf(t, buf, &codes PASS_REGS);
if (codes)
return NULL;
bool codes = false;
unsigned char *nbuf = codes2buf(t, buf, codes, true PASS_REGS);
return nbuf;
}
static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t,
seq_tv_t *inp USES_REGS) {
unsigned char *nbuf = codes2buf(t, buf, NULL PASS_REGS);
return nbuf;
return codes2buf(t, buf, NULL, false PASS_REGS);
}
#if USE_GEN_TYPE_ERROR
@ -425,28 +427,24 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
if (!(inp->type & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
LOCAL_Error_TYPE = TYPE_ERROR_TEXT;
LOCAL_ActiveError->errorRawTerm = inp->val.t;
}
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
if (inp->val.uc != NULL) {
LOCAL_ActiveError->errorRawTerm = MkUStringTerm(inp->val.uc);
}
Yap_ThrowError(LOCAL_Error_TYPE, LOCAL_ActiveError->errorRawTerm, "Converting to text from term ");
return NULL;
}
}
if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) {
// this is a term, extract to a buffer, and representation is wide
// Yap_DebugPlWriteln(inp->val.t);
@ -681,10 +679,10 @@ static Term write_codes(void *s0, seq_tv_t *out USES_REGS) {
static Atom write_atom(void *s0, seq_tv_t *out USES_REGS) {
unsigned char *s = s0;
int32_t ch;
size_t leng = strlen(s0);
if (leng == 0) {
if (s[0] == '\0') {
return Yap_LookupAtom("");
}
size_t leng = strlen(s0);
if (strlen_utf8(s0) <= leng) {
return Yap_LookupAtom(s0);
} else {

View File

@ -543,6 +543,22 @@ static inline Term Yap_AtomToListOfCodes(Term t0 USES_REGS) {
return out.val.t;
}
static inline Term Yap_AtomSWIToListOfCodes(Term t0 USES_REGS) {
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES |YAP_STRING_ATOMS_CODES |YAP_STRING_ATOMS_CODES |
YAP_STRING_TERM;
out.val.uc = NULL;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline Term Yap_AtomToNumber(Term t0 USES_REGS) {
seq_tv_t inp, out;
inp.val.t = t0;

View File

@ -21,7 +21,7 @@ ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0)
/// bad access, I/O
ECLASS(PERMISSION_ERROR, "permission_error", 3)
/// something that could not be represented into a type
ECLASS(REPRESENTATION_ERROR, "representation_error", 1)
ECLASS(REPRESENTATION_ERROR, "representation_error", 0)
/// not enough ....
ECLASS(RESOURCE_ERROR, "resource_error", 2)
/// bad text