From adea3bdb2480beceba824bb4aabf52890c59740e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 8 Dec 2013 19:12:24 +0000 Subject: [PATCH] more string fixes and get_code --- C/atomic.c | 306 +++++++++++++++++++++++++--------- C/c_interface.c | 2 +- C/errors.c | 14 ++ C/iopreds.c | 2 +- C/load_foreign.c | 2 +- C/parser.c | 2 +- C/pl-yap.c | 2 +- C/scanner.c | 2 +- C/text.c | 48 ++++-- H/YapText.h | 160 +++++++++++------- H/iatoms.h | 1 + H/ratoms.h | 1 + H/tatoms.h | 2 + include/YapError.h | 1 + library/dialect/swi/fli/swi.c | 2 +- misc/ATOMS | 1 + 16 files changed, 380 insertions(+), 168 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 649d5bd2f..18765c3b9 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -464,10 +464,14 @@ cont_atom_concat3( USES_REGS1 ) cut_fail(); } /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "atom_concat/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } @@ -500,69 +504,30 @@ init_atom_concat3( USES_REGS1 ) else cut_fail(); } /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "atom_concat/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } static Int -cont_atomic_concat3( USES_REGS1 ) -{ - Term t3; - Atom ats[2]; - Int i, max; - restart_aux: - t3 = Deref(ARG3); - i = IntOfTerm(EXTRA_CBACK_ARG(3,1)); - max = IntOfTerm(EXTRA_CBACK_ARG(3,2)); - EXTRA_CBACK_ARG(3,1) = MkIntTerm(i+1); - if ( ! Yap_SpliceAtom( t3, ats, i, max PASS_REGS ) ) { - cut_fail(); - } else { - if (i < max) return Yap_unify( ARG1, MkAtomTerm(ats[0])) && - Yap_unify( ARG2, MkAtomTerm(ats[1])) ; - if (Yap_unify( ARG1, MkAtomTerm(ats[0])) && - Yap_unify( ARG2, MkAtomTerm(ats[1]))) cut_succeed(); - cut_fail(); - } - /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { - goto restart_aux; - } - return FALSE; -} - - -static Int -init_atomic_concat3( USES_REGS1 ) +p_atomic_concat3( USES_REGS1 ) { Term t1; - Term t2, t3, ot; + Term t2; Term t; + Atom at; restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); - t3 = Deref(ARG3); - if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) { - Atom at = Yap_ConcatAtomics( t1, t2 PASS_REGS ); - if (at) t = MkAtomTerm(at); - else t=0L; - ot = ARG3; - } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) { - t = Yap_SubtractHeadAtomic( Deref(ARG3), t1 PASS_REGS ); - ot = ARG2; - } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { - t = Yap_SubtractTailAtomic( Deref(ARG3), t2 PASS_REGS ); - ot = ARG1; - } else { - EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); - return cont_atomic_concat3( PASS_REGS1 ); - } - if (t) { - if (Yap_unify(ot, t)) cut_succeed(); - else cut_fail(); + at = Yap_ConcatAtomics( t1, t2 PASS_REGS ); + if (at) { + t = MkAtomTerm(at); + return Yap_unify(ARG3, t); } /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError( "atomic_concat/3" )) { @@ -576,7 +541,7 @@ cont_string_concat3( USES_REGS1 ) { Term t3; Term ts[2]; - Int i, max; + size_t i, max; restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3,1)); @@ -592,10 +557,14 @@ cont_string_concat3( USES_REGS1 ) cut_fail(); } /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_concat/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } @@ -613,10 +582,10 @@ init_string_concat3( USES_REGS1 ) tf = Yap_ConcatStrings( t1, t2 PASS_REGS ); ot = ARG3; } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) { - tf = Yap_SubtractHeadString( Deref(ARG3), t1 PASS_REGS ); + tf = Yap_SubtractHeadString(t3, t1 PASS_REGS ); ot = ARG2; } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { - tf = Yap_SubtractTailString( Deref(ARG3), t2 PASS_REGS ); + tf = Yap_SubtractTailString( t3, t2 PASS_REGS ); ot = ARG1; } else { EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); @@ -624,14 +593,18 @@ init_string_concat3( USES_REGS1 ) return cont_string_concat3( PASS_REGS1 ); } if (tf) { - if (Yap_unify(ot, tf)) cut_succeed(); - else cut_fail(); + if (Yap_unify(ot, tf)) { cut_succeed(); } + else { cut_fail(); } } /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "string_concat/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_concat/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } static Int @@ -651,17 +624,21 @@ cont_string_code3( USES_REGS1 ) if (s[0]) { EXTRA_CBACK_ARG(3,1) = MkIntTerm(s-s0); EXTRA_CBACK_ARG(3,2) = MkIntTerm(j+1); - return Yap_unify(MkIntegerTerm( chr ), ARG3) && Yap_unify(MkIntegerTerm( j ), ARG1); + return Yap_unify(MkIntegerTerm( chr ), ARG3) && Yap_unify(MkIntegerTerm( j+1 ), ARG1); } if (Yap_unify(MkIntegerTerm( chr ), ARG3) && Yap_unify(MkIntegerTerm( j ), ARG1)) cut_succeed(); else cut_fail(); /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "get_code/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_code/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } @@ -694,9 +671,12 @@ init_string_code3( USES_REGS1 ) const char *ns = s; int chr; Int indx = IntegerOfTerm( t1 ); - if (indx < 0) { - LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - LOCAL_Error_Term = t1; + if (indx <= 0) { + if (indx < 0) { + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + LOCAL_Error_Term = t1; + } + cut_fail(); } ns = utf8_skip(s,indx); if (ns == NULL) { @@ -709,10 +689,73 @@ init_string_code3( USES_REGS1 ) } } /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "get_code/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_code/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); +} + + +static Int +p_get_string_code3( USES_REGS1 ) +{ + Term t1; + Term t2; + const char *s; + restart_aux: + t1 = Deref(ARG1); + t2 = Deref(ARG2); + if (IsVarTerm(t2)) { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t2; + } else if (!IsStringTerm(t2)) { + LOCAL_Error_TYPE = TYPE_ERROR_STRING; + LOCAL_Error_Term = t2; + } else { + s = StringOfTerm( t2 ); + t1 = Deref(ARG1); + if (IsVarTerm(t1)) { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_Term = t1; + } else if (!IsIntegerTerm( t1 )) { + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + LOCAL_Error_Term = t1; + } else { + const char *ns = s; + int chr; + Int indx = IntegerOfTerm( t1 ); + if (indx <= 0) { + if (indx < 0) { + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + LOCAL_Error_Term = t1; + } else { + return FALSE; + } + } else { + ns = utf8_skip(s,indx); + if (ns == NULL) { + return FALSE; + } else { + utf8_get_char( ns, &chr); + if ( chr != '\0') return Yap_unify(ARG3, MkIntegerTerm(chr)); + } + } + return FALSE; // replace by error code + } + } + /* Error handling */ + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_code/3" )) { + goto restart_aux; + } else { + return FALSE; + } + } + cut_fail(); } static Int @@ -754,10 +797,14 @@ p_atom_concat2( USES_REGS1 ) } error: /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { - goto restart_aux; + if (LOCAL_Error_TYPE) { + if (Yap_HandleError( "string_code/3" )) { + goto restart_aux; + } else { + return FALSE; + } } - return FALSE; + cut_fail(); } @@ -806,6 +853,100 @@ p_atomic_concat2( USES_REGS1 ) return FALSE; } +static Int +p_atomics_to_string2( USES_REGS1 ) +{ + Term t1; + Term *tailp; + Int n; + restart_aux: + t1 = Deref(ARG1); + n = Yap_SkipList(&t1, &tailp); + if (*tailp != TermNil) { + LOCAL_Error_TYPE = TYPE_ERROR_LIST; + } else { + seq_tv_t *inpv = (seq_tv_t *)malloc(n*sizeof(seq_tv_t)), out; + int i = 0; + Atom at; + + if (!inpv) { + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + free(inpv); + goto error; + } + + while (t1 != TermNil) { + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + inpv[i].val.t = HeadOfTerm(t1); + i++; + t1 = TailOfTerm(t1); + } + out.type = YAP_STRING_STRING; + if (!Yap_Concat_Text(n, inpv, &out PASS_REGS)) { + free(inpv); + goto error; + } + free(inpv); + at = out.val.a; + if (at) return Yap_unify(ARG2, MkAtomTerm(at)); + } + error: + /* Error handling */ + if (LOCAL_Error_TYPE && Yap_HandleError( "atomics_to_string/2" )) { + goto restart_aux; + } + return FALSE; +} + +static Int +p_atomics_to_string3( USES_REGS1 ) +{ + Term t1, t2; + Term *tailp; + Int n; + restart_aux: + t1 = Deref(ARG1); + t2 = Deref(ARG2); + n = Yap_SkipList(&t1, &tailp); + if (*tailp != TermNil) { + LOCAL_Error_TYPE = TYPE_ERROR_LIST; + } else { + seq_tv_t *inpv = (seq_tv_t *)malloc((n*2-1)*sizeof(seq_tv_t)), out; + int i = 0; + Atom at; + + if (!inpv) { + LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR; + free(inpv); + goto error; + } + + while (t1 != TermNil) { + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + inpv[i].val.t = HeadOfTerm(t1); + i++; + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + inpv[i].val.t = t2; + i++; + t1 = TailOfTerm(t1); + } + out.type = YAP_STRING_STRING; + if (!Yap_Concat_Text(2*n-1, inpv, &out PASS_REGS)) { + free(inpv); + goto error; + } + free(inpv); + at = out.val.a; + if (at) return Yap_unify(ARG3, MkAtomTerm(at)); + } + error: + /* Error handling */ + if (LOCAL_Error_TYPE && Yap_HandleError( "atomics_to_string/3" )) { + goto restart_aux; + } + return FALSE; +} + static Int p_atom_length( USES_REGS1 ) { @@ -1758,7 +1899,6 @@ Yap_InitBackAtoms(void) cont_current_wide_atom, SafePredFlag|SyncPredFlag); Yap_InitCPredBack("atom_concat", 3, 2, init_atom_concat3, cont_atom_concat3, 0); - Yap_InitCPredBack("atomic_concat", 3, 2, init_atomic_concat3, cont_atomic_concat3, 0); Yap_InitCPredBack("string_concat", 3, 2, init_string_concat3, cont_string_concat3, 0); Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atomic, 0); Yap_InitCPredBack("sub_string", 5, 5, init_sub_string, cont_sub_atomic, 0); @@ -1791,4 +1931,8 @@ Yap_InitAtomPreds(void) Yap_InitCPred("string_number", 2, p_string_number, 0); Yap_InitCPred("$atom_concat", 2, p_atom_concat2, 0); Yap_InitCPred("atomic_concat", 2, p_atomic_concat2, 0); + Yap_InitCPred("atomic_concat", 3, p_atomic_concat3, 0); + Yap_InitCPred("atomics_to_string", 2, p_atomics_to_string2, 0); + Yap_InitCPred("atomics_to_string", 3, p_atomics_to_string3, 0); + Yap_InitCPred("get_string_code", 3, p_get_string_code3, 0); } diff --git a/C/c_interface.c b/C/c_interface.c index 5f4778563..910d1dabe 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -354,7 +354,7 @@ #include "yap_structs.h" #define _yap_c_interface_h 1 #include "pl-shared.h" -#include "YapMirror.h" +#include "YapText.h" #include "pl-read.h" #ifdef TABLING #include "tab.macros.h" diff --git a/C/errors.c b/C/errors.c index 2627010b9..7f1076d5b 100644 --- a/C/errors.c +++ b/C/errors.c @@ -1880,6 +1880,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...) serious = TRUE; } break; + case TYPE_ERROR_TEXT: + { + int i; + Term ti[2]; + + i = strlen(tmpbuf); + ti[0] = MkAtomTerm(AtomText); + ti[1] = where; + nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti); + psize -= i; + fun = FunctorError; + serious = TRUE; + } + break; case TYPE_ERROR_UBYTE: { int i; diff --git a/C/iopreds.c b/C/iopreds.c index 82ea7cca9..a280d4b47 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -31,7 +31,7 @@ static char SccsId[] = "%W% %G%"; #include "eval.h" /* stuff we want to use in standard YAP code */ #include "pl-shared.h" -#include "YapMirror.h" +#include "YapText.h" #include #if HAVE_STDARG_H #include diff --git a/C/load_foreign.c b/C/load_foreign.c index f64272351..937c89f26 100755 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -22,7 +22,7 @@ static char SccsId[] = "%W% %G%.2"; #include "YapHeap.h" #include "yapio.h" #include "pl-shared.h" -#include "YapMirror.h" +#include "YapText.h" #include #if HAVE_STRING_H #include diff --git a/C/parser.c b/C/parser.c index 629eeb788..9975892a5 100644 --- a/C/parser.c +++ b/C/parser.c @@ -53,7 +53,7 @@ static char SccsId[] = "%W% %G%"; #include "eval.h" /* stuff we want to use in standard YAP code */ #include "pl-shared.h" -#include "YapMirror.h" +#include "YapText.h" #include "pl-read.h" #include "pl-text.h" #if HAVE_STRING_H diff --git a/C/pl-yap.c b/C/pl-yap.c index dd7127bb2..68dbd958f 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -7,7 +7,7 @@ #include "Yap.h" #include "Yatom.h" #include "pl-incl.h" -#include "YapMirror.h" +#include "YapText.h" #if HAVE_MATH_H #include #endif diff --git a/C/scanner.c b/C/scanner.c index d39088128..288bc1952 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -42,7 +42,7 @@ /* stuff we want to use in standard YAP code */ #include "pl-shared.h" #include "pl-read.h" -#include "YapMirror.h" +#include "YapText.h" #if _MSC_VER || defined(__MINGW32__) #if HAVE_FINITE==1 #undef HAVE_FINITE diff --git a/C/text.c b/C/text.c index 75928cc96..7d0efccc2 100644 --- a/C/text.c +++ b/C/text.c @@ -107,7 +107,7 @@ get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS) if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t)))) *s++ = RepAtom(at)->WStrOfAE[0]; else - *s++ = RepAtom(at)->StrOfAE[0]; + *s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]); if (--max == 0) { *s++ = 0; return s0; @@ -165,7 +165,8 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, int *wide) if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER; } *wide = TRUE; } else { - if ((RepAtom(AtomOfTerm(hd))->StrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER_CODE; } + AtomEntry *ae = RepAtom(AtomOfTerm(hd)); + if ((ae->StrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER_CODE; } } } else if (IsIntTerm(hd)) { Int ch = IntOfTerm(hd); @@ -312,6 +313,12 @@ Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, int *widep USES_REGS) static yap_error_number gen_type_error(int flags) { + if (flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_ATOMS_CODES|YAP_STRING_BIG)) + return TYPE_ERROR_TEXT; + if (flags & (YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) + return TYPE_ERROR_ATOMIC; + if (flags & (YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG)) + return TYPE_ERROR_NUMBER; if (flags & YAP_STRING_ATOM) return TYPE_ERROR_ATOM; if (flags & YAP_STRING_STRING) @@ -817,7 +824,7 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS) size_t max = -1; if (out->type & (YAP_STRING_NCHARS|YAP_STRING_TRUNC)) { - if (out->type & YAP_STRING_NCHARS) return out->sz; + if (out->type & YAP_STRING_NCHARS && out->sz != (size_t)-1) return out->sz; if (out->type & YAP_STRING_TRUNC) max = out->max; } @@ -1021,9 +1028,9 @@ advance_Text( void *s, int l, encoding_t enc ) } static int -cmp_Text( void *s1, void *s2, encoding_t enc1, encoding_t enc2, int l ) +cmp_Text( void *s1, void *s2, int l, encoding_t enc1, encoding_t enc2 ) { - int i; + Int i; switch (enc1) { case YAP_CHAR: { @@ -1152,7 +1159,7 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[] USES_REGS ) } else if (encv[i] == YAP_CHAR) { char *ptr = sv[i]; int chr; - while ( (chr = *ptr++) != '\0' ) *buf++ = chr; + while ( (chr = *ptr++) != '\0' ) *buf++ = (unsigned char)chr; } else { char *ptr = sv[i]; int chr; @@ -1183,7 +1190,7 @@ concat( int n, seq_tv_t *out, void *sv[], encoding_t encv[] USES_REGS ) } static void * -slice( int min, int max, void *buf, seq_tv_t *out, encoding_t enc USES_REGS ) +slice( size_t min, size_t max, void *buf, seq_tv_t *out, encoding_t enc USES_REGS ) { if (out->type == YAP_STRING_STRING) { /* we assume we concatenate strings only, or ASCII stuff like numbers */ @@ -1200,31 +1207,37 @@ slice( int min, int max, void *buf, seq_tv_t *out, encoding_t enc USES_REGS ) } else { const char *ptr = utf8_skip ( (const char *)buf, min ); int chr; + if (!ptr) return NULL; while ( min++ < max ) { ptr = utf8_get_char(ptr, & chr); nbuf = utf8_put_char(nbuf, chr); } } *nbuf ++ = '\0'; - close_tstring( buf PASS_REGS ); + close_tstring( nbuf PASS_REGS ); out->val.t = t; - return H; + return (void *)StringOfTerm(t); } else { Atom at; /* atom */ if (enc == YAP_WCHAR) { /* wide atom */ wchar_t *nbuf = (wchar_t *)H; - Term t = ARG1; + Term t = TermNil; wchar_t *ptr = (wchar_t *)buf + min; - LOCAL_ERROR( (max-min)*sizeof(wchar_t) ); - memcpy( nbuf, ptr, (max - min)*sizeof(wchar_t)); + if (max>min) { + LOCAL_ERROR( (max-min)*sizeof(wchar_t) ); + memcpy( nbuf, ptr, (max - min)*sizeof(wchar_t)); + } nbuf[max-min] = '\0'; at = Yap_LookupMaybeWideAtom( nbuf ); } else if (enc == YAP_CHAR) { /* atom */ char *nbuf = (char *)H; - Term t = ARG1; - char *ptr = (char *)buf + min; - LOCAL_ERROR( max-min ); - memcpy( nbuf, ptr, (max - min)); + + if (max>min) { + Term t = TermNil; + char *ptr = (char *)buf + min; + LOCAL_ERROR( max-min ); + memcpy( nbuf, ptr, (max - min)); + } nbuf[max-min] = '\0'; at = Yap_LookupAtom( nbuf ); } else { @@ -1264,6 +1277,7 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS) buf = NULL; for (i = 0 ; i < n ; i++) { void *nbuf = read_Text( buf, inp+i, encv+i, &minimal PASS_REGS ); + if (!nbuf) return 0L; bufv[i] = nbuf; @@ -1314,6 +1328,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv return NULL; l1 = l-l0; + buf1 = slice(l0, l, buf, outv+1, enc PASS_REGS); if (encv) encv[1] = enc; @@ -1323,6 +1338,7 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv if (!buf1) return NULL; l1 = write_length( buf1, outv+1, enc1, minimal1 PASS_REGS); + if (l < l1) return NULL; l0 = l-l1; if (cmp_Text( advance_Text(buf, l0, enc), buf1, l1, enc, enc1) != 0) return NULL; diff --git a/H/YapText.h b/H/YapText.h index b6bff0083..3a20411c8 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -362,10 +362,70 @@ Yap_ListOfAtomsToAtom(Term t0 USES_REGS) inp.type = YAP_STRING_ATOMS; out.type = YAP_STRING_ATOM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; + return NULL; return out.val.a; } +static inline Term +Yap_ListOfAtomsToNumber(Term t0 USES_REGS) +{ + seq_tv_t inp, out; + inp.val.t = t0; + inp.type = YAP_STRING_ATOMS; + out.type = YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + return out.val.t; +} + +static inline Term +Yap_ListOfAtomsToString(Term t0 USES_REGS) +{ + seq_tv_t inp, out; + inp.val.t = t0; + inp.type = YAP_STRING_ATOMS; + out.type = YAP_STRING_STRING; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + return out.val.t; +} + +static inline Atom +Yap_ListOfCodesToAtom(Term t0 USES_REGS) +{ + seq_tv_t inp, out; + inp.val.t = t0; + inp.type = YAP_STRING_CODES; + out.type = YAP_STRING_ATOM; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return NULL; + return out.val.a; +} + +static inline Term +Yap_ListOfCodesToNumber(Term t0 USES_REGS) +{ + seq_tv_t inp, out; + inp.val.t = t0; + inp.type = YAP_STRING_CODES; + out.type = YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + return out.val.t; +} + +static inline Term +Yap_ListOfCodesToString(Term t0 USES_REGS) +{ + seq_tv_t inp, out; + inp.val.t = t0; + inp.type = YAP_STRING_CODES; + out.type = YAP_STRING_STRING; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + return out.val.t; +} + static inline Atom Yap_ListToAtom(Term t0 USES_REGS) { @@ -628,6 +688,7 @@ static inline Atom Yap_StringToAtom(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_ATOM; @@ -640,6 +701,7 @@ static inline Atom Yap_StringSWIToAtom(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; 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; @@ -652,6 +714,7 @@ static inline size_t Yap_StringToAtomic(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; @@ -664,6 +727,7 @@ static inline size_t Yap_StringToLength(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_LENGTH; @@ -673,9 +737,10 @@ Yap_StringToLength(Term t0 USES_REGS) } static inline size_t -Yap_StringToListOfAtom(Term t0 USES_REGS) +Yap_StringToListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_ATOMS; @@ -688,6 +753,7 @@ static inline size_t Yap_StringSWIToListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; + inp.sz = -1; 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_ATOMS; @@ -701,6 +767,7 @@ Yap_StringToListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; + inp.sz = -1; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -725,6 +792,7 @@ Yap_StringToNumber(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; + inp.sz = -1; inp.type = YAP_STRING_STRING; out.type = YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -737,6 +805,7 @@ Yap_WCharsToListOfCodes(const wchar_t *s USES_REGS) { seq_tv_t inp, out; inp.val.w = s; + inp.sz = -1; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -751,6 +820,7 @@ Yap_WCharsToTDQ( wchar_t *s, Term mod USES_REGS ) inp.val.w = s; inp.type = YAP_STRING_WCHARS; + inp.sz = -1; inp.mod = mod; out.type = mod_to_type(mod PASS_REGS); if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -763,6 +833,7 @@ Yap_WCharsToString(const wchar_t *s USES_REGS) { seq_tv_t inp, out; inp.val.w = s; + inp.sz = -1; inp.type = YAP_STRING_WCHARS; out.type = YAP_STRING_STRING; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -776,8 +847,10 @@ Yap_ConcatAtoms(Term t1, Term t2 USES_REGS) seq_tv_t inpv[2], out; inpv[0].val.t = t1; inpv[0].type = YAP_STRING_ATOM; + inpv[0].sz = -1; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_ATOM; + inpv[1].sz = -1; out.type = YAP_STRING_ATOM; if (!Yap_Concat_Text(2, inpv, &out PASS_REGS)) return NULL; @@ -790,8 +863,10 @@ Yap_ConcatAtomics(Term t1, Term t2 USES_REGS) seq_tv_t inpv[2], out; inpv[0].val.t = t1; inpv[0].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + inpv[0].sz = -1; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; + inpv[1].sz = -1; out.type = YAP_STRING_ATOM; if (!Yap_Concat_Text(2, inpv, &out PASS_REGS)) return NULL; @@ -804,8 +879,10 @@ Yap_ConcatStrings(Term t1, Term t2 USES_REGS) seq_tv_t inpv[2], out; inpv[0].val.t = t1; inpv[0].type = YAP_STRING_STRING; + inpv[0].sz = -1; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_STRING; + inpv[1].sz = -1; out.type = YAP_STRING_STRING; if (!Yap_Concat_Text(2, inpv, &out PASS_REGS)) return 0L; @@ -822,8 +899,11 @@ Yap_SpliceAtom(Term t1, Atom ats[], size_t cut, size_t max USES_REGS) cuts[1] = max; inp.type = YAP_STRING_ATOM; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_ATOM; + outv[0].sz = -1; outv[1].type = YAP_STRING_ATOM; + outv[1].sz = -1; if (!Yap_Splice_Text(2, cuts, &inp, NULL, outv PASS_REGS)) return NULL; ats[0] = outv[0].val.a; @@ -837,10 +917,13 @@ Yap_SubtractHeadAtom(Term t1, Term th USES_REGS) seq_tv_t outv[2], inp; inp.type = YAP_STRING_ATOM; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_ATOM; outv[0].val.t = th; + outv[0].sz = -1; outv[1].type = YAP_STRING_ATOM; outv[1].val.t = 0; + outv[1].sz = -1; if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS)) return NULL; return outv[1].val.a; @@ -853,8 +936,10 @@ Yap_SubtractTailAtom(Term t1, Term th USES_REGS) seq_tv_t outv[2], inp; inp.type = YAP_STRING_ATOM; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_ATOM; outv[0].val.t = 0; + outv[0].sz = -1; outv[1].type = YAP_STRING_ATOM; outv[1].val.t = th; if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS)) @@ -869,8 +954,12 @@ Yap_SpliceString(Term t1, Term ts[], size_t cut, size_t max USES_REGS) size_t cuts[2]; inp.type = YAP_STRING_STRING; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_STRING; outv[1].type = YAP_STRING_STRING; + outv[1].sz = -1; + cuts[0] = cut; + cuts[1] = max; if (!Yap_Splice_Text(2, cuts, &inp, NULL, outv PASS_REGS)) return 0L; ts[0] = outv[0].val.t; @@ -884,10 +973,13 @@ Yap_SubtractHeadString(Term t1, Term th USES_REGS) seq_tv_t outv[2], inp; inp.type = YAP_STRING_STRING; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_STRING; outv[0].val.t = th; + outv[0].sz = -1; outv[1].type = YAP_STRING_STRING; outv[1].val.t = 0; + outv[1].sz = -1; if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS)) return 0L; return outv[1].val.t; @@ -899,8 +991,10 @@ Yap_SubtractTailString(Term t1, Term th USES_REGS) seq_tv_t outv[2], inp; inp.type = YAP_STRING_STRING; inp.val.t = t1; + inp.sz = -1; outv[0].type = YAP_STRING_STRING; outv[0].val.t = 0; + outv[0].sz = -1; outv[1].type = YAP_STRING_STRING; outv[1].val.t = th; if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS)) @@ -909,65 +1003,3 @@ Yap_SubtractTailString(Term t1, Term th USES_REGS) } -static inline Term -Yap_SpliceAtomic(Term t1, Term ts[], size_t cut, size_t max USES_REGS) -{ - seq_tv_t outv[2], inp; - size_t cuts[2]; - inp.type = YAP_STRING_ATOM; - inp.val.t = t1; - outv[0].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - outv[1].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - if (!Yap_Splice_Text(2, cuts, &inp, NULL, outv PASS_REGS)) - return 0L; - ts[0] = outv[0].val.t; - ts[1] = outv[1].val.t; - return ts[0]; -} - -static inline Term -Yap_SubtractHeadAtomic(Term t1, Term th USES_REGS) -{ - seq_tv_t outv[2], inp; - encoding_t encv[2]; - void *buf; - int minimal = FALSE; - - inp.type = YAP_STRING_ATOM; - inp.val.t = t1; - outv[0].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - outv[0].val.t = th; - outv[1].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - outv[1].val.t = 0; - if (!(buf = Yap_Splice_Text(2, NULL, &inp, encv, outv PASS_REGS))) - return 0L; - outv[0].type = YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - if ( write_Text( buf, outv, encv[0], minimal PASS_REGS ) ) - return outv[0].val.t; - else - return 0L; -} - -static inline Term -Yap_SubtractTailAtomic(Term t1, Term th USES_REGS) -{ - seq_tv_t outv[2], inp; - encoding_t encv[2]; - void *buf; - int minimal = FALSE; - - inp.type = YAP_STRING_ATOM; - inp.val.t = t1; - outv[0].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - outv[0].val.t = 0; - outv[1].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - outv[1].val.t = th; - if (!(buf = Yap_Splice_Text(2, NULL, &inp, encv, outv PASS_REGS))) - return 0L; - outv[1].type = YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; - if (write_Text( buf, outv+1, encv[1], minimal PASS_REGS ) ) - return outv[1].val.t; - else - return 0L; -} - diff --git a/H/iatoms.h b/H/iatoms.h index 789294802..018629ee7 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -307,6 +307,7 @@ AtomTerm = Yap_LookupAtom("term"); AtomTerms = Yap_LookupAtom("terms"); AtomTermExpansion = Yap_LookupAtom("term_expansion"); + AtomText = Yap_LookupAtom("text"); AtomTextStream = Yap_LookupAtom("text_stream"); AtomThreads = Yap_LookupAtom("threads"); AtomThrow = Yap_LookupAtom("throw"); diff --git a/H/ratoms.h b/H/ratoms.h index 479acea23..ff6bf6ce3 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -307,6 +307,7 @@ AtomTerm = AtomAdjust(AtomTerm); AtomTerms = AtomAdjust(AtomTerms); AtomTermExpansion = AtomAdjust(AtomTermExpansion); + AtomText = AtomAdjust(AtomText); AtomTextStream = AtomAdjust(AtomTextStream); AtomThreads = AtomAdjust(AtomThreads); AtomThrow = AtomAdjust(AtomThrow); diff --git a/H/tatoms.h b/H/tatoms.h index 0672da7d0..563e2362b 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -612,6 +612,8 @@ #define AtomTerms Yap_heap_regs->AtomTerms_ Atom AtomTermExpansion_; #define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_ + Atom AtomText_; +#define AtomText Yap_heap_regs->AtomText_ Atom AtomTextStream_; #define AtomTextStream Yap_heap_regs->AtomTextStream_ Atom AtomThreads_; diff --git a/include/YapError.h b/include/YapError.h index b19b89b8c..43370c6ac 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -116,6 +116,7 @@ typedef enum TYPE_ERROR_PREDICATE_INDICATOR, TYPE_ERROR_PTR, TYPE_ERROR_STRING, + TYPE_ERROR_TEXT, TYPE_ERROR_UBYTE, TYPE_ERROR_UCHAR, TYPE_ERROR_VARIABLE, diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 242c688a7..cbe474043 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -39,7 +39,7 @@ #include #include -#include +#include #ifdef USE_GMP #include diff --git a/misc/ATOMS b/misc/ATOMS index 3990d00ee..0abf26a63 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -312,6 +312,7 @@ A SystemLibraryDir N "system_library_directory" A Term N "term" A Terms N "terms" A TermExpansion N "term_expansion" +A Text N "text" A TextStream N "text_stream" A Threads N "threads" A Throw N "throw"