diff --git a/C/flags.c b/C/flags.c new file mode 100644 index 000000000..49d2267c1 --- /dev/null +++ b/C/flags.c @@ -0,0 +1,1397 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * +* * +************************************************************************** +* * +* File: flags.c * +* Last rev: * +* mods: * +* comments: abstract machine definitions * +* * +*************************************************************************/ + +/** @file flags.c + + @ingroup Flags + @{ +*/ + + +// this is where we define flags +#define INIT_FLAGS 1 + +#include "Yap.h" + +static bool ro( Term inp ); +static bool nat( Term inp ); +static bool isatom( Term inp ); +static bool boolean( Term inp ); +//static bool string( Term inp ); +//static bool list_atom( Term inp ); +static bool list_option( Term inp ); +static bool argv( Term inp ); +static bool os_argv( Term inp ); +static bool agc_threshold( Term inp ); +static bool gc_margin( Term inp ); +static bool executable( Term inp ); +static bool sys_thread_id(Term inp); +static bool mkprompt(Term inp); +static bool synerr(Term inp); +static bool indexer(Term inp); +static bool getenc(Term inp); +static bool typein( Term inp ); + +static void newFlag( Term fl, Term val ); +static Int current_prolog_flag(USES_REGS1); +static Int set_prolog_flag(USES_REGS1); + +#include "Yatom.h" +#include "yapio.h" +#include "eval.h" + +#define YAP_FLAG( ID, NAME, WRITABLE, DEF, INIT, HELPER ) { NAME, WRITABLE, DEF, INIT, HELPER } + +#define GZERO_FLAG { NULL, false, NULL, NULL, NULL } +#define LZERO_FLAG { NULL, false, NULL, NULL, NULL } + +static flag_info global_flags_setup[] = { +#include "YapGFlagInfo.h" + GZERO_FLAG + }; + +static flag_info local_flags_setup[] = { + #include "YapLFlagInfo.h" + LZERO_FLAG + }; + +static bool indexer( Term inp ) { + if (inp == TermOff || + inp == TermSingle|| + inp == TermCompact|| + inp == TermMulti|| + inp == TermOn|| + inp == TermMax ) + return true; + + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag index in {off,single,compact,multi,on,max}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {dec10,error,fail,quiet}"); + return false; +} + + +static bool isaccess( Term inp ) { + if (inp == TermReadWrite || + inp == TermReadOnly ) + return true; + + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {read_write,read_only}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {read_write,read_only}"); + return false; +} + +static bool isground( Term inp ) { + return Yap_IsGroundTerm( inp ); +} + + +static bool flagscope( Term inp ) { + if (inp == TermGlobal || + inp == TermThread || + inp == TermModule) + return true; + + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {global,module,thread}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {global,module,thread}"); + return false; +} + + +static bool mkprompt( Term inp ) { + CACHE_REGS + if (IsVarTerm(inp)) { + return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( LOCAL_Prompt )) ); + } + if (!IsAtomTerm(inp) ) { + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + return false; + } + strncpy( LOCAL_Prompt, RepAtom( AtomOfTerm( inp ) )->StrOfAE, MAX_PROMPT ); + return true; +} + +static bool getenc( Term inp ) { + CACHE_REGS + if (IsVarTerm(inp)) { + return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding) )) ); + } + if (!IsAtomTerm(inp) ) { + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + return false; + } + enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE ); + return true; +} + +/* +static bool enablerl( Term inp ) { + CACHE_REGS + if (IsVarTerm(inp)) { + return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding) )) ); + } + if (!IsAtomTerm(inp) ) { + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + return false; + } + enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE ); + return true; +} +*/ + +static bool typein( Term inp ) { + CACHE_REGS + if (IsVarTerm(inp)) { + Term tin = CurrentModule; + if (tin == PROLOG_MODULE) + tin = TermProlog; + return Yap_unify( inp, tin ); + } + if (!IsAtomTerm(inp) ) { + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag"); + return false; + } + CurrentModule = inp; + if (inp == TermProlog) CurrentModule = PROLOG_MODULE; + return true; +} + +#if 0 + +static Int p_has_yap_or(USES_REGS1) { +#ifdef YAPOR + return (TRUE); +#else + return (FALSE); +#endif +} + +static Int p_has_eam(USES_REGS1) { + +#ifdef BEAM + return (TRUE); +#else + return (FALSE); +#endif +} + +static Int p_has_jit(USES_REGS1) { +#ifdef HAS_JIT + return (TRUE); +#else + return (FALSE); +#endif +} + +static bool tabling( Term inp ) { + if (value == 0) { /* default */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + TabEnt_mode(tab_ent) = TabEnt_flags(tab_ent); + tab_ent = TabEnt_next(tab_ent); + } + yap_flags[TA BLING_MODE_FLAG] = 0; + } else if (value == 1) { /* batched */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_Batched(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_Batched(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 2) { /* local */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_Local(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_Local(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 3) { /* exec_answers */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_ExecAnswers(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_ExecAnswers(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 4) { /* load_answers */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_LoadAnswers(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 5) { /* local_trie */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_LocalTrie(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_LocalTrie(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 6) { /* global_trie */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_GlobalTrie(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG]); + } else if (value == 7) { /* CoInductive */ + tab_ent_ptr tab_ent = GLOBAL_root_tab_ent; + while (tab_ent) { + SetMode_CoInductive(TabEnt_mode(tab_ent)); + tab_ent = TabEnt_next(tab_ent); + } + SetMode_CoInductive(yap_flags[TABLING_MODE_FLAG]); + } +} + +static bool string( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + return false; + } + if (IsStringTerm( inp )) + return true; + Term inp0 = inp; + if (IsPairTerm(inp)) { + Term hd = HeadOfTerm(inp); + if (IsAtomTerm(hd)) { + do { + Term hd = HeadOfTerm(inp); + if (!IsAtomTerm(hd)) { + Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + return false; + } + } while (IsPairTerm( inp ) ); + } else if (IsIntTerm(hd)) { + do { + Term hd = HeadOfTerm(inp); + if (!IsIntTerm(hd)) { + Yap_Error(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..."); + return false; + } + } while (IsPairTerm( inp ) ); + } else { + Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + return false; + } + } + if ( inp != TermNil ) { + Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\""); + return false; + } + return true; +} + +static bool list_atom( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + return false; + } + Term inp0 = inp; + if (IsPairTerm(inp)) { + Term hd = HeadOfTerm(inp); + do { + if (!IsAtomTerm(hd)) { + Yap_Error(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 [...]"); + return false; + } + return true; +} +#endif + + +static bool list_option( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\""); + return false; + } + Term inp0 = inp; + if (IsPairTerm(inp)) { + do { + Term hd = HeadOfTerm(inp); + inp = TailOfTerm(inp); + if (IsAtomTerm(hd)) { + continue; + } + if(IsApplTerm(hd)) { + Functor f = FunctorOfTerm(hd); + if (!IsExtensionFunctor(f) && + ArityOfFunctor(f) == 1 && + Yap_IsGroundTerm(hd)) { + continue; + } + if (!Yap_IsGroundTerm(hd)) + Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\""); + return false; + } + } while (IsPairTerm( inp ) ); + if ( inp == TermNil ) { + return true; + } + Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); + return false; + } else /* lone option */ { + if (IsAtomTerm(inp)) { + return true; + } else if(IsApplTerm(inp)) { + Functor f = FunctorOfTerm(inp); + if (!IsExtensionFunctor(f) && + ArityOfFunctor(f) == 1 && + Yap_IsGroundTerm(ArgOfTerm(1, inp))) { + return true; + } + } + + } + return false; +} + +static bool agc_threshold( Term t ) { + t = Deref(t); + if (IsVarTerm(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"); + return FALSE; + } else { + Int i = IntegerOfTerm(t); + if (i<0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t,"prolog_flag/2 agc_margin"); + return FALSE; + } else { + GLOBAL_AGcThreshold = i; + return TRUE; + } + } +} + +static bool gc_margin( Term t ) { + t = Deref(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"); + return FALSE; + } else { + Int i = IntegerOfTerm(t); + if (i<0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t,"prolog_flag/2 gc_margin"); + return FALSE; + } else { + CACHE_REGS + Yap_PutValue(AtomGcMargin, MkIntegerTerm( i )); + return TRUE; + } + } +} + +static Term mk_argc_list(USES_REGS1) { + int i = 0; + Term t = TermNil; + while (i < GLOBAL_argc) { + char *arg = GLOBAL_argv[i]; + /* check for -L -- */ + if (arg[0] == '-' && arg[1] == 'L') { + arg += 2; + while (*arg != '\0' && (*arg == ' ' || *arg == '\t')) + arg++; + if (*arg == '-' && arg[1] == '-' && arg[2] == '\0') { + /* we found the separator */ + int j; + for (j = GLOBAL_argc - 1; j > i + 1; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t); + } + return t; + } else if (GLOBAL_argv[i + 1] && GLOBAL_argv[i + 1][0] == '-' && + GLOBAL_argv[i + 1][1] == '-' && + GLOBAL_argv[i + 1][2] == '\0') { + /* we found the separator */ + int j; + for (j = GLOBAL_argc - 1; j > i + 2; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t); + } + return t; + } + } + if (arg[0] == '-' && arg[1] == '-' && arg[2] == '\0') { + /* we found the separator */ + int j; + for (j = GLOBAL_argc - 1; j > i; --j) { + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t); + } + return (t); + } + i++; + } + return (t); +} + +static Term mk_os_argc_list(USES_REGS1) { + int i = 0; + Term t = TermNil; + for (i = 0; i < GLOBAL_argc; i++) { + char *arg = GLOBAL_argv[i]; + t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(arg)), t); + } + return (t); +} + +static bool argv(Term inp) { + CACHE_REGS + Term t = mk_argc_list(PASS_REGS1); + return Yap_unify(t, inp); +} + +static bool os_argv(Term inp) { + CACHE_REGS + Term t = mk_os_argc_list(PASS_REGS1); + return Yap_unify(t, inp); +} + + + + +static FlagEntry * +GetFlagProp(Atom a ) +{ /* look property list of atom a for kind */ + AtomEntry *ae = RepAtom(a); + FlagEntry *pp; + + READ_LOCK(ae->ARWLock); + + pp = RepFlagProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && pp->KindOfPE != FlagProperty) + pp = RepFlagProp(pp->NextOfPE); + READ_UNLOCK(ae->ARWLock); + + return pp; +} + +static void +initFlag(flag_info *f, int fnum, bool global) +{ + Atom name = Yap_LookupAtom( f->name ); + AtomEntry *ae = RepAtom(name); + WRITE_LOCK(ae->ARWLock); + FlagEntry * fprop = RepFlagProp(Yap_GetAPropHavingLock( name, FlagProperty ) ); + if (fprop == NULL) { + fprop = (FlagEntry *) Yap_AllocAtomSpace(sizeof(FlagEntry)); + if (fprop == NULL) { + WRITE_UNLOCK(ae->ARWLock); + Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for new Flag %s", ae->StrOfAE); return; + } + fprop->KindOfPE = FlagProperty; + fprop->FlagOfVE = fnum; + fprop->rw = f->writable; + fprop->global = global; + fprop->type = f->def; + fprop->helper = f->helper; + AddPropToAtom(ae, AbsFlagProp(fprop)); + } + WRITE_UNLOCK(ae->ARWLock); +} + +static bool executable(Term inp) { + CACHE_REGS + if (GLOBAL_argv && GLOBAL_argv[0]) + Yap_TrueFileName(GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE); + else + strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX - 1); + + return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), inp); +} + +static bool sys_thread_id(Term inp) +{ + CACHE_REGS + int pid; +#ifdef HAVE_GETTID_SYSCALL + pid = syscall(__NR_gettid); +#elif defined(HAVE_GETTID_MACRO) + pid = gettid(); +#elif defined(__WINDOWS__) + pid = GetCurrentThreadId(); +#else + pid = 0; +#endif + + return Yap_unify(MkIntegerTerm(pid), inp); +} + + +static bool setYapFlagInModule( Term tflag, Term t2, Term mod ) +{ + FlagEntry *fv; + ModEntry *new = Yap_GetModuleEntry(mod); + if (!mod) + return false; + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (!fv && !fv->global) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); + return FALSE; + } + if (mod == USER_MODULE && !setYapFlag( tflag, t2) ) + return false; + + // module specific stuff now + + if (fv->FlagOfVE == UNKNOWN_FLAG) { + if (t2 == TermError) { + new->flags &= ~(UNKNOWN_FAIL|UNKNOWN_WARNING); + new->flags |= (UNKNOWN_ERROR); + return true; + } else if (t2 == TermFail) { + new->flags &= ~(UNKNOWN_ERROR|UNKNOWN_WARNING); + new->flags |= (UNKNOWN_FAIL); + return true; + } else if (t2 == TermWarning) { + new->flags &= ~(UNKNOWN_ERROR|UNKNOWN_FAIL); + new->flags |= (UNKNOWN_WARNING); + return true; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option for %s:unknown flag", RepAtom(AtomOfTerm(tflag))->StrOfAE); + return false; + } else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) { + if (t2 == TermTrue) { + new->flags |= M_CHARESCAPE; + return true; + } else if (t2 == TermFalse) { + new->flags &= ~(M_CHARESCAPE); + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option for %s:character_escapes flag", RepAtom(AtomOfTerm(tflag))->StrOfAE); + return false; + } else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) { + new->flags &= ~(DBLQ_CHARS|DBLQ_CODES|DBLQ_ATOM|DBLQ_STRING); + if (t2 == TermString) { + new->flags |= DBLQ_STRING; + return true; + } else if (t2 == TermAtom) { + new->flags |= DBLQ_ATOM; + return true; + } else if (t2 == TermCodes) { + new->flags |= DBLQ_CODES; + return true; + } else if (t2 == TermChars) { + new->flags |= DBLQ_CHARS; + return true; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option for %s:backquoted_string flag", RepAtom(AtomOfTerm(tflag))->StrOfAE); + return false; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "flag %s is not module-scoped", RepAtom(AtomOfTerm(tflag))->StrOfAE); + return FALSE; +} + +static Term getYapFlagInModule( Term tflag, Term mod ) +{ + FlagEntry *fv; + ModEntry *new = Yap_GetModuleEntry(mod); + if (!mod) + return false; + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (!fv && !fv->global) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag"); + return 0L; + } + // module specific stuff now + + if (fv->FlagOfVE == UNKNOWN_FLAG) { + if (new->flags & UNKNOWN_ERROR) + return TermError; + if (new->flags & UNKNOWN_WARNING) + return TermWarning; + return TermFail; + } else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) { + if (new->flags & M_CHARESCAPE) + return TermTrue; + } else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) { + if (new->flags & DBLQ_CHARS) + return TermChars; + if (new->flags & DBLQ_CODES) + return TermCodes; + if (new->flags & DBLQ_ATOM) + return TermAtom; + return TermString; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped", RepAtom(AtomOfTerm(tflag))->StrOfAE); + return 0L; +} + +static Int cont_yap_flag(USES_REGS1) { + int i = IntOfTerm (EXTRA_CBACK_ARG (2, 1)); + int gmax = GLOBAL_flagCount; + int lmax = LOCAL_flagCount; + Term tflag = Deref(ARG1); + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1); + + if (IsApplTerm( tflag ) && FunctorOfTerm(tflag) == FunctorModule) { + Term modt = CurrentModule; + tflag = Yap_StripModule( tflag, &modt ); + while (i != gmax && + i != UNKNOWN_FLAG && + i != CHARACTER_ESCAPES_FLAG && + i != BACKQUOTED_STRING_FLAG) i++; + if (i == gmax) cut_fail(); + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i+1); + { + Term lab = MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ; + Term val = Deref(ARG2); + + if (! Yap_unify(tflag, lab) ) + return false; + if (IsVarTerm(val)) { + Term oval = getYapFlagInModule( lab, modt ); + if (oval == 0) + return false; + return Yap_unify( oval, val ); + } else { + return setYapFlagInModule( tflag, val, modt ); + } + } + return false; + } + if (i >= gmax ) { + Yap_unify( ARG1, MkAtomTerm( Yap_LookupAtom(local_flags_setup[i-gmax].name ) ) ); + if (i == gmax+lmax-1) + do_cut(0); + } else { + Yap_unify( ARG1, MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ); + } + Term flag = getYapFlag( Deref(ARG1) ); + return Yap_unify( flag, ARG2 ); +} + +static Int yap_flag(USES_REGS1) { + Term tflag = Deref(ARG1); + if (IsVarTerm( tflag ) ) { + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (0); + return cont_yap_flag( PASS_REGS1 ); + } + if (IsApplTerm( tflag ) && FunctorOfTerm(tflag) == FunctorModule) { + Term modt; + tflag = Yap_StripModule( tflag, &modt ); + if (IsVarTerm(tflag)) { + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (0); + return cont_yap_flag(); + } + do_cut( 0 ); + + if (!isatom(tflag)) return false; + if (!isatom(modt)) return false; + if (IsVarTerm(Deref(ARG2))) { + Term flag = getYapFlagInModule( tflag, modt ); + if (flag == 0) + return false; + return Yap_unify( flag, ARG2 ); + } else { + return setYapFlagInModule( tflag, Deref(ARG2), modt ); + } + } + + do_cut( 0 ); + + if (IsVarTerm(Deref(ARG2))) { + Term flag = getYapFlag( Deref(ARG1) ); + if (flag == 0) + return false; + return Yap_unify( flag, ARG2 ); + } + return set_prolog_flag( PASS_REGS1 ); +} + +static Int cont_prolog_flag(USES_REGS1) { + int i = IntOfTerm (EXTRA_CBACK_ARG (3, 1)); + while (i < GLOBAL_flagCount+LOCAL_flagCount) { + int gmax = GLOBAL_flagCount; + int lmax = LOCAL_flagCount; + Term flag, f; + + if (i >= gmax+lmax) { + cut_fail(); + } else if (i >= gmax) { + Yap_unify( ARG1, ( f = MkAtomTerm( Yap_LookupAtom(local_flags_setup[i-gmax].name ) ) )); + } else { + Yap_unify( ARG1, (f = MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ) ); + } + EXTRA_CBACK_ARG (3, 1) = MkIntTerm (++i); + flag = getYapFlag( f ); + if (! Yap_unify( f, ARG2 ) ) + return false; + return setYapFlag( f, Deref(ARG3) ); + } + cut_fail(); +} + +/** @pred prolog_flag(? _Flag_,- _OldValue_,+ _NewValue_) + +Obtain the value for a YAP Prolog flag and then set it to a new +value. Equivalent to first calling current_prolog_flag/2 with the +second argument _OldValue_ unbound and then calling +set_prolog_flag/2 with the third argument _NewValue_. + + +*/ +static Int prolog_flag(USES_REGS1) { + if (IsVarTerm( Deref(ARG1) ) ) { + EXTRA_CBACK_ARG (3, 1) = MkIntTerm (0); + return cont_prolog_flag( PASS_REGS1 ); + } + do_cut( 0 ); + { + Term flag = getYapFlag( Deref(ARG1) ); + if (flag == 0) + return false; + if (Yap_unify( flag, ARG2 ) ) + return false; + } + return setYapFlag( Deref(ARG1), Deref(ARG3) ); +} + + +/** @pred current_prolog_flag(? _Flag_,- _Value_) is iso + +Obtain the value for a YAP Prolog flag. Equivalent to calling +yap_flag/2 with the second argument unbound, and unifying the +returned second argument with _Value_. + +*/ +static Int current_prolog_flag( PASS_REGS1 ) { + Term tflag = Deref(ARG1); + Term tout = 0; + FlagEntry *fv; + flag_term *tarr; + + if (IsVarTerm(tflag)) { + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (0); + return cont_yap_flag( PASS_REGS1 ); + } + do_cut( 0 ); + if (!IsAtomTerm(tflag)) { + Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3"); + return (FALSE); + } + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (!fv) { + // should itself depend on a flag + return FALSE; + } + if (fv->global) + tarr = GLOBAL_Flags; + else + tarr = LOCAL_Flags; + tout = tarr[fv->FlagOfVE].at; + if (IsVarTerm(tout)) + tout = Yap_FetchTermFromDB(tarr[fv->FlagOfVE].DBT); + return (Yap_unify(ARG2, tout)); +} + +void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) +{ + Atom at = new->AtomOfME; + new->flags = 0; + if (at == AtomProlog ) { + new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE; + return; + } else if (cme == NULL) { + new->flags = UNKNOWN_ERROR | M_SYSTEM | M_CHARESCAPE; + return; + } else + new->flags = cme->flags; + } + +bool setYapFlag( Term tflag, Term t2 ) +{ + FlagEntry *fv; + flag_term *tarr; + if (IsVarTerm(tflag)) { + Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); + return (FALSE); + } + if (IsApplTerm( tflag ) && FunctorOfTerm(tflag) == FunctorModule) { + Term modt; + tflag = Yap_StripModule( tflag, &modt ); + if (!isatom(tflag)) return false; + if (!isatom(modt)) return false; + return setYapFlagInModule( tflag, t2, modt ); + } + if (!IsAtomTerm(tflag)) { + Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + return (FALSE); + } + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (!fv) { + Term fl = GLOBAL_Flags[USER_FLAGS_FLAG].at; + if (fl == TermSilent) { + Term t2 = Deref(ARG2); + newFlag( tflag, t2); + } else if (fl == TermWarning) { + Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); + } else { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl))); + } + return FALSE; + } + if (fv->global) + tarr = GLOBAL_Flags; + else { + CACHE_REGS + tarr = LOCAL_Flags; + } + if (!(fv->type(t2))) + return false; + if (fv->helper && !(fv->helper(t2))) + return false; + Term tout = tarr[fv->FlagOfVE].at; + if (IsVarTerm(tout)) + Yap_PopTermFromDB( tarr[fv->FlagOfVE].DBT ); + if (IsAtomOrIntTerm(t2)) + tarr[fv->FlagOfVE].at = t2; + else { + tarr[fv->FlagOfVE].DBT = Yap_StoreTermInDB(t2, 2); + } + return true; +} + +Term getYapFlag( Term tflag ) +{ + FlagEntry *fv; + flag_term *tarr; + if (IsVarTerm(tflag)) { + Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2"); + return (FALSE); + } + if (IsApplTerm( tflag ) && FunctorOfTerm(tflag) == FunctorModule) { + Term modt; + tflag = Yap_StripModule( tflag, &modt ); + if (!isatom(tflag)) return false; + if (!isatom(modt)) return false; + return getYapFlagInModule( tflag, modt ); + } + if (!IsAtomTerm(tflag)) { + Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + return (FALSE); + } + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (!fv) { + Term fl = GLOBAL_Flags[USER_FLAGS_FLAG].at; + if (fl == TermSilent) { + return false; + } else if (fl == TermWarning) { + Yap_Warning("Flag ~s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE); + } else { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, fl, "trying to read unknown flag"); + } + return FALSE; + } + if (fv->global) + tarr = GLOBAL_Flags; + else { + CACHE_REGS + tarr = LOCAL_Flags; + } + Term tout = tarr[fv->FlagOfVE].at; + if (IsVarTerm(tout)) + return Yap_FetchTermFromDB( tarr[fv->FlagOfVE].DBT ); + else + return tout; +} + +/** @pred set_prolog_flag(+ _Flag_,+ _Value_) is iso + +Set the value for YAP Prolog flag `Flag`. Equivalent to +calling yap_flag/2 with both arguments bound. + +*/ +static Int set_prolog_flag(USES_REGS1) { + Term tflag = Deref(ARG1), t2 = Deref(ARG2); + return setYapFlag( tflag, t2 ); + } + +/** @pred source + +After executing this goal, YAP keeps information on the source +of the predicates that will be consulted. This enables the use of +[listing/0](@ref listing), `listing/1` and [clause/2](@ref clause) for those +clauses. + +The same as `source_mode(_,on)` or as declaring all newly defined +static procedures as `public`. +*/ +static Int source(USES_REGS1) { + setBooleanGlobalPrologFlag(SOURCE_FLAG, true); + return true; +} + +/** @pred no_source + The opposite to `source`. + +The same as `source_mode(_,off)`. + +*/ +static Int no_source(USES_REGS1) { + setBooleanGlobalPrologFlag(SOURCE_FLAG, false); + return true; +} + + +/** + @pred source_mode(- _O_,+ _N_) + +The state of source mode can either be on or off. When the source mode +is on, all clauses are kept both as compiled code and in a "hidden" +database. _O_ is unified with the previous state and the mode is set +according to _N_. + +*/ +static Int +source_mode( USE_ARGS1 ) +{ + Term targ; + bool current = trueGlobalPrologFlag(SOURCE_FLAG); + if (current && !Yap_unify_constant( ARG1, TermTrue ) ) + return false; + if (!current && !Yap_unify_constant( ARG1, TermFalse) ) + return false; + targ = Deref(ARG2); + setYapFlag( TermSource, ARG2 ); + return true; +} + + +static bool +setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr ) +{ + errno = 0; + + if (f == boolean) { + if (!bootstrap) { return 0; } + if (!strcmp(s, "true")) { + tarr->at = TermTrue; + return true; + } + if (!strcmp(s, "false")) { + tarr->at = TermFalse; + return true; + } + if (!strcmp(s, "on")) { + tarr->at = TermTrue; + return true; + } + if (!strcmp(s, "off")) { + tarr->at = TermFalse; + return true; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s); + return false; + } else if (f == nat) { + if (!bootstrap) { return 0; } + UInt r = strtoul(s, NULL, 10); + Term t; + if (errno) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s); + return false; + } + CACHE_REGS + t= MkIntegerTerm(r); + if (IsIntTerm(t)) + tarr->at = t; + else { + tarr->DBT = Yap_StoreTermInDB(t, 2); + } + return true; + } else if (f == at2n) { + if (!bootstrap) { return 0; } + if (!strcmp(s, "INT_MAX")) { + tarr->at = MkIntTerm(Int_MAX); + return true; + } + if (!strcmp(s, "MAX_THREADS")) { + tarr->at = MkIntTerm(MAX_THREADS); + return true; + } + if (!strcmp(s, "MAX_WORKERS")) { + tarr->at = MkIntTerm(MAX_WORKERS); + return true; + } + if (!strcmp(s, "INT_MIN")) { + tarr->at = MkIntTerm(Int_MIN); + return true; + } + if (!strcmp(s, "YAP_NUMERIC_VERSION")) { + tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); + return true; + } + if (!strcmp(s, "YAP_NUMERIC_VERSION")) { + tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION)); + return true; + } + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s); + return false; + } else if (f == isatom) { + if (!bootstrap) { return false; } + Atom r = Yap_LookupAtom(s); + if (errno) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s); + tarr->at = TermNil; + } + tarr->at = MkAtomTerm( r ); + return true; + } else { + Term t0; + if (bootstrap) { return false; } + t0 = Yap_StringToTerm(s, strlen(s)+1, LOCAL_encoding, 1200, NULL); + if (!t0) + return false; + if (IsAtomTerm(t0) || IsIntTerm(t0)) { + tarr->at = t0; + } else { + tarr->DBT = Yap_StoreTermInDB(t0, 2); + } + return true; + } +} + +#define PROLOG_FLAG_PROPERTY_DEFS() \ + PAR( "access", isaccess, PROLOG_FLAG_PROPERTY_ACCESS, "read_write" ), \ + PAR( "type", isground, PROLOG_FLAG_PROPERTY_TYPE, "term" ), \ + PAR( "scope", flagscope, PROLOG_FLAG_PROPERTY_SCOPE, "global" ), \ + PAR( "keep", boolean, PROLOG_FLAG_PROPERTY_KEEP, "false" ), \ + PAR( NULL, ok, PROLOG_FLAG_PROPERTY_END, 0 ) + +#define PAR(x,y,z,w) z + + typedef enum prolog_flag_property_enum_choices + { + PROLOG_FLAG_PROPERTY_DEFS() + } prolog_flag_property_choices_t; + +#undef PAR + +#define PAR(x,y,z, w) { x , y, z, w } + + + static const param2_t prolog_flag_property_defs[] = + { + PROLOG_FLAG_PROPERTY_DEFS() + }; +#undef PAR + + + +static Int +do_prolog_flag_property (Term tflag, Term opts USES_REGS) +{ /* Init current_prolog_flag */ + FlagEntry *fv; + xarg *args; + prolog_flag_property_choices_t i; + bool rc = true; + args = Yap_ArgList2ToVector ( opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END ); + if (args == NULL) { + return FALSE; + } + if (!IsAtomTerm(tflag)) { + if (IsApplTerm( tflag ) && FunctorOfTerm(tflag) == FunctorModule) { + Term modt = CurrentModule; + tflag = Yap_YapStripModule( tflag, &modt ); + } else { + Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2"); + return (FALSE); + } + } + fv = GetFlagProp( AtomOfTerm( tflag ) ); + for (i=0; i < PROLOG_FLAG_PROPERTY_END; i ++) { + if (args[i].used) { + switch (i) { + case PROLOG_FLAG_PROPERTY_ACCESS: + if (fv->rw) + rc = rc && + Yap_unify(TermReadWrite, args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue PASS_REGS); + else + rc = rc && + Yap_unify(TermReadOnly, args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue PASS_REGS); + break; + case PROLOG_FLAG_PROPERTY_TYPE: + if (fv->type == boolean) + rc = rc && + Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue PASS_REGS); + else if (fv->type == isatom) + rc = rc && + Yap_unify(TermAtom, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue PASS_REGS); + else if (fv->type == nat) + rc = rc && + Yap_unify(TermInteger, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue PASS_REGS); + else if (fv->type == isfloat) + rc = rc && + Yap_unify(TermFloat, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue PASS_REGS); + else + rc = rc && + Yap_unify(TermTerm, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue PASS_REGS); + break; + case PROLOG_FLAG_PROPERTY_KEEP: + rc = rc && false; + break; + case PROLOG_FLAG_PROPERTY_SCOPE: + if (fv->global) { + if (fv->FlagOfVE == UNKNOWN_FLAG || + fv->FlagOfVE == CHARACTER_ESCAPES_FLAG || + fv->FlagOfVE == BACKQUOTED_STRING_FLAG) + Yap_unify(TermModule, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue PASS_REGS); + rc = rc && + Yap_unify(TermGlobal, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue PASS_REGS); + } else + rc = rc && + Yap_unify(TermThread, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue PASS_REGS); + break; + case PROLOG_FLAG_PROPERTY_END: + /* break; */ + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, opts, "Flag not supported by YAP"); + } + } + } + UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock); + return rc; +} + +static Int +cont_prolog_flag_property (USES_REGS1) +{ /* current_prolog_flag */ + int i = IntOfTerm (EXTRA_CBACK_ARG (2, 1)); + + while (i < GLOBAL_flagCount+LOCAL_flagCount) { + int gmax = GLOBAL_flagCount; + int lmax = LOCAL_flagCount; + Term lab; + + if (i >= gmax+lmax) { + cut_fail(); + } else if (i >= gmax) { + lab = MkAtomTerm( Yap_LookupAtom( local_flags_setup[i-gmax].name ) ) ; + } else { + if (i == UNKNOWN_FLAG || + i == CHARACTER_ESCAPES_FLAG || + i == BACKQUOTED_STRING_FLAG) { + Term labs[2]; + labs[0] = MkVarTerm(); + labs[1] = MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ; + lab = Yap_MkApplTerm(FunctorModule, 2, labs); + } else { + lab = MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ; + } + } + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (++i); + Yap_unify(ARG1, lab); + return do_prolog_flag_property(lab, Deref(ARG2) PASS_REGS); + } + cut_fail(); +} + +/** @pred prolog_flag_property(+ _Flag_,+ _Prooperties_) + +Report a property for a YAP Prolog flag. _Properties_ include + + * `type(+_Type_)` with _Type_ one of `boolean`, `integer`, `float`, `atom` +and `term` (that is, any ground term) + + * `access(+_Access_)` with _Access_ one of `read_only` or `read_write` + + * `scope(+_Scope_) the flag aplies to a `thread`, to a `module`, or is `global` to the system. + +*/ +static Int +prolog_flag_property (USES_REGS1) +{ /* Init current_prolog_flag */ + Term t1 = Deref(ARG1); + /* make valgrind happy by always filling in memory */ + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (0); + if (IsVarTerm(t1)) { + return (cont_prolog_flag_property (PASS_REGS1)); + } else { + if (IsApplTerm( t1 ) && FunctorOfTerm(t1) == FunctorModule) { + Term modt; + t1 = Yap_StripModule( t1, &modt ); + if (IsAtomTerm( modt )) { + Int rc; + rc = cont_prolog_flag_property( PASS_REGS1 ); + + return rc; + } + } else if (IsAtomTerm(t1)) { + do_cut(0); + return do_prolog_flag_property( t1, Deref(ARG2) PASS_REGS); + } else { + Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2"); + } + } + return false; +} + + +static void +newFlag( Term fl, Term val ) +{ + flag_info f; + int i = GLOBAL_flagCount; + + GLOBAL_flagCount ++; + f.name = RepAtom(AtomOfTerm(fl))->StrOfAE; + f.writable = true; + f.helper = 0; + f.def = ok; + initFlag(&f, i , true); + if (IsAtomOrIntTerm(val)) { + GLOBAL_Flags[i].at = val; + } else { + GLOBAL_Flags[i].DBT = Yap_StoreTermInDB(val, 2); + } +} + +static Int +do_create_prolog_flag( USES_REGS1 ) +{ + FlagEntry *fv; + xarg *args; + prolog_flag_property_choices_t i; + Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3); + + args = Yap_ArgList2ToVector ( opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END ); + if (args == NULL) { + return FALSE; + } + fv = GetFlagProp( AtomOfTerm( tflag ) ); + if (fv) { + if (args[PROLOG_FLAG_PROPERTY_KEEP].used && args[PROLOG_FLAG_PROPERTY_KEEP].tvalue == TermTrue) + return true; + } else { + newFlag( tflag, tval ); + fv = GetFlagProp( AtomOfTerm( tflag ) ); + } + for (i=0; i < PROLOG_FLAG_PROPERTY_END; i ++) { + if (args[i].used) { + switch (i) { + case PROLOG_FLAG_PROPERTY_KEEP: + break; + case PROLOG_FLAG_PROPERTY_ACCESS: + if (args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue == TermReadWrite) + fv->rw = true; + else + fv->rw = false; + break; + case PROLOG_FLAG_PROPERTY_TYPE: + { + Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue; + if (ttype == TermBoolean) + fv->type = boolean; + else if (ttype == TermInteger) + fv->type = isatom; + else if (ttype == TermFloat) + fv->type = isfloat; + else + fv->type = isground; + } + break; + case PROLOG_FLAG_PROPERTY_SCOPE: + return + false; + case PROLOG_FLAG_PROPERTY_END: + break; + } + } + } + UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock); + return true; + +} + +/** + * Init System Prolog flags. This is done in two phases: + * early on, it takes care of the atomic flags that are required by other modules; + * later, it looks at flags that are structured terms + * + * @param bootstrap: wether this is done before stack initialization, or afterwards. + * Complex terms can only be built in the second step. + */ + +void +Yap_InitFlags( bool bootstrap) { + CACHE_REGS + flag_info *f = + global_flags_setup; + GLOBAL_flagCount = 0; + if (bootstrap) { + GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm)*(2*sizeof(global_flags_setup)/sizeof(flag_info))); + } + while (f->name != NULL) { + bool itf = setInitialValue( bootstrap, f->def, f->init, GLOBAL_Flags+GLOBAL_flagCount ); + if (itf) { + initFlag( f, GLOBAL_flagCount, true); + } + GLOBAL_flagCount ++; + f++; + } + LOCAL_flagCount = 0; + int nflags = sizeof(local_flags_setup)/sizeof(flag_info); + if (bootstrap) + LOCAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm)*nflags); + f = + local_flags_setup; + while (f->name != NULL) { + bool itf = setInitialValue( bootstrap, f->def, f->init, LOCAL_Flags+LOCAL_flagCount ); + // Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1, LOCAL_encoding, 1200, &tp); + if (itf) { + initFlag( f, LOCAL_flagCount, false); + } + LOCAL_flagCount ++; + f++; + } + if (!bootstrap) { + Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag, cont_yap_flag, 0); + /** @pred prolog_flag(? _Flag_,- _Value__) + + Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2_. + */ + Yap_InitCPredBack("prolog_flag", 3, 1, prolog_flag, cont_yap_flag, 0); + Yap_InitCPredBack("prolog_flag", 2, 1, prolog_flag, cont_yap_flag, 0); + Yap_InitCPred("set_prolog_flag", 2, set_prolog_flag, SyncPredFlag); + Yap_InitCPred("$create_prolog_flag", 3, do_create_prolog_flag, SyncPredFlag); + Yap_InitCPredBack("yap_flag", 2, 1, yap_flag,cont_yap_flag, 0); + Yap_InitCPredBack("prolog_flag_property", 2, 1, prolog_flag_property,cont_prolog_flag_property, 0); + Yap_InitCPred("source", 0, source,SyncPredFlag); + Yap_InitCPred("no_source", 0, no_source,SyncPredFlag); + Yap_InitCPred("source_mode", 2, source_mode, SyncPredFlag); + } +} + + + /* Accessing and changing the flags for a predicate */ diff --git a/H/YapFlags.h b/H/YapFlags.h new file mode 100644 index 000000000..e260e9fab --- /dev/null +++ b/H/YapFlags.h @@ -0,0 +1,329 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * +* * +************************************************************************** +* * +* File: YapFlags.h * +* Last rev: * +* mods: * +* comments: flag system interface. * +* * +*************************************************************************/ + +/** @file YapFlags.h + + @ingroup Flags +*/ + +#ifndef YAP_FLAGS_H +#define YAP_FLAGS_H 1 + +//INLINE_ONLY inline EXTERN bool nat( Term inp ); + +static inline bool nat( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in 0..."); + return false; + } + if (IsIntTerm(inp)) { + Int i = IntOfTerm(inp); + if (i >= 0) return true; + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp, "set_prolog_flag in 0..."); + return false; + } + Yap_Error(TYPE_ERROR_INTEGER, inp, "set_prolog_flag in 0..."); + return false; +} + +static inline bool at2n( Term inp ) { + Yap_Error(PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag."); + return false; +} + +static inline bool isfloat( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in 0.0."); + return false; + } + if (IsFloatTerm(inp)) { + return true; + } + Yap_Error(TYPE_ERROR_FLOAT, inp, "set_prolog_flag in 0..."); + return false; +} + +INLINE_ONLY inline EXTERN bool ro( Term inp ); + +INLINE_ONLY inline EXTERN bool ro( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in 0..."); + return false; + } + Yap_Error( PERMISSION_ERROR_READ_ONLY_FLAG, inp, "set_prolog_flag."); + return false; +} + +//INLINE_ONLY inline EXTERN bool boolean( Term inp ); + +static inline bool boolean( Term inp ) { + if (inp == TermTrue || + inp == TermFalse|| + inp == TermOn|| + inp == TermOff ) + return true; + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in {true,false,on,off"); + return false; + } + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag in {true,false,on,off}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {true,false,on,off"); + return false; +} + +static bool synerr( Term inp ) { + if (inp == TermDec10 || + inp == TermFail|| + inp == TermError|| + inp == TermQuiet ) + return true; + + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag in {dec10,error,fail,quiet}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {dec10,error,fail,quiet}"); + return false; +} + + +static inline bool filler( Term inp ) +{ + return true; +} + +static bool bqs( Term inp ) { + if (inp == TermCodes || + inp == TermString|| + inp == TermSymbolChar ) + return true; + + if (IsAtomTerm(inp)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag in {codes,string}"); + return false; + } + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {codes,string}"); + return false; +} + +//INLINE_ONLY inline EXTERN bool isatom( Term inp ); + +static inline bool isatom( Term inp ) { + if (IsVarTerm(inp)) { + Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag"); + return false; + } + if (IsAtomTerm(inp) ) + return true; + Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flagm"); + return false; +} + +// INLINE_ONLY inline EXTERN bool ok( Term inp ); + +static inline bool ok( Term inp ) { + return true; +} + +// a pair, obtained from x(y) -> 1,2,y) +typedef struct x_el { + bool used; + Term tvalue; +} xarg; + +typedef struct struct_param { + char *name; + flag_func type; + int id; +} param_t; + +typedef struct struct_param2 { + char *name; + flag_func type; + int id; + const char *scope; +} param2_t; + +typedef struct { + const char *name; + bool writable; + flag_func def; + const char *init; + flag_func helper; +} flag_info; + + +typedef struct { + const char *name; + flag_func def; + const char *init; +} arg_info; + +typedef union flagTerm { + Term at; + struct DB_TERM *DBT; +} flag_term; + +void Yap_InitFlags( bool ); + +#define YAP_FLAG( x, NAME, WRITABLE, DEF, INIT, HELPER ) x + +typedef enum { +#include "YapGFlagInfo.h" +} global_flag_t; + +typedef enum { +#include "YapLFlagInfo.h" +} local_flag_t; +#undef YAP_FLAG + + +bool setYapFlag( Term tflag, Term t2 ); +Term getYapFlag( Term tflag ); + +static inline bool check_refs_to_ltable( void ) { + return true; +} + +static inline void setAtomicGlobalPrologFlag(int id, Term v) +{ + GLOBAL_Flags[id].at = v; +} + +static inline void setAtomicLocalPrologFlag(int id, Term v) +{ + CACHE_REGS + check_refs_to_ltable(); + LOCAL_Flags[id].at = v; +} + +static inline void setBooleanLocalPrologFlag(int id, bool v) +{ + CACHE_REGS + check_refs_to_ltable(); + if (v) { + LOCAL_Flags[id].at = TermTrue; + } else { + LOCAL_Flags[-id].at = TermFalse; + } +} + +static inline void setBooleanGlobalPrologFlag(int id, bool v) +{ + if (v) { + GLOBAL_Flags[id].at = TermTrue; + } else { + GLOBAL_Flags[id].at = TermFalse; + } +} + +static inline bool trueGlobalPrologFlag(int id) +{ + return GLOBAL_Flags[id].at == TermTrue; + +} + +static inline bool falseGlobalPrologFlag(int id) +{ + return GLOBAL_Flags[id].at == TermFalse; +} + +static inline bool trueLocalPrologFlag(int id) +{ + CACHE_REGS + return LOCAL_Flags[id].at == TermTrue; +} + +static inline bool falsePrologFlag(int id) +{ + CACHE_REGS + return LOCAL_Flags[id].at == TermFalse; +} + +static inline bool isoLanguageFlag(void){ + return GLOBAL_Flags[ISO_FLAG].at == TermTrue; +} + +static inline bool strictISOFlag(void){ + return GLOBAL_Flags[STRICT_ISO_FLAG].at == TermTrue; +} + +static inline bool silentMode(void) { + CACHE_REGS + return GLOBAL_Flags[VERBOSE_FLAG].at == TermSilent; +} + +static inline void setVerbosity(Term val) { + CACHE_REGS + GLOBAL_Flags[VERBOSE_FLAG].at = val; +} + +static inline bool setSyntaxErrorsFlag(Term val) { + if (!synerr( val )) + return false; + CACHE_REGS + LOCAL_Flags[SYNTAX_ERRORS_FLAG].at = val; + return true; +} + +static inline Term getSyntaxErrorsFlag(void) { + CACHE_REGS + return LOCAL_Flags[SYNTAX_ERRORS_FLAG].at; +} + +static inline bool setBackQuotesFlag(Term val) { + if (!bqs( val )) + return false; + if (val == TermSymbolChar) + val = TermString; + CACHE_REGS + GLOBAL_Flags[BACKQUOTED_STRING_FLAG].at = val; + return true; +} + +static inline Term getBackQuotesFlag(void) { + CACHE_REGS + return GLOBAL_Flags[BACKQUOTED_STRING_FLAG].at; +} + +static inline int indexingMode(void) { + CACHE_REGS + return GLOBAL_Flags[INDEX_FLAG].at; +} + +static inline const char *floatFormat(void) { + CACHE_REGS + return RepAtom(AtomOfTerm(GLOBAL_Flags[FLOAT_FORMAT_FLAG].at))->StrOfAE; +} + +static inline size_t indexingDepth(void) { + CACHE_REGS + return IntOfTerm(GLOBAL_Flags[INDEX_SUB_TERM_SEARCH_DEPTH_FLAG].at); +} + +bool rmdot(Term inp); + + +xarg * Yap_ArgListToVector (Term listl, const param_t *def, int n); + +xarg * Yap_ArgList2ToVector (Term listl, const param2_t *def, int n); + + +#endif // YAP_FLAGS_H diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h new file mode 100644 index 000000000..52bbae536 --- /dev/null +++ b/H/YapGFlagInfo.h @@ -0,0 +1,410 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * +* * +************************************************************************** +* * +* File: YapGFlagInfo.h * +* Last rev: * +* mods: * +* comments: global flag enumeration. * +* * +*************************************************************************/ + +/** @file YapGFlagInfo.h + + @ingroup Flags +*/ + +/** @pred yap_flag(? _Param_,? _Value_) + + +Set or read system properties for _Param_: + +*/ + +/// `address_bits` +/// +/// Number of address bits in the machine, either 64 or 32 bits. +YAP_FLAG( ADDRESS_BITS_FLAG, "address_bits", false, nat, BITNESS , NULL ), /** `address_bits` + Number of address bits in the machine, either 64 or 32 bits */ +YAP_FLAG( AGC_MARGIN_FLAG, "agc_margin", true, nat, "10000" , agc_threshold ), /**`agc_margin ` + + An integer: if this amount of atoms has been created since the last +atom-garbage collection, perform atom garbage collection at the first +opportunity. Initial value is 10,000. May be changed. A value of 0 +(zero) disables atom garbage collection. + */ +YAP_FLAG( ALLOW_ASSERT_FOR_STATIC_PREDICATES, "allow_assert_for_static_predicates", true, boolean, "true" , NULL ), /**< `allow asserting and retracting clauses of static predicates. */ + + /* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< `allow_variable_name_as_functor` */ + + /* allow A(X) *\/ */ +YAP_FLAG( ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p" , NULL ), /** `arithmetic_exceptions ` + + Read-write flag telling whether arithmetic exceptions generate + Prolog exceptions. If enabled: + +~~~~ + ?- X is 2/0. + ERROR!! + ZERO DIVISOR ERROR- X is Exp +~~~~ + + If disabled: +~~~~ + ?- X is 2/0. +X = (+inf). +~~~~ + + It is `true` by default, but it is disabled by packages like CLP(BN) and ProbLog. + */ +#if __APPLE__ +YAP_FLAG( APPLE_FLAG, "apple", false, boolean, "true" , NULL ), /**< `apple` + + Read-only boolean flag that unifies with `true` if YAP is +running on an Apple machine. + */ +#endif +YAP_FLAG( ARCH_FLAG, "arch", false, isatom, YAP_ARCH , NULL ), +YAP_FLAG( ARGV_FLAG, "argv", false, isatom, "[]" , argv ), +YAP_FLAG( ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean, "true" , NULL ), +YAP_FLAG( BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string" , ), +YAP_FLAG( BOUNDED_FLAG, "bounded", false, boolean, "false" , NULL ), /**< `bounded` is iso + + Read-only flag telling whether integers are bounded. The value depends +on whether YAP uses the GMP library or not. + */ +YAP_FLAG( C_CC_FLAG, "c_cc", false, isatom, C_CC , NULL ), +YAP_FLAG( C_CFLAGS_FLAG, "c_cflags", false, isatom, C_CFLAGS , NULL ), +YAP_FLAG( C_LDFLAGS_FLAG, "c_ldflags", false, isatom, C_LDFLAGS , NULL ), +YAP_FLAG( C_LIBPLSO_FLAG, "c_libplso", false, isatom, C_LIBPLSO , NULL ), +YAP_FLAG( C_LIBS_FLAG, "c_libs", false, isatom, C_LIBS , NULL ), +YAP_FLAG( CHAR_CONVERSION_FLAG, "char_conversion", true, boolean, "false" , NULL ), /**< `char_conversion is iso` + + Writable flag telling whether a character conversion table is used when +reading terms. The default value for this flag is `off` except in +`sicstus` and `iso` language modes, where it is `on`. + */ +YAP_FLAG( CHARACTER_ESCAPES_FLAG, "character_escapes", true, boolean, "true" , NULL ), /**< `character_escapes is iso ` + + Writable flag telling whether a character escapes are enables, +`true`, or disabled, `false`. The default value for this flag is +`true`. */ +YAP_FLAG( COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", true, boolean, "true" , NULL ), + YAP_FLAG( COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT , NULL ), /**< `compiled_at ` + + Read-only flag that gives the time when the main YAP binary was compiled. It is obtained staight from the __TIME__ macro, as defined in the C99. + */ + YAP_FLAG( DEBUG_FLAG, "debug", true, boolean, "false" , NULL ), /**< `debug is iso ` + + If _Value_ is unbound, tell whether debugging is `true` or +`false`. If _Value_ is bound to `true` enable debugging, and if +it is bound to `false` disable debugging. + */ + YAP_FLAG( DEBUG_INFO_FLAG, "debug_info", true, boolean, "true" , NULL ), + YAP_FLAG( DEBUG_ON_ERROR_FLAG, "debug_on_error", true, boolean, "true" , NULL ), + YAP_FLAG( DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true, list_option, "[quoted(true),numbervars(true),portrayed(true),max_depth(10)]" , NULL ), /**< `debugger_print_options ` + + If bound, set the argument to the `write_term/3` options the +debugger uses to write terms. If unbound, show the current options. + */ + YAP_FLAG( DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, boolean, "false" , NULL ), +YAP_FLAG( DIALECT_FLAG, "dialect", true, ro, "yap" , NULL ), /**< `dialect ` + + Read-only flag that always returns `yap`. + */ +YAP_FLAG( DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true, boolean, "true" , NULL ), /**< `discontiguous_warnings ` + + If `true` (default `true`) YAP checks for definitions of the same predicate that are separated by clauses for other predicates. This may indicate that different procedures have the sam*e name. + */ +YAP_FLAG( DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, boolean, "false" , NULL ), /**< `dollar_as_lower_case ` + + If `off` (default) consider the character `$` a control character, if +`on` consider `$` a lower case character. + */ + YAP_FLAG( DOUBLE_QUOTES_FLAG, "double_quotes", true, isatom, "codes" , NULL ), /**< `double_quotes is iso ` + + If _Value_ is unbound, tell whether a double quoted list of characters +token is converted to a list of atoms, `chars`, to a list of integers, +`codes`, or to a single atom, `atom`. If _Value_ is bound, set to +the corresponding behavior. The default value is `codes`. */ + YAP_FLAG( EDITOR_FLAG, "editor", true, isatom, "$EDITOR" , NULL ), +YAP_FLAG( EXECUTABLE_FLAG, "executable", false, isatom, "yap" , executable ), /**< `executable ` + + Read-only flag. It unifies with an atom that gives the +original program path. + */ +YAP_FLAG( FAST_FLAG, "fast", true, boolean, "false" , NULL ), /**< `fast ` + + If `on` allow fast machine code, if `off` (default) disable it. Only +available in experimental implementations. + */ +YAP_FLAG( FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, boolean, "true" , NULL ), +YAP_FLAG( FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%.15g" , NULL ), /**< + `float_format ` + + C-library `printf()` format specification used by write/1 and +friends to determine how floating point numbers are printed. The +default is `%.15g`. The specified value is passed to `printf()` +without further checking. For example, if you want less digits +printed, `%g` will print all floats using 6 digits instead of the +default 15. + */ +YAP_FLAG( GC_FLAG, "gc", true, boolean, "on" , NULL ), /**< `gc` + + If `on` allow garbage collection (default), if `off` disable it. + */ +YAP_FLAG( GC_MARGIN_FLAG, "gc_margin", true, nat, "0" , gc_margin ), /**< `gc_margin ` + + Set or show the minimum free stack before starting garbage +collection. The default depends on total stack size. + + */ +YAP_FLAG( GC_TRACE_FLAG, "gc_trace", true, boolean, "off" , NULL ), /**< `gc_trace ` + + If `off` (default) do not show information on garbage collection +and stack shifts, if `on` inform when a garbage collection or stack +shift happened, if verbose give detailed information on garbage +collection and stack shifts. Last, if `very_verbose` give detailed +information on data-structures found during the garbage collection +process, namely, on choice-points. + */ +YAP_FLAG( GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true, boolean, "true" , NULL ), /**< `generate_debug_info ` + + If `true` (default) generate debugging information for +procedures, including source mode. If `false` predicates no +information is generated, although debugging is still possible, and +source mode is disabled. + + */ +YAP_FLAG( GMP_VERSION_FLAG, "gmp_version", false, isatom, "4.8.12" , NULL ), +YAP_FLAG( HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, boolean, "false" , NULL ), +YAP_FLAG( HOME_FLAG, "home", false, isatom, YAP_ROOTDIR , NULL ), /**< home ` + +the root of the YAP installation, by default `/usr/local` in Unix or +`c:\Yap` in Windows system. Can only be set at configure tien + */ +YAP_FLAG( HOST_TYPE_FLAG, "host_type", false, isatom, HOST_ALIAS , NULL ), /**< host_type ` + + Return `configure` system information, including the machine-id +for which YAP was compiled and Operating System information. + */ +YAP_FLAG( INDEX_FLAG, "index", true, isatom, "multi" , indexer ), /**< `index ` + + If `on` allow indexing (default), if `off` disable it, if +`single` allow on first argument only. + */ +YAP_FLAG( INDEX_SUB_TERM_SEARCH_DEPTH_FLAG, "index_sub_term_search_depth", true, nat, "0" , NULL ), /**< `Index_sub_term_search_depth ` + + Maximum bound on searching sub-terms for indexing, if `0` (default) no bound. + */ +YAP_FLAG( INFORMATIONAL_MESSAGES_FLAG, "informational_messages", true, isatom, "normal" , NULL ), /**< `informational_messages ` + + If `on` allow printing of informational messages, such as the ones +that are printed when consulting. If `off` disable printing +these messages. It is `on` by default except if YAP is booted with +the `-L` flag. + */ +YAP_FLAG( INTEGER_ROUNDING_FUNCTION_FLAG, "integer_rounding_function", true, isatom, "toward_zero" , NULL ), /**< `integer_rounding_function is iso ` + + Read-only flag telling the rounding function used for integers. Takes the value +`toward_zero` for the current version of YAP. + */ +YAP_FLAG( ISO_FLAG, "iso", true, boolean, "false" , NULL ), +YAP_FLAG( LANGUAGE_FLAG, "language", true, isatom, "yap" , NULL ), /**< `language ` + + Choose whether YAP follows native, closer to C-Prolog, `yap`, iso-prolog, +`iso` or SICStus Prolog, `sicstus`. The current default is +`cprolog`. This flag affects update semantics, leashing mode, +style checking, handling calls to undefined procedures, how directives +are interpreted, when to use dynamic, character escapes, and how files +are consulted. Also check the `dialect` option. + */ +YAP_FLAG( MAX_ARITY_FLAG, "max_arity", false, isatom, "unbounded" , NULL ), /**< `max_arity is iso ` + + Read-only flag telling the maximum arity of a functor. Takes the value +`unbounded` for the current version of YAP. + */ +YAP_FLAG( MAX_TAGGED_INTEGER_FLAG, "max_tagged_integer", false, at2n, "INT_MAX" , NULL ), +YAP_FLAG( MAX_THREADS_FLAG, "max_threads", false, at2n, "MAX_THREADS" , NULL ), +YAP_FLAG( MAX_WORKERS_FLAG, "max_workers", false, at2n, "MAX_WORKERS" , NULL ), +YAP_FLAG( MIN_TAGGED_INTEGER_FLAG, "min_tagged_integer", false, at2n, "INT_MIN" , NULL ), +YAP_FLAG( N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, "256" , NULL ), +YAP_FLAG( OCCURS_CHECK_FLAG, "occurs_check", true, boolean, "false" , NULL ), +YAP_FLAG( OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, boolean, "true" , NULL ), /**< `open_expands_filename ` + + If `true` the open/3 builtin performs filename-expansion +before opening a file (SICStus Prolog like). If `false` it does not +(SWI-Prolog like). + */ +YAP_FLAG( OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, boolean, "true" , NULL ), /**< `open_shared_object ` + + If true, `open_shared_object/2` and friends are implemented, +providing access to shared libraries (`.so` files) or to dynamic link +libraries (`.DLL` files). + */ +YAP_FLAG( OPTIMISE_FLAG, "optimise", true, boolean, "false" , NULL ), +YAP_FLAG( OS_ARGV_FLAG, "os_argv", false, ro, "[]" , os_argv ), +YAP_FLAG( PID_FLAG, "pid", false, ro, "0" , NULL ), +YAP_FLAG( PIPE_FLAG, "pipe", true, boolean, "true" , NULL ), +YAP_FLAG( PROFILING_FLAG, "profiling", true, boolean, "false" , NULL ), /**< `profiling ` + + If `off` (default) do not compile call counting information for +procedures. If `on` compile predicates so that they calls and +retries to the predicate may be counted. Profiling data can be read through the +call_count_data/3 built-in. + */ +YAP_FLAG( PROMPT_ALTERNATIVES_ON_FLAG, "prompt_alternatives_on", true, isatom, "determinism" , NULL ), /**< `prompt_alternatives_on(atom, changeable) ` + + SWI-Compatible option, determines prompting for alternatives in the Prolog toplevel. Default is groundness, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is determinism which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints. */ +YAP_FLAG( QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, boolean, "true" , NULL ), +YAP_FLAG( READLINE_FLAG, "readline", true, boolean, "true" , NULL ), +YAP_FLAG( REPORT_ERROR_FLAG, "report_error", true, boolean, "true" , NULL ), +YAP_FLAG( SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false, isatom, SO_EXT ,NULL ), /**< `shared_object_extension ` + + Suffix associated with loadable code. + */ +YAP_FLAG( SHARED_OBJECT_SEARCH_PATH_FLAG, "shared_object_search_path", true, isatom, SO_PATH , NULL ), /**< `shared_object_search_path ` + + Name of the environment variable used by the system to search for shared +objects. + + */ +YAP_FLAG( SIGNALS_FLAG, "signals", true, boolean, "true" , NULL ), /**< `signals` + + If `true` (default) YAP handles Signals such as `^C` (`SIGINT`). + + */ +YAP_FLAG( SOURCE_FLAG, "source", true, boolean, "true" , NULL ), /**< `source` + +If `true` maintain the source for all clauses. Notice that this is trivially supported for facts, and always supported for dynamic code. + + */ +YAP_FLAG( STRICT_ISO_FLAG, "strict_iso", true, boolean, "false" , NULL ), /**< `strict_iso ` + + If _Value_ is unbound, tell whether strict ISO compatibility mode +is `on` or `off`. If _Value_ is bound to `on` set +language mode to `iso` and enable strict mode. If _Value_ is +bound to `off` disable strict mode, and keep the current language +mode. The default for YAP is `off`. +Under strict ISO Prolog mode all calls to non-ISO built-ins generate an +error. Compilation of clauses that would call non-ISO built-ins will +§§also generate errors. Pre-processing for grammar rules is also +disabled. Module expansion is still performed. +Arguably, ISO Prolog does not provide all the functionality required +from a modern Prolog system. Moreover, because most Prolog +implementations do not fully implement the standard and because the +standard itself gives the implementor latitude in a few important +questions, such as the unification algorithm and maximum size for +numbers there is no guarantee that programs compliant with this mode +will work the same way in every Prolog and in every platform. We thus +believe this mode is mostly useful when investigating how a program +depends on a Prolog's platform specific features. + + */ + YAP_FLAG( SYSTEM_OPTIONS_FLAG, "system_options", false, ro, "[big_numbers,coroutining,depth_limit,low_level_tracer,rational_trees,threads,tabling]" , NULL ), /**< `system_options ` + + This read only flag tells which options were used to compile +YAP. Currently it informs whether the system supports `big_numbers`, +`coroutining`, `depth_limit`, `low_level_tracer`, +`or-parallelism`, `rational_trees`, `readline`, `tabling`, +`threads`, or the `wam_profiler`. + */ +YAP_FLAG( SYSTEM_THREAD_ID_FLAG, "system_thread_id", false, ro, "0", sys_thread_id ), +YAP_FLAG( TABLING_MODE_FLAG, "tabling_mode", true, isatom, "[]" , NULL ), /**< `tabling_mode` + + Sets or reads the tabling mode for all tabled predicates. Please + (see Tabling) for the list of options. + + */ +YAP_FLAG( THREADS_FLAG, "threads", false, ro, "MAX_THREADS" , NULL ), +YAP_FLAG( TIMEZONE_FLAG, "timezone", false, ro, "18000" , NULL ), +YAP_FLAG( TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, boolean, "true" , NULL ), + YAP_FLAG( TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true, list_option, "[quoted(true),numbervars(true),portrayed(true)]" , NULL ), /**< `toplevel_hook ` + + If bound, set the argument to a goal to be executed before entering the +top-level. If unbound show the current goal or `true` if none is +presented. Only the first solution is considered and the goal is not +backtracked into. + + */ +YAP_FLAG( TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "~m~d~l~! ?- " , mkprompt ), +YAP_FLAG( TTY_CONTROL_FLAG, "tty_control", true, boolean, "true" , NULL ), +YAP_FLAG( UNIX_FLAG, "unix", false, ro, "true" , NULL ), /**< `unix` + + Read-only Boolean flag that unifies with `true` if YAP is +running on an Unix system. Defined if the C-compiler used to compile +this version of YAP either defines `__unix__` or `unix`. + */ +YAP_FLAG( UPDATE_SEMANTICS_FLAG, "update_semantics", false, ro, "logical" , NULL ), /**< `update_semantics ` + + Define whether YAP should follow `immediate` update +semantics, as in C-Prolog (default), `logical` update semantics, +as in Quintus Prolog, SICStus Prolog, or in the ISO standard. There is +also an intermediate mode, `logical_assert`, where dynamic +procedures follow logical semantics but the internal data base still +follows immediate semantics. + */ +YAP_FLAG( USER_FLAGS_FLAG, "user_flags", true, isatom, "error" , NULL ), /**< `user_flags ` + + Define the behaviour of set_prolog_flag/2 if the flag is not known. Values are `silent`, `warning` and `error`. The first two create the flag on-the-fly, with `warning` printing a message. The value `error` is consistent with ISO: it raises an existence error and does not create the flag. See also `create_prolog_flag/3`. The default is`error`, and developers are encouraged to use `create_prolog_flag/3` to create flags for their library. + */ +YAP_FLAG( UNKNOWN_FLAG, "unknown", true, isatom, "error" , NULL ), /**< `unknown is iso` + + Corresponds to calling the unknown/2 built-in. Possible values +are `error`, `fail`, and `warning`. + */ +YAP_FLAG( VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG, "variable_names_may_end_with_quotes", true, boolean, "false" , NULL ), +YAP_FLAG( VERBOSE_FLAG, "verbose", true, isatom, "normal" , NULL ), /**< `verbose ` + + If `normal` allow printing of informational and banner messages, +such as the ones that are printed when consulting. If `silent` +disable printing these messages. It is `normal` by default except if +YAP is booted with the `-q` or `-L` flag. + + */ +YAP_FLAG( VERBOSE_AUTOLOAD_FLAG, "verbose_autoload", true, boolean, "false" , NULL ), +YAP_FLAG( VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, boolean, "false" , NULL ), +YAP_FLAG( VERBOSE_LOAD_FLAG, "verbose_load", true, isatom, "normal" , NULL ), /**< `verbose_load ` + + If `true` allow printing of informational messages when +consulting files. If `false` disable printing these messages. It +is `normal` by default except if YAP is booted with the `-L` +flag. + */ + YAP_FLAG( VERSION_FLAG, "version", false, nat, YAP_NUMERIC_VERSION , NULL ), /**< `version_data ` + + Read-only flag that unifies with a number of the form + `_Major_ * 100000 + _Minor_ *100 + _Patch_`, where + _Major_ is the major version, _Minor_ is the minor version, +and _Patch_ is the patch number. + */ +YAP_FLAG( VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION , NULL ), /**< +`version ` Read-only flag that returns an a compound term with the +current version of YAP. The term will have the name `yap` and arity 4, the first argument will be the +major version, the second the minor version, the third the patch number, and the last one is reserved. + + */ + YAP_FLAG( VERSION_GIT_FLAG, "version_git", false, isatom, YAP_GIT_HEAD , NULL ), /**< `version_git ` + ` +this is the unique identifier for the last commit of the current GIT HEAD, it xan be used to identify versions that differ on small (or large) updates. + */ +YAP_FLAG( WRITE_ATTRIBUTES_FLAG, "write_attributes", true, isatom, "ignore" , NULL ), +#if __WINDOWS__ +YAP_FLAG( WINDOWS_FLAG, "windows", false, ro, "true" , NULL ), /**< `windows ` + + Read-only boolean flag that unifies with `true` if YAP is +running on an Windows machine. + */ +#endif + YAP_FLAG( WRITE_STRINGS_FLAG, "write_strings", true, boolean, "false" , NULL ), /**< `write_strings ` + + Writable flag telling whether the system should write lists of +integers that are writable character codes using the list notation. It +is `on` if enables or `off` if disabled. The default value for +this flag is `off`. + */ diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h new file mode 100644 index 000000000..d9fc4416d --- /dev/null +++ b/H/YapLFlagInfo.h @@ -0,0 +1,101 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- * +* * +************************************************************************** +* * +* File: YapLFlagInfo.h * +* Last rev: * +* mods: * +* comments: local flag enumeration. * +* * +*************************************************************************/ + +/** @file YapLFlagInfo.h + + @ingroup Flags +*/ + +YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, boolean, "false" , NULL ), +YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ), +YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "text" , getenc ), +YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, boolean, "true" , NULL ), /**< `fileerrors` + + If `on` `fileerrors` is `on`, if `off` (default) +`fileerrors` is disabled. + */ +YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, boolean, "true" , NULL ), /**< `redefine_warnings ` + + If _Value_ is unbound, tell whether warnings for procedures defined +in several different files are `on` or +`off`. If _Value_ is bound to `on` enable these warnings, +and if it is bound to `off` disable them. The default for YAP is +`off`, unless we are in `sicstus` or `iso` mode. + */ +YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, boolean, "true" , NULL ), /**< `single_var_warnings` + If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton. + + */ +YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, boolean, "false" , NULL ), /**< `stack_dump_on_error ` + + If `true` show a stack dump when YAP finds an error. The default is +`off`. + */ +YAP_FLAG( STREAM_TYPE_CHECK_FLAG, "stream_type_check", true, isatom, "loose" , NULL ), +YAP_FLAG( SYNTAX_ERRORS_FLAG, "syntax_errors", true, isatom, "error" , synerr ), /**< `syntax_errors` + + Control action to be taken after syntax errors while executing read/1, +`read/2`, or `read_term/3`: + + `dec10` +Report the syntax error and retry reading the term. + + `fail` +Report the syntax error and fail (default). + + `error` +Report the syntax error and generate an error. + + `quiet` +Just fail + */ +YAP_FLAG( TYPEIN_MODULE_FLAG, "typein_module", true, isatom, "user" , typein ), /**< `typein_module ` + + If bound, set the current working or type-in module to the argument, +which must be an atom. If unbound, unify the argument with the current +working module. + + */ +YAP_FLAG( USER_ERROR_FLAG, "user_error", true, isatom, "user_error" , NULL ), /**< `user_error1` + + If the second argument is bound to a stream, set user_error to +this stream. If the second argument is unbound, unify the argument with +the current user_error stream. +By default, the user_error stream is set to a stream +corresponding to the Unix `stderr` stream. +The next example shows how to use this flag: + +~~~{.prolog} + ?- open( '/dev/null', append, Error, + [alias(mauri_tripa)] ). + + Error = '$stream'(3) ? ; + + no + ?- set_prolog_flag(user_error, mauri_tripa). + + close(mauri_tripa). + + yes + ?- +~~~ + We execute three commands. First, we open a stream in write mode and +give it an alias, in this case `mauri_tripa`. Next, we set +user_error to the stream via the alias. Note that after we did so +prompts from the system were redirected to the stream +`mauri_tripa`. Last, we close the stream. At this point, YAP +automatically redirects the user_error alias to the original +`stderr`. + */ +YAP_FLAG( USER_INPUT_FLAG, "user_input", true, isatom, "user_input" , NULL ), + YAP_FLAG( USER_OUTPUT_FLAG, "user_output", true, isatom, "user_output" , NULL ),