diff --git a/C/pl-yap.c b/C/pl-yap.c index bae92c809..6b6a49af2 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -177,6 +177,23 @@ Yap_SetDefaultEncoding(IOENC new_encoding) LD->encoding = new_encoding; } +int +PL_qualify(term_t raw, term_t qualified) +{ GET_LD + Module m = NULL; + term_t mname; + + if ( !(mname = PL_new_term_ref()) || + !PL_strip_module(raw, &m, qualified) ) + return FALSE; + + /* modules are terms in YAP */ + Yap_PutInSlot(mname, (Term)m); + + return PL_cons_functor(qualified, FUNCTOR_colon2, mname, qualified); +} + + int valueExpression(term_t t, Number r ARG_LD) { @@ -476,6 +493,7 @@ int raiseStackOverflow(int overflow) * FEATURES * *******************************/ +int PL_set_prolog_flag(const char *name, int type, ...) { va_list args; int rval = TRUE; diff --git a/H/pl-global.h b/H/pl-global.h index f342d002c..cefef03db 100644 --- a/H/pl-global.h +++ b/H/pl-global.h @@ -247,6 +247,10 @@ typedef struct PL_local_data { int _current_buffer_id; } fli; + struct + { fid_t numbervars_frame; /* Numbervars choice-point */ + } var_names; + #ifdef O_GMP struct { diff --git a/H/pl-incl.h b/H/pl-incl.h index 1c74c4100..a24ac4cdb 100755 --- a/H/pl-incl.h +++ b/H/pl-incl.h @@ -370,6 +370,7 @@ typedef struct { functor_t functor; /* Functor to use ($VAR/1) */ av_action on_attvar; /* How to handle attvars */ int singletons; /* Write singletons as $VAR('_') */ + int numbered_check; /* Check for already numbered */ } nv_options; @@ -572,6 +573,21 @@ it mean anything? #define fail return FALSE #define TRY(goal) if ((goal) == FALSE) fail +/* Flags on module. Most of these flags are copied to the read context + in pl-read.c. +*/ + +#define M_SYSTEM (0x0001) /* system module */ +#define M_CHARESCAPE (0x0002) /* module */ +#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */ +#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */ +#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */ +#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING) +#define UNKNOWN_FAIL (0x0020) /* module */ +#define UNKNOWN_WARNING (0x0040) /* module */ +#define UNKNOWN_ERROR (0x0080) /* module */ +#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL) + extern int fileerrors; @@ -914,6 +930,8 @@ COMMON(void) cleanupPrologFlags(void); COMMON(void) initPrologFlags(void); COMMON(int) raiseStackOverflow(int overflow); +COMMON(int) PL_qualify(term_t raw, term_t qualified); + static inline word setBoolean(int *flag, term_t old, term_t new) { if ( !PL_unify_bool_ex(old, *flag) || @@ -923,6 +941,21 @@ setBoolean(int *flag, term_t old, term_t new) succeed; } +#define BEGIN_NUMBERVARS(save) \ + { fid_t _savedf; \ + if ( save ) \ + { _savedf = LD->var_names.numbervars_frame; \ + LD->var_names.numbervars_frame = PL_open_foreign_frame(); \ + } +#define END_NUMBERVARS(save) \ + if ( save ) \ + { PL_discard_foreign_frame(LD->var_names.numbervars_frame); \ + LD->var_names.numbervars_frame = _savedf; \ + } \ + } + + + COMMON(int) PL_get_atom__LD(term_t t1, atom_t *a ARG_LD); COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD); diff --git a/H/pl-yap.h b/H/pl-yap.h index 3c2ba8882..83adab8e9 100644 --- a/H/pl-yap.h +++ b/H/pl-yap.h @@ -150,9 +150,6 @@ atomLength(Atom atom) #define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0) #define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A))) -#define BEGIN_NUMBERVARS(X) -#define END_NUMBERVARS(X) - #define charEscapeWriteOption(A) FALSE // VSC: to implement #define wordToTermRef(A) YAP_InitSlot(*(A)) #define isTaggedInt(A) IsIntegerTerm(A) diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 3f34bad19..82bf8e1a2 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -538,6 +538,7 @@ extern X_API int PL_is_string(term_t); extern X_API int PL_is_variable(term_t); extern X_API int PL_term_type(term_t); extern X_API int PL_is_inf(term_t); +extern X_API int PL_is_acyclic(term_t t); /* end PL_is_* functions =============================*/ extern X_API void PL_halt(int); extern X_API int PL_initialise(int, char **); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 572cf20ab..e6a9a445e 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -1738,6 +1738,12 @@ X_API int PL_is_ground(term_t t) return Yap_IsGroundTerm(Yap_GetFromSlot(t PASS_REGS)); } +X_API int PL_is_acyclic(term_t t) +{ + CACHE_REGS + return Yap_IsAcyclicTerm(Yap_GetFromSlot(t PASS_REGS)); +} + X_API int PL_is_callable(term_t t) { CACHE_REGS diff --git a/os/pl-write.c b/os/pl-write.c index f226831e0..99b1a25fd 100644 --- a/os/pl-write.c +++ b/os/pl-write.c @@ -168,6 +168,28 @@ format_float(double f, char *buf) return buf; } +static int +bind_varnames(term_t varnames ARG_LD) +{ + CACHE_REGS + Term t = Yap_GetFromSlot(varnames PASS_REGS); + while(!IsVarTerm(t) && IsPairTerm(t)) { + Term tl = HeadOfTerm(t); + Functor f; + Term tv, t2, t1; + + if (!IsApplTerm(tl)) return FALSE; + if ((f = FunctorOfTerm(tl)) != FunctorEq) + return FALSE; + t1 = ArgOfTerm(1, tl); + t2 = ArgOfTerm(2, tl); + tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1); + if (!Yap_unify(t2, tv)) + return FALSE; + t = TailOfTerm(t); + } + return TRUE; +} char * varName(term_t t, char *name) @@ -197,6 +219,8 @@ writeTopTerm(term_t t, int prec, write_options *options) yap_flag |= Quote_illegal_f; if (options->flags & PL_WRT_NUMBERVARS) yap_flag |= Handle_vars_f; + if (options->flags & PL_WRT_VARNAMES) + yap_flag |= Handle_vars_f; if (options->flags & PL_WRT_IGNOREOPS) yap_flag |= Ignore_ops_f; if (flags & PL_WRT_PORTRAY) @@ -435,10 +459,13 @@ pl_write_term3(term_t stream, term_t term, term_t opts) } options.module = lookupModule(mname); - /* vsc if ( charescape == TRUE || - (charescape == -1 && true(options.module, M_CHARESCAPE)) ) - options.flags |= PL_WRT_CHARESCAPES; + (charescape == -1 +#ifndef __YAP_PROLOG__ +&& true(options.module, M_CHARESCAPE) +#endif + ) ) + options.flags |= PL_WRT_CHARESCAPES; if ( gportray ) { options.portray_goal = gportray; if ( !put_write_options(opts, &options) || @@ -446,7 +473,6 @@ pl_write_term3(term_t stream, term_t term, term_t opts) return FALSE; portray = TRUE; } - */ if ( numbervars == -1 ) numbervars = (portray ? TRUE : FALSE); @@ -460,14 +486,12 @@ pl_write_term3(term_t stream, term_t term, term_t opts) local_varnames = (varnames && false(&options, PL_WRT_NUMBERVARS)); BEGIN_NUMBERVARS(local_varnames); - /* vsc if ( varnames ) { if ( (rc=bind_varnames(varnames PASS_LD)) ) options.flags |= PL_WRT_VARNAMES; else goto out; } - */ if ( !(rc=getTextOutputStream(stream, &s)) ) goto out; @@ -522,9 +546,12 @@ do_write2(term_t stream, term_t term, int flags) options.flags = flags; options.out = s; options.module = MODULE_user; - /* vsc if ( options.module && true(options.module, M_CHARESCAPE) ) + if ( options.module +#ifndef __YAP_PROLOG__ + && true(options.module, M_CHARESCAPE) +#endif + ) options.flags |= PL_WRT_CHARESCAPES; - */ if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) ) options.flags |= PL_WRT_BACKQUOTED_STRING; @@ -566,8 +593,8 @@ pl_write_canonical2(term_t stream, term_t term) options.functor = FUNCTOR_isovar1; options.on_attvar = AV_SKIP; - // VSC options.singletons = PL_is_acyclic(term); - //options.numbered_check = FALSE; + options.singletons = PL_is_acyclic(term); + options.numbered_check = FALSE; rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 && do_write2(stream, term,