atom_codes

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;
   }
   {

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 {

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;

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