boot
This commit is contained in:
parent
302519868f
commit
90f5720fb0
125
C/flags.c
125
C/flags.c
@ -77,6 +77,7 @@ static bool sqf(Term t2);
|
||||
static bool set_error_stream(Term inp);
|
||||
static bool set_input_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 Int current_prolog_flag(USES_REGS1);
|
||||
@ -119,11 +120,11 @@ static Term indexer(Term inp) {
|
||||
return 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}");
|
||||
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;
|
||||
}
|
||||
|
||||
@ -147,14 +148,14 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
|
||||
return true;
|
||||
}
|
||||
/* 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 "
|
||||
"string flag, use one string, "
|
||||
"atom, codes or chars",
|
||||
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||
return false;
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t2,
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, t2,
|
||||
"set_prolog_flag(double_quotes, %s), should "
|
||||
"be {string,atom,codes,chars}",
|
||||
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||
@ -187,14 +188,14 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
|
||||
new->flags |= BCKQ_CHARS;
|
||||
return true;
|
||||
}
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||
"bad option %s for backquoted "
|
||||
"string flag, use one string, "
|
||||
"atom, codes or chars",
|
||||
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||
return false;
|
||||
} 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);
|
||||
return false;
|
||||
}
|
||||
@ -225,14 +226,14 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
|
||||
new->flags |= SNGQ_CHARS;
|
||||
return true;
|
||||
}
|
||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||
"bad option %s for backquoted "
|
||||
"string flag, use one string, "
|
||||
"atom, codes or chars",
|
||||
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||
return false;
|
||||
} 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);
|
||||
return false;
|
||||
}
|
||||
@ -244,6 +245,20 @@ static bool sqf(Term t2) {
|
||||
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) {
|
||||
if (inp == TermReadWrite || inp == TermReadOnly)
|
||||
return inp;
|
||||
@ -252,11 +267,11 @@ static Term isaccess(Term inp) {
|
||||
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
|
||||
}
|
||||
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}");
|
||||
return TermZERO;
|
||||
}
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp,
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
|
||||
"set_prolog_flag access in {read_write,read_only}");
|
||||
return TermZERO;
|
||||
}
|
||||
@ -302,11 +317,11 @@ static Term flagscope(Term inp) {
|
||||
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
|
||||
}
|
||||
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}");
|
||||
return TermZERO;
|
||||
}
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp,
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
|
||||
"set_prolog_flag access in {global,module,thread}");
|
||||
return TermZERO;
|
||||
}
|
||||
@ -320,7 +335,7 @@ static bool mkprompt(Term inp) {
|
||||
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
|
||||
}
|
||||
if (!IsAtomTerm(inp)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
return false;
|
||||
}
|
||||
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
|
||||
@ -334,7 +349,7 @@ static bool getenc(Term inp) {
|
||||
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
|
||||
}
|
||||
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "get_encoding");
|
||||
return false;
|
||||
}
|
||||
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) ) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
return false;
|
||||
}
|
||||
enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET );
|
||||
@ -368,7 +383,7 @@ static bool typein(Term inp) {
|
||||
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
|
||||
}
|
||||
if (!IsAtomTerm(inp)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||
return false;
|
||||
}
|
||||
CurrentModule = inp;
|
||||
@ -466,7 +481,7 @@ static bool typein(Term inp) {
|
||||
|
||||
static bool string( Term inp ) {
|
||||
if (IsVarTerm(inp)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
return false;
|
||||
}
|
||||
if (IsStringTerm( inp ))
|
||||
@ -481,7 +496,7 @@ static bool typein(Term inp) {
|
||||
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
|
||||
}
|
||||
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;
|
||||
}
|
||||
} while (IsPairTerm( inp ) );
|
||||
@ -489,21 +504,21 @@ static bool typein(Term inp) {
|
||||
do {
|
||||
Term hd = HeadOfTerm(inp);
|
||||
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;
|
||||
}
|
||||
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;
|
||||
}
|
||||
} while (IsPairTerm( inp ) );
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
|
||||
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
|
||||
return false;
|
||||
}
|
||||
}
|
||||
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 true;
|
||||
@ -511,7 +526,7 @@ static bool typein(Term inp) {
|
||||
|
||||
x static bool list_atom( Term inp ) {
|
||||
if (IsVarTerm(inp)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
return false;
|
||||
}
|
||||
Term inp0 = inp;
|
||||
@ -523,13 +538,13 @@ x static bool list_atom( Term inp ) {
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
} while (IsPairTerm( inp ) );
|
||||
}
|
||||
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 true;
|
||||
@ -538,7 +553,7 @@ x static bool list_atom( Term inp ) {
|
||||
|
||||
static Term list_option(Term inp) {
|
||||
if (IsVarTerm(inp)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||
return inp;
|
||||
}
|
||||
Term inp0 = inp;
|
||||
@ -559,14 +574,14 @@ static Term list_option(Term inp) {
|
||||
continue;
|
||||
}
|
||||
if (!Yap_IsGroundTerm(hd))
|
||||
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
|
||||
return TermZERO;
|
||||
}
|
||||
} while (IsPairTerm(inp));
|
||||
if (inp == TermNil) {
|
||||
return inp0;
|
||||
}
|
||||
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
|
||||
Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
|
||||
return TermZERO;
|
||||
} else /* lone option */ {
|
||||
if (IsStringTerm(inp)) {
|
||||
@ -591,12 +606,12 @@ static bool agc_threshold(Term t) {
|
||||
CACHE_REGS
|
||||
return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold));
|
||||
} 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;
|
||||
} else {
|
||||
Int i = IntegerOfTerm(t);
|
||||
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;
|
||||
} else {
|
||||
GLOBAL_AGcThreshold = i;
|
||||
@ -610,12 +625,12 @@ static bool gc_margin(Term t) {
|
||||
if (IsVarTerm(t)) {
|
||||
return Yap_unify(t, Yap_GetValue(AtomGcMargin));
|
||||
} 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;
|
||||
} else {
|
||||
Int i = IntegerOfTerm(t);
|
||||
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;
|
||||
} else {
|
||||
CACHE_REGS
|
||||
@ -710,7 +725,7 @@ static void initFlag(flag_info *f, int fnum, bool global) {
|
||||
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
|
||||
if (fprop == NULL) {
|
||||
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);
|
||||
return;
|
||||
}
|
||||
@ -766,7 +781,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
|
||||
return false;
|
||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||
if (!fv && !fv->global) {
|
||||
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
"trying to set unknown module flag");
|
||||
return false;
|
||||
}
|
||||
@ -783,7 +798,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
|
||||
Term t;
|
||||
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
|
||||
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;
|
||||
}
|
||||
}
|
||||
@ -810,7 +825,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
|
||||
me->flags |= (UNKNOWN_FAST_FAIL);
|
||||
return true;
|
||||
}
|
||||
Yap_Error(
|
||||
Yap_ThrowError(
|
||||
DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||
"bad option %s for unknown flag, use one of error, fail or warning.",
|
||||
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||
@ -825,7 +840,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
|
||||
me->flags &= ~(M_CHARESCAPE);
|
||||
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",
|
||||
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||
return false;
|
||||
@ -845,7 +860,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
|
||||
return false;
|
||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||
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;
|
||||
}
|
||||
// module specific stuff now
|
||||
@ -884,7 +899,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
|
||||
return TermAtom;
|
||||
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);
|
||||
return 0L;
|
||||
}
|
||||
@ -1081,7 +1096,7 @@ static Int current_prolog_flag2(USES_REGS1) {
|
||||
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||
}
|
||||
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);
|
||||
}
|
||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||
@ -1126,7 +1141,7 @@ bool setYapFlag(Term tflag, Term t2) {
|
||||
FlagEntry *fv;
|
||||
flag_term *tarr;
|
||||
if (IsVarTerm(tflag)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
|
||||
return (FALSE);
|
||||
}
|
||||
if (IsStringTerm(tflag)) {
|
||||
@ -1143,7 +1158,7 @@ bool setYapFlag(Term tflag, Term t2) {
|
||||
return setYapFlagInModule(tflag, t2, modt);
|
||||
}
|
||||
if (!IsAtomTerm(tflag)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
return (FALSE);
|
||||
}
|
||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||
@ -1156,7 +1171,7 @@ bool setYapFlag(Term tflag, Term t2) {
|
||||
} else if (fl == TermWarning) {
|
||||
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
|
||||
} else {
|
||||
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
"trying to set unknown flag \"%s\"",
|
||||
AtomName(AtomOfTerm(tflag)));
|
||||
}
|
||||
@ -1212,7 +1227,7 @@ Term getYapFlag(Term tflag) {
|
||||
flag_term *tarr;
|
||||
tflag = Deref(tflag);
|
||||
if (IsVarTerm(tflag)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
|
||||
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
|
||||
return (FALSE);
|
||||
}
|
||||
if (IsStringTerm(tflag)) {
|
||||
@ -1234,7 +1249,7 @@ Term getYapFlag(Term tflag) {
|
||||
return getYapFlagInModule(tflag, modt);
|
||||
}
|
||||
if (!IsAtomTerm(tflag)) {
|
||||
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
return (FALSE);
|
||||
}
|
||||
if (tflag == TermSilent)
|
||||
@ -1250,7 +1265,7 @@ Term getYapFlag(Term tflag) {
|
||||
Yap_Warning("Flag ~s does not exist",
|
||||
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||
} else {
|
||||
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||
"trying to use unknown flag %s",
|
||||
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||
}
|
||||
@ -1353,7 +1368,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
|
||||
tarr->at = TermFalse;
|
||||
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);
|
||||
return false;
|
||||
} 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);
|
||||
Term t;
|
||||
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);
|
||||
return false;
|
||||
}
|
||||
@ -1399,7 +1414,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
|
||||
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
|
||||
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);
|
||||
return false;
|
||||
} else if (f == isatom) {
|
||||
@ -1408,7 +1423,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
|
||||
}
|
||||
Atom r = Yap_LookupAtom(s);
|
||||
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);
|
||||
tarr->at = TermNil;
|
||||
}
|
||||
@ -1519,7 +1534,7 @@ do_prolog_flag_property(Term tflag,
|
||||
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
|
||||
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
|
||||
if (args == NULL) {
|
||||
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
|
||||
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
|
||||
return false;
|
||||
}
|
||||
if (IsStringTerm(tflag)) {
|
||||
@ -1531,7 +1546,7 @@ do_prolog_flag_property(Term tflag,
|
||||
tflag = Yap_YapStripModule(tflag, &modt);
|
||||
} else {
|
||||
free(args);
|
||||
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
|
||||
return (FALSE);
|
||||
}
|
||||
}
|
||||
@ -1584,7 +1599,7 @@ do_prolog_flag_property(Term tflag,
|
||||
break;
|
||||
case PROLOG_FLAG_PROPERTY_END:
|
||||
/* 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);
|
||||
return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
|
||||
Yap_ThrowError(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
|
||||
}
|
||||
}
|
||||
return false;
|
||||
@ -1693,7 +1708,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
|
||||
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
|
||||
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
|
||||
if (args == NULL) {
|
||||
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
|
||||
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
|
||||
return false;
|
||||
}
|
||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||
|
23
C/write.c
23
C/write.c
@ -583,8 +583,13 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
|
||||
wrf stream = wglb->stream;
|
||||
if (atom == NULL) return;
|
||||
s = RepAtom(atom)->UStrOfAE;
|
||||
if (s[0] == '\0')
|
||||
if (s[0] == '\0') {
|
||||
if (Quote_illegal) {
|
||||
wrputc('\'', stream);
|
||||
wrputc('\'', stream);
|
||||
}
|
||||
return;
|
||||
}
|
||||
if (IsBlob(atom)) {
|
||||
wrputblob(RepAtom(atom), Quote_illegal, wglb);
|
||||
return;
|
||||
@ -1091,16 +1096,12 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
|
||||
wglb.stream = mywrite;
|
||||
wglb.Ignore_ops = flags & Ignore_ops_f;
|
||||
wglb.Write_strings = flags & BackQuote_String_f;
|
||||
wglb.Use_portray = false;
|
||||
wglb.Handle_vars = true;
|
||||
wglb.Use_portray = false;
|
||||
wglb.Portray_delays = false;
|
||||
wglb.Keep_terms = false;
|
||||
wglb.Write_Loops = false;
|
||||
wglb.Write_strings = false;
|
||||
wglb.Quote_illegal = false;
|
||||
wglb.Ignore_ops = false;
|
||||
wglb.MaxDepth = 0;
|
||||
wglb.Use_portray = flags & Use_portray_f;
|
||||
wglb.Handle_vars = flags & Handle_vars_f;
|
||||
wglb.Portray_delays = flags & AttVar_Portray_f;
|
||||
wglb.Keep_terms = flags & To_heap_f;
|
||||
wglb.Write_Loops = flags & Handle_cyclics_f;
|
||||
wglb.Quote_illegal = flags & Quote_illegal_f;
|
||||
wglb.MaxArgs = 0 ;
|
||||
wglb.lw = separator;
|
||||
Term tp;
|
||||
|
@ -834,6 +834,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_a
|
||||
iap->HaltAfterBoot = true;
|
||||
case 'l':
|
||||
p++;
|
||||
iap->QuietMode = TRUE;
|
||||
if (!*++argv) {
|
||||
fprintf(stderr,
|
||||
"%% YAP unrecoverable error: missing load file name\n");
|
||||
|
15
H/YapFlags.h
15
H/YapFlags.h
@ -230,12 +230,15 @@ typedef struct struct_param2 {
|
||||
const char *scope;
|
||||
} param2_t;
|
||||
|
||||
/// @brief prolog_flag/2 support, notice flag is initialized as text.
|
||||
///
|
||||
///
|
||||
typedef struct {
|
||||
char *name;
|
||||
bool writable;
|
||||
flag_func def;
|
||||
const char *init;
|
||||
flag_helper_func helper;
|
||||
char *name; //< user visible name
|
||||
bool writable; //< read-write or read-only
|
||||
flag_func def; //< call on definition
|
||||
const char *init; //< initial value as string
|
||||
flag_helper_func helper; //< operations triggered by writing the flag.
|
||||
} flag_info;
|
||||
|
||||
typedef struct {
|
||||
@ -244,6 +247,8 @@ typedef struct {
|
||||
const char *init;
|
||||
} arg_info;
|
||||
|
||||
/// @brief
|
||||
/// a flag is represented as a Prolog term.
|
||||
typedef union flagTerm {
|
||||
Term at;
|
||||
struct DB_TERM *DBT;
|
||||
|
@ -222,7 +222,7 @@ Show their ancestors while debuggIng
|
||||
vxu `on` consider `$` a lower case character.
|
||||
*/
|
||||
YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true,
|
||||
booleanFlag, "false", NULL),
|
||||
booleanFlag, "false", dollar_to_lc),
|
||||
|
||||
/**< iso
|
||||
|
||||
|
@ -176,6 +176,7 @@ E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array")
|
||||
E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom")
|
||||
E(TYPE_ERROR_ATOMIC, TYPE_ERROR, "atomic")
|
||||
E(TYPE_ERROR_BIGNUM, TYPE_ERROR, "bignum")
|
||||
E(TYPE_ERROR_BOOLEAN, TYPE_ERROR, "boolean")
|
||||
E(TYPE_ERROR_BYTE, TYPE_ERROR, "byte")
|
||||
E(TYPE_ERROR_CALLABLE, TYPE_ERROR, "callable")
|
||||
E(TYPE_ERROR_CHAR, TYPE_ERROR, "char")
|
||||
|
@ -1,4 +1,4 @@
|
||||
version_info = (6, 3, 4, 'dev0')
|
||||
version_info = (6, 5, 0, 'dev0')
|
||||
__version__ = '.'.join(map(str, version_info))
|
||||
|
||||
kernel_protocol_version_info = (5, 1)
|
||||
|
@ -42,7 +42,6 @@
|
||||
use_module/3],
|
||||
['$add_multifile'/3,
|
||||
'$csult'/2,
|
||||
'$do_startup_reconsult'/1,
|
||||
'$elif'/2,
|
||||
'$else'/1,
|
||||
'$endif'/1,
|
||||
@ -928,14 +927,6 @@ nb_setval('$if_level',0).
|
||||
%
|
||||
% 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) :-
|
||||
peek_code(Stream, 0'#), !, % 35 is ASCII for '#
|
||||
|
123
pl/init.yap
123
pl/init.yap
@ -75,7 +75,8 @@
|
||||
current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
|
||||
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, '% database loaded from ~a~n', [Saved]).
|
||||
format(user_error, '% database loaded from ~a~n', [Saved]),
|
||||
fail.
|
||||
'$version'.
|
||||
|
||||
/**
|
||||
@ -84,24 +85,33 @@
|
||||
* Must be called after restoring.
|
||||
*/
|
||||
'$init_prolog' :-
|
||||
% do catch as early as possible
|
||||
'$version',
|
||||
yap_flag(file_name_variables, _OldF, true),
|
||||
'$init_consult',
|
||||
%set_prolog_flag(file_name_variables, OldF),
|
||||
'$init_globals',
|
||||
set_prolog_flag(fileerrors, true),
|
||||
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_from_saved_state_and_args', %start_low_level_trace,
|
||||
'$init_step'(_),
|
||||
fail.
|
||||
'$init_prolog'.
|
||||
% do catch as early as possible
|
||||
'$init_step'(1) :-
|
||||
'$version'.
|
||||
'$init_step'(2) :-
|
||||
set_prolog_flag(file_name_variables, _OldF, true),
|
||||
'$init_consult'.
|
||||
%set_prolog_flag(file_name_variables, OldF),
|
||||
'$init_step'(3) :-
|
||||
'$init_globals',
|
||||
set_prolog_flag(fileerrors, true),
|
||||
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.
|
||||
% '$startup_saved_state',
|
||||
'$init_step'(6) :-
|
||||
set_input(user_input),
|
||||
set_output(user_output),
|
||||
'$init_or_threads',
|
||||
@ -110,24 +120,24 @@
|
||||
|
||||
% then we can execute the programs.
|
||||
'$startup_goals' :-
|
||||
module(user),
|
||||
fail.
|
||||
'$startup_goals' :-
|
||||
recorded('$startup_goal',G,_),
|
||||
catch(once(user:G),Error,user:'$Error'(Error)),
|
||||
fail.
|
||||
'$startup_goals' :-
|
||||
'$startup_step',
|
||||
fail.
|
||||
|
||||
'$startup_step' :-
|
||||
module(user).
|
||||
'$startup_step' :-
|
||||
recorded('$startup_goal',G,_),
|
||||
catch(once(user:G),Error,user:'$Error'(Error)).
|
||||
'$startup_step' :-
|
||||
get_value('$init_goal',GA),
|
||||
GA \= [],
|
||||
set_value('$init_goal',[]),
|
||||
'$run_atom_goal'(GA),
|
||||
fail.
|
||||
'$startup_goals' :-
|
||||
recorded('$restore_flag', goal(Module:GA), R),
|
||||
erase(R),
|
||||
catch(once(Module:GA),Error,user:'$Error'(Error)),
|
||||
fail.
|
||||
'$startup_goals' :-
|
||||
'$run_atom_goal'(GA).
|
||||
'$startup_step' :-
|
||||
recorded('$restore_flag', goal(Module:GA), R),
|
||||
erase(R),
|
||||
catch(once(Module:GA),Error,user:'$Error'(Error)).
|
||||
'$startup_step' :-
|
||||
get_value('$myddas_goal',GA), GA \= [],
|
||||
set_value('$myddas_goal',[]),
|
||||
get_value('$myddas_user',User), User \= [],
|
||||
@ -150,9 +160,8 @@
|
||||
),
|
||||
use_module(library(myddas)),
|
||||
call(db_open(mysql,myddas,Host/Db,User,Pass)),
|
||||
'$myddas_import_all',
|
||||
fail.
|
||||
'$startup_goals'.
|
||||
'$myddas_import_all'.
|
||||
'$startup_step'.
|
||||
|
||||
%
|
||||
% 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
|
||||
'$init_from_saved_state_and_args' :-
|
||||
current_prolog_flag(hwnd, _HWND),
|
||||
load_files(library(win_menu), [silent(true)]),
|
||||
'$rebuild',
|
||||
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),
|
||||
erase(R),
|
||||
shlib:reload_foreign_libraries,
|
||||
fail.
|
||||
shlib:reload_foreign_libraries.
|
||||
% this should be done before -l kicks in.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$rebuild' :-
|
||||
current_prolog_flag(fast_boot, false),
|
||||
( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
|
||||
( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
|
||||
( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ),
|
||||
fail.
|
||||
% 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 \= [],
|
||||
set_value('$consult_on_boot',[]),
|
||||
'$do_startup_reconsult'(X),
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
load_files(X, [silent(true)]),
|
||||
set_value('$consult_on_boot',[]).
|
||||
'$rebuild' :-
|
||||
recorded('$restore_flag', init_file(M:B), R),
|
||||
erase(R),
|
||||
'$do_startup_reconsult'(M:B),
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
load_files(M:B, [silent(true)]).
|
||||
'$rebuild' :-
|
||||
recorded('$restore_flag', unknown(M:B), R),
|
||||
erase(R),
|
||||
yap_flag(M:unknown,B),
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
'$startup_goals',
|
||||
fail.
|
||||
'$init_from_saved_state_and_args' :-
|
||||
load_files(M:B, [silent(true)]),
|
||||
yap_flag(M:unknown,B).
|
||||
'$rebuild' :-
|
||||
'$startup_step'.
|
||||
'$rebuild' :-
|
||||
current_prolog_flag(halt_after_consult, true),
|
||||
halt.
|
||||
'$rebuild' :-
|
||||
recorded('$restore_goal',G,R),
|
||||
erase(R),
|
||||
prompt(_,'| '),
|
||||
catch(once(user:G),Error,user:'$Error'(Error)),
|
||||
fail.
|
||||
catch(once(user:G),Error,user:'$Error'(Error)).
|
||||
|
||||
'$init_path_extensions' :-
|
||||
get_value('$extend_file_search_path',P), !,
|
||||
|
@ -1042,9 +1042,8 @@ prolog:print_message(Severity, Msg) :-
|
||||
!.
|
||||
prolog:print_message(Level, _Msg) :-
|
||||
current_prolog_flag(verbose_load, false),
|
||||
'$show_consult_level'(LC),
|
||||
LC > 0,
|
||||
Level = informational,
|
||||
prolog_load_context(file, _FileName),
|
||||
Level \= warning,
|
||||
!.
|
||||
prolog:print_message(Level, _Msg) :-
|
||||
current_prolog_flag(verbose, silent),
|
||||
|
@ -600,7 +600,7 @@ qload_file( F0 ) :-
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$current_module'(Mod, Mod ),
|
||||
print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
|
||||
'$exec_initialization_goals'.
|
||||
'$init_prolog'.
|
||||
|
||||
'$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :-
|
||||
recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _),
|
||||
|
Reference in New Issue
Block a user