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

boot

This commit is contained in:
Vitor Santos Costa 2019-02-15 13:50:24 +00:00
parent 302519868f
commit 90f5720fb0
11 changed files with 166 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
C/flags.c
View File

@ -77,6 +77,7 @@ static bool sqf(Term t2);
static bool set_error_stream(Term inp); static bool set_error_stream(Term inp);
static bool set_input_stream(Term inp); static bool set_input_stream(Term inp);
static bool set_output_stream(Term inp); static bool set_output_stream(Term inp);
static bool dollar_to_lc(Term inp);
static void newFlag(Term fl, Term val); static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1); static Int current_prolog_flag(USES_REGS1);
@ -119,11 +120,11 @@ static Term indexer(Term inp) {
return inp; return inp;
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag index in {off,single,compact,multi,on,max}"); "set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom"); Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
return TermZERO; return TermZERO;
} }
@ -147,14 +148,14 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true; return true;
} }
/* bad argument, but still an atom */ /* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted " "bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t2, Yap_ThrowError(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should " "set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}", "be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
@ -187,14 +188,14 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS; new->flags |= BCKQ_CHARS;
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted " "bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} }
@ -225,14 +226,14 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= SNGQ_CHARS; new->flags |= SNGQ_CHARS;
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted " "bad option %s for backquoted "
"string flag, use one string, " "string flag, use one string, "
"atom, codes or chars", "atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE); RepAtom(AtomOfTerm(t2))->StrOfAE);
return false; return false;
} }
@ -244,6 +245,20 @@ static bool sqf(Term t2) {
return sqf1(new, t2 PASS_REGS); return sqf1(new, t2 PASS_REGS);
} }
static bool dollar_to_lc(Term inp) {
if (inp == TermTrue || inp == TermOn) {
Yap_chtype0['$'+1] = LC;
return true;
}
if (inp == TermFalse || inp == TermOff) {
Yap_chtype0['$'+1] = CC;
return false;
}
Yap_ThrowError(TYPE_ERROR_BOOLEAN, inp,
"dollar_to_lower_case is a boolean flag");
return TermZERO;
}
static Term isaccess(Term inp) { static Term isaccess(Term inp) {
if (inp == TermReadWrite || inp == TermReadOnly) if (inp == TermReadWrite || inp == TermReadOnly)
return inp; return inp;
@ -252,11 +267,11 @@ static Term isaccess(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
} }
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}"); "set_prolog_flag access in {read_write,read_only}");
return TermZERO; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {read_write,read_only}"); "set_prolog_flag access in {read_write,read_only}");
return TermZERO; return TermZERO;
} }
@ -302,11 +317,11 @@ static Term flagscope(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
} }
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}"); "set_prolog_flag access in {global,module,thread}");
return TermZERO; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {global,module,thread}"); "set_prolog_flag access in {global,module,thread}");
return TermZERO; return TermZERO;
} }
@ -320,7 +335,7 @@ static bool mkprompt(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
} }
if (!IsAtomTerm(inp)) { if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false; return false;
} }
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE, strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
@ -334,7 +349,7 @@ static bool getenc(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
} }
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) { if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding"); Yap_ThrowError(TYPE_ERROR_ATOM, inp, "get_encoding");
return false; return false;
} }
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding)))); return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding))));
@ -348,7 +363,7 @@ return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding)
)) ); )) );
} }
if (!IsAtomTerm(inp) ) { if (!IsAtomTerm(inp) ) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false; return false;
} }
enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET ); enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET );
@ -368,7 +383,7 @@ static bool typein(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE); inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
} }
if (!IsAtomTerm(inp)) { if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false; return false;
} }
CurrentModule = inp; CurrentModule = inp;
@ -466,7 +481,7 @@ static bool typein(Term inp) {
static bool string( Term inp ) { static bool string( Term inp ) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false; return false;
} }
if (IsStringTerm( inp )) if (IsStringTerm( inp ))
@ -481,7 +496,7 @@ static bool typein(Term inp) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE); hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
} }
if (!IsAtomTerm(hd)) { if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false; return false;
} }
} while (IsPairTerm( inp ) ); } while (IsPairTerm( inp ) );
@ -489,21 +504,21 @@ static bool typein(Term inp) {
do { do {
Term hd = HeadOfTerm(inp); Term hd = HeadOfTerm(inp);
if (!IsIntTerm(hd)) { if (!IsIntTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false; return false;
} }
if (IntOfTerm(hd) < 0) { if (IntOfTerm(hd) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0..."); Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
return false; return false;
} }
} while (IsPairTerm( inp ) ); } while (IsPairTerm( inp ) );
} else { } else {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false; return false;
} }
} }
if ( inp != TermNil ) { if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false; return false;
} }
return true; return true;
@ -511,7 +526,7 @@ static bool typein(Term inp) {
x static bool list_atom( Term inp ) { x static bool list_atom( Term inp ) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false; return false;
} }
Term inp0 = inp; Term inp0 = inp;
@ -523,13 +538,13 @@ x static bool list_atom( Term inp ) {
} }
if (!IsAtomTerm(hd)) { if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\""); Yap_ThrowError(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
return false; return false;
} }
} while (IsPairTerm( inp ) ); } while (IsPairTerm( inp ) );
} }
if ( inp != TermNil ) { if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return false; return false;
} }
return true; return true;
@ -538,7 +553,7 @@ x static bool list_atom( Term inp ) {
static Term list_option(Term inp) { static Term list_option(Term inp) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return inp; return inp;
} }
Term inp0 = inp; Term inp0 = inp;
@ -559,14 +574,14 @@ static Term list_option(Term inp) {
continue; continue;
} }
if (!Yap_IsGroundTerm(hd)) if (!Yap_IsGroundTerm(hd))
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\""); Yap_ThrowError(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
return TermZERO; return TermZERO;
} }
} while (IsPairTerm(inp)); } while (IsPairTerm(inp));
if (inp == TermNil) { if (inp == TermNil) {
return inp0; return inp0;
} }
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return TermZERO; return TermZERO;
} else /* lone option */ { } else /* lone option */ {
if (IsStringTerm(inp)) { if (IsStringTerm(inp)) {
@ -591,12 +606,12 @@ static bool agc_threshold(Term t) {
CACHE_REGS CACHE_REGS
return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold)); return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold));
} else if (!IsIntegerTerm(t)) { } else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE; return FALSE;
} else { } else {
Int i = IntegerOfTerm(t); Int i = IntegerOfTerm(t);
if (i < 0) { if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin"); Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
return FALSE; return FALSE;
} else { } else {
GLOBAL_AGcThreshold = i; GLOBAL_AGcThreshold = i;
@ -610,12 +625,12 @@ static bool gc_margin(Term t) {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return Yap_unify(t, Yap_GetValue(AtomGcMargin)); return Yap_unify(t, Yap_GetValue(AtomGcMargin));
} else if (!IsIntegerTerm(t)) { } else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin"); Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE; return FALSE;
} else { } else {
Int i = IntegerOfTerm(t); Int i = IntegerOfTerm(t);
if (i < 0) { if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin"); Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
return FALSE; return FALSE;
} else { } else {
CACHE_REGS CACHE_REGS
@ -710,7 +725,7 @@ static void initFlag(flag_info *f, int fnum, bool global) {
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry)); fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
if (fprop == NULL) { if (fprop == NULL) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"not enough space for new Flag %s", ae->StrOfAE); "not enough space for new Flag %s", ae->StrOfAE);
return; return;
} }
@ -766,7 +781,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
return false; return false;
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) { if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown module flag"); "trying to set unknown module flag");
return false; return false;
} }
@ -783,7 +798,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
Term t; Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) { while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
if (!Yap_gc(2, ENV, gc_P(P, CP))) { if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false; return false;
} }
} }
@ -810,7 +825,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags |= (UNKNOWN_FAST_FAIL); me->flags |= (UNKNOWN_FAST_FAIL);
return true; return true;
} }
Yap_Error( Yap_ThrowError(
DOMAIN_ERROR_OUT_OF_RANGE, t2, DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for unknown flag, use one of error, fail or warning.", "bad option %s for unknown flag, use one of error, fail or warning.",
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
@ -825,7 +840,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags &= ~(M_CHARESCAPE); me->flags &= ~(M_CHARESCAPE);
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for character_escapes flag, use true or false", "bad option %s for character_escapes flag, use true or false",
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false; return false;
@ -845,7 +860,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return false; return false;
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) { if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
return 0L; return 0L;
} }
// module specific stuff now // module specific stuff now
@ -884,7 +899,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return TermAtom; return TermAtom;
return TermString; return TermString;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped", Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
return 0L; return 0L;
} }
@ -1081,7 +1096,7 @@ static Int current_prolog_flag2(USES_REGS1) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE); tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
} }
if (!IsAtomTerm(tflag)) { if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3"); Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
return (FALSE); return (FALSE);
} }
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
@ -1126,7 +1141,7 @@ bool setYapFlag(Term tflag, Term t2) {
FlagEntry *fv; FlagEntry *fv;
flag_term *tarr; flag_term *tarr;
if (IsVarTerm(tflag)) { if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE); return (FALSE);
} }
if (IsStringTerm(tflag)) { if (IsStringTerm(tflag)) {
@ -1143,7 +1158,7 @@ bool setYapFlag(Term tflag, Term t2) {
return setYapFlagInModule(tflag, t2, modt); return setYapFlagInModule(tflag, t2, modt);
} }
if (!IsAtomTerm(tflag)) { if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE); return (FALSE);
} }
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
@ -1156,7 +1171,7 @@ bool setYapFlag(Term tflag, Term t2) {
} else if (fl == TermWarning) { } else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else { } else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown flag \"%s\"", "trying to set unknown flag \"%s\"",
AtomName(AtomOfTerm(tflag))); AtomName(AtomOfTerm(tflag)));
} }
@ -1212,7 +1227,7 @@ Term getYapFlag(Term tflag) {
flag_term *tarr; flag_term *tarr;
tflag = Deref(tflag); tflag = Deref(tflag);
if (IsVarTerm(tflag)) { if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE); return (FALSE);
} }
if (IsStringTerm(tflag)) { if (IsStringTerm(tflag)) {
@ -1234,7 +1249,7 @@ Term getYapFlag(Term tflag) {
return getYapFlagInModule(tflag, modt); return getYapFlagInModule(tflag, modt);
} }
if (!IsAtomTerm(tflag)) { if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE); return (FALSE);
} }
if (tflag == TermSilent) if (tflag == TermSilent)
@ -1250,7 +1265,7 @@ Term getYapFlag(Term tflag) {
Yap_Warning("Flag ~s does not exist", Yap_Warning("Flag ~s does not exist",
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
} else { } else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to use unknown flag %s", "trying to use unknown flag %s",
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
} }
@ -1353,7 +1368,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = TermFalse; tarr->at = TermFalse;
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s); "~s should be either true (on) or false (off)", s);
return false; return false;
} else if (f == nat) { } else if (f == nat) {
@ -1363,7 +1378,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
UInt r = strtoul(ss, NULL, 10); UInt r = strtoul(ss, NULL, 10);
Term t; Term t;
if (errno) { if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s); "~s should be a positive integer)", s);
return false; return false;
} }
@ -1399,7 +1414,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s); "~s should be either true (on) or false (off)", s);
return false; return false;
} else if (f == isatom) { } else if (f == isatom) {
@ -1408,7 +1423,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
} }
Atom r = Yap_LookupAtom(s); Atom r = Yap_LookupAtom(s);
if (errno) { if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s); "~s should be a positive integer)", s);
tarr->at = TermNil; tarr->at = TermNil;
} }
@ -1519,7 +1534,7 @@ do_prolog_flag_property(Term tflag,
Yap_ArgList2ToVector(opts, prolog_flag_property_defs, Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
if (IsStringTerm(tflag)) { if (IsStringTerm(tflag)) {
@ -1531,7 +1546,7 @@ do_prolog_flag_property(Term tflag,
tflag = Yap_YapStripModule(tflag, &modt); tflag = Yap_YapStripModule(tflag, &modt);
} else { } else {
free(args); free(args);
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE); return (FALSE);
} }
} }
@ -1584,7 +1599,7 @@ do_prolog_flag_property(Term tflag,
break; break;
case PROLOG_FLAG_PROPERTY_END: case PROLOG_FLAG_PROPERTY_END:
/* break; */ /* break; */
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP"); Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
} }
} }
} }
@ -1660,7 +1675,7 @@ static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
do_cut(0); do_cut(0);
return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS); return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS);
} else { } else {
Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2"); Yap_ThrowError(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
} }
} }
return false; return false;
@ -1693,7 +1708,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
Yap_ArgList2ToVector(opts, prolog_flag_property_defs, Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG); PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) { if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL); Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false; return false;
} }
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));

23
C/write.c
View File

@ -583,8 +583,13 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
wrf stream = wglb->stream; wrf stream = wglb->stream;
if (atom == NULL) return; if (atom == NULL) return;
s = RepAtom(atom)->UStrOfAE; s = RepAtom(atom)->UStrOfAE;
if (s[0] == '\0') if (s[0] == '\0') {
if (Quote_illegal) {
wrputc('\'', stream);
wrputc('\'', stream);
}
return; return;
}
if (IsBlob(atom)) { if (IsBlob(atom)) {
wrputblob(RepAtom(atom), Quote_illegal, wglb); wrputblob(RepAtom(atom), Quote_illegal, wglb);
return; return;
@ -1091,16 +1096,12 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.stream = mywrite; wglb.stream = mywrite;
wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f; wglb.Write_strings = flags & BackQuote_String_f;
wglb.Use_portray = false; wglb.Use_portray = flags & Use_portray_f;
wglb.Handle_vars = true; wglb.Handle_vars = flags & Handle_vars_f;
wglb.Use_portray = false; wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.Portray_delays = false; wglb.Keep_terms = flags & To_heap_f;
wglb.Keep_terms = false; wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Write_Loops = false; wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.Write_strings = false;
wglb.Quote_illegal = false;
wglb.Ignore_ops = false;
wglb.MaxDepth = 0;
wglb.MaxArgs = 0 ; wglb.MaxArgs = 0 ;
wglb.lw = separator; wglb.lw = separator;
Term tp; Term tp;

1
C/yap-args.c
View File

@ -834,6 +834,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a
iap->HaltAfterBoot = true; iap->HaltAfterBoot = true;
case 'l': case 'l':
p++; p++;
iap->QuietMode = TRUE;
if (!*++argv) { if (!*++argv) {
fprintf(stderr, fprintf(stderr,
"%% YAP unrecoverable error: missing load file name\n"); "%% YAP unrecoverable error: missing load file name\n");

15
H/YapFlags.h
View File

@ -230,12 +230,15 @@ typedef struct struct_param2 {
const char *scope; const char *scope;
} param2_t; } param2_t;
/// @brief prolog_flag/2 support, notice flag is initialized as text.
///
///
typedef struct { typedef struct {
char *name; char *name; //< user visible name
bool writable; bool writable; //< read-write or read-only
flag_func def; flag_func def; //< call on definition
const char *init; const char *init; //< initial value as string
flag_helper_func helper; flag_helper_func helper; //< operations triggered by writing the flag.
} flag_info; } flag_info;
typedef struct { typedef struct {
@ -244,6 +247,8 @@ typedef struct {
const char *init; const char *init;
} arg_info; } arg_info;
/// @brief
/// a flag is represented as a Prolog term.
typedef union flagTerm { typedef union flagTerm {
Term at; Term at;
struct DB_TERM *DBT; struct DB_TERM *DBT;

2
H/YapGFlagInfo.h
View File

@ -222,7 +222,7 @@ Show their ancestors while debuggIng
vxu `on` consider `$` a lower case character. vxu `on` consider `$` a lower case character.
*/ */
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
booleanFlag, "false", NULL), booleanFlag, "false", dollar_to_lc),
/**< iso /**< iso

1
include/YapErrors.h
View File

@ -176,6 +176,7 @@ E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array")
E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom") E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom")
E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic") E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic")
E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum") E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum")
E(TYPE_ERROR_BOOLEAN, TYPE_ERROR, "boolean")
E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte") E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte")
E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable") E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable")
E(TYPE_ERROR_CHAR, TYPE_ERROR, "char") E(TYPE_ERROR_CHAR, TYPE_ERROR, "char")

2
packages/python/yap_kernel/yap_kernel/_version.py
View File

@ -1,4 +1,4 @@
version_info = (6, 3, 4, 'dev0') version_info = (6, 5, 0, 'dev0')
__version__ = '.'.join(map(str, version_info)) __version__ = '.'.join(map(str, version_info))
kernel_protocol_version_info = (5, 1) kernel_protocol_version_info = (5, 1)

9
pl/consult.yap
View File

@ -42,7 +42,6 @@
use_module/3], use_module/3],
['$add_multifile'/3, ['$add_multifile'/3,
'$csult'/2, '$csult'/2,
'$do_startup_reconsult'/1,
'$elif'/2, '$elif'/2,
'$else'/1, '$else'/1,
'$endif'/1, '$endif'/1,
@ -928,14 +927,6 @@ nb_setval('$if_level',0).
% %
% reconsult at startup... % reconsult at startup...
% %
'$do_startup_reconsult'(_X) :-
'$init_win_graphics',
fail.
'$do_startup_reconsult'(X) :-
catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)),
!,
( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_).
'$skip_unix_header'(Stream) :- '$skip_unix_header'(Stream) :-
peek_code(Stream, 0'#), !, % 35 is ASCII for '# peek_code(Stream, 0'#), !, % 35 is ASCII for '#

123
pl/init.yap
View File

@ -75,7 +75,8 @@
current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ), current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
current_prolog_flag(resource_database, Saved ), current_prolog_flag(resource_database, Saved ),
format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]), format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]),
format(user_error, '% database loaded from ~a~n', [Saved]). format(user_error, '% database loaded from ~a~n', [Saved]),
fail.
'$version'. '$version'.
/** /**
@ -84,24 +85,33 @@
* Must be called after restoring. * Must be called after restoring.
*/ */
'$init_prolog' :- '$init_prolog' :-
% do catch as early as possible '$init_step'(_),
'$version', fail.
yap_flag(file_name_variables, _OldF, true), '$init_prolog'.
'$init_consult', % do catch as early as possible
%set_prolog_flag(file_name_variables, OldF), '$init_step'(1) :-
'$init_globals', '$version'.
set_prolog_flag(fileerrors, true), '$init_step'(2) :-
set_value('$gc',on), set_prolog_flag(file_name_variables, _OldF, true),
('$exit_undefp' -> true ; true), '$init_consult'.
prompt1(' ?- '), %set_prolog_flag(file_name_variables, OldF),
set_prolog_flag(debug, false), '$init_step'(3) :-
% simple trick to find out if this is we are booting from Prolog. '$init_globals',
% boot from a saved state set_prolog_flag(fileerrors, true),
'$init_from_saved_state_and_args', %start_low_level_trace, set_value('$gc',on),
('$exit_undefp' -> true ; true),
prompt1(' ?- '),
set_prolog_flag(debug, false).
% simple trick to find out if this is we are booting from Prolog.
% boot from a saved state
'$init_step'(4) :-
'$init_from_saved_state_and_args'.
'$db_clean_queues'(_), '$init_step'(5) :-
'$db_clean_queues'(_).
% this must be executed from C-code. % this must be executed from C-code.
% '$startup_saved_state', % '$startup_saved_state',
'$init_step'(6) :-
set_input(user_input), set_input(user_input),
set_output(user_output), set_output(user_output),
'$init_or_threads', '$init_or_threads',
@ -110,24 +120,24 @@
% then we can execute the programs. % then we can execute the programs.
'$startup_goals' :- '$startup_goals' :-
module(user), '$startup_step',
fail. fail.
'$startup_goals' :-
recorded('$startup_goal',G,_), '$startup_step' :-
catch(once(user:G),Error,user:'$Error'(Error)), module(user).
fail. '$startup_step' :-
'$startup_goals' :- recorded('$startup_goal',G,_),
catch(once(user:G),Error,user:'$Error'(Error)).
'$startup_step' :-
get_value('$init_goal',GA), get_value('$init_goal',GA),
GA \= [], GA \= [],
set_value('$init_goal',[]), set_value('$init_goal',[]),
'$run_atom_goal'(GA), '$run_atom_goal'(GA).
fail. '$startup_step' :-
'$startup_goals' :- recorded('$restore_flag', goal(Module:GA), R),
recorded('$restore_flag', goal(Module:GA), R), erase(R),
erase(R), catch(once(Module:GA),Error,user:'$Error'(Error)).
catch(once(Module:GA),Error,user:'$Error'(Error)), '$startup_step' :-
fail.
'$startup_goals' :-
get_value('$myddas_goal',GA), GA \= [], get_value('$myddas_goal',GA), GA \= [],
set_value('$myddas_goal',[]), set_value('$myddas_goal',[]),
get_value('$myddas_user',User), User \= [], get_value('$myddas_user',User), User \= [],
@ -150,9 +160,8 @@
), ),
use_module(library(myddas)), use_module(library(myddas)),
call(db_open(mysql,myddas,Host/Db,User,Pass)), call(db_open(mysql,myddas,Host/Db,User,Pass)),
'$myddas_import_all', '$myddas_import_all'.
fail. '$startup_step'.
'$startup_goals'.
% %
% MYDDAS: Import all the tables from one database % MYDDAS: Import all the tables from one database
@ -166,46 +175,48 @@
% use if we come from a save_program and we have SWI's shlib % use if we come from a save_program and we have SWI's shlib
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args' :-
current_prolog_flag(hwnd, _HWND), '$rebuild',
load_files(library(win_menu), [silent(true)]),
fail. fail.
'$init_from_saved_state_and_args' :- '$init_from_saved_state_and_args'.
'$rebuild' :-
current_prolog_flag(hwnd, _HWND),
load_files(library(win_menu), [silent(true)]).
'$rebuild' :-
recorded('$reload_foreign_libraries',_G,R), recorded('$reload_foreign_libraries',_G,R),
erase(R), erase(R),
shlib:reload_foreign_libraries, shlib:reload_foreign_libraries.
fail.
% this should be done before -l kicks in. % this should be done before -l kicks in.
'$init_from_saved_state_and_args' :- '$rebuild' :-
current_prolog_flag(fast_boot, false), current_prolog_flag(fast_boot, false),
( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ), ( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ), ( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ), ( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ),
fail. fail.
% use if we come from a save_program and we have a goal to execute % use if we come from a save_program and we have a goal to execute
'$init_from_saved_state_and_args' :- '$rebuild' :-
get_value('$consult_on_boot',X), X \= [], get_value('$consult_on_boot',X), X \= [],
set_value('$consult_on_boot',[]), load_files(X, [silent(true)]),
'$do_startup_reconsult'(X), set_value('$consult_on_boot',[]).
fail. '$rebuild' :-
'$init_from_saved_state_and_args' :-
recorded('$restore_flag', init_file(M:B), R), recorded('$restore_flag', init_file(M:B), R),
erase(R), erase(R),
'$do_startup_reconsult'(M:B), load_files(M:B, [silent(true)]).
fail. '$rebuild' :-
'$init_from_saved_state_and_args' :-
recorded('$restore_flag', unknown(M:B), R), recorded('$restore_flag', unknown(M:B), R),
erase(R), erase(R),
yap_flag(M:unknown,B), load_files(M:B, [silent(true)]),
fail. yap_flag(M:unknown,B).
'$init_from_saved_state_and_args' :- '$rebuild' :-
'$startup_goals', '$startup_step'.
fail. '$rebuild' :-
'$init_from_saved_state_and_args' :- current_prolog_flag(halt_after_consult, true),
halt.
'$rebuild' :-
recorded('$restore_goal',G,R), recorded('$restore_goal',G,R),
erase(R), erase(R),
prompt(_,'| '), prompt(_,'| '),
catch(once(user:G),Error,user:'$Error'(Error)), catch(once(user:G),Error,user:'$Error'(Error)).
fail.
'$init_path_extensions' :- '$init_path_extensions' :-
get_value('$extend_file_search_path',P), !, get_value('$extend_file_search_path',P), !,

5
pl/messages.yap
View File

@ -1042,9 +1042,8 @@ prolog:print_message(Severity, Msg) :-
!. !.
prolog:print_message(Level, _Msg) :- prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose_load, false), current_prolog_flag(verbose_load, false),
'$show_consult_level'(LC), prolog_load_context(file, _FileName),
LC > 0, Level \= warning,
Level = informational,
!. !.
prolog:print_message(Level, _Msg) :- prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose, silent), current_prolog_flag(verbose, silent),

2
pl/qly.yap
View File

@ -600,7 +600,7 @@ qload_file( F0 ) :-
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod, Mod ), '$current_module'(Mod, Mod ),
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)), print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
'$exec_initialization_goals'. '$init_prolog'.
'$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :- '$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :-
recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _), recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _),