diff --git a/C/stdpreds.c b/C/stdpreds.c index 9937d4f9b..8ef6c22bd 100755 --- a/C/stdpreds.c +++ b/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);