diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more atom/string manipulation fixes and SWI compatibility

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-12-05 21:26:46 +00:00
parent 5ada26eab3
commit 7e58cf7755
9 changed files with 158 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/amasm.c
View File

@ -1152,8 +1152,7 @@ a_ustring(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blo
code_p->opc = emit_op(opcode);
code_p->u.ou.opcw = emit_op(opcode_w);
code_p->u.ou.u =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(ou);

69
C/atoms.c
View File

@ -65,6 +65,10 @@ p_char_code( USES_REGS1 )
Yap_Error(INSTANTIATION_ERROR,t0,"char_code/2");
return(FALSE);
} else if (!IsIntegerTerm(t1)) {
if (!IsBigIntTerm(t1)) {
Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2");
return(FALSE);
}
Yap_Error(TYPE_ERROR_INTEGER,t1,"char_code/2");
return(FALSE);
} else {
@ -78,6 +82,10 @@ p_char_code( USES_REGS1 )
if (code > MAX_ISO_LATIN1) {
wchar_t wcodes[2];
if (code > CHARCODE_MAX) {
Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2");
return(FALSE);
}
wcodes[0] = code;
wcodes[1] = '\0';
tout = MkAtomTerm(Yap_LookupWideAtom(wcodes));
@ -184,12 +192,12 @@ p_string_to_atom( USES_REGS1 )
if (!IsVarTerm(t1)) {
Atom at;
// verify if an atom, int, float or bignnum
at = Yap_StringToAtom( t1 PASS_REGS );
at = Yap_StringSWIToAtom( t1 PASS_REGS );
if (at)
return Yap_unify(MkAtomTerm(at), t2);
// else
} else {
Term t0 = Yap_AtomToString( t2 PASS_REGS );
Term t0 = Yap_AtomSWIToString( t2 PASS_REGS );
if (t0) return Yap_unify(t0, t1);
}
if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atom/2" )) {
@ -284,6 +292,30 @@ p_atom_codes( USES_REGS1 )
return FALSE;
}
static Int
p_string_codes( USES_REGS1 )
{
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
} else {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_ListSWIToString(t PASS_REGS);
if (tf)
return Yap_unify( ARG1, tf );
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atom_codes/2" )) {
t1 = Deref(ARG1);
goto restart_aux;
}
return FALSE;
}
static Int
p_number_chars( USES_REGS1 )
@ -335,6 +367,31 @@ p_number_atom( USES_REGS1 )
return FALSE;
}
static Int
p_number_string( USES_REGS1 )
{
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
Term tf;
tf = Yap_NumberToString(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
} else {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_StringToNumber(t PASS_REGS);
if (tf)
return Yap_unify( ARG1, tf );
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "number_string/2")) {
goto restart_aux;
}
return FALSE;
}
static Int
p_number_codes( USES_REGS1 )
{
@ -559,7 +616,7 @@ p_atom_length( USES_REGS1 )
Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2");
return(FALSE);
}
if ((len = IntegerOfTerm(t2)) < 0) {
if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2");
return(FALSE);
}
@ -589,7 +646,7 @@ p_atomic_length( USES_REGS1 )
Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2");
return(FALSE);
}
if ((len = IntegerOfTerm(t2)) < 0) {
if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2");
return(FALSE);
}
@ -619,7 +676,7 @@ p_string_length( USES_REGS1 )
Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2");
return(FALSE);
}
if ((len = IntegerOfTerm(t2)) < 0) {
if (FALSE && (len = IntegerOfTerm(t2)) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2");
return(FALSE);
}
@ -1514,12 +1571,14 @@ Yap_InitAtomPreds(void)
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);
Yap_InitCPred("string_codes", 2, p_string_codes, 0);
Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
Yap_InitCPred("atomic_length", 2, p_atomic_length, SafePredFlag);
Yap_InitCPred("string_length", 2, p_string_length, SafePredFlag);
Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag);
Yap_InitCPred("number_chars", 2, p_number_chars, 0);
Yap_InitCPred("number_atom", 2, p_number_atom, 0);
Yap_InitCPred("number_string", 2, p_number_string, 0);
Yap_InitCPred("number_codes", 2, p_number_codes, 0);
Yap_InitCPred("atom_number", 2, p_atom_number, 0);
Yap_InitCPred("string_number", 2, p_string_number, 0);

3
C/compiler.c
View File

@ -693,7 +693,6 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
Int sz = (3+src[1])*sizeof(CELL);
CELL *dest;
char *ptr = src+2; int chr;
/* use a special list to store the blobs */
cglobs->cint.cpc = cglobs->cint.icpc;
/* if (IsFloatTerm(t)) {
@ -719,7 +718,7 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
else
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_string_op
: unify_string_op) :
write_string_op), t, Zero, &cglobs->cint);
write_string_op), l1, Zero, &cglobs->cint);
} else {
/* we are taking a blob, that is a binary that is supposed to be
guarded in the clause itself. Possible examples include

13
C/errors.c
View File

@ -1476,6 +1476,19 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
serious = TRUE;
}
break;
case REPRESENTATION_ERROR_INT:
{
int i;
Term ti[1];
i = strlen(tmpbuf);
ti[0] = MkAtomTerm(AtomInt);
nt[0] = Yap_MkApplTerm(FunctorRepresentationError, 1, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
}
break;
case REPRESENTATION_ERROR_MAX_ARITY:
{
int i;

9
C/pl-yap.c
View File

@ -390,14 +390,13 @@ typedef union
int
get_atom_ptr_text(Atom a, PL_chars_t *text)
{
YAP_Atom ya = (YAP_Atom)a;
if (YAP_IsWideAtom(ya)) {
pl_wchar_t *name = (pl_wchar_t *)YAP_WideAtomName(ya);
if (IsWideAtom(a)) {
pl_wchar_t *name = (pl_wchar_t *)a->WStrOfAE;
text->text.w = name;
text->length = wcslen(name);
text->encoding = ENC_WCHAR;
} else
{ char *name = (char *)YAP_AtomName(ya);
{ char *name = a->StrOfAE;
text->text.t = name;
text->length = strlen(name);
text->encoding = ENC_ISO_LATIN_1;
@ -411,7 +410,7 @@ get_atom_ptr_text(Atom a, PL_chars_t *text)
int
get_atom_text(atom_t atom, PL_chars_t *text)
{ Atom a = (Atom)atomValue(atom);
{ Atom a = YAP_AtomFromSWIAtom(atom);
return get_atom_ptr_text(a, text);
}

20
C/strings.c
View File

@ -60,7 +60,7 @@ get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
Atom at;
if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t)))) {
int i = RepAtom(at)->WStrOfAE[0];
if (i <= 0 || i > 255) {
if (i <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL;
}
@ -116,7 +116,12 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
}
} else {
while (t != TermNil) {
*s++ = IntOfTerm(HeadOfTerm(t));
int code;
*s++ = code = IntOfTerm(HeadOfTerm(t));
if (code <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL;
}
if (--max == 0) {
*s++ = 0;
return s0;
@ -456,7 +461,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
} else if (IsAtomTerm(t)) {
if (inp->type & (YAP_STRING_ATOM)) {
inp->type &= (YAP_STRING_ATOM);
inp->val.a = AtomOfTerm(t);
inp->val.t = t;
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
@ -511,7 +516,7 @@ write_strings( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
LOCAL_TERM_ERROR( 2*(lim-s) );
buf = buf_from_tstring(H);
while (cp < lim) {
while (*cp && cp < lim) {
int chr;
cp = utf8_get_char(cp, &chr);
buf = utf8_put_char(buf, chr);
@ -629,7 +634,7 @@ write_atoms( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
w[1] = '\0';
LOCAL_TERM_ERROR( 2*(lim-s) );
while (cp < lim) {
while (*cp && cp < lim) {
int chr;
cp = get_wchar(cp, &chr);
w[0] = chr;
@ -673,7 +678,7 @@ write_codes( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
{ char *s = s0, *lim = s + strnlen(s, max);
char *cp = s;
LOCAL_TERM_ERROR( 2*(lim-s) );
while (cp < lim) {
while (*cp && cp < lim) {
int chr;
cp = utf8_get_char(cp, &chr);
H[0] = MkIntTerm(chr);
@ -750,11 +755,12 @@ write_atom( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
wchar_t *buf = malloc(sizeof(wchar_t)*((lim+1)-s)), *ptr = buf;
Atom at;
while (s < lim) {
while (*s && s < lim) {
int chr;
s = utf8_get_char(s, &chr);
*ptr++ = chr;
}
*ptr++ = '\0';
if (min > max) max = min;
at = Yap_LookupMaybeWideAtomWithLength( buf, max );
free( buf );

59
H/YapMirror.h
View File

@ -18,6 +18,12 @@
static char SccsId[] = "%W% %G%";
#endif
#if SIZEOF_WCHAR_T == 2
#define CHARCODE_MAX 0xffff
#else
#define CHARCODE_MAX 0x10ffff
#endif
/*
* This file defines main data-structure for text conversion and
* mirroring
@ -223,6 +229,20 @@ Yap_AtomToString(Term t0 USES_REGS)
return out.val.t;
}
static inline Term
Yap_AtomSWIToString(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_TERM;
out.type = YAP_STRING_STRING;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline Term
Yap_AtomicToString(Term t0 USES_REGS)
{
@ -383,6 +403,21 @@ Yap_ListToString(Term t0 USES_REGS)
}
static inline Term
Yap_ListSWIToString(Term t0 USES_REGS)
{
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM;
out.type = YAP_STRING_STRING;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline Term
YapListToTDQ(Term t0, Term mod USES_REGS)
{
@ -584,6 +619,18 @@ Yap_StringToAtom(Term t0 USES_REGS)
return out.val.a;
}
static inline Atom
Yap_StringSWIToAtom(Term t0 USES_REGS)
{
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM;
out.type = YAP_STRING_ATOM;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.a;
}
static inline size_t
Yap_StringToAtomic(Term t0 USES_REGS)
{
@ -632,6 +679,18 @@ Yap_StringToListOfCodes(Term t0 USES_REGS)
return out.val.t;
}
static inline size_t
Yap_StringSWIToListOfCodes(Term t0 USES_REGS)
{
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_ATOMS_CODES|YAP_STRING_TERM;
out.type = YAP_STRING_CODES;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline Term
Yap_StringToNumber(Term t0 USES_REGS)
{

4
H/pl-yap.h
View File

@ -133,7 +133,7 @@ void PL_license(const char *license, const char *module);
#define isVar(A) IsVarTerm((A))
#define valReal(w) FloatOfTerm((w))
#define valFloat(w) FloatOfTerm((w))
#define atomValue(atom) YAP_AtomFromSWIAtom(atom)
#define atomValue(atom) AtomOfTerm(atom)
#define atomFromTerm(term) YAP_SWIAtomFromAtom(AtomOfTerm(term))
inline static char *
@ -184,7 +184,7 @@ charCode(Term w)
return -1;
}
if (strlen(a->StrOfAE) == 1)
return a->StrOfAE[0];
return ((unsigned char *)(a->StrOfAE))[0];
return -1;
}
return -1;

1
include/YapError.h
View File

@ -84,6 +84,7 @@ typedef enum
PRED_ENTRY_COUNTER_UNDERFLOW,
REPRESENTATION_ERROR_CHARACTER,
REPRESENTATION_ERROR_CHARACTER_CODE,
REPRESENTATION_ERROR_INT,
REPRESENTATION_ERROR_MAX_ARITY,
REPRESENTATION_ERROR_VARIABLE,
RESOURCE_ERROR_HUGE_INT,