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

more atom and string

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-12-06 15:08:35 +00:00
parent 7e58cf7755
commit 35f6ecad66
5 changed files with 426 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

287
C/atoms.c
View File

@ -133,7 +133,7 @@ p_name( USES_REGS1 )
LOCAL_MAX_SIZE = 1024;
restart_aux:
if (!IsVarTerm(AtomNameT)) {
if (Yap_IsGroundTerm(AtomNameT)) {
if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
Yap_Error(TYPE_ERROR_LIST,ARG2,
"name/2");
@ -163,7 +163,7 @@ p_string_to_atomic( USES_REGS1 )
LOCAL_MAX_SIZE = 1024;
restart_aux:
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term t;
// verify if an atom, int, float or bignnum
t = Yap_StringToAtomic( t1 PASS_REGS );
@ -174,7 +174,7 @@ p_string_to_atomic( USES_REGS1 )
Term t0 = Yap_AtomicToString( t2 PASS_REGS );
if (t0) return Yap_unify(t0, t1);
}
if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atom/2" )) {
if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atomic/2" )) {
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_aux;
@ -189,7 +189,7 @@ p_string_to_atom( USES_REGS1 )
LOCAL_MAX_SIZE = 1024;
restart_aux:
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Atom at;
// verify if an atom, int, float or bignnum
at = Yap_StringSWIToAtom( t1 PASS_REGS );
@ -215,7 +215,7 @@ p_string_to_list( USES_REGS1 )
LOCAL_MAX_SIZE = 1024;
restart_aux:
if (!IsVarTerm(list)) {
if (Yap_IsGroundTerm(list)) {
Term t1 = Yap_ListToString( list PASS_REGS);
if (t1)
return Yap_unify( ARG1, t1 );
@ -249,8 +249,8 @@ p_atom_chars( USES_REGS1 )
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
Term tf = Yap_AtomToListOfAtoms(t1 PASS_REGS);
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_AtomSWIToListOfAtoms(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
} else {
@ -273,8 +273,8 @@ p_atom_codes( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS);
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_AtomicToListOfCodes(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
} else {
@ -298,7 +298,7 @@ p_string_codes( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
@ -317,13 +317,38 @@ p_string_codes( USES_REGS1 )
return FALSE;
}
static Int
p_string_chars( USES_REGS1 )
{
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_StringSWIToListOfAtoms(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( "string_chars/2" )) {
t1 = Deref(ARG1);
goto restart_aux;
}
return FALSE;
}
static Int
p_number_chars( USES_REGS1 )
{
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf;
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS);
if (tf)
@ -348,7 +373,7 @@ p_number_atom( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Atom af;
af = Yap_NumberToAtom(t1 PASS_REGS);
if (af)
@ -373,7 +398,7 @@ p_number_string( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf;
tf = Yap_NumberToString(t1 PASS_REGS);
if (tf)
@ -398,7 +423,7 @@ p_number_codes( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf;
tf = Yap_NumberToListOfCodes(t1 PASS_REGS);
if (tf)
@ -422,15 +447,21 @@ cont_atom_concat3( USES_REGS1 )
{
Term t3;
Atom ats[2];
Int i;
Int i, max;
restart_aux:
t3 = Deref(ARG3);
i = IntOfTerm(EXTRA_CBACK_ARG(3,1));
EXTRA_CBACK_ARG(3,1) = MkIntTerm(++i);
if ( ! Yap_SpliceAtom( t3, ats, i PASS_REGS ) ) {
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 return Yap_unify( ARG1, MkAtomTerm(ats[0])) &&
Yap_unify( ARG2, MkAtomTerm(ats[1])) ;
} 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;
@ -449,17 +480,18 @@ init_atom_concat3( USES_REGS1 )
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t3 = Deref(ARG3);
if (!IsVarTerm(t1) && !IsVarTerm(t2)) {
if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) {
at = Yap_ConcatAtoms( t1, t2 PASS_REGS );
ot = ARG3;
} else if (!IsVarTerm(t1) && !IsVarTerm(t3) ) {
} else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) {
at = Yap_SubtractHeadAtom( Deref(ARG3), t1 PASS_REGS );
ot = ARG2;
} else if (!IsVarTerm(t2) && !IsVarTerm(t3)) {
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
at = Yap_SubtractTailAtom( 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_atom_concat3( PASS_REGS1 );
}
if (at) {
@ -473,6 +505,135 @@ init_atom_concat3( USES_REGS1 )
return FALSE;
}
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 )
{
Term t1;
Term t2, t3, ot;
Term t;
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();
}
/* Error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atoicm_concat/3" )) {
goto restart_aux;
}
return FALSE;
}
static Int
cont_string_concat3( USES_REGS1 )
{
Term t3;
Term ts[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_SpliceString( t3, ts, i, max PASS_REGS ) ) {
cut_fail();
} else {
if (i < max) return Yap_unify( ARG1, ts[0]) &&
Yap_unify( ARG2, ts[1]) ;
if (Yap_unify( ARG1, ts[0]) &&
Yap_unify( ARG2, ts[1])) cut_succeed();
cut_fail();
}
/* Error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) {
goto restart_aux;
}
return FALSE;
}
static Int
init_string_concat3( USES_REGS1 )
{
Term t1;
Term t2, t3, ot;
Term tf;
restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t3 = Deref(ARG3);
if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) {
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 );
ot = ARG2;
} else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) {
tf = Yap_SubtractTailString( Deref(ARG3), t2 PASS_REGS );
ot = ARG1;
} else {
EXTRA_CBACK_ARG(3,1) = MkIntTerm(0);
EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS));
return cont_string_concat3( PASS_REGS1 );
}
if (tf) {
if (Yap_unify(ot, tf)) cut_succeed();
else cut_fail();
}
/* Error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) {
goto restart_aux;
}
return FALSE;
}
static Int
p_atom_concat2( USES_REGS1 )
{
@ -518,61 +679,22 @@ p_atom_concat2( USES_REGS1 )
return FALSE;
}
static Int
p_atomic_concat3( USES_REGS1 )
{
Term t1;
Term t2;
restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
if (!IsVarTerm(t1) && !IsVarTerm(t2)) {
Atom at = Yap_ConcatAtomics( t1, t2 PASS_REGS );
if (at) return Yap_unify(ARG2, MkAtomTerm(at));
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atomic_concat/2" )) {
goto restart_aux;
}
return FALSE;
}
static Int
p_string_concat3( USES_REGS1 )
{
Term t1;
Term t2;
restart_aux:
t1 = Deref(ARG1);
t2 = Deref(ARG2);
if (!IsVarTerm(t1) && !IsVarTerm(t2)) {
Term t = Yap_ConcatStrings( t1, t2 PASS_REGS );
if (t) return Yap_unify(ARG2, t);
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atomic_concat/2" )) {
goto restart_aux;
}
return FALSE;
}
static Int
p_string_concat2( USES_REGS1 )
p_atomic_concat2( USES_REGS1 )
{
Term t1;
Term *tailp;
Int n;
restart_aux:
t1 = Deref(ARG1);
n = Yap_SkipList(&t1, &tailp);
if (*tailp == TermNil) {
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;
Term tf;
Atom at;
if (!inpv) {
LOCAL_Error_TYPE = OUT_OF_HEAP_ERROR;
@ -581,23 +703,23 @@ p_string_concat2( USES_REGS1 )
}
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_STRING;
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;
out.type = YAP_STRING_ATOM;
if (!Yap_Concat_Text(n, inpv, &out PASS_REGS)) {
free(inpv);
goto error;
}
free(inpv);
tf = out.val.t;
if (tf) return Yap_unify(ARG2, tf);
at = out.val.a;
if (at) return Yap_unify(ARG2, MkAtomTerm(at));
}
error:
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "string_concat/2" )) {
/* Error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) {
goto restart_aux;
}
return FALSE;
@ -610,7 +732,7 @@ p_atom_length( USES_REGS1 )
Term t2 = Deref(ARG2);
ssize_t len;
if (!IsVarTerm(t2)) {
if (Yap_IsGroundTerm(t2)) {
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2");
@ -623,7 +745,7 @@ p_atom_length( USES_REGS1 )
}
restart_aux:
t1 = Deref(ARG1);
len = Yap_AtomToLength(t1 PASS_REGS);
len = Yap_AtomicToLength(t1 PASS_REGS);
if (len != (size_t)-1)
return Yap_unify( ARG2, MkIntegerTerm(len) );
/* error handling */
@ -640,7 +762,7 @@ p_atomic_length( USES_REGS1 )
Term t2 = Deref(ARG2);
ssize_t len;
if (!IsVarTerm(t2)) {
if (Yap_IsGroundTerm(t2)) {
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2");
@ -670,7 +792,7 @@ p_string_length( USES_REGS1 )
Term t2 = Deref(ARG2);
ssize_t len;
if (!IsVarTerm(t2)) {
if (Yap_IsGroundTerm(t2)) {
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2");
@ -683,7 +805,7 @@ p_string_length( USES_REGS1 )
}
restart_aux:
t1 = Deref(ARG1);
len = Yap_StringToLength(t1 PASS_REGS);
len = Yap_AtomicToLength(t1 PASS_REGS);
if (len != (size_t)-1)
return Yap_unify( ARG2, MkIntegerTerm(len) );
/* error handling */
@ -804,7 +926,7 @@ p_atom_number( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_AtomToNumber(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
@ -830,7 +952,7 @@ p_string_number( USES_REGS1 )
Term t1;
restart_aux:
t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (Yap_IsGroundTerm(t1)) {
Term tf = Yap_StringToNumber(t1 PASS_REGS);
if (tf)
return Yap_unify( ARG2, tf );
@ -883,7 +1005,7 @@ build_new_atomic(int mask, wchar_t *wp, char *p, size_t min, size_t len USES_REG
nat = Yap_LookupMaybeWideAtom(d);
if (nat)
return MkAtomTerm(nat);
} else if (mask & SUB_ATOM_HAS_UTF8) {
} else if (!(mask & SUB_ATOM_HAS_UTF8)) {
char *src = p+min;
char *d = alloc_tmp_stack((len+1)*sizeof(char) PASS_REGS);
if (!d) return NIL;
@ -1554,7 +1676,9 @@ Yap_InitBackAtoms(void)
Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,
cont_current_wide_atom,
SafePredFlag|SyncPredFlag);
Yap_InitCPredBack("atom_concat", 3, 1, init_atom_concat3, cont_atom_concat3, 0);
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);
@ -1572,6 +1696,7 @@ Yap_InitAtomPreds(void)
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("string_chars", 2, p_string_chars, 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);
@ -1583,7 +1708,5 @@ Yap_InitAtomPreds(void)
Yap_InitCPred("atom_number", 2, p_atom_number, 0);
Yap_InitCPred("string_number", 2, p_string_number, 0);
Yap_InitCPred("$atom_concat", 2, p_atom_concat2, 0);
Yap_InitCPred("atomic_concat", 3, p_atomic_concat3, 0);
Yap_InitCPred("$string_concat", 3, p_string_concat3, 0);
Yap_InitCPred("$string_concat", 2, p_string_concat2, 0);
Yap_InitCPred("atomic_concat", 2, p_atomic_concat2, 0);
}

83
C/strings.c
View File

@ -310,6 +310,17 @@ 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_ATOM)
return TYPE_ERROR_ATOM;
if (flags & YAP_STRING_STRING)
return TYPE_ERROR_STRING;
if (flags & (YAP_STRING_CODES|YAP_STRING_ATOMS))
return TYPE_ERROR_LIST;
return TYPE_ERROR_NUMBER;
}
static void *
read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
{
@ -447,7 +458,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->type &= (YAP_STRING_STRING);
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsPairTerm(t)) {
@ -455,7 +466,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->type &= (YAP_STRING_CODES|YAP_STRING_ATOMS);
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsAtomTerm(t)) {
@ -464,7 +475,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->val.t = t;
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsIntegerTerm(t)) {
@ -473,7 +484,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->val.i = IntegerOfTerm(t);
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsFloatTerm(t)) {
@ -482,7 +493,7 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->val.f = FloatOfTerm(t);
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_FLOAT;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else if (IsBigIntTerm(t)) {
@ -491,9 +502,14 @@ read_Text( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal USES_REGS)
inp->val.b = Yap_BigIntOfTerm(t);
return read_Text( buf, inp, enc, minimal PASS_REGS);
} else {
LOCAL_Error_TYPE = TYPE_ERROR_BIGNUM;
LOCAL_Error_TYPE = gen_type_error( inp->type );
LOCAL_Error_Term = t;
}
} else {
if (!Yap_IsGroundTerm(t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
LOCAL_Error_Term = t;
}
}
return NULL;
}
@ -809,7 +825,7 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
case YAP_UTF8:
{
const char *s = s0;
return utf8_strlen(s, strlen(s));
return utf8_strlen1(s);
}
case YAP_CHAR:
{
@ -895,7 +911,8 @@ write_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
return 0L;
}
static int
int
write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal USES_REGS)
{
@ -1223,7 +1240,7 @@ slice( int min, int max, void *buf, seq_tv_t *out, encoding_t enc USES_REGS )
at = Yap_LookupMaybeWideAtom( (wchar_t*)H );
}
out->val.a = at;
return at;
return at->StrOfAE;
}
return NULL;
}
@ -1261,18 +1278,25 @@ Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS)
//
// out must be an atom or a string
void *
Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, seq_tv_t outv[] USES_REGS)
Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv_t outv[] USES_REGS)
{
encoding_t enc;
int minimal = FALSE;
void *buf;
void *buf, *store;
size_t l;
int i, min;
buf = read_Text( NULL, inp, &enc, &minimal PASS_REGS );
l = write_length( buf, inp, enc, minimal PASS_REGS);
if (!buf)
return NULL;
l = write_length( buf, inp, enc, minimal PASS_REGS);
/* where to allocate next is the most complicated part */
if ((char *)buf >= AuxBase && (char *)buf < AuxTop) {
store = compute_end( buf, enc );
} else {
store = NULL;
}
if (!cuts) {
if (n == 2) {
@ -1280,32 +1304,43 @@ Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, seq_tv_t outv[] USES_REGS
encoding_t enc0, enc1;
int minimal0, minimal1;
void *buf0, *buf1;
if (outv[0].val.t) {
buf0 = read_Text( buf, outv, &enc0, &minimal0 PASS_REGS );
buf0 = read_Text( store, outv, &enc0, &minimal0 PASS_REGS );
if (!buf0)
return NULL;
l0 = write_length( buf0, outv, enc, minimal0 PASS_REGS);
if (cmp_Text( buf, buf0, l0, enc, enc0) == 0)
if (cmp_Text( buf, buf0, l0, enc, enc0) != 0)
return NULL;
l1 = l-l0;
slice(l0, l, buf, outv+1, enc PASS_REGS);
return buf0;
} else /* if (outv[1].val.t) */ {
buf1 = read_Text( buf, outv, &enc1, &minimal1 PASS_REGS );
l1 = write_length( buf1, outv, enc1, minimal1 PASS_REGS);
l0 = l-l1;
if (cmp_Text( advance_Text(buf, l0, enc), buf1, l1, enc, enc1) == 0)
return NULL;
slice(0, l0, buf, outv, enc PASS_REGS);
buf1 = slice(l0, l, buf, outv+1, enc PASS_REGS);
if (encv)
encv[1] = enc;
return buf1;
} else /* if (outv[1].val.t) */ {
buf1 = read_Text( store, outv+1, &enc1, &minimal1 PASS_REGS );
if (!buf1)
return NULL;
l1 = write_length( buf1, outv+1, enc1, minimal1 PASS_REGS);
l0 = l-l1;
if (cmp_Text( advance_Text(buf, l0, enc), buf1, l1, enc, enc1) != 0)
return NULL;
buf0 = slice(0, l0, buf, outv, enc PASS_REGS);
if (encv)
encv[0] = enc;
return buf0;
}
}
}
for (i = 0; i < n-1; i++) {
for (i = 0; i < n; i++) {
if (i == 0) min = 0;
else min = cuts[i-1];
slice(min, cuts[i], buf, outv+i, enc PASS_REGS);
if (!(outv[i].val.a))
return NULL;
if (encv)
encv[i] = enc;
}
return (void *)outv;;
}

2
C/write.c
View File

@ -437,7 +437,7 @@ legalAtom(unsigned char *s) /* Is this a legal atom ? */
return (s[1] == '}' && !s[2]);
} else if (Yap_chtype[ch] == SL) {
return (!s[1]);
} else if ((ch == ',' || ch == '.') && !s[1]) {
} else if ((ch == ',' /* || ch == '.' */) && !s[1]) {
return FALSE;
} else {
if (ch == '/') {

162
H/YapMirror.h
View File

@ -124,9 +124,10 @@ mod_to_type( Term mod USES_REGS )
// the routines
extern int write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal USES_REGS);
extern int Yap_CVT_Text( seq_tv_t *inp, seq_tv_t *out USES_REGS);
extern void *Yap_Concat_Text( int n, seq_tv_t inp[], seq_tv_t *out USES_REGS);
extern void *Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, seq_tv_t outv[] USES_REGS);
extern void *Yap_Splice_Text( int n, size_t cuts[], seq_tv_t *inp, encoding_t encv[], seq_tv_t outv[] USES_REGS);
// user friendly interface
@ -135,7 +136,7 @@ Yap_AtomicToLength(Term t0 USES_REGS)
{
seq_tv_t inp, out;
inp.val.t = t0;
inp.type = YAP_STRING_STRING|YAP_STRING_CODES|YAP_STRING_ATOMS|YAP_STRING_ATOM|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM;
inp.type = YAP_STRING_STRING|YAP_STRING_CODES|YAP_STRING_ATOMS|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM;
out.type = YAP_STRING_LENGTH;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
@ -154,7 +155,6 @@ Yap_AtomicToListOfAtoms(Term t0 USES_REGS)
return out.val.t;
}
static inline Term
Yap_AtomicToListOfCodes(Term t0 USES_REGS)
{
@ -175,8 +175,8 @@ Yap_AtomToLength(Term t0 USES_REGS)
inp.type = YAP_STRING_ATOM;
out.type = YAP_STRING_LENGTH;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
return (size_t)(-1L);
return out.val.l;
}
static inline Term
@ -191,6 +191,21 @@ Yap_AtomToListOfAtoms(Term t0 USES_REGS)
return out.val.t;
}
static inline Term
Yap_AtomSWIToListOfAtoms(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_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline Term
Yap_AtomToListOfCodes(Term t0 USES_REGS)
{
@ -651,8 +666,8 @@ Yap_StringToLength(Term t0 USES_REGS)
inp.type = YAP_STRING_STRING;
out.type = YAP_STRING_LENGTH;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
return (size_t)(-1L);
return out.val.l;
}
static inline size_t
@ -667,6 +682,18 @@ Yap_StringToListOfAtom(Term t0 USES_REGS)
return out.val.t;
}
static inline size_t
Yap_StringSWIToListOfAtoms(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_ATOMS;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
return out.val.t;
}
static inline size_t
Yap_StringToListOfCodes(Term t0 USES_REGS)
{
@ -785,14 +812,17 @@ Yap_ConcatStrings(Term t1, Term t2 USES_REGS)
static inline Atom
Yap_SpliceAtom(Term t1, Atom ats[], size_t cut USES_REGS)
Yap_SpliceAtom(Term t1, Atom ats[], size_t cut, size_t max USES_REGS)
{
seq_tv_t outv[2], inp;
size_t cuts[2];
cuts[0] = cut;
cuts[1] = max;
inp.type = YAP_STRING_ATOM;
inp.val.t = t1;
outv[0].type = YAP_STRING_ATOM;
outv[1].type = YAP_STRING_ATOM;
if (!Yap_Splice_Text(2, &cut, &inp, outv PASS_REGS))
if (!Yap_Splice_Text(2, cuts, &inp, NULL, outv PASS_REGS))
return NULL;
ats[0] = outv[0].val.a;
ats[1] = outv[1].val.a;
@ -809,11 +839,12 @@ Yap_SubtractHeadAtom(Term t1, Term th USES_REGS)
outv[0].val.t = th;
outv[1].type = YAP_STRING_ATOM;
outv[1].val.t = 0;
if (!Yap_Splice_Text(2, NULL, &inp, outv PASS_REGS))
if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS))
return NULL;
return outv[1].val.a;
}
static inline Atom
Yap_SubtractTailAtom(Term t1, Term th USES_REGS)
{
@ -824,7 +855,116 @@ Yap_SubtractTailAtom(Term t1, Term th USES_REGS)
outv[0].val.t = 0;
outv[1].type = YAP_STRING_ATOM;
outv[1].val.t = th;
if (!Yap_Splice_Text(2, NULL, &inp, outv PASS_REGS))
if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS))
return NULL;
return outv[0].val.a;
}
static inline Term
Yap_SpliceString(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_STRING;
inp.val.t = t1;
outv[0].type = YAP_STRING_STRING;
outv[1].type = YAP_STRING_STRING;
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_SubtractHeadString(Term t1, Term th USES_REGS)
{
seq_tv_t outv[2], inp;
inp.type = YAP_STRING_STRING;
inp.val.t = t1;
outv[0].type = YAP_STRING_STRING;
outv[0].val.t = th;
outv[1].type = YAP_STRING_STRING;
outv[1].val.t = 0;
if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS))
return 0L;
return outv[1].val.t;
}
static inline Term
Yap_SubtractTailString(Term t1, Term th USES_REGS)
{
seq_tv_t outv[2], inp;
inp.type = YAP_STRING_STRING;
inp.val.t = t1;
outv[0].type = YAP_STRING_STRING;
outv[0].val.t = 0;
outv[1].type = YAP_STRING_STRING;
outv[1].val.t = th;
if (!Yap_Splice_Text(2, NULL, &inp, NULL, outv PASS_REGS))
return 0L;
return outv[0].val.t;
}
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;
}

28
pl/utils.yap
View File

@ -347,29 +347,29 @@ atom_concat(Xs,At) :-
).
% the constraints are of the form hole: HoleAtom, Begin, Atom, End
'$atom_concat_constraints'([At], start, At, _, []) :- !.
'$atom_concat_constraints'([At], 0, At, _, []) :- !.
'$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :- !.
% just slice first atom
'$atom_concat_constraints'([At0|Xs], start, At, Unbound) :-
'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
atom(At0), !,
sub_atom(At, 0, Sz, L, At0),
sub_atom(At, _, L, 0, Atr), %remainder
'$atom_concat_constraints'(Xs, start, Atr, Unbound).
sub_atom(At, 0, Sz, L, At0 ),
sub_atom(At, _, L, 0, Atr ), %remainder
'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
% first hole: Follow says whether we have two holes in a row, At1 will be our atom
'$atom_concat_constraints'([At0|Xs], start, At, [hole(At0, 0, At1, Next)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(Next,At1), Atr, Unbound).
'$atom_concat_constraints'([At0|Xs], start, At, [hole(At0, 0, At, Next)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(Next,At1), At, Unbound).
% end of a run
'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
atom(At0), !,
sub_atom(At, Next, Sz, L, At0),
sub_atom(At, 0, Next, Next, At1),
sub_atom(At, _, L, 0, Atr), %remainder
'$atom_concat_constraints'(Xs, start, Atr, _, Unbound).
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At1, Follow)|Unbound]) :-
'$atom_concat_constraints'(Xs, 0, Atr, _, Unbound).
'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
'$atom_concat_constraints'(Xs, mid(NextFollow, At1), At, Unbound).
'$process_atom_holes'([]).
'$process_atom_holes'([hole(At0, Next, At1, end)|Unbound]) :-
'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
sub_atom(At1, Next, _, 0, At0),
'$process_atom_holes'(Unbound).
'$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
@ -378,14 +378,6 @@ atom_concat(Xs,At) :-
'$process_atom_holes'(Unbound).
string_concat(X,Y,St) :-
( var(St) ->
'$string_concat'(X, Y, At )
;
sub_string(At, 0, _, Left, X),
sub_string(At, Left, _, 0, Y)
).
callable(A) :-
( var(A) -> fail ; number(A) -> fail ; true ).