string_to_atom/2.

C/stdpreds.c

@@ -1065,6 +1065,116 @@ p_name( USES_REGS1 )
 
 }
 
+static Int 
+p_string_to_atom( USES_REGS1 )
+{				/* name(?Atomic,?String)		 */
+  char            *String; /* alloc temp space on trail */
+  Term            t = Deref(ARG1), NewT, AtomNameT = Deref(ARG2);
+
+ restart_aux:
+  if (!IsVarTerm(t)) {
+    Atom at;
+    do {
+      if (Yap_IsWideStringTerm(t)) {
+	at = Yap_LookupWideAtom(Yap_BlobWideStringOfTerm(t));
+      } else if (Yap_IsStringTerm(t)) {
+	at = Yap_LookupAtom(Yap_BlobStringOfTerm(t));
+      } else if (IsAtomTerm(t)) {
+	return Yap_unify(t, ARG2);
+      } else if (IsIntTerm(t)) {
+	char *String = Yap_PreAllocCodeSpace();
+	if (String + 1024 > (char *)AuxSp) 
+	  goto expand_auxsp;
+	sprintf(String, Int_FORMAT, IntOfTerm(t));
+	at = Yap_LookupAtom(String);
+      } else if (IsFloatTerm(t)) {
+	char *String = Yap_PreAllocCodeSpace();
+	if (String + 1024 > (char *)AuxSp) 
+	  goto expand_auxsp;
+
+	sprintf(String, "%f", FloatOfTerm(t));
+	at = Yap_LookupAtom(String);
+    } else if (IsLongIntTerm(t)) {
+	char *String = Yap_PreAllocCodeSpace();
+	if (String + 1024 > (char *)AuxSp) 
+	  goto expand_auxsp;
+
+	sprintf(String, Int_FORMAT, LongIntOfTerm(t));
+	at = Yap_LookupAtom(String);
+#if USE_GMP
+      } else if (IsBigIntTerm(t)) {
+	String = Yap_PreAllocCodeSpace();
+	if (!Yap_gmp_to_string(t, String, ((char *)AuxSp-String)-1024, 10 ))
+	  goto expand_auxsp;
+	at = Yap_LookupAtom(String);
+#endif
+      } else {
+	Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2");
+	return FALSE;
+      }
+      if (at != NIL)
+	break;
+      if (!Yap_growheap(FALSE, 0, NULL)) {
+	Yap_Error(OUT_OF_HEAP_ERROR, ARG2, "generating atom from string in string_to_atom/2");
+	return FALSE;
+      }
+      t = Deref(ARG1);
+    } while(TRUE);
+    return Yap_unify_constant(ARG2, MkAtomTerm(at));
+  }
+  if (!IsVarTerm(AtomNameT)) {
+    if (IsAtomTerm(AtomNameT)) {
+      Atom at = AtomOfTerm(AtomNameT);
+      if (IsWideAtom(at)) {
+	wchar_t *s = RepAtom(at)->WStrOfAE;
+	NewT = Yap_MkBlobWideStringTerm(s, wcslen(s));
+	return Yap_unify(NewT, ARG1);
+      } else
+	String = RepAtom(at)->StrOfAE;
+    } else if (IsIntTerm(AtomNameT)) {
+      String = Yap_PreAllocCodeSpace();
+      if (String + 1024 > (char *)AuxSp) 
+	goto expand_auxsp;
+      sprintf(String, Int_FORMAT, IntOfTerm(AtomNameT));
+    } else if (IsFloatTerm(AtomNameT)) {
+      String = Yap_PreAllocCodeSpace();
+      if (String + 1024 > (char *)AuxSp) 
+	goto expand_auxsp;
+
+      sprintf(String, "%f", FloatOfTerm(AtomNameT));
+    } else if (IsLongIntTerm(AtomNameT)) {
+      String = Yap_PreAllocCodeSpace();
+      if (String + 1024 > (char *)AuxSp) 
+	goto expand_auxsp;
+
+      sprintf(String, Int_FORMAT, LongIntOfTerm(AtomNameT));
+#if USE_GMP
+    } else if (IsBigIntTerm(AtomNameT)) {
+      String = Yap_PreAllocCodeSpace();
+      if (!Yap_gmp_to_string(AtomNameT, String, ((char *)AuxSp-String)-1024, 10 ))
+	goto expand_auxsp;
+#endif
+      NewT = Yap_MkBlobStringTerm(String, strlen(String));
+      return Yap_unify(NewT, ARG1);
+    }
+  }
+  Yap_Error(INSTANTIATION_ERROR, ARG1, "string_to_atom/2");
+  return(FALSE);		
+
+  /* error handling */
+ expand_auxsp:
+  String = Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE);
+  if (String + 1024 > (char *)AuxSp) {
+    /* crash in flames */
+    Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in string_to_atom/2");
+    return FALSE;
+  }
+  AtomNameT = Deref(ARG1);
+  t = Deref(ARG2);
+  goto restart_aux;
+
+}
+
 static Int 
 p_atom_chars( USES_REGS1 )
 {
@@ -4126,6 +4236,7 @@ Yap_InitCPreds(void)
   /* general purpose */
   Yap_InitCPred("$opdec", 4, p_opdec, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("name", 2, p_name, 0);
+  Yap_InitCPred("string_to_atom", 2, p_string_to_atom, 0);
   Yap_InitCPred("char_code", 2, p_char_code, SafePredFlag);
   Yap_InitCPred("atom_chars", 2, p_atom_chars, 0);
   Yap_InitCPred("atom_codes", 2, p_atom_codes, 0);