From 75b7cebdaf2402ddc0a061852470b21d733d1678 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 4 Jul 2018 11:23:19 +0100 Subject: [PATCH] atom_codes --- C/atomic.c | 24 +++++++++++++++------ C/text.c | 52 ++++++++++++++++++++++----------------------- H/YapText.h | 16 ++++++++++++++ include/YapErrors.h | 2 +- 4 files changed, 59 insertions(+), 35 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 8dfac4b3d..e3016935d 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -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; } { diff --git a/C/text.c b/C/text.c index f256bc6e0..f9b4d0c4a 100644 --- a/C/text.c +++ b/C/text.c @@ -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 { diff --git a/H/YapText.h b/H/YapText.h index d5a1ed0ae..953e6a4b8 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -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; diff --git a/include/YapErrors.h b/include/YapErrors.h index 484df0451..536a1699e 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -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