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

SWI extension including write variable_names

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-01-17 00:17:02 +00:00
parent 4b5ef10caf
commit 7407ecb60c
7 changed files with 99 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/pl-yap.c
View File

@ -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;

4
H/pl-global.h
View File

@ -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
View File

@ -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);

3
H/pl-yap.h
View File

@ -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)

1
include/SWI-Prolog.h
View File

@ -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 **);

6
library/dialect/swi/fli/swi.c
View File

@ -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

47
os/pl-write.c
View File

@ -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,