diff --git a/C/adtdefs.c b/C/adtdefs.c index 617027a14..f067d5965 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -55,9 +55,8 @@ uint64_t HashFunction(const unsigned char *CHP) { static Prop GetFunctorProp(AtomEntry *ae, arity_t arity) { /* look property list of atom a for kind */ - FunctorEntry *pp; - PropEntry *p = RepFunctorProp(ae->PropsOfAE); + PropEntry *p = ae->PropsOfAE; while (p != NIL) { if (p->KindOfPE == FunctorProperty && RepFunctorProp(p)->ArityOfFE == arity) { diff --git a/C/arith1.c b/C/arith1.c index cb0a9cba6..8514804dd 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -326,7 +326,7 @@ msb(Int inp USES_REGS) /* calculate the most significant bit for an integer */ Int out = 0; if (inp < 0) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "msb/1 received %d", inp); } @@ -363,7 +363,7 @@ lsb(Int inp USES_REGS) /* calculate the least significant bit for an integer */ Int out = 0; if (inp < 0) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "msb/1 received %d", inp); } if (inp==0) @@ -387,7 +387,7 @@ popcount(Int inp USES_REGS) /* calculate the least significant bit for an intege Int c = 0, j = 0, m = ((CELL)1); if (inp < 0) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "popcount/1 received %d", inp); } if (inp==0) @@ -434,7 +434,7 @@ eval1(Int fi, Term t USES_REGS) { case long_int_e: RINT(~IntegerOfTerm(t)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP return Yap_gmp_unot_big(t); @@ -450,7 +450,7 @@ eval1(Int fi, Term t USES_REGS) { if (dbl >= 0) { RFLOAT(log(dbl)); } else { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); + Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "log(%f)", dbl); } } case op_log10: @@ -459,7 +459,7 @@ eval1(Int fi, Term t USES_REGS) { if (dbl >= 0) { RFLOAT(log10(dbl)); } else { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log10(%f)", dbl); + Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "log10(%f)", dbl); } } case op_sqrt: @@ -468,7 +468,7 @@ eval1(Int fi, Term t USES_REGS) { out = sqrt(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "sqrt(%f)", dbl); + Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "sqrt(%f)", dbl); } #endif RFLOAT(out); @@ -517,7 +517,7 @@ eval1(Int fi, Term t USES_REGS) { out = asin(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "asin(%f)", dbl); + Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "asin(%f)", dbl); } #endif RFLOAT(out); @@ -530,7 +530,7 @@ eval1(Int fi, Term t USES_REGS) { out = acos(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "acos(%f)", dbl); + Yap_ArithError(EVALUATION_ERROR_UNDEFINED, t, "acos(%f)", dbl); } #endif RFLOAT(out); @@ -543,7 +543,7 @@ eval1(Int fi, Term t USES_REGS) { out = atan(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atan(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atan(%f)", dbl); } #endif RFLOAT(out); @@ -556,7 +556,7 @@ eval1(Int fi, Term t USES_REGS) { out = asinh(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "asinh(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "asinh(%f)", dbl); } #endif RFLOAT(out); @@ -569,7 +569,7 @@ eval1(Int fi, Term t USES_REGS) { out = acosh(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "acosh(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "acosh(%f)", dbl); } #endif RFLOAT(out); @@ -582,7 +582,7 @@ eval1(Int fi, Term t USES_REGS) { out = atanh(dbl); #if HAVE_ISNAN if (isnan(out)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -645,12 +645,12 @@ eval1(Int fi, Term t USES_REGS) { } #if HAVE_ISNAN if (isnan(dbl)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); } #endif #if HAVE_ISINF if (isinf(dbl)) { - return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ (%f)",dbl); } #endif @@ -674,12 +674,12 @@ eval1(Int fi, Term t USES_REGS) { } #if HAVE_ISNAN if (isnan(dbl)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); } #endif #if HAVE_ISINF if (isinf(dbl)) { - return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ (%f)",dbl); } #endif @@ -704,12 +704,12 @@ eval1(Int fi, Term t USES_REGS) { } #if HAVE_ISNAN if (isnan(dbl)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); } #endif #if HAVE_ISINF if (isinf(dbl)) { - return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ (%f)",dbl); } #endif @@ -734,12 +734,12 @@ eval1(Int fi, Term t USES_REGS) { } #if HAVE_ISNAN if (isnan(dbl)) { - return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); + Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); } #endif #if HAVE_ISINF if (isinf(dbl)) { - return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer (%f)",dbl); + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer (%f)",dbl); } #endif if (dbl < 0.0) @@ -804,7 +804,7 @@ eval1(Int fi, Term t USES_REGS) { case long_int_e: RINT(msb(IntegerOfTerm(t) PASS_REGS)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP return Yap_gmp_msb(t); @@ -817,7 +817,7 @@ eval1(Int fi, Term t USES_REGS) { case long_int_e: RINT(lsb(IntegerOfTerm(t) PASS_REGS)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP return Yap_gmp_lsb(t); @@ -830,7 +830,7 @@ eval1(Int fi, Term t USES_REGS) { case long_int_e: RINT(popcount(IntegerOfTerm(t) PASS_REGS)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP return Yap_gmp_popcount(t); @@ -842,7 +842,7 @@ eval1(Int fi, Term t USES_REGS) { switch (ETypeOfTerm(t)) { case long_int_e: if (isoLanguageFlag()) { /* iso */ - return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); } else { RFLOAT(0.0); } @@ -863,7 +863,7 @@ eval1(Int fi, Term t USES_REGS) { case op_fintp: switch (ETypeOfTerm(t)) { case long_int_e: - return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); case double_e: RFLOAT(rint(FloatOfTerm(t))); break; @@ -901,7 +901,7 @@ eval1(Int fi, Term t USES_REGS) { case long_int_e: RINT(Yap_random()*IntegerOfTerm(t)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP return Yap_gmp_mul_float_big(Yap_random(), t); diff --git a/C/arith2.c b/C/arith2.c index 4551bf8da..ddce481a5 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -150,7 +150,7 @@ p_mod(Term t1, Term t2 USES_REGS) { Int mod; if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " mod 0", i1); if (i1 == Int_MIN && i2 == -1) { return MkIntTerm(0); } @@ -160,7 +160,7 @@ p_mod(Term t1, Term t2 USES_REGS) { RINT(mod); } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); case (CELL)big_int_e: #ifdef USE_GMP return Yap_gmp_mod_int_big(IntegerOfTerm(t1), t2); @@ -170,7 +170,7 @@ p_mod(Term t1, Term t2 USES_REGS) { break; } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2"); case (CELL)big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -180,14 +180,14 @@ p_mod(Term t1, Term t2 USES_REGS) { Int i2 = IntegerOfTerm(t2); if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... mod 0"); return Yap_gmp_mod_big_int(t1, i2); } case (CELL)big_int_e: /* two bignums */ return Yap_gmp_mod_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); default: RERROR(); } @@ -210,12 +210,12 @@ p_div2(Term t1, Term t2 USES_REGS) { Int res, mod; if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1); if (i1 == Int_MIN && i2 == -1) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); #else - return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, "// /2 with %d and %d", i1, i2); #endif } @@ -226,7 +226,7 @@ p_div2(Term t1, Term t2 USES_REGS) { RINT(res); } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); case (CELL)big_int_e: #ifdef USE_GMP return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2); @@ -236,7 +236,7 @@ p_div2(Term t1, Term t2 USES_REGS) { break; } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); case (CELL)big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -246,14 +246,14 @@ p_div2(Term t1, Term t2 USES_REGS) { Int i2 = IntegerOfTerm(t2); if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... div 0"); return Yap_gmp_div2_big_int(t1, i2); } case (CELL)big_int_e: /* two bignums */ return Yap_gmp_div2_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "div/2"); default: RERROR(); } @@ -275,14 +275,14 @@ p_rem(Term t1, Term t2 USES_REGS) { Int i2 = IntegerOfTerm(t2); if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rem 0", i1); if (i1 == Int_MIN && i2 == -1) { return MkIntTerm(0); } RINT(i1%i2); } case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); case (CELL)big_int_e: #ifdef USE_GMP return Yap_gmp_rem_int_big(IntegerOfTerm(t1), t2); @@ -292,19 +292,19 @@ p_rem(Term t1, Term t2 USES_REGS) { } break; case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t1, "rem/2"); case (CELL)big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { case long_int_e: if (IntegerOfTerm(t2) == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rem 0"); return Yap_gmp_rem_big_int(t1, IntegerOfTerm(t2)); case (CELL)big_int_e: /* two bignums */ return Yap_gmp_rem_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rem/2"); default: RERROR(); } @@ -320,7 +320,7 @@ p_rdiv(Term t1, Term t2 USES_REGS) { #ifdef USE_GMP switch (ETypeOfTerm(t1)) { case (CELL)double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2"); case (CELL)long_int_e: switch (ETypeOfTerm(t2)) { case (CELL)long_int_e: @@ -330,7 +330,7 @@ p_rdiv(Term t1, Term t2 USES_REGS) { Int i2 = IntegerOfTerm(t2); if (i2 == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " rdiv 0", i1); return Yap_gmq_rdiv_int_int(i1, i2); } case (CELL)big_int_e: @@ -344,13 +344,13 @@ p_rdiv(Term t1, Term t2 USES_REGS) { switch (ETypeOfTerm(t2)) { case long_int_e: if (IntegerOfTerm(t2) == 0) - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is ... rdiv 0"); /* I know the term is much larger, so: */ return Yap_gmq_rdiv_big_int(t1, IntegerOfTerm(t2)); case (CELL)big_int_e: return Yap_gmq_rdiv_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "rdiv/2"); default: RERROR(); } @@ -449,7 +449,7 @@ p_xor(Term t1, Term t2 USES_REGS) /* two integers */ RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2)); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); case big_int_e: #ifdef USE_GMP return Yap_gmp_xor_int_big(IntegerOfTerm(t1), t2); @@ -459,7 +459,7 @@ p_xor(Term t1, Term t2 USES_REGS) } break; case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2"); case big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -468,7 +468,7 @@ p_xor(Term t1, Term t2 USES_REGS) case big_int_e: return Yap_gmp_xor_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); default: RERROR(); } @@ -690,7 +690,7 @@ p_exp(Term t1, Term t2 USES_REGS) Int pow; if (i2 < 0) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "%d ^ %d", i1, i2); } pow = ipow(i1,i2); @@ -836,7 +836,7 @@ p_gcd(Term t1, Term t2 USES_REGS) RINT(gcd(i1,i2 PASS_REGS)); } case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); case big_int_e: #ifdef USE_GMP return Yap_gmp_gcd_int_big(IntegerOfTerm(t1), t2); @@ -846,7 +846,7 @@ p_gcd(Term t1, Term t2 USES_REGS) } break; case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2"); case big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -855,7 +855,7 @@ p_gcd(Term t1, Term t2 USES_REGS) case big_int_e: return Yap_gmp_gcd_big_big(t1, t2); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); default: RERROR(); } diff --git a/C/atomic.c b/C/atomic.c index 2b274a134..b71049052 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -68,9 +68,21 @@ static Int hide_atom(USES_REGS1); static Int hidden_atom(USES_REGS1); static Int unhide_atom(USES_REGS1); -#define ReleaseAndReturn(r) { pop_text_stack(l); return r; } -#define release_cut_fail() { pop_text_stack(l); cut_fail(); } -#define release_cut_succeed() { pop_text_stack(l); cut_succeed(); } +#define ReleaseAndReturn(r) \ + { \ + pop_text_stack(l); \ + return r; \ + } +#define release_cut_fail() \ + { \ + pop_text_stack(l); \ + cut_fail(); \ + } +#define release_cut_succeed() \ + { \ + pop_text_stack(l); \ + cut_succeed(); \ + } static int AlreadyHidden(unsigned char *name) { AtomEntry *chain; @@ -240,7 +252,7 @@ static Int char_code(USES_REGS1) { Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2"); return (FALSE); } - size_t n = put_utf8( codes, code); + size_t n = put_utf8(codes, code); codes[n] = code; tout = MkAtomTerm(Yap_ULookupAtom(codes)); } else { @@ -266,7 +278,7 @@ static Int char_code(USES_REGS1) { return FALSE; } tf = MkIntTerm(v); - return Yap_unify(ARG2, tf); + return Yap_unify(ARG2, tf); } } @@ -274,30 +286,30 @@ static Int name(USES_REGS1) { /* name(?Atomic,?String) */ Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (Yap_IsGroundTerm(AtomNameT)) { if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) { Yap_Error(TYPE_ERROR_LIST, ARG2, "name/2"); - pop_text_stack( l); - ReleaseAndReturn( FALSE ); + pop_text_stack(l); + ReleaseAndReturn(FALSE); } // verify if an atom, int, float or bi§gnnum NewT = Yap_AtomicToListOfCodes(AtomNameT PASS_REGS); if (NewT) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(NewT, ARG2) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(NewT, ARG2)); } // else } else if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "name/2"); - pop_text_stack( l); + pop_text_stack(l); return FALSE; } else { Term at = Yap_ListToAtomic(t PASS_REGS); if (at) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(at, ARG1) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(at, ARG1)); } } if (LOCAL_Error_TYPE && Yap_HandleError("atom/2")) { @@ -305,30 +317,30 @@ restart_aux: t = Deref(ARG2); goto restart_aux; } - pop_text_stack( l); - ReleaseAndReturn( FALSE ); + pop_text_stack(l); + ReleaseAndReturn(FALSE); } static Int string_to_atomic( USES_REGS1) { /* string_to_atom(?String,?Atom) */ Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsStringTerm(t1)) { Term t; // verify if an atom, int, float or bignnum t = Yap_StringToAtomic(t1 PASS_REGS); if (t != 0L) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(t, t2) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(t, t2)); } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomicToString(t2 PASS_REGS); if (t0) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(t0, t1) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(t0, t1)); } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; @@ -338,15 +350,15 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - pop_text_stack( l); - ReleaseAndReturn( FALSE ); + pop_text_stack(l); + ReleaseAndReturn(FALSE); } static Int string_to_atom( USES_REGS1) { /* string_to_atom(?String,?Atom) */ Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsStringTerm(t1)) { @@ -354,15 +366,15 @@ restart_aux: // verify if an atom, int, float or bignnum at = Yap_StringSWIToAtom(t1 PASS_REGS); if (at) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomSWIToString(t2 PASS_REGS); if (t0) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(t0, t1) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(t0, t1)); } } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; @@ -372,26 +384,26 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - pop_text_stack( l); - ReleaseAndReturn( FALSE ); + pop_text_stack(l); + ReleaseAndReturn(FALSE); } static Int string_to_list(USES_REGS1) { Term list = Deref(ARG2), string = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsVarTerm(string)) { Term t1 = Yap_ListToString(list PASS_REGS); if (t1) { - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(ARG1, t1) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(ARG1, t1)); } } else if (IsStringTerm(string)) { Term tf = Yap_StringToListOfCodes(string PASS_REGS); - pop_text_stack( l); - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + pop_text_stack(l); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -400,14 +412,14 @@ restart_aux: list = Deref(ARG2); goto restart_aux; } - pop_text_stack( l); - ReleaseAndReturn( FALSE ); + pop_text_stack(l); + ReleaseAndReturn(FALSE); } static Int atom_string(USES_REGS1) { Term t1 = Deref(ARG1), t2 = Deref(ARG2); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsVarTerm(t1)) { @@ -415,12 +427,12 @@ restart_aux: // verify if an atom, int, float or bignnum at = Yap_StringSWIToAtom(t2 PASS_REGS); if (at) - ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t1) ); + ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t1)); // else } else if (IsAtomTerm(t1)) { Term t0 = Yap_AtomSWIToString(t1 PASS_REGS); if (t0) - ReleaseAndReturn( Yap_unify(t0, t2) ); + ReleaseAndReturn(Yap_unify(t0, t2)); } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -429,26 +441,26 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int atom_chars(USES_REGS1) { Term t1; LOCAL_MAX_SIZE = 1024; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (IsAtomTerm(t1)) { Term tf = Yap_AtomSWIToListOfAtoms(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListOfAtomsToAtom(t PASS_REGS); if (af) - ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); + ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); /* error handling */ } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; @@ -456,24 +468,24 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("atom_chars/2")) { goto restart_aux; } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } static Int atom_codes(USES_REGS1) { Term t1; t1 = Deref(ARG1); - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsAtomTerm(t1)) { Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListToAtom(t PASS_REGS); if (af) - ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); + ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -482,24 +494,24 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int string_codes(USES_REGS1) { Term t1; t1 = Deref(ARG1); - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -508,24 +520,24 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int string_chars(USES_REGS1) { Term t1; t1 = Deref(ARG1); - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfAtoms(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -534,7 +546,7 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } /** @pred number_chars(? _I_,? _L_) is iso @@ -547,7 +559,7 @@ characters of the external representation of _I_. */ static Int number_chars(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { @@ -556,11 +568,11 @@ restart_aux: t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS); } if (t1) { - ReleaseAndReturn( Yap_unify(t1, t2) ); + ReleaseAndReturn(Yap_unify(t1, t2)); } else { t2 = Yap_ListToNumber(t2 PASS_REGS); if (t2) { - ReleaseAndReturn( Yap_unify(t1, t2) ); + ReleaseAndReturn(Yap_unify(t1, t2)); } } } else if (IsVarTerm(t1)) { @@ -568,7 +580,7 @@ restart_aux: Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) { - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; @@ -577,12 +589,12 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_chars/2")) { goto restart_aux; } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } static Int number_atom(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { @@ -592,11 +604,11 @@ restart_aux: if (af) { if (IsVarTerm(t2)) { - ReleaseAndReturn( Yap_unify(t1, t2) ); + ReleaseAndReturn(Yap_unify(t1, t2)); } else { t2 = Yap_AtomToNumber(t2 PASS_REGS); if (t2) { - ReleaseAndReturn( Yap_unify(t1, t2) ); + ReleaseAndReturn(Yap_unify(t1, t2)); } } } @@ -604,32 +616,32 @@ restart_aux: /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_AtomToNumber(t PASS_REGS); - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("number_atom/2")) { goto restart_aux; } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } static Int number_string(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToString(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_StringToNumber(t PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -637,25 +649,25 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_string/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int number_codes(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToListOfCodes(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -663,14 +675,14 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_codes/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int cont_atom_concat3(USES_REGS1) { Term t3; Atom ats[2]; Int i, max; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); @@ -681,8 +693,9 @@ restart_aux: release_cut_fail(); } else { if (i < max) { - ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(ats[0])) && - Yap_unify(ARG2, MkAtomTerm(ats[1])) ); } + ReleaseAndReturn(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]))) release_cut_succeed(); @@ -693,7 +706,7 @@ restart_aux: if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } release_cut_fail(); @@ -704,7 +717,7 @@ static Int atom_concat3(USES_REGS1) { Term t2, t3, ot; Atom at; bool g1, g2, g3; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -724,12 +737,12 @@ restart_aux: } else if (g3) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); - ReleaseAndReturn( cont_atom_concat3(PASS_REGS1) ); + ReleaseAndReturn(cont_atom_concat3(PASS_REGS1)); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } - pop_text_stack( l); + pop_text_stack(l); if (at) { if (Yap_unify(ot, MkAtomTerm(at))) { release_cut_succeed(); @@ -742,7 +755,7 @@ restart_aux: if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } release_cut_fail(); @@ -761,7 +774,7 @@ static Int cont_atomic_concat3(USES_REGS1) { Term t3; Atom ats[2]; size_t i, max; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); @@ -773,7 +786,7 @@ restart_aux: Term t1 = CastToNumeric(ats[0]); Term t2 = CastToNumeric(ats[1]); if (i < max) - ReleaseAndReturn( Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2) ); + ReleaseAndReturn(Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)); if (Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)) release_cut_succeed(); release_cut_fail(); @@ -783,7 +796,7 @@ restart_aux: if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -794,7 +807,7 @@ static Int atomic_concat3(USES_REGS1) { Term t2, t3, ot; Atom at = NULL; bool g1, g2, g3; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -841,7 +854,7 @@ static Int cont_string_concat3(USES_REGS1) { Term t3; Term ts[2]; size_t i, max; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); @@ -873,7 +886,7 @@ static Int string_concat3(USES_REGS1) { Term tf = 0; bool g1, g2, g3; Atom at; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -901,7 +914,7 @@ restart_aux: if (tf) { if (Yap_unify(ot, tf)) { release_cut_succeed(); - } else { + } else { release_cut_fail(); } } @@ -910,7 +923,7 @@ restart_aux: if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } release_cut_fail(); @@ -922,7 +935,7 @@ static Int cont_string_code3(USES_REGS1) { utf8proc_int32_t chr; const unsigned char *s; const unsigned char *s0; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t2 = Deref(ARG2); s0 = UStringOfTerm(t2); @@ -934,10 +947,11 @@ restart_aux: if (s[0]) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(s - s0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(j + 1); - ReleaseAndReturn( Yap_unify(MkIntegerTerm(chr), ARG3) && - Yap_unify(MkIntegerTerm(j + 1), ARG1) ); + ReleaseAndReturn(Yap_unify(MkIntegerTerm(chr), ARG3) && + Yap_unify(MkIntegerTerm(j + 1), ARG1)); } - if (Yap_unify(MkIntegerTerm(chr), ARG3) && Yap_unify(MkIntegerTerm(j), ARG1)) { + if (Yap_unify(MkIntegerTerm(chr), ARG3) && + Yap_unify(MkIntegerTerm(j), ARG1)) { release_cut_succeed(); } else { release_cut_fail(); @@ -947,7 +961,7 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ) ; + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -957,7 +971,7 @@ static Int string_code3(USES_REGS1) { Term t1; Term t2; const unsigned char *s; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1001,7 +1015,7 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -1011,7 +1025,7 @@ static Int get_string_code3(USES_REGS1) { Term t1; Term t2; const unsigned char *s; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1036,20 +1050,20 @@ restart_aux: if (indx < 0) { LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } else { - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } else { indx -= 1; ns = skip_utf8(ns, indx); if (ns == NULL) { - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } else { get_utf8(ns, -1, &chr); if (chr != '\0') - ReleaseAndReturn( Yap_unify(ARG3, MkIntegerTerm(chr)) ); + ReleaseAndReturn(Yap_unify(ARG3, MkIntegerTerm(chr))); } } - ReleaseAndReturn( FALSE ); // replace by error cod )e + ReleaseAndReturn(FALSE); // replace by error cod )e } } /* Error handling */ @@ -1057,7 +1071,7 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -1067,7 +1081,7 @@ static Int atom_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1098,7 +1112,7 @@ restart_aux: free(inpv); at = out.val.a; if (at) - ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); } error: /* Error handling */ @@ -1106,7 +1120,7 @@ error: if (Yap_HandleError("atom_concat/2")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -1116,7 +1130,7 @@ static Int string_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1145,7 +1159,7 @@ restart_aux: } free(inpv); if (out.val.t) - ReleaseAndReturn( Yap_unify(ARG2, out.val.t) ); + ReleaseAndReturn(Yap_unify(ARG2, out.val.t)); } error: /* Error handling */ @@ -1153,7 +1167,7 @@ error: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } } release_cut_fail(); @@ -1163,7 +1177,7 @@ static Int atomic_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1175,7 +1189,7 @@ restart_aux: Atom at; if (n == 1) - ReleaseAndReturn( Yap_unify(ARG2, HeadOfTerm(t1)) ); + ReleaseAndReturn(Yap_unify(ARG2, HeadOfTerm(t1))); if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1198,7 +1212,7 @@ restart_aux: free(inpv); at = out.val.a; if (at) - ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); } error: /* Error handling */ @@ -1212,7 +1226,7 @@ static Int atomics_to_string2(USES_REGS1) { Term t1; Term *tailp; Int n; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1244,21 +1258,21 @@ restart_aux: free(inpv); at = out.val.a; if (at) - ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int atomics_to_string3(USES_REGS1) { Term t1, t2; Term *tailp; Int n; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1295,14 +1309,14 @@ restart_aux: free(inpv); at = out.val.a; if (at) - ReleaseAndReturn( Yap_unify(ARG3, MkAtomTerm(at)) ); + ReleaseAndReturn(Yap_unify(ARG3, MkAtomTerm(at))); } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/3")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int atom_length(USES_REGS1) { @@ -1310,34 +1324,34 @@ static Int atom_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } else if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "at first argument"); - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_length/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int atomic_length(USES_REGS1) { @@ -1345,31 +1359,31 @@ static Int atomic_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } if (IsNonVarTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomic_length/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int string_length(USES_REGS1) { @@ -1377,28 +1391,28 @@ static Int string_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; - int l = push_text_stack( ); + int l = push_text_stack(); if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } if (FALSE && (Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2"); - ReleaseAndReturn( FALSE); + ReleaseAndReturn(FALSE); } } restart_aux: t1 = Deref(ARG1); len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); + ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_length/2")) { goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } /** @pred downcase_text_to_atom(+Text, -Atom) @@ -1411,16 +1425,16 @@ static Int downcase_text_to_atom(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1428,11 +1442,11 @@ static Int downcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_atom/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); + ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred upcase_text_to_atom(+Text, -Atom) @@ -1445,16 +1459,16 @@ static Int upcase_text_to_atom(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1462,11 +1476,11 @@ static Int upcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_atom/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); + ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred downcase_text_to_string(+Text, -String) @@ -1479,16 +1493,16 @@ static Int downcase_text_to_string(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1496,11 +1510,11 @@ static Int downcase_text_to_string(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_string/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred upcase_text_to_string(+Text, -String) @@ -1513,16 +1527,16 @@ static Int upcase_text_to_string(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1530,11 +1544,11 @@ static Int upcase_text_to_string(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_string/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred downcase_text_to_codes(+Text, -Codes) @@ -1547,16 +1561,16 @@ static Int downcase_text_to_codes(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } while (true) { @@ -1564,11 +1578,11 @@ static Int downcase_text_to_codes(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_codes/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred upcase_text_to_codes(+Text, -Codes) @@ -1581,16 +1595,16 @@ static Int upcase_text_to_codes(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1598,11 +1612,11 @@ static Int upcase_text_to_codes(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_codes/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred downcase_text_to_chars(+Text, -Chars) @@ -1615,16 +1629,16 @@ static Int downcase_text_to_chars(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } while (true) { @@ -1632,11 +1646,11 @@ static Int downcase_text_to_chars(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_to_chars/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /** @pred upcase_text_to_chars(+Text, -Chars) @@ -1649,16 +1663,16 @@ static Int upcase_text_to_chars(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - int l = push_text_stack( ); + int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } } while (true) { @@ -1666,11 +1680,11 @@ static Int upcase_text_to_chars(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_chars/2")) continue; - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - ReleaseAndReturn( Yap_unify(t, t2) ); + ReleaseAndReturn(Yap_unify(t, t2)); } - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } /* split an atom into two sub-atoms */ @@ -1681,93 +1695,94 @@ static Int atom_split(USES_REGS1) { Term to1, to2; Atom at; - int l = push_text_stack( ); + int l = push_text_stack(); if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "$atom_split/4"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "$atom_split/4"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "$atom_split/4"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } if (!IsIntTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "$atom_split/4"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } if ((Int)(len = IntOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "$atom_split/4"); - ReleaseAndReturn( (FALSE) ); + ReleaseAndReturn((FALSE)); } at = AtomOfTerm(t1); - unsigned char *s, *s1, *s10; - s = RepAtom(at)->UStrOfAE; - if (len > (Int)strlen_utf8(s)) - ReleaseAndReturn( (FALSE) ); - s1 = s10 = Malloc(len); - if (s1 + len > (unsigned char *)ASP - 1024) - Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); - size_t j; - for (j = 0; j < len; j++) { - int32_t val; - s += get_utf8(s,1,&val); - s1 += put_utf8(s,val); - } - s1[0] = '\0'; - to1 = MkAtomTerm(Yap_ULookupAtom(s10)); - to2 = MkAtomTerm(Yap_ULookupAtom(s)); - ReleaseAndReturn( (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2)) ); + unsigned char *s, *s1, *s10; + s = RepAtom(at)->UStrOfAE; + if (len > (Int)strlen_utf8(s)) + ReleaseAndReturn((FALSE)); + s1 = s10 = Malloc(len); + if (s1 + len > (unsigned char *)ASP - 1024) + Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); + size_t j; + for (j = 0; j < len; j++) { + int32_t val; + s += get_utf8(s, 1, &val); + s1 += put_utf8(s, val); + } + s1[0] = '\0'; + to1 = MkAtomTerm(Yap_ULookupAtom(s10)); + to2 = MkAtomTerm(Yap_ULookupAtom(s)); + ReleaseAndReturn( + (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2))); } static Int atom_number(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_AtomToNumber(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_NumberToAtom(t PASS_REGS); if (af) - ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); + ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } static Int string_number(USES_REGS1) { Term t1; - int l = push_text_stack( ); + int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_StringToNumber(t1 PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG2, tf) ); + ReleaseAndReturn(Yap_unify(ARG2, tf)); } else { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_NumberToString(t PASS_REGS); if (tf) - ReleaseAndReturn( Yap_unify(ARG1, tf) ); + ReleaseAndReturn(Yap_unify(ARG1, tf)); } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn( FALSE ); + ReleaseAndReturn(FALSE); } #define SUB_ATOM_HAS_MIN 1 @@ -1777,89 +1792,85 @@ restart_aux: #define SUB_ATOM_HAS_ATOM 16 #define SUB_ATOM_HAS_UTF8 32 - -static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, size_t minv,size_t len USES_REGS) -{ +static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, + size_t minv, size_t len USES_REGS) { int n; - seq_tv_t outv[5], inp; - size_t cuts[3]; - if (minv) { - cuts[0] = minv; - cuts[1] = minv+len; - cuts[2] = 0; - outv[0].type = 0; - n = 1; - } else { - cuts[0] = minv+len; - cuts[1] = 0; - n = 0; - } + seq_tv_t outv[5], inp; + size_t cuts[3]; + if (minv) { + cuts[0] = minv; + cuts[1] = minv + len; + cuts[2] = 0; + outv[0].type = 0; + n = 1; + } else { + cuts[0] = minv + len; + cuts[1] = 0; + n = 0; + } inp.type = YAP_STRING_CHARS; - inp.enc = ENC_ISO_UTF8; + inp.enc = ENC_ISO_UTF8; inp.val.uc0 = p; - outv[n+1].type = 0; + outv[n + 1].type = 0; if (mask & SUB_ATOM_HAS_ATOM) { outv[n].type = YAP_STRING_ATOM; } else { - outv[n].type = YAP_STRING_STRING; - outv[n].val.c = Malloc(512); + outv[n].type = YAP_STRING_STRING; + outv[n].val.c = Malloc(512); } int lvl = push_text_stack(PASS_REGS1); -bool rc = Yap_Splice_Text(2+n, cuts, &inp, outv PASS_REGS); - pop_text_stack(lvl); - if (!rc) - return( false ); - if (mask & SUB_ATOM_HAS_ATOM) - return( MkAtomTerm(outv[n].val.a) ); - return( outv[n].val.t ); + bool rc = Yap_Splice_Text(2 + n, cuts, &inp, outv PASS_REGS); + pop_text_stack(lvl); + if (!rc) + return (false); + if (mask & SUB_ATOM_HAS_ATOM) + return (MkAtomTerm(outv[n].val.a)); + return (outv[n].val.t); } - static int check_sub_atom_at(int minv, Atom at, Atom nat, size_t len) { - const unsigned char *p1; - const unsigned char *p2 = RepAtom(nat)->UStrOfAE; - p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); - return cmpn_utf8(p1, p2, len) == 0 ; + const unsigned char *p1; + const unsigned char *p2 = RepAtom(nat)->UStrOfAE; + p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); + return cmpn_utf8(p1, p2, len) == 0; } static int check_sub_string_at(int minv, const unsigned char *p1, const unsigned char *p2, size_t len) { p1 = skip_utf8((unsigned char *)p1, minv); - if (p1 == NULL || p2 == NULL) - return p1 == p2; + if (p1 == NULL || p2 == NULL) + return p1 == p2; return cmpn_utf8(p1, p2, len) == 0; } - static int check_sub_string_bef(int max, Term at, Term nat) { - size_t len = strlen_utf8(UStringOfTerm(nat)); - int minv = max - len; - const unsigned char *p1, *p2; - int c1; + size_t len = strlen_utf8(UStringOfTerm(nat)); + int minv = max - len; + const unsigned char *p1, *p2; + int c1; - if ((Int)(minv - len) < 0) - return FALSE; + if ((Int)(minv - len) < 0) + return FALSE; - p1 = skip_utf8((unsigned char *)UStringOfTerm(at), minv); - p2 = UStringOfTerm(nat); - while ((c1 = *p1++) == *p2++ && c1) - ; - return c1 == 0; + p1 = skip_utf8((unsigned char *)UStringOfTerm(at), minv); + p2 = UStringOfTerm(nat); + while ((c1 = *p1++) == *p2++ && c1) + ; + return c1 == 0; } - static int check_sub_atom_bef(int max, Atom at, Atom nat) { - const unsigned char *p1, *p2 = RepAtom(nat)->UStrOfAE; - size_t len = strlen_utf8(p2); - int minv = max - len; - int c1; + const unsigned char *p1, *p2 = RepAtom(nat)->UStrOfAE; + size_t len = strlen_utf8(p2); + int minv = max - len; + int c1; - if ((Int)(minv - len) < 0) - return false; - p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); - while ((c1 = *p1++) == *p2++ && c1) - ; - return c1 == 0; + if ((Int)(minv - len) < 0) + return false; + p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); + while ((c1 = *p1++) == *p2++ && c1) + ; + return c1 == 0; } static Int cont_sub_atomic(USES_REGS1) { @@ -1869,15 +1880,14 @@ static Int cont_sub_atomic(USES_REGS1) { size_t minv, len, after, sz; wchar_t *wp = NULL; const unsigned char *p = NULL, *p5 = NULL; - Term nat; - - int l = push_text_stack( ); + bool sub_atom = TRUE; + mask = IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)); minv = IntegerOfTerm(EXTRA_CBACK_ARG(5, 2)); len = IntegerOfTerm(EXTRA_CBACK_ARG(5, 3)); after = IntegerOfTerm(EXTRA_CBACK_ARG(5, 4)); sz = IntegerOfTerm(EXTRA_CBACK_ARG(5, 5)); - + if (!IsVarTerm(tat1)) { if (IsAtomTerm(tat1)) { p = AtomOfTerm(tat1)->UStrOfAE; @@ -1893,544 +1903,551 @@ static Int cont_sub_atomic(USES_REGS1) { } } /* we can have one of two cases: A5 bound or unbound */ - if (mask & SUB_ATOM_HAS_VAL) { - int found = FALSE; - nat = Deref(ARG5); - { - const unsigned char *p1 = p; - - while (!found) { - p = skip_utf8(p1, minv); - if (cmpn_utf8(p, p5, len) == 0) { - Yap_unify(ARG2, MkIntegerTerm(minv)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - found = TRUE; - /* found one, check if there is any left */ - while (minv <= sz - len) { - int chr; - p += get_utf8((unsigned char *)p, -1, &chr); - after--; - minv++; - if (cmpn_utf8(p, UStringOfTerm(nat), len) == 0) - break; - } - } else { - if (minv == sz - len) - break; - after--; - minv++; + if (mask & SUB_ATOM_HAS_VAL) { + bool found = false; + { + const unsigned char *p1 = p; + + while (!found) { + p = skip_utf8(p1, minv); + if (cmpn_utf8(p, p5, len) == 0) { + Yap_unify(ARG2, MkIntegerTerm(minv)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + found = true; + /* found one, check if there is any left */ + while (minv <= sz - len) { + int chr; + p += get_utf8((unsigned char *)p, -1, &chr); + after--; + minv++; + if (cmpn_utf8(p, p5, len) == 0) + break; + } + } else { + if (minv == sz - len) + break; + after--; + minv++; + } + } } - } - } - if (found) { - if (minv > sz - len) - release_cut_succeed(); + if (found) { + if (minv > sz - len) + cut_succeed(); + } else { + cut_fail(); + } + } else if (mask & SUB_ATOM_HAS_SIZE) { + Term nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + Yap_unify(ARG2, MkIntegerTerm(minv)); + Yap_unify(ARG4, MkIntegerTerm(after)); + Yap_unify(ARG5, nat); + minv++; + if (after-- == 0) + cut_succeed(); + } else if (mask & SUB_ATOM_HAS_MIN) { + after = sz - (minv + len); + Term nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + Yap_unify(ARG5, nat); + len++; + if (after-- == 0) + cut_succeed(); + } else if (mask & SUB_ATOM_HAS_AFTER) { + len = sz - (minv + after); + Term nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + Yap_unify(ARG2, MkIntegerTerm(minv)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG5, nat); + minv++; + if (len-- == 0) + cut_succeed(); } else { - release_cut_fail(); + Term nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + Yap_unify(ARG2, MkIntegerTerm(minv)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + Yap_unify(ARG5, nat); + len++; + if (after-- == 0) { + if (minv == sz) + cut_succeed(); + minv++; + len = 0; + after = sz - minv; + } } - } else if (mask & SUB_ATOM_HAS_SIZE) { - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - Yap_unify(ARG2, MkIntegerTerm(minv)); - Yap_unify(ARG4, MkIntegerTerm(after)); - Yap_unify(ARG5, nat); - minv++; - if (after-- == 0) - release_cut_succeed(); - } else if (mask & SUB_ATOM_HAS_MIN) { - after = sz - (minv + len); - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - Yap_unify(ARG5, nat); - len++; - if (after-- == 0) - release_cut_succeed(); - } else if (mask & SUB_ATOM_HAS_AFTER) { - len = sz - (minv + after); - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - Yap_unify(ARG2, MkIntegerTerm(minv)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG5, nat); - minv++; - if (len-- == 0) - release_cut_succeed(); - } else { - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - Yap_unify(ARG2, MkIntegerTerm(minv)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - Yap_unify(ARG5, nat); - len++; - if (after-- == 0) { - if (minv == sz) - release_cut_succeed(); - minv++; - len = 0; - after = sz - minv; - } - } - EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); - EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv); - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); - EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); - EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - ReleaseAndReturn( TRUE ); + EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); + EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv); + EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); + EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); + EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); + return TRUE; } -static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { - Term tat1, tbef, tsize, tafter, tout; - int mask = SUB_ATOM_HAS_UTF8; - size_t minv, len, after, sz; - wchar_t *wp = NULL; - const unsigned char *p = NULL; - int bnds = 0; - Term nat = 0L; - Atom at = NULL; - int l = push_text_stack( ); - if (sub_atom) - mask |= SUB_ATOM_HAS_ATOM; + static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { + Term tat1, tbef, tsize, tafter, tout; + int mask = SUB_ATOM_HAS_UTF8; + size_t minv, len, after, sz; + wchar_t *wp = NULL; + const unsigned char *p = NULL; + int bnds = 0; + Term nat = 0L; + Atom at = NULL; + int l = push_text_stack(); + if (sub_atom) + mask |= SUB_ATOM_HAS_ATOM; - tat1 = Deref(ARG1); + tat1 = Deref(ARG1); - if (!IsVarTerm(tat1)) { - if (IsAtomTerm(tat1)) { - if (sub_atom) { + if (!IsVarTerm(tat1)) { + if (sub_atom) { + if (IsAtomTerm(tat1)) { p = AtomOfTerm(tat1)->UStrOfAE; sz = strlen_utf8(p); } else { Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } - } else if (IsStringTerm(tat1)) { - if (sub_string) { + } else if (sub_string) { + if (IsStringTerm(tat1)) { p = UStringOfTerm(tat1); sz = strlen_utf8(p); } else { Yap_Error(TYPE_ERROR_STRING, tat1, "sub_atom/5"); - ReleaseAndReturn( false ); + ReleaseAndReturn(false); } } - } else { - Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n"); - ReleaseAndReturn( false ); - } - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0); - tbef = Deref(ARG2); - if (IsVarTerm(tbef)) { - minv = 0; - } else if (!IsIntegerTerm(tbef)) { - Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5"); - ReleaseAndReturn( FALSE ); - } else { - minv = IntegerOfTerm(tbef); - if ((Int)minv < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); - ReleaseAndReturn( FALSE ); - }; - mask |= SUB_ATOM_HAS_MIN; - bnds++; - } - if (IsVarTerm(tsize = Deref(ARG3))) { - len = 0; - } else if (!IsIntegerTerm(tsize)) { - Yap_Error(TYPE_ERROR_INTEGER, tsize, "sub_string/5"); - ReleaseAndReturn( FALSE ); - } else { - len = IntegerOfTerm(tsize); - if ((Int)len < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); - ReleaseAndReturn( FALSE ); - }; - mask |= SUB_ATOM_HAS_SIZE; - bnds++; - } - if (IsVarTerm(tafter = Deref(ARG4))) { - after = 0; - } else if (!IsIntegerTerm(tafter)) { - Yap_Error(TYPE_ERROR_INTEGER, tafter, "sub_string/5"); - ReleaseAndReturn( FALSE ); - } else { - after = IntegerOfTerm(tafter); - if ((Int)after < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); - ReleaseAndReturn( FALSE ); - }; - mask |= SUB_ATOM_HAS_AFTER; - bnds++; - } - if (!IsVarTerm(tout = Deref(ARG5))) { - if (sub_atom) { - if (!IsAtomTerm(tout)) { - Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); - ReleaseAndReturn( FALSE ); } else { - Atom oat; - mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; - oat = AtomOfTerm(tout); - len = strlen_utf8(RepAtom(oat)->UStrOfAE); + Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n"); + ReleaseAndReturn(false); } - } else { - if (!IsStringTerm(tout)) { - Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); - ReleaseAndReturn( FALSE ); - } else { - mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; - len = strlen_utf8(UStringOfTerm(tout)); - } - } - if (!Yap_unify(ARG3, MkIntegerTerm(len))) - release_cut_fail(); - bnds += 2; - } - /* the problem is deterministic if we have two cases */ - if (bnds > 1) { - int out = FALSE; - - if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) == - (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) { - if (minv + len > sz) - release_cut_fail(); - if ((Int)(after = (sz - (minv + len))) < 0) - release_cut_fail(); - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - if (!nat) - release_cut_fail(); - out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat); - } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) == - (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) { - if (sz < minv + after) - release_cut_fail(); - len = sz - (minv + after); - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - if (!nat) - release_cut_fail(); - out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat); - } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) == - (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) { - if (len + after > sz) - release_cut_fail(); - minv = sz - (len + after); - nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); - if (!nat) - release_cut_fail(); - out = Yap_unify(ARG2, MkIntegerTerm(minv)) && Yap_unify(ARG5, nat); - } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) { - if (sub_atom) - out = check_sub_atom_at(minv, at, AtomOfTerm(nat), len); - else - out = check_sub_string_at(minv, p, UStringOfTerm(nat), len); - } else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) { - if (sub_atom) - out = check_sub_atom_bef(sz - after, at, AtomOfTerm(nat)); - else - out = check_sub_string_bef(sz - after, tat1, tout); - } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) { - if (!sub_atom) { - out = (strlen_utf8(UStringOfTerm(tout)) == len); - if (!out) - release_cut_fail(); - } else { - out = (strlen_utf8(RepAtom(AtomOfTerm(tout))->UStrOfAE) - == len); - if (!out) - release_cut_fail(); - } - if (len == sz) { - out = out && Yap_unify(ARG1, ARG5) && - Yap_unify(ARG2, MkIntegerTerm(0)) && - Yap_unify(ARG4, MkIntegerTerm(0)); - } else if (len > sz) { - release_cut_fail(); - } else { - mask |= SUB_ATOM_HAS_SIZE; + EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0); + tbef = Deref(ARG2); + if (IsVarTerm(tbef)) { minv = 0; - after = sz - len; - goto backtrackable; - } - } - if (out) - release_cut_succeed(); - release_cut_fail(); - } else { - if (!(mask & SUB_ATOM_HAS_MIN)) - minv = 0; - if (!(mask & SUB_ATOM_HAS_SIZE)) - len = 0; - if (!(mask & SUB_ATOM_HAS_AFTER)) - after = sz - (len + minv); - } -backtrackable: - EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); - EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv); - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); - EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); - EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - ReleaseAndReturn( cont_sub_atomic(PASS_REGS1) ); -} - -/** @pred sub_atom(+ _A_,? _Bef_, ? _Size_, ? _After_, ? _At_out_) is iso - - -True when _A_ and _At_out_ are atoms such that the name of - _At_out_ has size _Size_ and is a sub-string of the name of - _A_, such that _Bef_ is the number of characters before and - _After_ the number of characters afterwards. - -Note that _A_ must always be known, but _At_out_ can be unbound when -calling this built-in. If all the arguments for sub_atom/5 but _A_ -are unbound, the built-in will backtrack through all possible -sub-strings of _A_. - - */ -static Int sub_atom(USES_REGS1) { return( sub_atomic(true, false PASS_REGS) );} - -/** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is iso - - -True when _S_ and _S_out_ are strings such that the - _S_out_ has size _Size_ and is a sub-string of - _S_, _Bef_ is the number of characters before, and - _After_ the number of characters afterwards. - -Note that _S_ must always be known, but _S_out_ can be unbound when -calling this built-in. If all the arguments for sub_string/5 but _S_ -are unbound, the built-in will generate all possible -sub-strings of _S_. - - */ -static Int sub_string(USES_REGS1) { return sub_atomic(false, true PASS_REGS); } - -static Int cont_current_atom(USES_REGS1) { - Atom catom; - Int i = IntOfTerm(EXTRA_CBACK_ARG(1, 2)); - AtomEntry *ap; /* nasty hack for gcc on hpux */ - - /* protect current hash table line */ - if (IsAtomTerm(EXTRA_CBACK_ARG(1, 1))) - catom = AtomOfTerm(EXTRA_CBACK_ARG(1, 1)); - else - catom = NIL; - if (catom == NIL) { - i++; - /* move away from current hash table line */ - while (i < AtomHashTableSize) { - READ_LOCK(HashChain[i].AERWLock); - catom = HashChain[i].Entry; - READ_UNLOCK(HashChain[i].AERWLock); - if (catom != NIL) { - break; - } - i++; - } - if (i == AtomHashTableSize) { - cut_fail(); - } - } - ap = RepAtom(catom); - if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) { - READ_LOCK(ap->ARWLock); - if (ap->NextOfAE == NIL) { - READ_UNLOCK(ap->ARWLock); - i++; - while (i < AtomHashTableSize) { - READ_LOCK(HashChain[i].AERWLock); - catom = HashChain[i].Entry; - READ_UNLOCK(HashChain[i].AERWLock); - if (catom != NIL) { - break; - } - i++; - } - if (i == AtomHashTableSize) { - cut_fail(); + } else if (!IsIntegerTerm(tbef)) { + Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5"); + ReleaseAndReturn(FALSE); } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(catom); + minv = IntegerOfTerm(tbef); + if ((Int)minv < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); + ReleaseAndReturn(FALSE); + }; + mask |= SUB_ATOM_HAS_MIN; + bnds++; } - } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(ap->NextOfAE); - READ_UNLOCK(ap->ARWLock); + if (IsVarTerm(tsize = Deref(ARG3))) { + len = 0; + } else if (!IsIntegerTerm(tsize)) { + Yap_Error(TYPE_ERROR_INTEGER, tsize, "sub_string/5"); + ReleaseAndReturn(FALSE); + } else { + len = IntegerOfTerm(tsize); + if ((Int)len < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); + ReleaseAndReturn(FALSE); + }; + mask |= SUB_ATOM_HAS_SIZE; + bnds++; + } + if (IsVarTerm(tafter = Deref(ARG4))) { + after = 0; + } else if (!IsIntegerTerm(tafter)) { + Yap_Error(TYPE_ERROR_INTEGER, tafter, "sub_string/5"); + ReleaseAndReturn(FALSE); + } else { + after = IntegerOfTerm(tafter); + if ((Int)after < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); + ReleaseAndReturn(FALSE); + }; + mask |= SUB_ATOM_HAS_AFTER; + bnds++; + } + if (!IsVarTerm(tout = Deref(ARG5))) { + if (sub_atom) { + if (!IsAtomTerm(tout)) { + Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); + ReleaseAndReturn(FALSE); + } else { + Atom oat; + mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; + oat = AtomOfTerm(tout); + len = strlen_utf8(RepAtom(oat)->UStrOfAE); + } + } else { + if (!IsStringTerm(tout)) { + Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); + ReleaseAndReturn(FALSE); + } else { + mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; + len = strlen_utf8(UStringOfTerm(tout)); + } + } + if (!Yap_unify(ARG3, MkIntegerTerm(len))) + release_cut_fail(); + bnds += 2; + } + /* the problem is deterministic if we have two cases */ + if (bnds > 1) { + int out = FALSE; + + if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) == + (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) { + if (minv + len > sz) + release_cut_fail(); + if ((Int)(after = (sz - (minv + len))) < 0) + release_cut_fail(); + nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + if (!nat) + release_cut_fail(); + out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat); + } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) == + (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) { + if (sz < minv + after) + release_cut_fail(); + len = sz - (minv + after); + nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + if (!nat) + release_cut_fail(); + out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat); + } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) == + (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) { + if (len + after > sz) + release_cut_fail(); + minv = sz - (len + after); + nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); + if (!nat) + release_cut_fail(); + out = Yap_unify(ARG2, MkIntegerTerm(minv)) && Yap_unify(ARG5, nat); + } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) == + (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) { + if (sub_atom) + out = check_sub_atom_at(minv, at, AtomOfTerm(nat), len); + else + out = check_sub_string_at(minv, p, UStringOfTerm(nat), len); + } else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) == + (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) { + if (sub_atom) + out = check_sub_atom_bef(sz - after, at, AtomOfTerm(nat)); + else + out = check_sub_string_bef(sz - after, tat1, tout); + } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) == + (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) { + if (!sub_atom) { + out = (strlen_utf8(UStringOfTerm(tout)) == len); + if (!out) + release_cut_fail(); + } else { + out = (strlen_utf8(RepAtom(AtomOfTerm(tout))->UStrOfAE) == len); + if (!out) + release_cut_fail(); + } + if (len == sz) { + out = out && Yap_unify(ARG1, ARG5) && + Yap_unify(ARG2, MkIntegerTerm(0)) && + Yap_unify(ARG4, MkIntegerTerm(0)); + } else if (len > sz) { + release_cut_fail(); + } else { + mask |= SUB_ATOM_HAS_SIZE; + minv = 0; + after = sz - len; + goto backtrackable; + } + } + if (out) + release_cut_succeed(); + release_cut_fail(); + } else { + if (!(mask & SUB_ATOM_HAS_MIN)) + minv = 0; + if (!(mask & SUB_ATOM_HAS_SIZE)) + len = 0; + if (!(mask & SUB_ATOM_HAS_AFTER)) + after = sz - (len + minv); + } + backtrackable: + EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); + EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(minv); + EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); + EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); + EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); + ReleaseAndReturn(cont_sub_atomic(PASS_REGS1)); } - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i); - return( TRUE ); - } else { - return( FALSE ); - } -} -static Int current_atom(USES_REGS1) { /* current_atom(?Atom) */ - Term t1 = Deref(ARG1); - if (!IsVarTerm(t1)) { - if (IsAtomTerm(t1)) - cut_succeed(); - else - cut_fail(); - } - READ_LOCK(HashChain[0].AERWLock); - if (HashChain[0].Entry != NIL) { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(HashChain[0].Entry); - } else { - EXTRA_CBACK_ARG(1, 1) = MkIntTerm(0); - } - READ_UNLOCK(HashChain[0].AERWLock); - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(0); - return (cont_current_atom(PASS_REGS1)); -} - -void Yap_InitBackAtoms(void) { - Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom, - SafePredFlag | SyncPredFlag); - Yap_InitCPredBack("atom_concat", 3, 2, atom_concat3, cont_atom_concat3, 0); - Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, cont_atomic_concat3, - 0); - Yap_InitCPredBack("string_concat", 3, 2, string_concat3, cont_string_concat3, - 0); - Yap_InitCPredBack("sub_atom", 5, 5, sub_atom, cont_sub_atomic, 0); - Yap_InitCPredBack("sub_string", 5, 5, sub_string, cont_sub_atomic, 0); - Yap_InitCPredBack("string_code", 3, 1, string_code3, cont_string_code3, 0); -} - -void Yap_InitAtomPreds(void) { - Yap_InitCPred("name", 2, name, 0); - /** @pred name( _A_, _L_) + /** @pred sub_atom(+ _A_,? _Bef_, ? _Size_, ? _After_, ? _At_out_) is iso - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _A_ will - be unified with an atomic symbol and _L_ with the list of the ASCII - codes for the characters of the external representation of _A_. + True when _A_ and _At_out_ are atoms such that the name of + _At_out_ has size _Size_ and is a sub-string of the name of + _A_, such that _Bef_ is the number of characters before and + _After_ the number of characters afterwards. - ~~~~~{.prolog} - name(yap,L). - ~~~~~ - will return: + Note that _A_ must always be known, but _At_out_ can be unbound when + calling this built-in. If all the arguments for sub_atom/5 but _A_ + are unbound, the built-in will backtrack through all possible + sub-strings of _A_. - ~~~~~{.prolog} - L = [121,97,112]. - ~~~~~ - and + */ + static Int sub_atom(USES_REGS1) { + return (sub_atomic(true, false PASS_REGS)); + } - ~~~~~{.prolog} - name(3,L). - ~~~~~ - will return: - - ~~~~~{.prolog} - L = [51]. - ~~~~~ + /** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is + iso + True when _S_ and _S_out_ are strings such that the + _S_out_ has size _Size_ and is a sub-string of + _S_, _Bef_ is the number of characters before, and + _After_ the number of characters afterwards. + + Note that _S_ must always be known, but _S_out_ can be unbound when + calling this built-in. If all the arguments for sub_string/5 but _S_ + are unbound, the built-in will generate all possible + sub-strings of _S_. + + */ + static Int sub_string(USES_REGS1) { + return sub_atomic(false, true PASS_REGS); + } + + static Int cont_current_atom(USES_REGS1) { + Atom catom; + Int i = IntOfTerm(EXTRA_CBACK_ARG(1, 2)); + AtomEntry *ap; /* nasty hack for gcc on hpux */ + + /* protect current hash table line */ + if (IsAtomTerm(EXTRA_CBACK_ARG(1, 1))) + catom = AtomOfTerm(EXTRA_CBACK_ARG(1, 1)); + else + catom = NIL; + if (catom == NIL) { + i++; + /* move away from current hash table line */ + while (i < AtomHashTableSize) { + READ_LOCK(HashChain[i].AERWLock); + catom = HashChain[i].Entry; + READ_UNLOCK(HashChain[i].AERWLock); + if (catom != NIL) { + break; + } + i++; + } + if (i == AtomHashTableSize) { + cut_fail(); + } + } + ap = RepAtom(catom); + if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) { + READ_LOCK(ap->ARWLock); + if (ap->NextOfAE == NIL) { + READ_UNLOCK(ap->ARWLock); + i++; + while (i < AtomHashTableSize) { + READ_LOCK(HashChain[i].AERWLock); + catom = HashChain[i].Entry; + READ_UNLOCK(HashChain[i].AERWLock); + if (catom != NIL) { + break; + } + i++; + } + if (i == AtomHashTableSize) { + cut_fail(); + } else { + EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(catom); + } + } else { + EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(ap->NextOfAE); + READ_UNLOCK(ap->ARWLock); + } + EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i); + return (TRUE); + } else { + return (FALSE); + } + } + + static Int current_atom(USES_REGS1) { /* current_atom(?Atom) + */ + Term t1 = Deref(ARG1); + if (!IsVarTerm(t1)) { + if (IsAtomTerm(t1)) + cut_succeed(); + else + cut_fail(); + } + READ_LOCK(HashChain[0].AERWLock); + if (HashChain[0].Entry != NIL) { + EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(HashChain[0].Entry); + } else { + EXTRA_CBACK_ARG(1, 1) = MkIntTerm(0); + } + READ_UNLOCK(HashChain[0].AERWLock); + EXTRA_CBACK_ARG(1, 2) = MkIntTerm(0); + return (cont_current_atom(PASS_REGS1)); + } + + void Yap_InitBackAtoms(void) { + Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom, + SafePredFlag | SyncPredFlag); + Yap_InitCPredBack("atom_concat", 3, 2, atom_concat3, cont_atom_concat3, + 0); + Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, + cont_atomic_concat3, 0); + Yap_InitCPredBack("string_concat", 3, 2, string_concat3, + cont_string_concat3, 0); + Yap_InitCPredBack("sub_atom", 5, 5, sub_atom, cont_sub_atomic, 0); + Yap_InitCPredBack("sub_string", 5, 5, sub_string, cont_sub_atomic, 0); + Yap_InitCPredBack("string_code", 3, 1, string_code3, cont_string_code3, + 0); + } + + void Yap_InitAtomPreds(void) { + Yap_InitCPred("name", 2, name, 0); + /** @pred name( _A_, _L_) + + + The predicate holds when at least one of the arguments is ground + (otherwise, an error message will be displayed). The argument _A_ will + be unified with an atomic symbol and _L_ with the list of the ASCII + codes for the characters of the external representation of _A_. + + ~~~~~{.prolog} + name(yap,L). + ~~~~~ + will return: + + ~~~~~{.prolog} + L = [121,97,112]. + ~~~~~ + and + + ~~~~~{.prolog} + name(3,L). + ~~~~~ + will return: + + ~~~~~{.prolog} + L = [51]. + ~~~~~ + + + */ + Yap_InitCPred("string_to_atom", 2, string_to_atom, 0); + Yap_InitCPred("atom_string", 2, atom_string, 0); + Yap_InitCPred("string_to_atomic", 2, string_to_atomic, 0); + Yap_InitCPred("string_to_list", 2, string_to_list, 0); + Yap_InitCPred("char_code", 2, char_code, SafePredFlag); + /** @pred char_code(? _A_,? _I_) is iso + + + The built-in succeeds with _A_ bound to character represented as an + atom, and _I_ bound to the character code represented as an + integer. At least, one of either _A_ or _I_ must be bound before + the call. + + + */ + Yap_InitCPred("atom_chars", 2, atom_chars, 0); + /** @pred atom_chars(? _A_,? _L_) is iso + + + The predicate holds when at least one of the arguments is ground + (otherwise, an error message will be displayed). The argument _A_ must + be unifiable with an atom, and the argument _L_ with the list of the + characters of _A_. + + + */ + Yap_InitCPred("atom_codes", 2, atom_codes, 0); + Yap_InitCPred("string_codes", 2, string_codes, 0); + Yap_InitCPred("string_chars", 2, string_chars, 0); + Yap_InitCPred("atom_length", 2, atom_length, SafePredFlag); + /** @pred atom_length(+ _A_,? _I_) is iso + + + The predicate holds when the first argument is an atom, and the second + unifies with the number of characters forming that atom. + + + */ + Yap_InitCPred("atomic_length", 2, atomic_length, SafePredFlag); + Yap_InitCPred("string_length", 2, string_length, SafePredFlag); + Yap_InitCPred("$atom_split", 4, atom_split, SafePredFlag); + Yap_InitCPred("number_chars", 2, number_chars, 0); + Yap_InitCPred("number_atom", 2, number_atom, 0); + /** @pred number_atom(? _I_,? _L_) + + + + The predicate holds when at least one of the arguments is ground + (otherwise, an error message will be displayed). The argument _I_ must + be unifiable with a number, and the argument _L_ must be unifiable + with an atom representing the number. + + + */ + Yap_InitCPred("number_string", 2, number_string, 0); + Yap_InitCPred("number_codes", 2, number_codes, 0); + Yap_InitCPred("atom_number", 2, atom_number, 0); + /** @pred atom_number(? _Atom_,? _Number_) + + + The predicate holds when at least one of the arguments is ground + (otherwise, an error message will be displayed). If the argument + _Atom_ is an atom, _Number_ must be the number corresponding + to the characters in _Atom_, otherwise the characters in + _Atom_ must encode a number _Number_. + + + */ + Yap_InitCPred("string_number", 2, string_number, 0); + Yap_InitCPred("$atom_concat", 2, atom_concat2, 0); + Yap_InitCPred("$string_concat", 2, string_concat2, 0); + Yap_InitCPred("atomic_concat", 2, atomic_concat2, 0); + /** @pred atomic_concat(+ _As_,? _A_) + + + The predicate holds when the first argument is a list of atomic terms, + and + the second unifies with the atom obtained by concatenating all the + atomic terms in the first list. The first argument thus may contain + atoms or numbers. + + + */ + Yap_InitCPred("atomics_to_string", 2, atomics_to_string2, 0); + Yap_InitCPred("atomics_to_string", 3, atomics_to_string3, 0); + Yap_InitCPred("get_string_code", 3, get_string_code3, 0); + + Yap_InitCPred("downcase_text_to_atom", 2, downcase_text_to_atom, 0); + Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0); + Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0); + Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0); + Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0); + Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0); + Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0); + Yap_InitCPred("upcase_text_to_codes", 2, upcase_text_to_codes, 0); + Yap_InitCPred("downcase_text_to_chars", 2, downcase_text_to_chars, 0); + Yap_InitCPred("upcase_text_to_chars", 2, upcase_text_to_chars, 0); + + /* hiding and unhiding some predicates */ + Yap_InitCPred("hide_atom", 1, hide_atom, SafePredFlag | SyncPredFlag); + Yap_InitCPred("hide", 1, hide_atom, SafePredFlag | SyncPredFlag); + Yap_InitCPred("unhide_atom", 1, unhide_atom, SafePredFlag | SyncPredFlag); + Yap_InitCPred("$hidden_atom", 1, hidden_atom, + HiddenPredFlag | SafePredFlag | SyncPredFlag); + } + + /** + @} */ - Yap_InitCPred("string_to_atom", 2, string_to_atom, 0); - Yap_InitCPred("atom_string", 2, atom_string, 0); - Yap_InitCPred("string_to_atomic", 2, string_to_atomic, 0); - Yap_InitCPred("string_to_list", 2, string_to_list, 0); - Yap_InitCPred("char_code", 2, char_code, SafePredFlag); - /** @pred char_code(? _A_,? _I_) is iso - - - The built-in succeeds with _A_ bound to character represented as an - atom, and _I_ bound to the character code represented as an - integer. At least, one of either _A_ or _I_ must be bound before - the call. - - - */ - Yap_InitCPred("atom_chars", 2, atom_chars, 0); - /** @pred atom_chars(? _A_,? _L_) is iso - - - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _A_ must - be unifiable with an atom, and the argument _L_ with the list of the - characters of _A_. - - - */ - Yap_InitCPred("atom_codes", 2, atom_codes, 0); - Yap_InitCPred("string_codes", 2, string_codes, 0); - Yap_InitCPred("string_chars", 2, string_chars, 0); - Yap_InitCPred("atom_length", 2, atom_length, SafePredFlag); - /** @pred atom_length(+ _A_,? _I_) is iso - - - The predicate holds when the first argument is an atom, and the second - unifies with the number of characters forming that atom. - - - */ - Yap_InitCPred("atomic_length", 2, atomic_length, SafePredFlag); - Yap_InitCPred("string_length", 2, string_length, SafePredFlag); - Yap_InitCPred("$atom_split", 4, atom_split, SafePredFlag); - Yap_InitCPred("number_chars", 2, number_chars, 0); - Yap_InitCPred("number_atom", 2, number_atom, 0); - /** @pred number_atom(? _I_,? _L_) - - - - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _I_ must - be unifiable with a number, and the argument _L_ must be unifiable - with an atom representing the number. - - - */ - Yap_InitCPred("number_string", 2, number_string, 0); - Yap_InitCPred("number_codes", 2, number_codes, 0); - Yap_InitCPred("atom_number", 2, atom_number, 0); - /** @pred atom_number(? _Atom_,? _Number_) - - - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). If the argument - _Atom_ is an atom, _Number_ must be the number corresponding - to the characters in _Atom_, otherwise the characters in - _Atom_ must encode a number _Number_. - - - */ - Yap_InitCPred("string_number", 2, string_number, 0); - Yap_InitCPred("$atom_concat", 2, atom_concat2, 0); - Yap_InitCPred("$string_concat", 2, string_concat2, 0); - Yap_InitCPred("atomic_concat", 2, atomic_concat2, 0); - /** @pred atomic_concat(+ _As_,? _A_) - - - The predicate holds when the first argument is a list of atomic terms, and - the second unifies with the atom obtained by concatenating all the - atomic terms in the first list. The first argument thus may contain - atoms or numbers. - - - */ - Yap_InitCPred("atomics_to_string", 2, atomics_to_string2, 0); - Yap_InitCPred("atomics_to_string", 3, atomics_to_string3, 0); - Yap_InitCPred("get_string_code", 3, get_string_code3, 0); - - Yap_InitCPred("downcase_text_to_atom", 2, downcase_text_to_atom, 0); - Yap_InitCPred("downcase_atom", 2, downcase_text_to_atom, 0); - Yap_InitCPred("upcase_text_to_atom", 2, upcase_text_to_atom, 0); - Yap_InitCPred("upcase_atom", 2, upcase_text_to_atom, 0); - Yap_InitCPred("downcase_text_to_string", 2, downcase_text_to_string, 0); - Yap_InitCPred("upcase_text_to_string", 2, upcase_text_to_string, 0); - Yap_InitCPred("downcase_text_to_codes", 2, downcase_text_to_codes, 0); - Yap_InitCPred("upcase_text_to_codes", 2, upcase_text_to_codes, 0); - Yap_InitCPred("downcase_text_to_chars", 2, downcase_text_to_chars, 0); - Yap_InitCPred("upcase_text_to_chars", 2, upcase_text_to_chars, 0); - - /* hiding and unhiding some predicates */ - Yap_InitCPred("hide_atom", 1, hide_atom, SafePredFlag | SyncPredFlag); - Yap_InitCPred("hide", 1, hide_atom, SafePredFlag | SyncPredFlag); - Yap_InitCPred("unhide_atom", 1, unhide_atom, SafePredFlag | SyncPredFlag); - Yap_InitCPred("$hidden_atom", 1, hidden_atom, - HiddenPredFlag | SafePredFlag | SyncPredFlag); -} - -/** -@} -*/ diff --git a/C/cdmgr.c b/C/cdmgr.c index 892459b53..858e304be 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1453,6 +1453,8 @@ static void addcl_permission_error(AtomEntry *ap, Int Arity, int in_use) { ti[1] = MkIntegerTerm(Arity); t = Yap_MkApplTerm(FunctorSlash, 2, ti); LOCAL_Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE; + LOCAL_ErrorMessage = Malloc( 256 ); + if (in_use) { if (Arity == 0) sprintf(LOCAL_ErrorMessage, "static predicate %s is in use", ap->StrOfAE); diff --git a/C/cmppreds.c b/C/cmppreds.c index d650e4410..093412031 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -379,7 +379,6 @@ inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */ if (IsExtensionFunctor(f)) return 1; else { - int out; if (f != FunctorDot) return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE); else { @@ -596,10 +595,10 @@ inline static Int flt_cmp(Float dif) { static Int a_cmp(Term t1, Term t2 USES_REGS) { if (IsVarTerm(t1)) { - Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" ); + Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" ); } if (IsVarTerm(t2)) { - Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" ); + Yap_ThrowError( INSTANTIATION_ERROR, t1, 4, "while doing arithmetic comparison" ); } if (IsFloatTerm(t1) && IsFloatTerm(t2)) { return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2)); @@ -622,7 +621,7 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); } #endif return flt_cmp(i1 - f2); @@ -637,7 +636,7 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) { Float f1 = FloatOfTerm(t1); #if HAVE_ISNAN if (isnan(f1)) { - Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, "trying to evaluate nan" ); + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, 4, "trying to evaluate nan" ); } #endif t2 = Yap_Eval(t2); @@ -653,7 +652,7 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); } #endif return flt_cmp(f1 - f2); @@ -675,7 +674,7 @@ static Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, 4, "trying to evaluate nan" ); } #endif return Yap_gmp_cmp_big_float(t1, f2); diff --git a/C/compiler.c b/C/compiler.c index 29735c82e..77d8906a3 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -1103,16 +1103,14 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Int i2; if (!IsIntegerTerm(t2)) { - char s[32]; - Yap_ThrowError( TYPE_ERROR_INTEGER, t2, "compiling functor/3"); + Yap_Error( TYPE_ERROR_INTEGER, t2, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } i2 = IntegerOfTerm(t2); if (i2 < 0) { - char s[32]; - Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO , t2, "compiling functor/3"); + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO , t2,4, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } diff --git a/C/errors.c b/C/errors.c index 3e00393b1..6d8aac85b 100755 --- a/C/errors.c +++ b/C/errors.c @@ -311,11 +311,11 @@ yap_error_descriptor_t *Yap_popErrorContext(void) { } void Yap_ThrowError__(const char *file, const char *function, int lineno, - yap_error_number type, Term where, ...) { + yap_error_number type, Term where, int code, ...) { va_list ap; char tmpbuf[MAXPATHLEN]; - va_start(ap, where); + va_start(ap, code); char *format = va_arg(ap, char *); if (format != NULL) { #if HAVE_VSNPRINTF @@ -328,7 +328,7 @@ Yap_Error__(file, function, lineno, type, where, tmpbuf); } else { Yap_Error__(file, function, lineno, type, where); } - siglongjmp(LOCAL_RestartEnv, 2); + siglongjmp(LOCAL_RestartEnv, code); } /** @@ -560,8 +560,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, /* This is used by some complex procedures to detect there was an error */ if (IsAtomTerm(nt[0])) { - strncpy(LOCAL_ErrorMessage, (char *)RepAtom(AtomOfTerm(nt[0]))->StrOfAE, - MAX_ERROR_MSG_SIZE); + LOCAL_ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE; } else { LOCAL_ErrorMessage = (char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE; diff --git a/C/eval.c b/C/eval.c index 72eecf918..b4c08d13d 100644 --- a/C/eval.c +++ b/C/eval.c @@ -93,7 +93,7 @@ static Term get_matrix_element(Term t1, Term t2 USES_REGS) { static Term Eval(Term t USES_REGS) { if (IsVarTerm(t)) { - return Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic"); + Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic"); } else if (IsNumTerm(t)) { return t; } else if (IsAtomTerm(t)) { @@ -101,7 +101,7 @@ static Term Eval(Term t USES_REGS) { Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), + Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } @@ -112,10 +112,10 @@ static Term Eval(Term t USES_REGS) { const char *s = (const char *)StringOfTerm(t); if (s[1] == '\0') return MkIntegerTerm(s[0]); - return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, + Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string in arithmetic expression"); } else if ((Atom)fun == AtomFoundVar) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, + Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "cyclic term in arithmetic expression"); } else { Int n = ArityOfFunctor(fun); @@ -124,7 +124,7 @@ static Term Eval(Term t USES_REGS) { Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), + Yap_ArithError(TYPE_ERROR_EVALUABLE, takeIndicator(t), "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE, n); } @@ -153,7 +153,7 @@ static Term Eval(Term t USES_REGS) { } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { - return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, + Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be " "evaluated as an arithmetic expression"); } @@ -369,32 +369,6 @@ static Int p_logsum(USES_REGS1) { /* X is Y */ } } -Int Yap_ArithError__(const char *file, const char *function, int lineno, - yap_error_number type, Term where, ...) { - CACHE_REGS - va_list ap; - char *format; - char buf[MAX_ERROR_MSG_SIZE]; - - LOCAL_Error_TYPE = type; - LOCAL_Error_File = file; - LOCAL_Error_Function = function; - LOCAL_Error_Lineno = lineno; - va_start(ap, where); - format = va_arg(ap, char *); - if (format != NULL) { -#if HAVE_VSNPRINTF - (void)vsnprintf(buf, MAX_ERROR_MSG_SIZE, format, ap); -#else - (void)vsprintf(buf, format, ap); -#endif - } else { - buf[0] = '\0'; - } - va_end(ap); - return 0L; -} - yamop *Yap_EvalError__(const char *file, const char *function, int lineno, yap_error_number type, Term where, ...) { CACHE_REGS diff --git a/C/exec.c b/C/exec.c index b6f61030b..fa669c67a 100755 --- a/C/exec.c +++ b/C/exec.c @@ -292,7 +292,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) { Term t2 = ArgOfTerm(2, t); if (IsVarTerm(t2)) return CallMetaCall(t, mod PASS_REGS); - if (!CommaCall(t2, mod)) + if (1 || !CommaCall(t2, mod)) return CallMetaCall(t, mod PASS_REGS); Term t1 = ArgOfTerm(1, t); @@ -315,6 +315,9 @@ inline static bool do_execute(Term t, Term mod USES_REGS) { /* I cannot use the standard macro here because otherwise I would dereference the argument and might skip a svar */ + if (pen->PredFlags & MetaPredFlag) { + return CallMetaCall(t, mod PASS_REGS); + } pt = RepAppl(t) + 1; for (i = 1; i <= arity; i++) { #if YAPOR_SBA @@ -1441,19 +1444,23 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { LOCAL_PrologMode = UserMode; P = (yamop *)FAILCODE; } break; - case 2: { - /* arithmetic exception */ - /* must be done here, otherwise siglongjmp will clobber all the - * registers - */ - Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); - /* reset the registers so that we don't have trash in abstract - * machine */ - Yap_set_fpu_exceptions( - getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); - P = (yamop *)FAILCODE; - LOCAL_PrologMode = UserMode; - } break; + case 2: { + /* arithmetic exception */ + /* must be done here, otherwise siglongjmp will clobber all the + * registers + */ + Yap_Error(LOCAL_Error_TYPE, TermNil, NULL); + /* reset the registers so that we don't have trash in abstract + * machine */ + Yap_set_fpu_exceptions( + getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); + P = (yamop *)FAILCODE; + LOCAL_PrologMode = UserMode; + } break; + case 4: { + P = (yamop *)FAILCODE; + LOCAL_PrologMode = UserMode; + } break; case 3: { /* saved state */ LOCAL_CBorder = OldBorder; return false; @@ -2074,16 +2081,15 @@ static Int jump_env(USES_REGS1) { Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound"); return false; } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) { - Term t2; + Term t2, te; Yap_find_prolog_culprit(PASS_REGS1); - LOCAL_Error_TYPE = ERROR_EVENT; - t = ArgOfTerm(1, t); - if (IsApplTerm(t) && IsAtomTerm((t2 = ArgOfTerm(1, t)))) { + te = ArgOfTerm(1, t); + if (IsApplTerm(te) && IsAtomTerm((t2 = ArgOfTerm(1, te)))) { LOCAL_ActiveError->errorAsText = AtomOfTerm(t2); - LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t)); - } else if (IsAtomTerm(t)) { - LOCAL_ActiveError->errorAsText = AtomOfTerm(t); + LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(te)); + } else if (IsAtomTerm(te)) { + LOCAL_ActiveError->errorAsText = AtomOfTerm(te); LOCAL_ActiveError->classAsText = NULL; } } else { diff --git a/C/globals.c b/C/globals.c index 07b74511c..9897a3221 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1654,7 +1654,8 @@ static Int p_nb_queue_close(USES_REGS1) { return Yap_unify(ARG3, ARG2); } out = Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG2, qp[QUEUE_HEAD]); - qp[QUEUE_HEAD] = qp[QUEUE_TAIL] = RESET_VARIABLE(qp + QUEUE_TAIL); + RESET_VARIABLE(qp + QUEUE_TAIL); + qp[QUEUE_HEAD] = qp[QUEUE_TAIL] = (CELL)(qp + QUEUE_TAIL); qp[QUEUE_SIZE] = MkIntTerm(0); return out; } diff --git a/C/gmp_support.c b/C/gmp_support.c index 5de3d4f8b..167802cb1 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -32,7 +32,7 @@ MkBigAndClose(MP_INT *new) Term t = Yap_MkBigIntTerm(new); mpz_clear(new); if (t == TermNil) { - return Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2"); + Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2"); } return t; } @@ -43,7 +43,7 @@ MkRatAndClose(MP_RAT *new) Term t = Yap_MkBigRatTerm(new); mpq_clear(new); if (t == TermNil) { - return Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2"); + Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2"); } return t; } @@ -243,7 +243,7 @@ Yap_gmp_div_big_int(Term t, Int i) if (i > 0) { mpz_tdiv_q_ui(&new, &new, i); } else if (i == 0) { - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); } else { /* we do not handle MIN_INT */ mpz_tdiv_q_ui(&new, &new, -i); @@ -253,7 +253,7 @@ Yap_gmp_div_big_int(Term t, Int i) if (i > 0) { mpz_fdiv_q_ui(&new, &new, i); } else if (i == 0) { - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); } else { /* we do not handle MIN_INT */ mpz_fdiv_q_ui(&new, &new, -i); @@ -285,7 +285,7 @@ Yap_gmp_div2_big_int(Term t, Int i) if (i > 0) { mpz_fdiv_q_ui(&new, &new, i); } else if (i == 0) { - return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); + Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); } else { /* we do not handle MIN_INT */ mpz_fdiv_q_ui(&new, &new, -i); @@ -311,7 +311,7 @@ Yap_gmp_and_int_big(Int i, Term t) CELL *pt = RepAppl(t); MP_INT *b; if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "/\\/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "/\\/2"); } b = Yap_BigIntOfTerm(t); @@ -328,7 +328,7 @@ Yap_gmp_ior_int_big(Int i, Term t) CELL *pt = RepAppl(t); MP_INT *b; if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\/ /2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\/ /2"); } b = Yap_BigIntOfTerm(t); @@ -367,7 +367,7 @@ Yap_gmp_xor_int_big(Int i, Term t) CELL *pt = RepAppl(t); MP_INT *b; if (pt[1] != BIG_INT) { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/2"); } b = Yap_BigIntOfTerm(t); @@ -394,7 +394,7 @@ Yap_gmp_sll_big_int(Term t, Int i) mpz_init(&new); if (i == Int_MIN) { CACHE_REGS - return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, MkIntegerTerm(i), "< 0) { @@ -992,7 +992,7 @@ Yap_gmp_exp_int_big(Int i, Term t) CACHE_REGS CELL *pt = RepAppl(t); if (pt[1] == BIG_INT) { - return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t, "^/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t, "^/2"); } else { MP_INT *b = Yap_BigIntOfTerm(t); Float dbl = mpz_get_d(b); @@ -1009,7 +1009,7 @@ Yap_gmp_exp_big_big(Term t1, Term t2) Float dbl1, dbl2; if (pt1[1] == BIG_INT && pt2[1] == BIG_INT) { - return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); } else { if (pt1[1] != BIG_INT) { dbl1 = mpz_get_d(Yap_BigIntOfTerm(t1)); @@ -1476,7 +1476,7 @@ Yap_gmp_unot_big(Term t) mpz_com(&new, &new); return MkBigAndClose(&new); } else { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/1"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "#/1"); } } @@ -1571,7 +1571,7 @@ Yap_gmp_float_fractional_part(Term t) { CELL *pt = RepAppl(t); if (pt[1] == BIG_INT) { - return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", FloatOfTerm(t)); } else { MP_RAT *b = Yap_BigRatOfTerm(t); MP_RAT new; @@ -1591,7 +1591,7 @@ Yap_gmp_float_integer_part(Term t) { CELL *pt = RepAppl(t); if (pt[1] == BIG_INT) { - return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", FloatOfTerm(t)); + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", FloatOfTerm(t)); } else { MP_RAT *b = Yap_BigRatOfTerm(t); MP_INT new; @@ -1624,12 +1624,12 @@ Yap_gmp_lsb(Term t) if (pt[1] == BIG_INT) { MP_INT *big = Yap_BigIntOfTerm(t); if ( mpz_sgn(big) <= 0 ) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "lsb/1 received negative bignum"); } return MkIntegerTerm(mpz_scan1(big,0)); } else { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "lsb"); } } @@ -1641,12 +1641,12 @@ Yap_gmp_msb(Term t) if (pt[1] == BIG_INT) { MP_INT *big = Yap_BigIntOfTerm(t); if ( mpz_sgn(big) <= 0 ) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "msb/1 received negative bignum"); } return MkIntegerTerm(mpz_sizeinbase(big,2)); } else { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount"); } } @@ -1658,17 +1658,17 @@ Yap_gmp_popcount(Term t) if (pt[1] == BIG_INT) { MP_INT *big = Yap_BigIntOfTerm(t); if ( mpz_sgn(big) <= 0 ) { - return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, + Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "popcount/1 received negative bignum"); } return MkIntegerTerm(mpz_popcount(big)); } else { - return Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount"); + Yap_ArithError(TYPE_ERROR_INTEGER, t, "popcount"); } } char * -Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base) +Yap_mpz_to_string( MP_INT *b, char *s, size_t sz, int base) { if (s) { size_t size = mpz_sizeinbase(b, base); diff --git a/C/grow.c b/C/grow.c index e3e373d62..13e30ad11 100755 --- a/C/grow.c +++ b/C/grow.c @@ -832,7 +832,7 @@ static_growheap(size_t esize, bool fix_code, struct intermediates *cip, tr_fr_pt fprintf( stderr, "%% Worker Id %d:\n", worker_id); #endif fprintf( stderr, "%% Database Overflow %d\n", LOCAL_heap_overflows); - fprintf( stderr, "%% growing the heap %ld bytes\n", size); + fprintf( stderr, "%% growing the heap " Int_FORMAT " bytes\n", size); } /* CreepFlag is set to force heap expansion */ if ( Yap_only_has_signal( YAP_CDOVF_SIGNAL) ) { @@ -976,7 +976,7 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS) fprintf(stderr, "%% Worker Id %d:\n", worker_id); #endif fprintf(stderr, "%% %cO %s Overflow %d\n", vb_msg1, vb_msg2, LOCAL_delay_overflows); - fprintf(stderr, "%% %cO growing the stacks %ld bytes\n", vb_msg1, size); + fprintf(stderr, "%% %cO growing the stacks " UInt_FORMAT " bytes\n", vb_msg1, size); } ASP -= 256; YAPEnterCriticalSection(); @@ -1794,7 +1794,7 @@ static int do_growtrail(size_t esize, bool contiguous_only, bool in_parser, tr_f fprintf(stderr, "%% Trail:%8ld cells (%p-%p)\n", (unsigned long int)(TR-(tr_fr_ptr)LOCAL_TrailBase),LOCAL_TrailBase,TR); #endif - fprintf(stderr, "%% growing the trail %ld bytes\n", size); + fprintf(stderr, "%% growing the trail " UInt_FORMAT " bytes\n", size); } LOCAL_ErrorMessage = NULL; if (!GLOBAL_AllowTrailExpansion) { diff --git a/C/load_dll.c b/C/load_dll.c index 98facdb65..ea881df06 100755 --- a/C/load_dll.c +++ b/C/load_dll.c @@ -45,10 +45,10 @@ Yap_LoadForeignFile(char *file, int flags) void *ptr= (void *)LoadLibrary(file); if (!ptr) { CACHE_REGS - LOCAL_ErrorSay[0]='\0'; + LOCAL_ErrorMessage = NULL; FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, GetLastError(), - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), LOCAL_ErrorSay, 256, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), LOCAL_ErrorMessage, 256, NULL); } return ptr; @@ -86,13 +86,13 @@ LoadForeign(StringList ofiles, StringList libs, if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, true) && (handle=LoadLibrary(LOCAL_FileNameBuf)) != 0) { - LOCAL_ErrorSay[0]=~'\0'; + LOCAL_ErrorMessage = NULL; if (*init_proc == NULL) *init_proc = (YapInitProc)GetProcAddress((HMODULE)handle, proc_name); } else { FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, GetLastError(), - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), LOCAL_ErrorSay, 256, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), LOCAL_ErrorMessage, 256, NULL); //fprintf(stderr,"WinError: %s\n", LOCAL_ErrorSay); } @@ -124,7 +124,7 @@ LoadForeign(StringList ofiles, StringList libs, } if(*init_proc == NULL) { - strcpy(LOCAL_ErrorSay,"Could not locate initialization routine"); + LOCAL_ErrorMessage = "Could not locate initialization routine"; return LOAD_FAILLED; } diff --git a/C/modules.c b/C/modules.c index 5709ba07f..a35cd917b 100644 --- a/C/modules.c +++ b/C/modules.c @@ -370,16 +370,57 @@ static Int new_system_module(USES_REGS1) { } static Int strip_module(USES_REGS1) { - Term t1 = Deref(ARG1), tmod = CurrentModule; - if (tmod == PROLOG_MODULE) { - tmod = TermProlog; - } - t1 = Yap_StripModule(t1, &tmod); - if (!t1) { + Term t1 = Deref(ARG1), tmod = CurrentModule; + if (tmod == PROLOG_MODULE) { + tmod = TermProlog; + } + t1 = Yap_StripModule(t1, &tmod); + if (!t1) { + Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); + return FALSE; + } + return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod); +} + +static Int yap_strip_clause(USES_REGS1) { + Functor f; + Term t1 = Deref(ARG1), tmod = LOCAL_SourceModule; + if (tmod == PROLOG_MODULE) { + tmod = TermProlog; + } + t1 = Yap_StripModule(t1, &tmod); + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module"); + return false; + } else if (IsVarTerm(tmod)) { + Yap_Error(INSTANTIATION_ERROR, tmod, "trying to obtain module"); + return false; + } else if (IsIntTerm(t1) || (IsApplTerm(t1) && IsExtensionFunctor((f = FunctorOfTerm(t1))))) { Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); - return FALSE; - } - return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod); + return false; + } else if (!IsAtomTerm(tmod)) { + Yap_Error(TYPE_ERROR_ATOM, tmod, "trying to obtain module"); + return false; + } + if (f == FunctorAssert || f == FunctorDoubleArrow) { + Term thmod = tmod; + Term th = ArgOfTerm(1, t1); + th = Yap_StripModule(th, &thmod); + if (IsVarTerm(th)) { + Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module"); + return false; + } else if (IsVarTerm(thmod)) { + Yap_Error(INSTANTIATION_ERROR, thmod, "trying to obtain module"); + return false; + } else if (IsIntTerm(th) || (IsApplTerm(th) && IsExtensionFunctor(FunctorOfTerm(t1)))) { + Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); + return false; + }else if (!IsAtomTerm(thmod)) { + Yap_Error(TYPE_ERROR_ATOM, thmod, "trying to obtain module"); + return false; + } + } + return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod); } Term Yap_YapStripModule(Term t, Term *modp) { @@ -564,13 +605,14 @@ void Yap_InitModulesC(void) { SafePredFlag | SyncPredFlag); Yap_InitCPred("$change_module", 1, change_module, SafePredFlag | SyncPredFlag); - Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag); + Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag); + Yap_InitCPred("$yap_strip_module", 3, yap_strip_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("source_module", 1, source_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("current_source_module", 2, current_source_module, SafePredFlag | SyncPredFlag); - Yap_InitCPred("$yap_strip_module", 3, yap_strip_module, - SafePredFlag | SyncPredFlag); - Yap_InitCPred("context_module", 1, context_module, 0); + Yap_InitCPred("$yap_strip_clause", 3, yap_strip_clause, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("context_module", 1, context_module, 0); Yap_InitCPred("$is_system_module", 1, is_system_module, SafePredFlag); Yap_InitCPred("$copy_operators", 2, copy_operators, 0); Yap_InitCPred("new_system_module", 1, new_system_module, SafePredFlag); diff --git a/C/parser.c b/C/parser.c index b8c0c794e..e4001d273 100755 --- a/C/parser.c +++ b/C/parser.c @@ -168,7 +168,8 @@ static Term ParseArgs(Atom, Term, JMPBUFF *, Term, encoding_t, Term CACHE_TYPE); static Term ParseList(JMPBUFF *, encoding_t, Term CACHE_TYPE); static Term ParseTerm(int, JMPBUFF *, encoding_t, Term CACHE_TYPE); -const char *Yap_tokRep(void *tokptr, encoding_t enc); +extern Term Yap_tokRep(void* tokptr); +extern const char * Yap_tokText(void *tokptr); static void syntax_msg(const char *msg, ...) { CACHE_REGS @@ -366,6 +367,7 @@ static Term Variables(VarEntry *p, Term l USES_REGS) { Term Yap_Variables(VarEntry *p, Term l) { CACHE_REGS + l = Variables(LOCAL_AnonVarTable, l PASS_REGS); return Variables(p, l PASS_REGS); } @@ -466,7 +468,7 @@ inline static void checkfor(Term c, JMPBUFF *FailBuff, encoding_t enc USES_REGS) { if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || LOCAL_tokptr->TokInfo != c) { char s[1024]; - strncpy(s, Yap_tokRep(LOCAL_tokptr, enc), 1023); + strncpy(s, Yap_tokText(LOCAL_tokptr), 1023); syntax_msg("line %d: expected to find " "\'%c....................................\', found %s", LOCAL_tokptr->TokPos, c, s); @@ -654,7 +656,7 @@ loop: } } else { syntax_msg("line %d: looking for symbol ',','|' got symbol '%s'", - LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); + LOCAL_tokptr->TokPos, Yap_tokText(LOCAL_tokptr)); FAIL; } return (o); @@ -675,7 +677,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, NextToken; /* special rules apply for +1, -2.3, etc... */ if (LOCAL_tokptr->Tok == Number_tok) { - if ((Atom)t == AtomMinus) { + if (t == TermMinus) { t = LOCAL_tokptr->TokInfo; if (IsIntTerm(t)) t = MkIntTerm(-IntOfTerm(t)); @@ -698,7 +700,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, if (LOCAL_tokptr->Tok == Name_tok) { Atom at = AtomOfTerm(LOCAL_tokptr->TokInfo); #ifndef _MSC_VER - if ((Atom)t == AtomPlus) { + if (t == TermPlus) { if (at == AtomInf) { t = MkFloatTerm(INFINITY); NextToken; @@ -708,7 +710,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, NextToken; break; } - } else if ((Atom)t == AtomMinus) { + } else if (t == TermMinus) { if (at == AtomInf) { t = MkFloatTerm(-INFINITY); NextToken; @@ -764,7 +766,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, case Error_tok: syntax_msg("line %d: found ill-formed \"%s\"", LOCAL_tokptr->TokPos, - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; case Ponctuation_tok: @@ -806,7 +808,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, break; default: syntax_msg("line %d: unexpected ponctuation signal %s", - LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); + LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr)); FAIL; } break; @@ -851,12 +853,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, t = ParseTerm(GLOBAL_MaxPriority, FailBuff, enc, cmod PASS_REGS); if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { syntax_msg("expected to find quasi quotes, got \"%s\"", , - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } if (!(is_quasi_quotation_syntax(t, &at))) { syntax_msg("bad quasi quotation syntax, at \"%s\"", - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } /* Arg 2: the content */ @@ -866,7 +868,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)), &qq->text, qq->text + strlen((const char *)qq->text))) { syntax_msg("could not get quasi quotation, at \"%s\"", - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } if (positions) { @@ -878,7 +880,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, qq->mid.charno + 2, /* end of | token */ PL_INTPTR, qqend - 2)) /* end minus "|}" */ syntax_msg("failed to unify quasi quotation, at \"%s\"", - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } @@ -898,7 +900,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, break; default: syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos, - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } @@ -1013,7 +1015,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, } if (LOCAL_tokptr->Tok <= Ord(String_tok)) { syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos, - Yap_tokRep(LOCAL_tokptr, enc)); + Yap_tokText(LOCAL_tokptr)); FAIL; } break; @@ -1046,7 +1048,11 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { } if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { LOCAL_Error_TYPE = SYNTAX_ERROR; + if (LOCAL_tokptr->TokNext) { + LOCAL_ErrorMessage = "operator misssing . "; + } else { LOCAL_ErrorMessage = "term does not end on . "; + } t = 0; } if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) { diff --git a/C/prim_absmi_insts.h b/C/prim_absmi_insts.h index 00358ba10..fc10ba1a4 100644 --- a/C/prim_absmi_insts.h +++ b/C/prim_absmi_insts.h @@ -33,13 +33,13 @@ BEGP(pt0); deref_body(d0, pt0, plus_vv_unk, plus_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, plus_vv_nvar_unk, plus_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -67,7 +67,7 @@ BEGP(pt0); deref_body(d0, pt0, plus_vc_unk, plus_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -101,13 +101,13 @@ BEGP(pt0); deref_body(d0, pt0, plus_y_vv_unk, plus_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, plus_y_vv_nvar_unk, plus_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -138,7 +138,7 @@ BEGP(pt0); deref_body(d0, pt0, plus_y_vc_unk, plus_y_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -169,13 +169,13 @@ BEGP(pt0); deref_body(d0, pt0, minus_vv_unk, minus_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, minus_vv_nvar_unk, minus_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); ENDD(d1); @@ -203,7 +203,7 @@ BEGP(pt0); deref_body(d0, pt0, minus_cv_unk, minus_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -237,13 +237,13 @@ BEGP(pt0); deref_body(d0, pt0, minus_y_vv_unk, minus_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, minus_y_vv_nvar_unk, minus_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -274,7 +274,7 @@ BEGP(pt0); deref_body(d0, pt0, minus_y_cv_unk, minus_y_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -304,13 +304,13 @@ BEGP(pt0); deref_body(d0, pt0, times_vv_unk, times_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, times_vv_nvar_unk, times_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -338,7 +338,7 @@ BEGP(pt0); deref_body(d0, pt0, times_vc_unk, times_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -372,13 +372,13 @@ BEGP(pt0); deref_body(d0, pt0, times_y_vv_unk, times_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, times_y_vv_nvar_unk, times_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -409,7 +409,7 @@ BEGP(pt0); deref_body(d0, pt0, times_y_vc_unk, times_y_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -430,7 +430,7 @@ if (IsIntTerm(d0) && IsIntTerm(d1)) { Int div = IntOfTerm(d1); if (div == 0) { - Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR); + Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR,d1); } d0 = MkIntTerm(IntOfTerm(d0) / div); } else { @@ -444,13 +444,13 @@ BEGP(pt0); deref_body(d0, pt0, div_vv_unk, div_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, div_vv_nvar_unk, div_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -478,7 +478,7 @@ BEGP(pt0); deref_body(d0, pt0, div_vc_unk, div_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -494,7 +494,7 @@ if (IsIntTerm(d0)) { Int div = IntOfTerm(d0); if (div == 0) { - Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR); + Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR,d0); FAIL(); } d0 = MkIntegerTerm(d1 / div); @@ -509,7 +509,7 @@ BEGP(pt0); deref_body(d0, pt0, div_cv_unk, div_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -530,7 +530,7 @@ if (IsIntTerm(d0) && IsIntTerm(d1)) { Int div = IntOfTerm(d1); if (div == 0) { - Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR); + Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR, d0); FAIL(); } d0 = MkIntTerm(IntOfTerm(d0) / div); @@ -548,13 +548,13 @@ BEGP(pt0); deref_body(d0, pt0, div_y_vv_unk, div_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, div_y_vv_nvar_unk, div_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -585,7 +585,7 @@ BEGP(pt0); deref_body(d0, pt0, div_y_vc_unk, div_y_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -601,7 +601,7 @@ if (IsIntTerm(d0)) { Int div = IntOfTerm(d0); if (div == 0) { - Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR); + Yap_AsmError(EVALUATION_ERROR_ZERO_DIVISOR,d0); FAIL(); } d0 = MkIntegerTerm(d1 / div); @@ -651,13 +651,13 @@ BEGP(pt0); deref_body(d0, pt0, and_vv_unk, and_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, and_vv_nvar_unk, and_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -719,13 +719,13 @@ BEGP(pt0); deref_body(d0, pt0, and_y_vv_unk, and_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, and_y_vv_nvar_unk, and_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -787,13 +787,13 @@ BEGP(pt0); deref_body(d0, pt0, or_vv_unk, or_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, or_vv_nvar_unk, or_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -854,13 +854,13 @@ BEGP(pt0); deref_body(d0, pt0, or_y_vv_unk, or_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, or_y_vv_nvar_unk, or_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -926,13 +926,13 @@ BEGP(pt0); deref_body(d0, pt0, sll_vv_unk, sll_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, sll_vv_nvar_unk, sll_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -960,7 +960,7 @@ BEGP(pt0); deref_body(d0, pt0, sll_vc_unk, sll_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -991,7 +991,7 @@ BEGP(pt0); deref_body(d0, pt0, sll_cv_unk, sll_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1029,13 +1029,13 @@ BEGP(pt0); deref_body(d0, pt0, sll_y_vv_unk, sll_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, sll_y_vv_nvar_unk, sll_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -1066,7 +1066,7 @@ BEGP(pt0); deref_body(d0, pt0, sll_y_vc_unk, sll_y_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1100,7 +1100,7 @@ BEGP(pt0); deref_body(d0, pt0, sll_y_cv_unk, sll_y_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1135,13 +1135,13 @@ BEGP(pt0); deref_body(d0, pt0, slr_vv_unk, slr_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, slr_vv_nvar_unk, slr_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -1169,7 +1169,7 @@ BEGP(pt0); deref_body(d0, pt0, slr_vc_unk, slr_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1200,7 +1200,7 @@ BEGP(pt0); deref_body(d0, pt0, slr_cv_unk, slr_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1238,13 +1238,13 @@ BEGP(pt0); deref_body(d0, pt0, slr_y_vv_unk, slr_y_vv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); BEGP(pt0); deref_body(d1, pt0, slr_y_vv_nvar_unk, slr_y_vv_nvar_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); FAIL(); ENDP(pt0); ENDD(d1); @@ -1275,7 +1275,7 @@ BEGP(pt0); deref_body(d0, pt0, slr_y_vc_unk, slr_y_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt0); ENDD(d0); ENDOp(); @@ -1300,7 +1300,7 @@ } } if (d0 == 0L) { - Yap_AsmError(LOCAL_Error_TYPE); + Yap_AsmError(LOCAL_Error_TYPE,d0); FAIL(); } BEGP(pt0); @@ -1312,7 +1312,7 @@ BEGP(pt0); deref_body(d0, pt0, slr_y_cv_unk, slr_y_cv_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); FAIL(); ENDP(pt0); ENDD(d0); @@ -1968,7 +1968,7 @@ } else { if (IsBigIntTerm(d0)) FAIL(); - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, d0); FAIL(); } @@ -1984,7 +1984,7 @@ pt0 = RepAppl(d1); d1 = *pt0; if (IsExtensionFunctor((Functor)d1)) { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND, AbsAppl(pt0)); FAIL(); } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor)d1)) { @@ -2007,7 +2007,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); pt0 = RepPair(d1); if (d0 != 1 && d0 != 2) { if ((Int)d0 < 0) { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(d0) ); } FAIL(); } @@ -2016,14 +2016,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); GONext(); ENDP(pt0); } else { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND, d1); FAIL(); } BEGP(pt0); deref_body(d1, pt0, arg_arg2_unk, arg_arg2_nvar); saveregs(); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ; setregs(); ENDP(pt0); @@ -2033,7 +2033,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt0); deref_body(d0, pt0, arg_arg1_unk, arg_arg1_nvar); saveregs(); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ; setregs(); ENDP(pt0); @@ -2068,7 +2068,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); pt0 = RepAppl(d1); d1 = *pt0; if (IsExtensionFunctor((Functor)d1)) { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND,XREG(PREG->y_u.xxn.xi)); FAIL(); } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor)d1)) { @@ -2092,7 +2092,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (d0 != 1 && d0 != 2) { if ((Int)d0 < 0) { saveregs(); - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, XREG(PREG->y_u.xxn.xi)); } FAIL(); } @@ -2101,13 +2101,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); GONext(); ENDP(pt0); } else { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND, XREG(PREG->y_u.xxn.xi)); FAIL(); } BEGP(pt0); deref_body(d1, pt0, arg_arg2_vc_unk, arg_arg2_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR, XREG(PREG->y_u.xxn.xi)); ENDP(pt0); FAIL(); ENDD(d1); @@ -2138,7 +2138,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else { if (IsBigIntTerm(d0)) FAIL(); - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, XREG(PREG->y_u.yxx.x1)); FAIL(); } @@ -2154,7 +2154,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); pt0 = RepAppl(d1); d1 = *pt0; if (IsExtensionFunctor((Functor)d1)) { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND,XREG(PREG->y_u.yxx.x2)); FAIL(); } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor)d1)) { @@ -2181,7 +2181,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (d0 != 1 && d0 != 2) { if ((Int)d0 < 0) { saveregs(); - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, YREG[PREG->y_u.yxx.y]); } FAIL(); } @@ -2193,20 +2193,20 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); ENDP(pt1); ENDP(pt0); } else { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND, d1); FAIL(); } BEGP(pt0); deref_body(d1, pt0, arg_y_arg2_unk, arg_y_arg2_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt0); FAIL(); ENDD(d1); BEGP(pt0); deref_body(d0, pt0, arg_y_arg1_unk, arg_y_arg1_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt0); FAIL(); ENDD(d0); @@ -2240,7 +2240,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); pt0 = RepAppl(d1); d1 = *pt0; if (IsExtensionFunctor((Functor)d1)) { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND, XREG(PREG->y_u.yxn.xi)); FAIL(); } if ((Int)d0 <= 0 || (Int)d0 > ArityOfFunctor((Functor)d1)) { @@ -2264,7 +2264,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (d0 != 1 && d0 != 2) { if ((Int)d0 < 0) { saveregs(); - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, YREG[PREG->y_u.yxn.y]); } FAIL(); } @@ -2276,13 +2276,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); GONext(); ENDP(pt0); } else { - Yap_AsmError(TYPE_ERROR_COMPOUND); + Yap_AsmError(TYPE_ERROR_COMPOUND,YREG[PREG->y_u.yxn.y]); FAIL(); } BEGP(pt0); deref_body(d1, pt0, arg_y_arg2_vc_unk, arg_y_arg2_vc_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt0); FAIL(); ENDD(d1); @@ -2320,15 +2320,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); saveregs(); if (IsBigIntTerm(d1)) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK,d1); } else { setregs(); - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER,d1); } FAIL(); } if (!IsAtomicTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } /* We made it!!!!! we got in d0 the name, in d1 the arity and @@ -2346,7 +2346,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else if ((Int)d1 > 0) { /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } BEGP(pt1); @@ -2363,7 +2363,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG, xxx), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1 ); JMPNext(); } else { setregs(); @@ -2387,12 +2387,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx), Osbpp), l); GONext(); } else { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(d1)); } BEGP(pt1); deref_body(d1, pt1, func2s_unk2, func2s_nvar2); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt1); /* Oops, third argument was unbound */ FAIL(); @@ -2400,7 +2400,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2s_unk, func2s_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -2435,10 +2435,10 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); saveregs(); if (IsBigIntTerm(d1)) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); } else { setregs(); - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, d1); } FAIL(); } @@ -2457,7 +2457,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else if ((Int)d1 > 0) { /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } BEGP(pt1); @@ -2474,7 +2474,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG, xxc), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); JMPNext(); } else { setregs(); @@ -2498,12 +2498,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc), Osbpp), l); GONext(); } else { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,d1); } BEGP(pt1); deref_body(d1, pt1, func2s_unk2_cv, func2s_nvar2_cv); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt1); /* Oops, third argument was unbound */ FAIL(); @@ -2537,7 +2537,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGD(d1); d1 = PREG->y_u.xxn.c; if (!IsAtomicTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } /* We made it!!!!! we got in d0 the name, in d1 the arity and @@ -2560,7 +2560,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); GONext(); } if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } BEGP(pt1); @@ -2576,7 +2576,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); saveregs(); if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG, xxn), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(INSTANTIATION_ERROR,d1); JMPNext(); } else { setregs(); @@ -2599,7 +2599,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2s_unk_vc, func2s_nvar_vc); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -2636,15 +2636,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); saveregs(); if (IsBigIntTerm(d1)) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); } else { setregs(); - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, d1); } FAIL(); } if (!IsAtomicTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } /* We made it!!!!! we got in d0 the name, in d1 the arity and @@ -2663,7 +2663,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else if ((Int)d1 > 0) { /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM, d0); FAIL(); } BEGP(pt1); @@ -2680,7 +2680,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG, yxx), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); JMPNext(); } else { setregs(); @@ -2710,12 +2710,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); ENDP(pt1); GONext(); } else { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(d1)); } BEGP(pt1); deref_body(d1, pt1, func2s_y_unk2, func2s_y_nvar2); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt1); /* Oops, third argument was unbound */ FAIL(); @@ -2723,7 +2723,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2s_y_unk, func2s_y_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -2756,9 +2756,9 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); d1 = IntegerOfTerm(d1); } else { if (IsBigIntTerm(d1)) { - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); } else { - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, d1); } FAIL(); } @@ -2780,7 +2780,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else if ((Int)d1 > 0) { /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } if (!IsAtomTerm(d0)) { @@ -2797,7 +2797,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG, yxc), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); JMPNext(); } else { setregs(); @@ -2827,12 +2827,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); ENDP(pt1); GONext(); } else { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(d1)); } BEGP(pt1); deref_body(d1, pt1, func2s_y_unk_cv, func2s_y_nvar_cv); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt1); /* Oops, third argument was unbound */ FAIL(); @@ -2866,7 +2866,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGD(d1); d1 = PREG->y_u.yxn.c; if (!IsAtomicTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } /* We made it!!!!! we got in d0 the name, in d1 the arity and @@ -2894,12 +2894,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); GONext(); } if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } BEGP(pt1); @@ -2916,7 +2916,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG, yxn), Osbpp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(RESOURCE_ERROR_STACK, d1); JMPNext(); } else { setregs(); @@ -2942,7 +2942,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2s_y_unk_vc, func2s_y_nvar_vc); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -2990,7 +2990,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2f_xx_unk, func2f_xx_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -3041,7 +3041,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2f_xy_unk, func2f_xy_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -3092,7 +3092,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2f_yx_unk, func2f_yx_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -3146,7 +3146,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func2f_yy_unk, func2f_yy_nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); @@ -3250,11 +3250,11 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (IsIntTerm(d1)) d1 = IntOfTerm(d1); else { - Yap_AsmError(TYPE_ERROR_INTEGER); + Yap_AsmError(TYPE_ERROR_INTEGER, d1); FAIL(); } if (!IsAtomicTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } /* We made it!!!!! we got in d0 the name, in d1 the arity and * in pt0 the variable to bind it to. */ @@ -3266,7 +3266,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); } else if ((Int)d1 > 0) { /* now let's build a compound term */ if (!IsAtomTerm(d0)) { - Yap_AsmError(TYPE_ERROR_ATOM); + Yap_AsmError(TYPE_ERROR_ATOM,d0); FAIL(); } BEGP(pt1); @@ -3283,7 +3283,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); if (!Yap_gcl((1 + d1) * sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG, e), Osbmp))) { setregs(); - Yap_AsmError(RESOURCE_ERROR_STACK); + Yap_AsmError(INSTANTIATION_ERROR,d1); } else { setregs(); } @@ -3297,7 +3297,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); HR = pt1; ENDP(pt1); } else if ((Int)d1 < 0) { - Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO); + Yap_AsmError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(d1)); FAIL(); } /* else if arity is 0 just pass d0 through */ @@ -3308,7 +3308,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d1, pt1, func_var_3unk, func_var_3nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d1); ENDP(pt1); /* Oops, third argument was unbound */ FAIL(); @@ -3316,7 +3316,7 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO ); BEGP(pt1); deref_body(d0, pt1, func_var_2unk, func_var_2nvar); - Yap_AsmError(INSTANTIATION_ERROR); + Yap_AsmError(INSTANTIATION_ERROR,d0); ENDP(pt1); /* Oops, second argument was unbound too */ FAIL(); diff --git a/C/scanner.c b/C/scanner.c index 0b661653a..015d7c72b 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -457,6 +457,7 @@ static void Yap_setCurrentSourceLocation(struct stream_desc *s) { char_kind_t Yap_chtype0[NUMBER_OF_CHARS + 1] = { EF, /* nul soh stx etx eot enq ack bel bs ht nl vt np cr so si + */ BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, @@ -630,18 +631,6 @@ static char *AllocScannerMemory(unsigned int size) { return AuxSpScan; } -static void PopScannerMemory(char *block, unsigned int size) { - CACHE_REGS - if (block == LOCAL_ScannerStack - size) { - LOCAL_ScannerStack -= size; - } else if (block == (char *)(LOCAL_ScannerExtraBlocks + 1)) { - struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; - - LOCAL_ScannerExtraBlocks = ptr->next; - free(ptr); - } -} - char *Yap_AllocScannerMemory(unsigned int size) { /* I assume memory has been initialized */ return AllocScannerMemory(size); @@ -1111,13 +1100,12 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, int sign) { /* given a function getchr scan until we either find the number or end of file */ -Term Yap_scan_num(StreamDesc *inp) { +Term Yap_scan_num(StreamDesc *inp, bool error_on) { CACHE_REGS Term out; int sign = 1; int ch, cherr; - char *ptr, *mp; - int kind; + char *ptr; void *old_tr = TR; InitScannerMemory(); @@ -1127,8 +1115,8 @@ Term Yap_scan_num(StreamDesc *inp) { LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; return 0; } -#if HAVE_ISWBLANK - while (iswblank(ch = getchr(inp))) +#if HAVE_ISWSPACE + while (iswspace(ch = getchr(inp))) ; #else while (isspace(ch = getchr(inp))) @@ -1151,64 +1139,22 @@ Term Yap_scan_num(StreamDesc *inp) { return 0; } out = get_num(&ch, &cherr, inp, sign); /* */ - } - if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) { - CACHE_REGS - char *s = ptr; - int sign = 1; - + } else { out = 0; - if (s[0] == '+') { - s++; - } - if (s[0] == '-') { - s++; - sign = -1; - } - if (strcmp(s, "inf") == 0) { - if (sign > 0) { - out = MkFloatTerm(INFINITY); - } else { - out = MkFloatTerm(-INFINITY); - } - } - if (strcmp(s, "nan") == 0) { - if (sign > 0) { - out = MkFloatTerm(NAN); - } else { - out = MkFloatTerm(-NAN); - } - } - if (out == 0) { - TokEntry *e, *ef; - size_t len = strlen(ptr); - mp = AllocScannerMemory(len + 1); - tokptr->Tok = Ord(kind = String_tok); - tokptr->TokInfo = MkStringTerm(mp); - e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); - ef = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); - tokptr->TokNext = e; - e->Tok = Error_tok; - if (!LOCAL_ErrorMessage) { - LOCAL_ErrorMessage = - "syntax error while converting from a string to a number"; - } - e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); - e->TokPos = GetCurInpPos(inp); - e->TokNext = ef; - ef->Tok = Ord(kind = eot_tok); - ef->TokInfo = TermSyntaxError; - ef->TokPos = GetCurInpPos(inp); - ef->TokNext = NULL; - LOCAL_tokptr = tokptr; - LOCAL_toktide = e; - Yap_JumpToEnv( - Yap_syntax_error(e, inp - GLOBAL_Stream) ); - LOCAL_Error_TYPE = SYNTAX_ERROR; - } } - PopScannerMemory(ptr, 4096); - Yap_clean_tokenizer(old_tr, NULL, NULL); +#if HAVE_ISWSPACE + while (iswspace(ch = getchr(inp))) + ; +#else + while (isspace(ch = getchr(inp))) + ; +#endif + if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) { + Yap_clean_tokenizer(old_tr, NULL, NULL); + if (error_on) + Yap_Error(SYNTAX_ERROR, ARG2, "converting number"); + return 0; + } return out; } @@ -1225,35 +1171,86 @@ Term Yap_scan_num(StreamDesc *inp) { return l; \ } -const char *Yap_tokRep(void *tokptre, encoding_t encoding) { - CACHE_REGS - TokEntry *tokptr = tokptre; - Term info = tokptr->TokInfo; - size_t length; - UInt flags = 0; - - switch (tokptr->Tok) { - case Name_tok: - case Number_tok: - case Ponctuation_tok: - case String_tok: - case BQString_tok: - return Yap_TermToString(info, &length, encoding, flags); - case Var_tok: - { - VarEntry *varinfo = (VarEntry *)info; - varinfo->VarAdr = TermNil; - return RepAtom(varinfo->VarRep)->StrOfAE; - } - case Error_tok: - return ""; - case eot_tok: - return ""; - case QuasiQuotes_tok: - return ""; - } +Term Yap_tokRep(void *tokptre) { + CACHE_REGS + TokEntry *tokptr = tokptre; + Term info = tokptr->TokInfo; + + switch (tokptr->Tok) { + case Name_tok: + if (!info) { + info = TermNil; + } + return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info); + case QuasiQuotes_tok: + info = MkAtomTerm(Yap_LookupAtom("")); + return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info); + case Number_tok: + return Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, &info); + break; + case Var_tok: { + Term t[2]; + VarEntry *varinfo = (VarEntry *)info; + if ((t[0]= varinfo->VarAdr) == TermNil) { + t[0] = varinfo->VarAdr = MkVarTerm(); + } + t[1] = MkAtomTerm((Atom)(varinfo->VarRep)); + return Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); + } + case String_tok: + return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); + case BQString_tok: + return Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); + case Error_tok: + return MkAtomTerm(AtomError); + case eot_tok: + return MkAtomTerm(Yap_LookupAtom("EOT")); + case Ponctuation_tok: + return info; + } + return TermDot; } + +const char * Yap_tokText(void *tokptre) { + CACHE_REGS + TokEntry *tokptr = tokptre; + Term info = tokptr->TokInfo; + + switch (tokptr->Tok) { + case eot_tok: + return "EOT"; + case Ponctuation_tok: + case Error_tok: + case BQString_tok: + case String_tok: + case Name_tok: + return AtomOfTerm(info)->StrOfAE; + case QuasiQuotes_tok: + return ""; + case Number_tok: + if (IsIntegerTerm(info)) { + char *s = Malloc(36); + snprintf(s, 35, Int_FORMAT, IntegerOfTerm(info)); + return s; + }else if (IsFloatTerm(info)) { + char *s = Malloc( 64); + snprintf(s, 63, "%6g", FloatOfTerm(info)); + return s; + } else { + size_t len = Yap_gmp_to_size(info,10); + char *s = Malloc(len+2); + return Yap_gmp_to_string(info,s, len+1,10); + } + break; + case Var_tok: + if (info == 0) return "[]"; + return ((Atom)info)->StrOfAE; + } + return "."; +} + + static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) { CELL *h0 = HR; HR += 5; @@ -1314,6 +1311,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, int solo_flag = TRUE; int32_t ch, och; struct qq_struct_t *cur_qq = NULL; + int sign = 1; InitScannerMemory(); LOCAL_VarTable = NULL; @@ -1331,7 +1329,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, do { int quote, isvar; unsigned char *charp, *mp; - unsigned int len; + size_t len; unsigned char *TokImage = NULL; t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); @@ -1396,8 +1394,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, int32_t och = ch; ch = getchr(inp_stream); size_t sz = 512; - scan_name: TokImage = Malloc(sz PASS_REGS); + scan_name: charp = (unsigned char *)TokImage; isvar = (chtype(och) != LC); add_ch_to_buff(och); @@ -1446,13 +1444,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } break; - case NU: { + case NU: { int cherr; - int cha = ch; + int cha; + sign = 1; - cherr = 0; + scan_number: + cha = ch; + cherr = 0; CHECK_SPACE(); - if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, 1)) == 0L) { + if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, sign)) == 0L) { if (p) { p->Tok = eot_tok; t->TokInfo = TermError; @@ -1479,7 +1480,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, case 'e': case 'E': och = cherr; - goto scan_name; + TokImage = Malloc(1024 PASS_REGS); + goto scan_name; break; case '=': case '_': @@ -1511,6 +1513,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, { TokEntry *e2; + if (chtype(ch) == NU) { + if (och == '-') + sign = -1; + else + sign = 1; + goto scan_number; + } t->Tok = Name_tok; if (ch == '(') solo_flag = FALSE; @@ -1558,7 +1567,9 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, LOCAL_ErrorMessage = "layout character \n inside quotes"; break; } - + if (ch == EOFCHAR) { + break; + } if (ch == quote) { ch = getchrq(inp_stream); if (ch != quote) @@ -1627,23 +1638,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, break; case SY: { int pch; - if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) && - (chtype(pch) == BS || chtype(pch) == EF || pch == '%')) { - t->Tok = Ord(kind = eot_tok); - // consume... - if (pch == '%') { - t->TokInfo = TermNewLine; - return l; + if (ch == '.' && (pch = Yap_peek(inp_stream - GLOBAL_Stream)) && + (chtype(pch) == BS || chtype(pch) == EF || pch == '%')) { + t->Tok = Ord(kind = eot_tok); + // consume... + if (pch == '%') { + t->TokInfo = TermNewLine; + return l; + } + return l; } - ch = getchr(inp_stream); - if (chtype(ch) == EF) { - mark_eof(inp_stream); - t->TokInfo = TermEof; - } else { - t->TokInfo = TermNewLine; - } - return l; - } if (ch == '`') goto quoted_string; och = ch; @@ -1664,7 +1668,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, return l; } } - if (och == '/' && ch == '*') { + if (och == '/' && ch == '*') { if (store_comments) { CHECK_SPACE(); open_comment('/', inp_stream PASS_REGS); @@ -1721,7 +1725,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, return l; } else { Atom ae; - size_t sz = 1024; + sz = 1024; TokImage = Malloc(sz); charp = TokImage; add_ch_to_buff(och); @@ -1949,13 +1953,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t->Tok = Ord(kind = eot_tok); t->TokInfo = TermEof; } -#if DEBUG - if (GLOBAL_Option[2]) { - static int n; - fprintf(stderr, "[Token %d %s %d]", Ord(kind), - Yap_tokRep(t, inp_stream->encoding), n++); - } -#endif if (LOCAL_ErrorMessage) { /* insert an error token to inform the system of what happened */ TokEntry *e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); diff --git a/C/text.c b/C/text.c index 6034c3e1d..d6f361ebf 100644 --- a/C/text.c +++ b/C/text.c @@ -206,7 +206,7 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp, (*atoms)++; if (*atoms < length) { *tailp = l; - return -TYPE_ERROR_NUMBER; + return -REPRESENTATION_ERROR_CHARACTER_CODE; } else { AtomEntry *ae = RepAtom(AtomOfTerm(hd)); if ((ae->StrOfAE)[1] != '\0') { @@ -219,10 +219,10 @@ static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp, } else if (IsIntegerTerm(hd)) { ch = IntegerOfTerm(hd); if (*atoms) - length = -TYPE_ERROR_ATOM; + length = -REPRESENTATION_ERROR_CHARACTER; else if (ch < 0) { *tailp = l; - length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + length = -REPRESENTATION_ERROR_CHARACTER_CODE; } else { *wide |= ch > 0x80; } @@ -386,30 +386,34 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); Atom at = AtomOfTerm(inp->val.t); + if (lengp) + *lengp = strlen_utf8(at->UStrOfAE); return at->UStrOfAE; } if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); - return (unsigned char *)UStringOfTerm(inp->val.t); + if (lengp) + *lengp = strlen_utf8(UStringOfTerm(inp->val.t)); + return (unsigned char *)UStringOfTerm(inp->val.t); } if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == (YAP_STRING_CODES | YAP_STRING_ATOMS)) && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return inp->val.uc = + return Yap_ListToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a sfer, and representation is wide } if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return inp->val.uc = Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, + return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a sfer, and representation is wide } if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - return inp->val.uc = Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, + return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide, lengp PASS_REGS); // this is a term, extract to a buffer, and representation is wide } @@ -426,22 +430,23 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) { AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); } *lengp = strlen(s); - Malloc(*lengp); - return inp->val.uc = (unsigned char *)s; + return (unsigned char *)s; } if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { char *s; + size_t sz = 1024; // Yap_DebugPlWriteln(inp->val.t); if (s0) - s = (char *)s0; + { s = (char *)s0; sz = strlen(s);} else - s = Malloc(0); + s = Malloc(sz); + if (!s) AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); - if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, MaxTmp() - 1)) { - AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); + while (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, sz - 1)) { + if (s0) { s = Malloc(sz=1024); s0 = NULL; } + else s = Realloc(s, sz+1024); } *lengp = strlen(s); - Malloc(*lengp); return inp->val.uc = (unsigned char *)s; } #if USE_GMP @@ -595,8 +600,7 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) { unsigned char *s = s0, *lim = s + strlen((char *)s); unsigned char *cp = s; - wchar_t w[2]; - w[1] = '\0'; + LOCAL_TERM_ERROR(t, 2 * (lim - s)); while (*cp) { utf8proc_int32_t chr; @@ -630,8 +634,11 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) { static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) { unsigned char *s = s0; int32_t ch; - if (!leng || strlen_utf8(s0) <= leng) { - return Yap_LookupAtom(s0); + if ( leng == 0) { + return Yap_LookupAtom(""); + } + if ( strlen_utf8(s0) <= leng) { + return Yap_LookupAtom(s0); } else { size_t n = get_utf8(s, 1, &ch); unsigned char *buf = Malloc(n + 1); @@ -713,10 +720,10 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out, return leng; } -static Term write_number(unsigned char *s, seq_tv_t *out, int size USES_REGS) { +static Term write_number(unsigned char *s, seq_tv_t *out, int size, bool error_on USES_REGS) { Term t; int i = push_text_stack(); - t = Yap_StringToNumberTerm((char *)s, &out->enc); + t = Yap_StringToNumberTerm((char *)s, &out->enc, error_on); pop_text_stack(i); return t; } @@ -739,7 +746,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { return out->val.t != 0; } if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) { - if ((out->val.t = write_number(inp, out, leng PASS_REGS)) != 0L) { + if ((out->val.t = write_number(inp, out, leng,!(out->type & YAP_STRING_ATOM) PASS_REGS)) != 0L) { // Yap_DebugPlWriteln(out->val.t); return true; @@ -790,7 +797,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { // Yap_DebugPlWriteln(out->val.t); return out->val.a != NULL; case YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG: - out->val.t = write_number(inp, out, leng PASS_REGS); + out->val.t = write_number(inp, out, leng, true PASS_REGS); // Yap_DebugPlWriteln(out->val.t); return out->val.t != 0; default: { return true ; } @@ -898,8 +905,8 @@ static int cmp_Text(const unsigned char *s1, const unsigned char *s2, int l) { return 0; } -static unsigned char *concat(int n, unsigned char *sv[] USES_REGS) { - char *buf; +static unsigned char *concat(int n, void *sv[] USES_REGS) { + void *buf; unsigned char *buf0; size_t room = 0; int i; @@ -908,9 +915,14 @@ static unsigned char *concat(int n, unsigned char *sv[] USES_REGS) { room += strlen((char *)sv[i]); } buf = Malloc(room + 1); - buf0 = (unsigned char *)buf; + buf0 = buf; for (i = 0; i < n; i++) { +#if _WIN32 + strcpy(buf, sv[i]); + buf = (char*)buf + strlen(buf); +#else buf = stpcpy(buf, sv[i]); +#endif } return buf0; } @@ -932,7 +944,7 @@ static void *slice(size_t min, size_t max, unsigned char *buf USES_REGS) { // // Out must be an atom or a string bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { - unsigned char **bufv; + void **bufv; unsigned char *buf; int i; size_t leng; @@ -951,7 +963,7 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { bufv[i] = nbuf; } buf = concat(tot, bufv PASS_REGS); - bool rc = write_Text(buf, out, 0 PASS_REGS); + bool rc = write_Text(buf, out, strlen_utf8(buf) PASS_REGS); return rc; } @@ -1009,7 +1021,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, next = 0; else next = cuts[i - 1]; - if (cuts[i] == 0) + if (i>0 && cuts[i] == 0) break; void *bufi = slice(next, cuts[i], buf PASS_REGS); if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) { @@ -1022,7 +1034,7 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, /** * Function to convert a generic text term (string, atom, list of codes, list -of +of< atoms) into a buff er. * @@ -1073,7 +1085,7 @@ const char *Yap_TextTermToText(Term t, char *buf, size_t len, encoding_t enc) { const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) { CACHE_REGS Atom at; - arity_t arity; + arity_t arity = 0; Functor f; char *s, *smax, *s0; s = s0 = malloc(1024); diff --git a/C/write.c b/C/write.c index c9b8ada28..91064bdd7 100644 --- a/C/write.c +++ b/C/write.c @@ -565,9 +565,12 @@ static void write_string(const unsigned char *s, qt = '"'; wrputc(qt, stream); do { - ptr += get_utf8(ptr, -1, &chr); + int delta; + ptr += (delta = get_utf8(ptr, -1, &chr) ); + if (chr == '\0') break; + if (delta == 0) {chr = *ptr++; } write_quoted(chr, qt, stream); } while (TRUE); wrputc(qt, stream); diff --git a/CMakeLists.txt b/CMakeLists.txt index f89ffc07a..5a8c3097e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,11 +8,15 @@ project( YAP ) +if (ANDROID) + set(YAP_APP_DIR "$CMAKE_SOURCE_DIR/../..") + cmake_policy(VERSION 3.4) +else () cmake_minimum_required(VERSION 2.8) include(CMakeToolsHelpers OPTIONAL) -# cmake_policy(VERSION 3.4) +endif() set( CMAKE_MODULE_PATH @@ -43,6 +47,7 @@ include(Model NO_POLICY_SCOPE) include_directories ( utf8proc packages/myddas packages/myddas/sqlite3 ) if (ANDROID) + include_directories ( packages/myddas/sqlite3/Android/jni/sqlite/nativehelper packages/myddas/sqlite3/Android/jni/sqlite ) endif (ANDROID) add_definitions(-DUSE_MYDDAS=1 -DMYDDAS_SQLITE3=1) @@ -69,18 +74,12 @@ if (ANDROID) # # -set (SWIG_SOURCES ${CMAKE_SOURCE_DIR}/packages/swig/yap.i) -set (SWIG_CXX ${CMAKE_BINARY_DIR}/yap_swig.cpp) -find_host_package (SWIG) -macro_log_feature (SWIG_FOUND "Swig" - "Use SWIG Language Interface " -"http://www.swig.org" ON) - add_custom_command (OUTPUT ${SWIG_CXX} - COMMAND ${SWIG_EXECUTABLE} -c++ -java -package pt.up.yap.lib -outdir ${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/../../../../../src/generated/java -I${CMAKE_SOURCE_DIR}/CXX -o ${SWIG_CXX} - ${SWIG_SOURCES} - ) +set (SWIG_CXX ${CMAKE_BINARY_DIR}/packages/swig/android/yap_swig.cpp) + + +add_subdirectory("packages/swig") ADD_SUBDIRECTORY(os) ADD_SUBDIRECTORY(OPTYap) @@ -132,7 +131,7 @@ endif (USE_READLINE) if (ANDROID) - add_dependencies(libYap plmyddas) + add_dependencies(libYap plmyddas swig) target_link_libraries(libYap android log) diff --git a/CXX/yapa.hh b/CXX/yapa.hh index 924238099..212d40492 100644 --- a/CXX/yapa.hh +++ b/CXX/yapa.hh @@ -57,8 +57,10 @@ class YAPAtom { /// construct new YAPAtom from Atom YAPAtom( Atom at ) { a = at; } public: - /// construct new YAPAtom from UTF-8 string - YAPAtom( const char * s) { a = Yap_LookupAtom( s ); } + /// construct new YAPAtom from UTF-8 string + YAPAtom( const char * s) { a = Yap_LookupAtom( s ); } + /// construct new YAPAtom from UTF-8 string + YAPAtom( const wchar_t * s) { CACHE_REGS a = UTF32ToAtom( s PASS_REGS ); } /// construct new YAPAtom from wide string //YAPAtom( const wchar_t * s) { a = Yap_LookupMaybeWideAtom( s ); } /// construct new YAPAtom from max-length string diff --git a/CXX/yapdb.hh b/CXX/yapdb.hh index f80ae3fd4..2be2fb58f 100644 --- a/CXX/yapdb.hh +++ b/CXX/yapdb.hh @@ -97,7 +97,7 @@ public: /// Note: Python confuses the 3 constructors, /// use YAPFunctorFromWideString inline YAPFunctor(const wchar_t *s, uintptr_t arity) { - f = Yap_MkFunctor(Yap_LookupWideAtom(s), arity); + CACHE_REGS f = Yap_MkFunctor(UTF32ToAtom(s PASS_REGS), arity); } ~YAPFunctor(){}; /// Getter: extract name of functor as an atom diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 22dbdf9a0..63e32092c 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -412,31 +412,6 @@ YAPTerm YAPListTerm::car() { } } -YAPTerm::YAPTerm(YAPFunctor f, YAPTerm ts[]) { - CACHE_REGS - BACKUP_H(); - Functor fun = f.f; - arity_t arity = ArityOfFunctor(fun); - while (HR + arity > ASP - 1024) { - RECOVER_H(); - if (!Yap_dogc(0, NULL PASS_REGS)) { - t = TermNil; - } - BACKUP_H(); - } - if (fun == FunctorDot) { - t = AbsPair(HR); - HR[0] = ts[0].term(); - HR[1] = ts[1].term(); - } else { - t = AbsAppl(HR); - *HR++ = (CELL)fun; - for (arity_t i = 0; i < arity; i++) { - HR[i] = ts[i].term(); - } - RECOVER_H(); - } -} YAPListTerm::YAPListTerm(YAPTerm ts[], arity_t n) { CACHE_REGS @@ -519,12 +494,8 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) { } return false; } - // don't forget, on success these l); -if (!result) { + // don't forget, on success these bindings will still be there); YAP_LeaveGoal(false, &q); - } else { - YAP_LeaveGoal(FALSE, &q); - } RECOVER_MACHINE_REGS(); return result; } @@ -595,7 +566,7 @@ Term YAPEngine::fun(Term t) { BACKUP_MACHINE_REGS(); Term tmod = CurrentModule, *ts = nullptr; PredEntry *ap ; - arity_t arity = arity; + arity_t arity; Functor f; jmp_buf q_env; Atom name; @@ -612,9 +583,11 @@ Term YAPEngine::fun(Term t) { } else if (IsAtomTerm(t)) { name = AtomOfTerm(t); f = nullptr; + arity = 0; } else if (IsPairTerm(t)) { XREGS[1] = ts[0]; XREGS[2] = ts[1]; + arity = 2; name = AtomDot; f = FunctorDot; } else { @@ -653,12 +626,11 @@ Term YAPEngine::fun(Term t) { } __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "out %d", result); - Term result; t = Yap_GetFromSlot(q.CurSlot); Yap_CloseHandles(q.CurSlot); if (!t) { YAP_LeaveGoal(false, &q); - result = 0; + t = 0; } RECOVER_MACHINE_REGS(); return t; @@ -668,7 +640,7 @@ YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm ts[]) : YAPPredicate(f, mod) { /* ignore flags for now */ BACKUP_MACHINE_REGS(); - goal = YAPTerm(f, ts); + goal = YAPApplTerm(f, ts); vnames = YAPListTerm(); openQuery(); RECOVER_MACHINE_REGS(); @@ -677,7 +649,7 @@ YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm ts[]) YAPQuery::YAPQuery(YAPFunctor f, YAPTerm ts[]) : YAPPredicate(f) { /* ignore flags for now */ BACKUP_MACHINE_REGS(); - goal = YAPTerm(f, ts); + goal = YAPApplTerm(f, ts); vnames = YAPListTerm(); openQuery(); RECOVER_MACHINE_REGS(); @@ -685,7 +657,7 @@ YAPQuery::YAPQuery(YAPFunctor f, YAPTerm ts[]) : YAPPredicate(f) { YAPQuery::YAPQuery(YAPPredicate p, YAPTerm ts[]) : YAPPredicate(p.ap) { BACKUP_MACHINE_REGS(); - goal = YAPTerm(YAPFunctor(ap->FunctorOfPred), ts); + goal = YAPApplTerm(YAPFunctor(ap->FunctorOfPred), ts); vnames = YAPListTerm(); openQuery(); RECOVER_MACHINE_REGS(); diff --git a/CXX/yapt.hh b/CXX/yapt.hh index 0edd8d949..b375743be 100644 --- a/CXX/yapt.hh +++ b/CXX/yapt.hh @@ -39,12 +39,12 @@ public: } /// construct a term out of an integer (if you know object type use /// YAPIntegerTerm) - YAPTerm(long int num) { mk(MkIntegerTerm(num)); } + /// YAPTerm(long int num) { mk(MkIntegerTerm(num)); } /// construct a term out of an integer (if you know object type use /// YAPIntegerTerm) - YAPTerm(double num) { mk(MkFloatTerm(num)); } + /// YAPTerm(double num) { mk(MkFloatTerm(num)); } /// parse string s and construct a term. - YAPTerm(YAPFunctor f, YAPTerm ts[]); + /// YAPTerm(YAPFunctor f, YAPTerm ts[]); /// extract the tag of a term, after dereferencing. YAP_tag_t tag(); /// copy the term ( term copy ) @@ -322,8 +322,6 @@ class YAPAtomTerm : public YAPTerm { // Constructor: receives a C-atom; YAPAtomTerm(Atom a) { mk(MkAtomTerm(a)); } YAPAtomTerm(Term t) : YAPTerm(t) { IsAtomTerm(t); } - // Getter for Prolog atom - Term getTerm() { return t; } public: // Constructor: receives an atom; diff --git a/H/ATOMS b/H/ATOMS index 81f0ad055..07ac71035 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -196,6 +196,7 @@ A Id N "id" A Ignore N "ignore" A Inf N "inf" A Infinity N "infinity" +A Info N "info" A InitGoal F "$init_goal" A InitProlog F "$init_prolog" A InStackExpansion N "in stack expansion" @@ -495,6 +496,7 @@ F Dot6 Dot 6 F Dot7 Dot 7 F Dot8 Dot 8 F Dot9 Dot 9 +F DoubleArrow DoubleArrow 2 F DoubleSlash DoubleSlash 2 F EmptySquareBrackets EmptySquareBrackets 2 F Eq Eq 2 @@ -523,6 +525,10 @@ F HandleThrow HandleThrow 3 F Hat Hat 2 F I I 2 F Id Id 1 +F Info1 Info 1 +F Info2 Info 2 +F Info3 Info 3 +F Info4 Info 4 F Is Is 2 F J J 2 F LastExecuteWithin LastExecuteWithin 1 diff --git a/H/YapText.h b/H/YapText.h index c6c501b3b..57f16f969 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -40,7 +40,9 @@ extern void Free(void *buf USES_REGS); extern int push_text_stack( USES_REGS1 ); extern int pop_text_stack( int lvl USES_REGS ); +#ifndef min #define min(x,y) (x>/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); } RINT(SLR(IntegerOfTerm(t1), -i2)); } return do_sll(IntegerOfTerm(t1), i2 PASS_REGS); } case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<>/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<>/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); } return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS); } RINT(SLR(IntegerOfTerm(t1), i2)); } case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); case big_int_e: #ifdef USE_GMP - return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); #endif default: RERROR(); } break; case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2"); case big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { case long_int_e: return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2)); case big_int_e: - return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); + Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); case double_e: - return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); + Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); default: RERROR(); } diff --git a/H/eval.h b/H/eval.h index 2d670f6d1..f61be284b 100644 --- a/H/eval.h +++ b/H/eval.h @@ -407,7 +407,7 @@ yamop *Yap_EvalError__(const char *, const char *, int, yap_error_number, Term, ...); #define Yap_ArithError(id, t, ...) \ - Yap_ArithError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__) + Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, 2, __VA_ARGS__) #define Yap_BinError(id) \ Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "") #define Yap_AbsmiError(id) \ diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index 3507ac20e..9ebbb212f 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -191,6 +191,7 @@ AtomIgnore = Yap_LookupAtom("ignore"); TermIgnore = MkAtomTerm(AtomIgnore); AtomInf = Yap_LookupAtom("inf"); TermInf = MkAtomTerm(AtomInf); AtomInfinity = Yap_LookupAtom("infinity"); TermInfinity = MkAtomTerm(AtomInfinity); + AtomInfo = Yap_LookupAtom("info"); TermInfo = MkAtomTerm(AtomInfo); AtomInitGoal = Yap_FullLookupAtom("$init_goal"); TermInitGoal = MkAtomTerm(AtomInitGoal); AtomInitProlog = Yap_FullLookupAtom("$init_prolog"); TermInitProlog = MkAtomTerm(AtomInitProlog); AtomInStackExpansion = Yap_LookupAtom("in stack expansion"); TermInStackExpansion = MkAtomTerm(AtomInStackExpansion); @@ -490,6 +491,7 @@ FunctorDot7 = Yap_MkFunctor(AtomDot,7); FunctorDot8 = Yap_MkFunctor(AtomDot,8); FunctorDot9 = Yap_MkFunctor(AtomDot,9); + FunctorDoubleArrow = Yap_MkFunctor(AtomDoubleArrow,2); FunctorDoubleSlash = Yap_MkFunctor(AtomDoubleSlash,2); FunctorEmptySquareBrackets = Yap_MkFunctor(AtomEmptySquareBrackets,2); FunctorEq = Yap_MkFunctor(AtomEq,2); @@ -518,6 +520,10 @@ FunctorHat = Yap_MkFunctor(AtomHat,2); FunctorI = Yap_MkFunctor(AtomI,2); FunctorId = Yap_MkFunctor(AtomId,1); + FunctorInfo1 = Yap_MkFunctor(AtomInfo,1); + FunctorInfo2 = Yap_MkFunctor(AtomInfo,2); + FunctorInfo3 = Yap_MkFunctor(AtomInfo,3); + FunctorInfo4 = Yap_MkFunctor(AtomInfo,4); FunctorIs = Yap_MkFunctor(AtomIs,2); FunctorJ = Yap_MkFunctor(AtomJ,2); FunctorLastExecuteWithin = Yap_MkFunctor(AtomLastExecuteWithin,1); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index e8f1fd332..1c5d5f8d8 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -191,6 +191,7 @@ AtomIgnore = AtomAdjust(AtomIgnore); TermIgnore = MkAtomTerm(AtomIgnore); AtomInf = AtomAdjust(AtomInf); TermInf = MkAtomTerm(AtomInf); AtomInfinity = AtomAdjust(AtomInfinity); TermInfinity = MkAtomTerm(AtomInfinity); + AtomInfo = AtomAdjust(AtomInfo); TermInfo = MkAtomTerm(AtomInfo); AtomInitGoal = AtomAdjust(AtomInitGoal); TermInitGoal = MkAtomTerm(AtomInitGoal); AtomInitProlog = AtomAdjust(AtomInitProlog); TermInitProlog = MkAtomTerm(AtomInitProlog); AtomInStackExpansion = AtomAdjust(AtomInStackExpansion); TermInStackExpansion = MkAtomTerm(AtomInStackExpansion); @@ -490,6 +491,7 @@ FunctorDot7 = FuncAdjust(FunctorDot7); FunctorDot8 = FuncAdjust(FunctorDot8); FunctorDot9 = FuncAdjust(FunctorDot9); + FunctorDoubleArrow = FuncAdjust(FunctorDoubleArrow); FunctorDoubleSlash = FuncAdjust(FunctorDoubleSlash); FunctorEmptySquareBrackets = FuncAdjust(FunctorEmptySquareBrackets); FunctorEq = FuncAdjust(FunctorEq); @@ -518,6 +520,10 @@ FunctorHat = FuncAdjust(FunctorHat); FunctorI = FuncAdjust(FunctorI); FunctorId = FuncAdjust(FunctorId); + FunctorInfo1 = FuncAdjust(FunctorInfo1); + FunctorInfo2 = FuncAdjust(FunctorInfo2); + FunctorInfo3 = FuncAdjust(FunctorInfo3); + FunctorInfo4 = FuncAdjust(FunctorInfo4); FunctorIs = FuncAdjust(FunctorIs); FunctorJ = FuncAdjust(FunctorJ); FunctorLastExecuteWithin = FuncAdjust(FunctorLastExecuteWithin); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index 3f061d0ab..24d966852 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -191,6 +191,7 @@ EXTERNAL Atom AtomId; EXTERNAL Term TermId; EXTERNAL Atom AtomIgnore; EXTERNAL Term TermIgnore; EXTERNAL Atom AtomInf; EXTERNAL Term TermInf; EXTERNAL Atom AtomInfinity; EXTERNAL Term TermInfinity; +EXTERNAL Atom AtomInfo; EXTERNAL Term TermInfo; EXTERNAL Atom AtomInitGoal; EXTERNAL Term TermInitGoal; EXTERNAL Atom AtomInitProlog; EXTERNAL Term TermInitProlog; EXTERNAL Atom AtomInStackExpansion; EXTERNAL Term TermInStackExpansion; @@ -544,6 +545,8 @@ EXTERNAL Functor FunctorDot8; EXTERNAL Functor FunctorDot9; +EXTERNAL Functor FunctorDoubleArrow; + EXTERNAL Functor FunctorDoubleSlash; EXTERNAL Functor FunctorEmptySquareBrackets; @@ -600,6 +603,14 @@ EXTERNAL Functor FunctorI; EXTERNAL Functor FunctorId; +EXTERNAL Functor FunctorInfo1; + +EXTERNAL Functor FunctorInfo2; + +EXTERNAL Functor FunctorInfo3; + +EXTERNAL Functor FunctorInfo4; + EXTERNAL Functor FunctorIs; EXTERNAL Functor FunctorJ; diff --git a/Prelims.cmake b/Prelims.cmake index f7c9de1db..83aafe7b3 100644 --- a/Prelims.cmake +++ b/Prelims.cmake @@ -141,18 +141,20 @@ if(POLICY CMP0043) endif(POLICY CMP0043) +if (ANDROID) + set ( prefix ${YAP_APP_DIR}/app/build/generated ) + set ( datarootdir ${YAP_APP_DIR}/app/build/generated/assets ) +set ( includedir "${prefix}/assets/include") + set ( libpl ${YAP_APP_DIR}/app/build/generated/assets/Yap) +else() set ( prefix "${CMAKE_INSTALL_PREFIX}") +set ( datarootdir "${prefix}/share") + set ( libpl "${datarootdir}/Yap") +set ( includedir "${prefix}/include") +endif() set ( exec_prefix "${prefix}") set ( libdir "${exec_prefix}/lib") set ( dlls "${exec_prefix}/lib/Yap") -set ( includedir "${prefix}/include") -set ( datarootdir "${prefix}/share") -if (ANDROID) - set ( libpl "${CMAKE_LIBRARY_OUTPUT_DIRECTORY}/../../../../../build/generated/assets/Yap") -else() - set ( libpl "${datarootdir}/Yap") - -endif() set ( datadir "${datarootdir}") set ( mandir "${datarootdir}/man") set ( bindir "${exec_prefix}/bin") diff --git a/cmake/Config.cmake b/cmake/Config.cmake index 9c0abcae4..86ce9e31f 100644 --- a/cmake/Config.cmake +++ b/cmake/Config.cmake @@ -255,6 +255,7 @@ check_function_exists(__builtin_ffsll HAVE___BUILTIN_FFSLL) check_function_exists(fgetpos HAVE_FGETPOS) check_function_exists(finite HAVE_FINITE) check_function_exists(iswblank HAVE_ISWBLANK) +check_function_exists(iswspace HAVE_ISWSPACE) check_symbol_exists(flsl HAVE_FLSL) check_symbol_exists(flsll HAVE_FLSLL) check_function_exists(fmemopen HAVE_FMEMOPEN) diff --git a/config.h.cmake b/config.h.cmake index 9f34be495..02fab125e 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -586,6 +586,11 @@ function. */ #cmakedefine HAVE_ISWBLANK ${HAVE_ISWBLANK} #endif +/* Define to 1 if you have the `iswspace' function. */ +#ifndef HAVE_ISWSPACE +#cmakedefine HAVE_ISWSPACE ${HAVE_ISWSPACE} +#endif + /* Define to 1 if you have the header file. */ #ifndef HAVE_JUDY_H #cmakedefine HAVE_JUDY_H ${HAVE_JUDY_H} diff --git a/include/YapError.h b/include/YapError.h index 7fdb82142..9c68dbcce 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -42,7 +42,7 @@ struct yami *Yap_Error__(const char *file, const char *function, int lineno, yap_error_number err, YAP_Term wheret, ...); void Yap_ThrowError__(const char *file, const char *function, int lineno, - yap_error_number err, YAP_Term wheret, ...); + yap_error_number err, YAP_Term wheret, int code, ...) __attribute__ ((noreturn)); #define Yap_NilError(id, ...) \ @@ -51,8 +51,8 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, #define Yap_Error(id, inp, ...) \ Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) -#define Yap_ThrowError(id, inp, ...) \ -Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) +#define Yap_ThrowError(id, inp, code, ...) \ +Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, inp, code, __VA_ARGS__) #ifdef YAP_TERM_H /** diff --git a/library/lineutils.yap b/library/lineutils.yap index 1dbc2320f..8119a2f04 100644 --- a/library/lineutils.yap +++ b/library/lineutils.yap @@ -248,6 +248,49 @@ split_within(SplitCodes, DoubleQs, C-SingleQs, Strings, C) --> split_within(SplitCodes, DoubleQs, SingleQs, [[C|String]|Strings], C) --> split_within(SplitCodes, DoubleQs, SingleQs, [String|Strings]). +/** @pred split_unquoted(+ _Line_,+ _Separators_,- _Split_) + + + +Unify _Words_ with a set of strings obtained from _Line_ by +using the character codes in _Separators_ as separators, but treat text wi +thin double quotes as a single unit. As an +example, consider: + +~~~~~{.prolog} +?- split("Hello * I \"am free\""," *",S). + +S = ["Hello","I","am free"] ? + +no +~~~~~ + +*/ +split_unquoted(String, SplitCodes, Strings) :- + split_unquoted_at_blank(SplitCodes, Strings, String, []). + +split_unquoted_at_blank(SplitCodes, [[0'"|New]|More]) --> %0'" + "\"", + split_quoted(New, More), + split_unquoted_at_blank(SplitCodes, More). +split_unquoted_at_blank(SplitCodes, More) --> + [C], + { member(C, SplitCodes) }, !, + split_unquoted_at_blank(SplitCodes, More). +split_unquoted_at_blank(SplitCodes, [[C|New]| More]) --> + [C], !, + split_unquoted(SplitCodes, New, More). +split_unquoted_at_blank(_, []) --> []. + +split_unquoted(SplitCodes, [], More) --> + [C], + { member(C, SplitCodes) }, !, + split_unquoted_at_blank(SplitCodes, More). +split_unquoted(SplitCodes, [C|New], Set) --> + [C], !, + split_unquoted(SplitCodes, New, Set). +split_unquoted(_, [], []) --> []. + /** @pred split_quoted(+ _Line_,+ _Separators_, GroupQuotes, SingleQuotes, - _Split_) diff --git a/os/chartypes.c b/os/chartypes.c index b8e574e2a..f7019b3b9 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -79,7 +79,7 @@ static char SccsId[] = "%W% %G%"; static Int p_change_type_of_char(USES_REGS1); -Term Yap_StringToNumberTerm(const char *s, encoding_t *encp) { +Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on) { CACHE_REGS int sno; Term t; @@ -95,7 +95,7 @@ Term Yap_StringToNumberTerm(const char *s, encoding_t *encp) { while (*s && isblank(*s) && Yap_wide_chtype(*s) == BS) s++; #endif - t = Yap_scan_num(GLOBAL_Stream + sno); + t = Yap_scan_num(GLOBAL_Stream + sno, error_on); if (LOCAL_Error_TYPE == SYNTAX_ERROR) LOCAL_Error_TYPE = YAP_NO_ERROR; Yap_CloseStream(sno); diff --git a/os/iopreds.h b/os/iopreds.h index 5a60e64bf..680562834 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -109,7 +109,7 @@ extern void Yap_plwrite(Term, struct stream_desc *, int, int, int); extern void Yap_WriteAtom(struct stream_desc *s, Atom atom); extern bool Yap_WriteTerm( int output_stream, Term t, Term opts USES_REGS); -extern Term Yap_scan_num(struct stream_desc *); +extern Term Yap_scan_num(struct stream_desc *, bool); extern void Yap_DefaultStreamOps(StreamDesc *st); extern void Yap_PipeOps(StreamDesc *st); diff --git a/os/readterm.c b/os/readterm.c index f1fea677c..34c63ae62 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -217,26 +217,26 @@ static const param_t read_defs[] = {READ_DEFS()}; */ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { CACHE_REGS - Term info; Term startline, errline, endline; - Term tf[4]; - Term *tailp = tf + 3; + Term tf[3]; + Term tm; + Term *tailp = tf + 2; CELL *Hi = HR; TokEntry *tok = LOCAL_tokptr; Int cline = tok->TokPos; startline = MkIntegerTerm(cline); - if (errtok != LOCAL_toktide) { + endline = MkIntegerTerm(cline); + if (errtok != LOCAL_toktide) { errtok = LOCAL_toktide; } LOCAL_Error_TYPE = YAP_NO_ERROR; errline = MkIntegerTerm(errtok->TokPos); if (LOCAL_ErrorMessage) - tf[0] = MkStringTerm(LOCAL_ErrorMessage); + tm = MkStringTerm(LOCAL_ErrorMessage); else - tf[0] = MkStringTerm(""); + tm = MkStringTerm("syntax error"); while (tok) { - Term ts[2]; if (HR > ASP - 1024) { errline = MkIntegerTerm(0); @@ -254,57 +254,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { *tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil); tailp = RepPair(*tailp) + 1; } - info = tok->TokInfo; - switch (tok->Tok) { - case Name_tok: { - Term t0[1]; - if (info) { - t0[0] = MkAtomTerm((Atom)info); - } else { - t0[0] = TermNil; - } - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; - case QuasiQuotes_tok: { - Term t0[2]; - t0[0] = MkAtomTerm(Yap_LookupAtom("")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; - case Number_tok: - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &info); - break; - case Var_tok: { - Term t[2]; - VarEntry *varinfo = (VarEntry *)info; - - t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); - } break; - case String_tok: { - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); - } break; - case BQString_tok: { - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); - } break; - case Error_tok: { - ts[0] = MkAtomTerm(AtomError); - } break; - case eot_tok: - endline = MkIntegerTerm(tok->TokPos); - ts[0] = MkAtomTerm(Yap_LookupAtom("EOT")); - - break; - case Ponctuation_tok: { - char s[2]; - s[1] = '\0'; - if ((info) == 'l') { - s[0] = '('; - } else { - s[0] = (char)info; - } - ts[0] = MkAtomTerm(Yap_LookupAtom(s)); - } - } + Term rep = Yap_tokRep(tok ); if (tok->TokNext) { tok = tok->TokNext; } else { @@ -312,7 +262,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { tok = NULL; break; } - *tailp = MkPairTerm(ts[0], TermNil); + *tailp = MkPairTerm(rep , TermNil); tailp = RepPair(*tailp) + 1; } { @@ -320,19 +270,18 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { t[0] = startline; t[1] = errline; t[2] = endline; - tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t); + tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t); } - /* 0: id */ - /* 1: strat, error, end line */ + /* 0: strat, error, end line */ /*2 msg */ - /* file */ - tf[2] = Yap_StreamUserName(sno); + /* 1: file */ + tf[1] = Yap_StreamUserName(sno); clean_vars(LOCAL_VarTable); clean_vars(LOCAL_AnonVarTable); - Term terr = Yap_MkApplTerm(FunctorSyntaxError, 4, tf); + Term terr = Yap_MkApplTerm(FunctorInfo3, 3, tf); Term tn[2]; - tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr); - tn[1] = TermNil; + tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &tm); + tn[1] = terr; terr = Yap_MkApplTerm(FunctorError, 2, tn); #if DEBUG if (Yap_ExecutionMode == YAP_BOOT_MODE) { @@ -401,7 +350,6 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { fe->cmod = PROLOG_MODULE; if (args[READ_BACKQUOTED_STRING].used) { if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) { - free(args); return false; } } @@ -695,7 +643,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream); static parser_state_t scanEOF(FEnv *fe, int inp_stream) { CACHE_REGS // bool store_comments = false; - TokEntry *tokstart = LOCAL_tokptr; + TokEntry *tokstart = LOCAL_tokptr; // check for an user abort if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) { /* we got the end of file from an abort */ @@ -782,10 +730,11 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { TokEntry *t = LOCAL_tokptr; int n = 0; while (t) { - fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok), - Yap_tokRep(t, ENC_ISO_UTF8), n++); + fprintf(stderr, "[Token %d %s %d]", + Ord(t->Tok),Yap_tokText(t), n++); t = t->TokNext; } + fprintf(stderr, "\n"); } #endif if (LOCAL_ErrorMessage) @@ -856,14 +805,12 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } else { - char *s = syntax_error(fe->toklast, inp_stream, fe->cmod); + Term t = syntax_error(fe->toklast, inp_stream, fe->cmod); if (ParserErrorStyle == TermError) { - LOCAL_ErrorMessage = s; + LOCAL_ActiveError->errorTerm = Yap_StoreTermInDB( t, 4); LOCAL_Error_TYPE = SYNTAX_ERROR; - return YAP_PARSING_FINISHED; // dec-10 - } else if (Yap_PrintWarning(MkStringTerm(s))) { - free(s); + } else if (Yap_PrintWarning(t)) { LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_SCANNING; } diff --git a/os/sysbits.c b/os/sysbits.c index 1480cf946..c5a8ee9c0 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -1926,34 +1926,8 @@ static HKEY reg_open_key(const wchar_t *which, int create) { #define MAXREGSTRLEN 1024 -static void recover_space(wchar_t *k, Atom At) { - if (At->WStrOfAE != k) - Yap_FreeCodeSpace((char *)k); -} - static wchar_t *WideStringFromAtom(Atom KeyAt USES_REGS) { - if (IsWideAtom(KeyAt)) { - return KeyAt->WStrOfAE; - } else { - int len = strlen(KeyAt->StrOfAE); - int sz = sizeof(wchar_t) * (len + 1); - char *chp = KeyAt->StrOfAE; - wchar_t *kptr, *k; - - k = (wchar_t *)Yap_AllocCodeSpace(sz); - while (k == NULL) { - if (!Yap_growheap(false, sz, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, MkIntegerTerm(sz), - "generating key in win_registry_get_value/3"); - return false; - } - k = (wchar_t *)Yap_AllocCodeSpace(sz); - } - kptr = k; - while ((*kptr++ = *chp++)) - ; - return k; - } + return Yap_AtomToWide( KeyAt ); } static Int p_win_registry_get_value(USES_REGS1) { @@ -1965,24 +1939,29 @@ static Int p_win_registry_get_value(USES_REGS1) { Term Key = Deref(ARG1); Term Name = Deref(ARG2); Atom KeyAt, NameAt; + int l = push_text_stack(); if (IsVarTerm(Key)) { Yap_Error(INSTANTIATION_ERROR, Key, "argument to win_registry_get_value unbound"); - return FALSE; + pop_text_stack(l); + return FALSE; } if (!IsAtomTerm(Key)) { Yap_Error(TYPE_ERROR_ATOM, Key, "argument to win_registry_get_value"); - return FALSE; + pop_text_stack(l); + return FALSE; } KeyAt = AtomOfTerm(Key); if (IsVarTerm(Name)) { Yap_Error(INSTANTIATION_ERROR, Key, "argument to win_registry_get_value unbound"); - return FALSE; + pop_text_stack(l); + return FALSE; } if (!IsAtomTerm(Name)) { Yap_Error(TYPE_ERROR_ATOM, Key, "argument to win_registry_get_value"); +pop_text_stack(l); return FALSE; } NameAt = AtomOfTerm(Name); @@ -1990,7 +1969,7 @@ static Int p_win_registry_get_value(USES_REGS1) { k = WideStringFromAtom(KeyAt PASS_REGS); if (!(key = reg_open_key(k, FALSE))) { Yap_Error(EXISTENCE_ERROR_KEY, Key, "argument to win_registry_get_value"); - recover_space(k, KeyAt); +pop_text_stack(l); return FALSE; } name = WideStringFromAtom(NameAt PASS_REGS); @@ -1999,26 +1978,22 @@ static Int p_win_registry_get_value(USES_REGS1) { RegCloseKey(key); switch (type) { case REG_SZ: - recover_space(k, KeyAt); - recover_space(name, NameAt); ((wchar_t *)data)[len] = '\0'; - return Yap_unify(MkAtomTerm(Yap_LookupMaybeWideAtom((wchar_t *)data)), - ARG3); + Atom at = Yap_NWCharsToAtom((wchar_t *)data, len PASS_REGS); + pop_text_stack(l); + return Yap_unify(MkAtomTerm(at),ARG3); case REG_DWORD: - recover_space(k, KeyAt); - recover_space(name, NameAt); - { + { DWORD *d = (DWORD *)data; +pop_text_stack(l); return Yap_unify(MkIntegerTerm((Int)d[0]), ARG3); } default: - recover_space(k, KeyAt); - recover_space(name, NameAt); - return FALSE; + pop_text_stack(l); + return FALSE; } } - recover_space(k, KeyAt); - recover_space(name, NameAt); +pop_text_stack(l); return FALSE; } diff --git a/os/writeterm.c b/os/writeterm.c index 381c5dea1..e35dea94c 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -224,7 +224,7 @@ static bool write_term(int output_stream, Term t, xarg *args USES_REGS) { flags |= AttVar_Dots_f; } else if (ctl != TermIgnore) { Yap_Error( - DOMAIN_ERROR_OUT_OF_RANGE, ctl, + DOMAIN_ERROR_WRITE_OPTION, ctl, "write attributes should be one of {dots,ignore,portray,write}"); rc = false; goto end; diff --git a/os/yapio.h b/os/yapio.h index cd1e83f34..8ce7d80ca 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -107,7 +107,7 @@ extern char *Yap_MemStreamBuf(int sno); extern X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings_p); -extern Term Yap_StringToNumberTerm(const char *s, encoding_t *encp); +extern Term Yap_StringToNumberTerm(const char *s, encoding_t *encp, bool error_on); extern int Yap_FormatFloat(Float f, char **s, size_t sz); extern int Yap_open_buf_read_stream(const char *buf, size_t nchars, encoding_t *encp, memBufSource src); diff --git a/packages/cplint/approx/simplecuddLPADs/simplecudd.c b/packages/cplint/approx/simplecuddLPADs/simplecudd.c index 17fd46949..234ef9c4f 100644 --- a/packages/cplint/approx/simplecuddLPADs/simplecudd.c +++ b/packages/cplint/approx/simplecuddLPADs/simplecudd.c @@ -388,7 +388,7 @@ int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, perror(filename); return -1; } - const char *vs = varmap.vars; + const char **vs = varmap.vars; ret = Cudd_DumpDot(manager, 1, f, vs, NULL, fd); fclose(fd); return ret; diff --git a/packages/myddas/sqlite3/myddas_sqlite3.c b/packages/myddas/sqlite3/myddas_sqlite3.c index 80954c466..1db67f3c5 100644 --- a/packages/myddas/sqlite3/myddas_sqlite3.c +++ b/packages/myddas/sqlite3/myddas_sqlite3.c @@ -586,8 +586,7 @@ static Int c_sqlite3_row(USES_REGS1) { } else if (res == SQLITE_ROW) { list = arg_list_args; - Term tf; - + Term tf = 0; for (i = 0; i < arity; i++) { /* convert data types here */ head = HeadOfTerm(list); diff --git a/packages/swig/android/CMakeLists.txt b/packages/swig/android/CMakeLists.txt index fa2e4c4c1..f4dc3b56c 100644 --- a/packages/swig/android/CMakeLists.txt +++ b/packages/swig/android/CMakeLists.txt @@ -1,25 +1,21 @@ # This is a CMake example for Python and Java - INCLUDE(UseJava) - - - - # set(ANDROID_SO_OUTDIR ${libdir}) - # set(CMAKE_SWIG_OUTDIR ${CMAKE_SOURCE_DIR}/android/yaplib/build/generated/source/pt/up/yap/lib) - #set(CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR}/derived) + set(CMAKE_SWIG_OUTDIR ${YAP_APP_DIR}/app/src/main/java/pt/up/yap/lib ) + set ( SWIG_SOURCES ../yap.i ) SET_SOURCE_FILES_PROPERTIES(${SWIG_SOURCES} PROPERTIES CPLUSPLUS ON) include_directories ( ${CMAKE_SOURCE_DIR}/CXX - ${JAVA_INCLUDE_DIRS} - ${JNI_INCLUDE_DIRS} + ) + + add_custom_target ( swig ALL + DEPENDS ${SWIG_CXX} ) - - add_custom_command (OUTPUT ${SWIG_CXX} - COMMAND ${SWIG} -java -outdir ${CMAKE_CURRENT_BINARY_DIR} -c++ -addextern -I${CMAKE_SOURCE_DIR}/CXX ${SWIG_SOURCES} -o ${SWIG_CXX} - ${SWIG_SOURCES} + add_custom_command (OUTPUT ${SWIG_CXX} + COMMAND ${SWIG} -java -outdir ${CMAKE_SWIG_OUTDIR} -c++ -addextern -I${CMAKE_SOURCE_DIR}/CXX -o ${SWIG_CXX}${SWIG_SOURCES} ) + diff --git a/pl/atoms.yap b/pl/atoms.yap index 23e5d2e61..f3dd5d967 100644 --- a/pl/atoms.yap +++ b/pl/atoms.yap @@ -165,8 +165,6 @@ current_atom(A) :- % check atom(A), !. current_atom(A) :- % generate '$current_atom'(A). -current_atom(A) :- % generate - '$current_wide_atom'(A). string_concat(Xs,At) :- ( var(At) -> diff --git a/pl/boot.yap b/pl/boot.yap index 5b6972631..106d9a0dd 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1,3 +1,4 @@ + /************************************************************************* * * * YAP Prolog * @@ -174,7 +175,7 @@ list, since backtracking could not "pass through" the cut. system_module(_Mod, _SysExps, _Decls). % new_system_module(Mod). -use_system_module(Module, _SysExps). +use_system_module(_Module, _SysExps). private(_). @@ -291,8 +292,9 @@ private(_). '$bootstrap_predicate'(print_message(Context, Msg), _M, _) :- !, '$early_print_message'(Context, Msg). '$bootstrap_predicate'(print_message(Context, Msg), _M, _) :- !, - '$early_print_message'(Context, Msg). -'$bootstrap_predicate'(prolog_file_type(A,B), _, prolog_file_type(A,B)) :- !, B = prolog. + '$early_print_message'(Context, Msg). +'$bootstrap_predicate'(prolog_file_type(A,prolog), _, _) :- !, + ( A = yap ; A = pl ; A = prolog ). '$bootstrap_predicate'(file_search_path(_A,_B), _, _ ) :- !, fail. '$bootstrap_predicate'(meta_predicate(G), M, _) :- !, strip_module(M:G, M1, G1), @@ -446,7 +448,6 @@ live :- W1 is W-1, '$start_orp_threads'(W1). - % Start file for yap /* I/O predicates */ @@ -1428,7 +1429,7 @@ Command = (H --> B) -> '$check_head_and_body'(MH, M, H, true, P) :- '$yap_strip_module'(MH,M,H), - error:is_callable(M:H,P). + is_callable(M:H,P). % term expansion % % return two arguments: Expanded0 is the term after "USER" expansion. @@ -1453,8 +1454,8 @@ Command = (H --> B) -> '$precompile_term'(Term, Term, Term). '$expand_clause'(InputCl, C1, CO) :- - source_module(SM), - '$yap_strip_module'(SM:InputCl, M, ICl), + source_module(SM), + '$yap_strip_clause'(SM:InputCl, M, ICl), '$expand_a_clause'( M:ICl, SM, C1, CO), !. '$expand_clause'(Cl, Cl, Cl). diff --git a/pl/dbload.yap b/pl/dbload.yap index 4506db1d1..6e2dd3781 100644 --- a/pl/dbload.yap +++ b/pl/dbload.yap @@ -29,10 +29,7 @@ dbload_from_stream(R, M0, rdf, term ) :- '$lines_in_file'(R, Lines), - '$input_lines'(R, Type, Lines), - dbload_from_stream(R, M0, Type, Storage ) :- - '$lines_in_file'(R, Lines), - '$input_lines'(R, Type, Lines), + '$input_lines'(R, Type, Lines). '$input_lines'(R, csv, yeLines ) :- '$process_lines'(R, Lines, Type ), diff --git a/pl/errors.yap b/pl/errors.yap index a273e1125..231c54833 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -138,6 +138,8 @@ system_error(Type,Goal,Culprit) :- throw(error(permission_error(module,redefined,A),B)). '$process_error'(error(Msg, Where), _) :- print_message(error,error(Msg, Where)), !. +'$process_error'(error(Msg, Where), _) :- + print_message(error,error(Msg, [g|Where])), !. '$process_error'(Throw, _) :- print_message(error,error(unhandled_exception,Throw)). diff --git a/pl/messages.yap b/pl/messages.yap index 3f574e35a..14553d528 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -65,6 +65,34 @@ messages that do not produce output but that can be intercepted by hooks. The next table shows the main predicates and hooks associated to message handling in YAP: + +An error record comsists of An ISO compatible descriptor of the format + +error(errror_kind(Culprit,..), Info) + +In YAP, the infoo field describes: + +- what() more detauls on the event + +- input_stream, may be ine of; + + - loop_sream + - file() + - none + + - prolog_source(_) a record containing file, line, predicate, and clause + that activated the goal, or a list therof. YAP tries to search for the user + code generatinng the error. + + - c_source(0), a record containing the line of C-code thhat caused the event. This + is reported under systm debugging mode, or if this is user code. + + - stream_source() - a record containg data on the the I/O stream datum causisng the evwnt. + + - user_message () - ttext on the event. + + + @{ */ @@ -210,11 +238,11 @@ compose_message(Term, Level) --> main_message( Term, Level, LC), [nl,nl]. -location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_), _ , _) --> - !, - [ '~a:~d:0 ' - [FileName,LN] ] . +location(error(syntax_error(_),info(between(_,LN,_), FileName, _)), _ , _) --> + !, + [ '~a:~d:~d ' - [FileName,LN,0] ] . + location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) --> - % { stream_position_data( line_count, LN) }, !, [ '~a:~d:0 ' - [FileName,LN] ] . location( error(_,Term), Level, LC ) --> @@ -231,7 +259,7 @@ location( error(_,Term), Level, LC ) --> %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, main_message(error(Msg,Info), _, _) --> {var(Info)}, !, [ ' error: uninstantiated message ~w~n.' - [Msg], nl ]. -main_message( error(syntax_error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)),_), Level, LC ) --> +main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream,Term)), Level, LC ) --> !, [' ~a: syntax error ~s' - [Level,Msg]], [nl], @@ -602,7 +630,7 @@ list_of_preds([P|L]) --> list_of_preds(L). syntax_error_term(between(_I,_J,_L),LTaL,LC) --> - ['error found at line ~d to line ~d' - [_I,_L], nl ], + ['term between lines ~d and ~d' - [_I,_L], nl ], syntax_error_tokens(LTaL, LC). syntax_error_tokens([], _LC) --> []. @@ -615,7 +643,7 @@ syntax_error_token(atom(A), _LC) --> !, syntax_error_token(number(N), _LC) --> !, [ '~w' - [N] ]. syntax_error_token(var(_,S), _LC) --> !, - [ '~s' - [S] ]. + [ '~a' - [S] ]. syntax_error_token(string(S), _LC) --> !, [ '`~s`' - [S] ]. syntax_error_token(error, _LC) --> !, diff --git a/pl/meta.yap b/pl/meta.yap index ed4732567..e5a4dd814 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -284,14 +284,14 @@ meta_predicate declaration nonvar(G), G = (A = B), !. -'$expand_goals'(\+A,\+A1,(AO-> false;true),HM,SM,BM,HVars) :- !, +'$expand_goals'(\+A,\+A1,('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> false;true),HM,SM,BM,HVars) :- !, '$expand_goals'(A,A1,AO,HM,SM,BM,HVars). '$expand_goals'(once(A),once(A1), ('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !, '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), '$clean_cuts'(AO0, CP, AO). '$expand_goals'(ignore(A),ignore(A1), - (AO -> true ; true),HM,SM,BM,HVars) :- !, + ('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> true ; true),HM,SM,BM,HVars) :- !, '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), '$clean_cuts'(AO0, AO). '$expand_goals'(forall(A,B),forall(A1,B1), @@ -299,7 +299,7 @@ meta_predicate declaration '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars), '$expand_goals'(B,B1,BO,HM,SM,BM,HVars), '$clean_cuts'(AO0, AO). -'$expand_goals'(not(A),not(A1),(AO -> fail; true),HM,SM,BM,HVars) :- !, +'$expand_goals'(not(A),not(A1),('$current_choice_point'(CP),AO,'$$cut_by'(CP) -> fail; true),HM,SM,BM,HVars) :- !, '$expand_goals'(A,A1,AO,HM,SM,BM,HVars). '$expand_goals'(if(A,B,C),if(A1,B1,C1), ('$current_choicepoint'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !, diff --git a/pl/modules.yap b/pl/modules.yap index 60fd7e62e..6f9f70e6a 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -338,8 +338,8 @@ system_module(Mod) :- '$pred_exists'(Pred, Mod), !. '$continue_imported'(FM,Mod,FPred,Pred) :- - recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !, - '$continue_imported'(FM, IM, FPred, IPred). + recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), + '$continue_imported'(FM, IM, FPred, IPred), !. '$continue_imported'(FM,Mod,FPred,Pred) :- prolog:'$parent_module'(Mod,IM), '$continue_imported'(FM, IM, FPred, Pred). diff --git a/pl/preddyns.yap b/pl/preddyns.yap index 95f5e7091..13a202837 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -51,6 +51,7 @@ assert(Clause) :- '$assert'(Clause, assertz, _). '$assert'(Clause, Where, R) :- +'$yap_strip_clause'(Clause, _, _Clause0), '$expand_clause'(Clause,C0,C), '$$compile'(C, Where, C0, R). diff --git a/pl/signals.yap b/pl/signals.yap index 1729c9510..9990ff2c0 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -192,7 +192,7 @@ order of dispatch. '$hacks':'$stack_dump', '$execute0'(G,M). '$do_signal'(sig_fpe,G) :- - '$signal_handler'(sig_fpe, G) + '$signal_handler'(sig_fpe, G). '$do_signal'(sig_alarm, G) :- '$signal_handler'(sig_alarm, G). '$do_signal'(sig_vtalarm, G) :-