diff --git a/C/atoms.c b/C/atoms.c index 0f6a6c388..5f785074d 100644 --- a/C/atoms.c +++ b/C/atoms.c @@ -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); } diff --git a/C/strings.c b/C/strings.c index 620708246..ef67e4c24 100644 --- a/C/strings.c +++ b/C/strings.c @@ -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;; } diff --git a/C/write.c b/C/write.c index 133a0633d..60f347f49 100644 --- a/C/write.c +++ b/C/write.c @@ -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 == '/') { diff --git a/H/YapMirror.h b/H/YapMirror.h index 9dd694ee2..f6459553a 100644 --- a/H/YapMirror.h +++ b/H/YapMirror.h @@ -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; +} diff --git a/pl/utils.yap b/pl/utils.yap index dec4f0f28..6fd9aa38b 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -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 ).