SWI extension including write variable_names
This commit is contained in:
parent
4b5ef10caf
commit
7407ecb60c
18
C/pl-yap.c
18
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;
|
||||
|
@ -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
|
||||
{
|
||||
|
33
H/pl-incl.h
33
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);
|
||||
|
@ -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)
|
||||
|
@ -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 **);
|
||||
|
@ -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
|
||||
|
@ -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,
|
||||
|
Reference in New Issue
Block a user