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

improve SWI compatibility.

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-03-13 19:40:27 +00:00
parent d6a06fe092
commit 67b29f3c85
8 changed files with 283 additions and 233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
include/SWI-Prolog.h
View File

@ -19,6 +19,7 @@
#include <stdarg.h>
#include <stdlib.h>
#include <stddef.h>
#include <wchar.h>
#if HAVE_TIME_H
#include <time.h>
#endif
@ -450,10 +451,16 @@ UNICODE file functions.
#ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */
extern X_API int PL_unify_stream(term_t t, IOSTREAM *s);
extern X_API int PL_open_stream(term_t t, IOSTREAM *s); /* compat */
extern X_API int PL_get_stream_handle(term_t t, IOSTREAM **s);
#define PL_open_stream PL_unify_stream
extern X_API int PL_get_stream_handle(term_t t, IOSTREAM **s);\
extern X_API IOSTREAM *Snew(void *handle,int flags,IOFUNCTIONS *functions);
extern X_API int Sgetcode(IOSTREAM *);
extern X_API int Sfeof(IOSTREAM *);
#endif
#define succeed return TRUE
#define fail return FALSE
extern X_API const char *PL_cwd(void);
void swi_install(void);

4
include/SWI-Stream.h
View File

@ -164,6 +164,8 @@ typedef struct io_stream
struct io_stream * upstream; /* stream providing our input */
struct io_stream * downstream; /* stream providing our output */
unsigned newline : 2; /* Newline mode */
int io_errno; /* Save errno value */
void * exception; /* pending exception (record_t) */
intptr_t reserved[3]; /* reserved for extension */
} IOSTREAM;
@ -224,6 +226,8 @@ typedef struct io_stream
#define SIO_GETSIZE (1) /* get size of underlying object */
#define SIO_GETFILENO (2) /* get underlying file (if any) */
#define SIO_SETENCODING (3) /* modify encoding of stream */
#define SIO_FLUSHOUTPUT (4) /* flush output */
#define SIO_LASTERROR (5) /* string holding last error */
/* Sread_pending() */
#define SIO_RP_BLOCK 0x1 /* wait for new input */

4
library/dialect/swi.yap
View File

@ -11,6 +11,8 @@
:- module(swi, []).
:- load_foreign_files([plstream], [], initIO).
:- ensure_loaded(library(atts)).
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
@ -191,7 +193,7 @@ prolog:load_foreign_library(P,Command) :-
prolog:load_foreign_library(P) :-
prolog:load_foreign_library(P,install).
do_volatile(_,_).
do_volatile(P,M) :- dynamic(M:P).
:- use_module(library(lists)).

478
library/yap2swi/yap2swi.c
View File

@ -82,7 +82,7 @@ PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m)
}
static void
UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mod)
UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mod, int flags)
{
PredEntry *pe;
Term cm = CurrentModule;
@ -94,7 +94,7 @@ UserCPredicateWithArgs(char *a, CPredicate def, unsigned long int arity, Term mo
Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
pe->PredFlags |= CArgsPredFlag;
pe->PredFlags |= (CArgsPredFlag|flags);
CurrentModule = cm;
}
@ -349,52 +349,66 @@ X_API int PL_get_nchars(term_t l, size_t *len, char **sp, unsigned flags)
/* same as get_chars, but works on buffers of wide chars */
X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
{
if (IsAtomTerm(l)) {
YAP_Atom at = YAP_AtomOfTerm(l);
Term t = Yap_GetFromSlot(l);
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL)))
return 0;
if (YAP_IsWideAtom(at))
/* will this always work? */
*wsp = (wchar_t *)YAP_WideAtomName(at);
} else {
char *sp;
int res = PL_get_chars(l, &sp, ((flags & ~(BUF_MALLOC|BUF_DISCARDABLE))|BUF_RING));
size_t sz;
if (IsVarTerm(t)) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars");
return 0;
}
if (flags & CVT_ATOM) {
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
if (!res) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars");
return 0;
if (!(flags & (CVT_ATOM|CVT_ATOMIC|CVT_ALL)))
return 0;
if (IsWideAtom(at)) {
/* will this always work? */
*wsp = RepAtom(at)->WStrOfAE;
} else {
char *sp = RepAtom(at)->StrOfAE;
size_t sz;
sz = strlen(sp);
if (flags & BUF_MALLOC) {
int i;
wchar_t *nbf = (wchar_t *)YAP_AllocSpaceFromYap((sz+1)*sizeof(wchar_t));
if (nbf == NULL) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: lack of memory");
return 0;
}
*wsp = nbf;
for (i=0; i<= sz; i++)
*nbf++ = *sp++;
} else if (flags & BUF_DISCARDABLE) {
wchar_t *buf = (wchar_t *)buffers;
int i;
if ((sz+1)*sizeof(wchar_t) >= BUF_SIZE) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
return 0;
}
*wsp = buf;
for (i=0; i<= sz; i++)
*buf++ = *sp++;
} else {
wchar_t *tmp = (wchar_t *)alloc_ring_buf();
int i;
if ((sz+1)*sizeof(wchar_t) >= BUF_SIZE) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
return 0;
}
*wsp = tmp;
for (i=0; i<= sz; i++)
*tmp++ = *sp++;
}
return 1;
}
}
sz = wcstombs(sp,NULL,BUF_SIZE);
if (flags & BUF_MALLOC) {
wchar_t *nbf = (wchar_t *)YAP_AllocSpaceFromYap(sz+1);
if (nbf == NULL) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: lack of memory");
return 0;
}
*wsp = nbf;
} else if (flags & BUF_DISCARDABLE) {
wchar_t *buf = (wchar_t *)buffers;
if (wcstombs(sp,buf,BUF_SIZE) == -1) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
return 0;
}
*wsp = buf;
} else {
wchar_t *tmp = (wchar_t *)alloc_ring_buf();
if (wcstombs(sp, tmp, BUF_SIZE) == -1) {
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars: wcstombs");
return 0;
}
*wsp = tmp;
}
return res;
}
if (flags & CVT_EXCEPTION)
YAP_Error(0, 0L, "PL_get_wchars");
@ -973,10 +987,20 @@ X_API int PL_unify_int64(term_t t, int64_t n)
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_list(term_t t, term_t h, term_t tail)
X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
{
YAP_Term pairterm = YAP_MkPairTerm(Yap_GetFromSlot(h),Yap_GetFromSlot(tail));
return YAP_Unify(Yap_GetFromSlot(t), pairterm);
Term t = Deref(Yap_GetFromSlot(tt));
if (IsVarTerm(t)) {
Term pairterm = Yap_MkNewPairTerm();
Yap_unify(t, pairterm);
/* avoid calling deref */
t = pairterm;
} else if (!IsPairTerm(t)) {
return FALSE;
}
Yap_PutInSlot(h,HeadOfTerm(t));
Yap_PutInSlot(tail,TailOfTerm(t));
return TRUE;
}
/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
@ -1090,14 +1114,14 @@ static Atom
LookupMaxAtom(size_t n, char *s)
{
Atom catom;
char *buf = (char *)YAP_AllocSpaceFromYap(n+1);
char *buf = (char *)Yap_AllocCodeSpace(n+1);
if (!buf)
return FALSE;
strncpy(buf, s, n);
buf[n] = '\0';
catom = Yap_LookupAtom(buf);
free(buf);
Yap_FreeCodeSpace(buf);
return catom;
}
@ -1105,14 +1129,14 @@ static Atom
LookupMaxWideAtom(size_t n, wchar_t *s)
{
Atom catom;
wchar_t *buf = (wchar_t *)YAP_AllocSpaceFromYap((n+1)*sizeof(wchar_t));
wchar_t *buf = (wchar_t *)Yap_AllocCodeSpace((n+1)*sizeof(wchar_t));
if (!buf)
return FALSE;
wcsncpy(buf, s, n);
buf[n] = '\0';
catom = Yap_LookupMaybeWideAtom(buf);
free(buf);
Yap_FreeAtomSpace((ADDR)buf);
return catom;
}
@ -1125,94 +1149,12 @@ MkBoolTerm(int b)
return MkAtomTerm(AtomFalse);
}
static YAP_Term
get_term(arg_types **buf)
{
arg_types *ptr = *buf;
int type = ptr->type;
YAP_Term t;
#define MAX_DEPTH 64
switch (type) {
/* now build the error string */
case PL_VARIABLE:
t = YAP_MkVarTerm();
ptr++;
break;
case PL_BOOL:
t = MkBoolTerm(ptr->arg.i);
ptr++;
break;
case PL_ATOM:
t = MkAtomTerm(SWIAtomToAtom(ptr->arg.a));
ptr++;
break;
case PL_CHARS:
t = MkAtomTerm(Yap_LookupAtom(ptr->arg.s));
break;
case PL_NCHARS:
t = MkAtomTerm(LookupMaxAtom(ptr->arg.ns.n, ptr->arg.ns.s));
break;
case PL_NWCHARS:
t = MkAtomTerm(LookupMaxWideAtom(ptr->arg.nw.n, ptr->arg.nw.w));
break;
case PL_INTEGER:
t = YAP_MkIntTerm(ptr->arg.l);
ptr++;
break;
case PL_FLOAT:
t = YAP_MkFloatTerm(ptr->arg.dbl);
ptr++;
break;
case PL_POINTER:
t = YAP_MkIntTerm((long int)(ptr->arg.p));
ptr++;
break;
case PL_STRING:
t = YAP_BufferToString(ptr->arg.s);
ptr++;
break;
case PL_TERM:
t = Yap_GetFromSlot(ptr->arg.t);
ptr++;
break;
case PL_FUNCTOR:
{
functor_t f = ptr->arg.f;
long int arity, i;
term_t loc;
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
t = (Term)ff;
break;
}
arity = YAP_ArityOfFunctor((YAP_Functor)ff);
loc = Yap_NewSlots(arity);
ptr++;
for (i= 0; i < arity; i++) {
Yap_PutInSlot(loc+i,get_term(&ptr));
}
t = YAP_MkApplTerm((YAP_Functor)ff,arity,YAP_AddressFromSlot(loc));
}
break;
case PL_LIST:
{
term_t loc;
loc = Yap_NewSlots(2);
ptr++;
Yap_PutInSlot(loc,get_term(&ptr));
Yap_PutInSlot(loc+1,get_term(&ptr));
t = YAP_MkPairTerm(Yap_GetFromSlot(loc),Yap_GetFromSlot(loc+1));
}
break;
default:
fprintf(stderr, "type %d not implemented yet\n", type);
exit(1);
}
*buf = ptr;
return t;
}
typedef struct {
int nels;
CELL *ptr;
} stack_el;
/* SWI: int PL_unify_term(term_t ?t1, term_t ?t2)
YAP long int YAP_Unify(YAP_Term* a, Term* b) */
@ -1221,71 +1163,159 @@ X_API int PL_unify_term(term_t l,...)
va_list ap;
int type;
int nels = 1;
arg_types *ptr = (arg_types *)buffers;
int depth = 1;
Term a[1], *pt;
stack_el stack[MAX_DEPTH];
va_start (ap, l);
while (nels > 0) {
type = va_arg(ap, int);
nels --;
ptr->type = type;
switch(type) {
case PL_VARIABLE:
break;
case PL_BOOL:
ptr->arg.i = va_arg(ap, int);
break;
case PL_ATOM:
ptr->arg.a = va_arg(ap, atom_t);
break;
case PL_INTEGER:
ptr->arg.l = va_arg(ap, long);
break;
case PL_FLOAT:
ptr->arg.dbl = va_arg(ap, double);
break;
case PL_STRING:
ptr->arg.s = va_arg(ap, char *);
break;
case PL_TERM:
ptr->arg.t = va_arg(ap, term_t);
break;
case PL_POINTER:
ptr->arg.p = va_arg(ap, void *);
break;
case PL_CHARS:
ptr->arg.s = va_arg(ap, char *);
break;
case PL_NCHARS:
ptr->arg.ns.n = va_arg(ap, size_t);
ptr->arg.ns.s = va_arg(ap, char *);
break;
case PL_NWCHARS:
ptr->arg.nw.n = va_arg(ap, size_t);
ptr->arg.nw.w = va_arg(ap, wchar_t *);
break;
case PL_FUNCTOR:
{
functor_t f = va_arg(ap, functor_t);
Functor ff = SWIFunctorToFunctor(f);
ptr->arg.f = f;
if (!IsAtomTerm((YAP_Term)ff)) {
nels += YAP_ArityOfFunctor((YAP_Functor)ff);
pt = a;
while (depth > 0) {
while (nels > 0) {
type = va_arg(ap, int);
nels--;
switch(type) {
case PL_VARIABLE:
*pt++ = MkVarTerm();
break;
case PL_BOOL:
*pt++ = MkBoolTerm(va_arg(ap, int));
break;
case PL_ATOM:
*pt++ = MkAtomTerm(SWIAtomToAtom(va_arg(ap, atom_t)));
break;
case PL_INTEGER:
*pt++ = MkIntegerTerm(va_arg(ap, long));
break;
case PL_SHORT:
*pt++ = MkIntegerTerm(va_arg(ap, int));
break;
case PL_INT:
*pt++ = MkIntegerTerm(va_arg(ap, int));
break;
case PL_FLOAT:
*pt++ = MkFloatTerm(va_arg(ap, double));
break;
case PL_STRING:
*pt++ = YAP_BufferToString(va_arg(ap, char *));
break;
case PL_CHARS:
*pt++ = MkAtomTerm(Yap_LookupAtom(va_arg(ap, char *)));
break;
case PL_NCHARS:
{
size_t sz = va_arg(ap, size_t);
*pt++ = MkAtomTerm(LookupMaxAtom(sz,va_arg(ap, char *)));
}
break;
case PL_NWCHARS:
{
size_t sz = va_arg(ap, size_t);
*pt++ = MkAtomTerm(LookupMaxWideAtom(sz,va_arg(ap, wchar_t *)));
}
break;
case PL_TERM:
{
Term t = Yap_GetFromSlot(va_arg(ap, size_t));
if (IsVarTerm(t) && VarOfTerm(t) >= ASP && VarOfTerm(t) < LCL0) {
Yap_unify(*pt++, t);
}
else {
*pt++ = t;
}
}
break;
case PL_POINTER:
*pt++ = MkIntegerTerm((Int)va_arg(ap, void *));
break;
case PL_FUNCTOR:
{
functor_t f = va_arg(ap, functor_t);
Functor ff = SWIFunctorToFunctor(f);
UInt arity = ArityOfFunctor(ff);
if (!arity) {
*pt++ = MkAtomTerm((Atom)f);
} else {
Term t = Yap_MkNewApplTerm(ff, arity);
if (nels) {
if (depth == MAX_DEPTH) {
fprintf(stderr,"ERROR: very deep term in PL_unify_term, change MAX_DEPTH from %d\n", MAX_DEPTH);
return FALSE;
}
stack[depth].nels = nels;
stack[depth].ptr = pt+1;
depth++;
}
*pt = t;
if (ff == FunctorDot)
pt = RepPair(t);
else
pt = RepAppl(t)+1;
nels = arity;
}
}
break;
case PL_FUNCTOR_CHARS:
{
char *fname = va_arg(ap, char *);
size_t arity = va_arg(ap, size_t);
if (!arity) {
*pt++ = MkAtomTerm(Yap_LookupAtom(fname));
} else {
Functor ff = Yap_MkFunctor(Yap_LookupAtom(fname),arity);
Term t = Yap_MkNewApplTerm(ff, arity);
if (nels) {
if (depth == MAX_DEPTH) {
fprintf(stderr,"very deep term in PL_unify_term\n");
return FALSE;
}
stack[depth].nels = nels;
stack[depth].ptr = pt+1;
depth++;
}
*pt = t;
if (ff == FunctorDot)
pt = RepPair(t);
else
pt = RepAppl(t)+1;
nels = arity;
}
}
break;
case PL_LIST:
{
Term t = Yap_MkNewPairTerm();
if (nels) {
if (depth == MAX_DEPTH) {
fprintf(stderr,"very deep term in PL_unify_term\n");
return FALSE;
}
stack[depth].nels = nels;
stack[depth].ptr = pt+1;
depth++;
}
*pt = t;
pt = RepPair(t);
nels = 2;
}
break;
default:
fprintf(stderr, "PL_unify_term: %d not supported\n", type);
exit(1);
}
break;
case PL_LIST:
nels += 2;
break;
default:
fprintf(stderr, "%d not supported\n", type);
exit(1);
}
ptr++;
depth--;
if (depth) {
pt = stack[depth-1].ptr;
nels = stack[depth-1].nels;
}
}
va_end (ap);
ptr = (arg_types *)buffers;
return YAP_Unify(Yap_GetFromSlot(l),get_term(&ptr));
return YAP_Unify(Yap_GetFromSlot(l),a[0]);
}
/* end PL_unify_* functions =============================*/
@ -1508,7 +1538,8 @@ PL_rewind_foreign_frame(fid_t f)
X_API void
PL_discard_foreign_frame(fid_t f)
{
fprintf(stderr,"WARNING: PL_discard_foreign_frame not fully implemented!!");
if (f)
fprintf(stderr,"WARNING: PL_discard_foreign_frame not fully implemented!!\n");
/* Missing: undo Trail!! */
}
@ -1702,51 +1733,45 @@ X_API int PL_call(term_t tp, module_t m)
return YAP_RunGoal(g);
}
X_API void PL_register_foreign_in_module(const char *module, const char *name, int arity, foreign_t (*function)(void), int flags)
{
Term tmod;
if (flags & (PL_FA_NOTRACE|PL_FA_NONDETERMINISTIC|PL_FA_CREF)) {
fprintf(stderr,"PL_register_foreign_in_module called with non-implemented flag %x when creating predicate %s:%s/%d\n", flags, module, name, arity);
}
if (module == NULL) {
tmod = CurrentModule;
} else {
tmod = MkAtomTerm(Yap_LookupAtom((char *)module));
}
if (flags & PL_FA_VARARGS)
UserCPredicateVarargs((char *)name,(YAP_Bool (*)(void))function,arity,tmod);
else if (flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,tmod,ModuleTransparentPredFlag);
else
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,tmod,0);
}
X_API void PL_register_extensions(PL_extension *ptr)
{
while(ptr->predicate_name != NULL) {
if (ptr->flags & (PL_FA_NOTRACE|PL_FA_NONDETERMINISTIC|PL_FA_VARARGS|PL_FA_CREF)) {
YAP_Error(0,YAP_MkIntTerm(ptr->flags),"non-implemented flag %x when creating predicates", ptr->flags);
return;
}
if (ptr->flags & PL_FA_VARARGS)
UserCPredicateVarargs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (ptr->flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
PL_register_foreign_in_module(NULL, ptr->predicate_name, ptr->arity, ptr->function, ptr->flags);
ptr++;
}
}
X_API void PL_register_foreign_in_module(const char *module, const char *name, int arity, foreign_t (*function)(void), int flags)
{
if (flags & (PL_FA_NOTRACE|PL_FA_NONDETERMINISTIC|PL_FA_VARARGS|PL_FA_CREF)) {
YAP_Error(0,YAP_MkIntTerm(flags),"non-implemented flag %x when creating predicates", flags);
return;
}
if (flags & PL_FA_VARARGS)
UserCPredicateVarargs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (flags & PL_FA_TRANSPARENT)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom("prolog")));
else if (module == NULL)
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,YAP_CurrentModule());
else
UserCPredicateWithArgs((char *)name,(YAP_Bool (*)(void))function,arity,MkAtomTerm(Yap_LookupAtom((char *)module)));
}
X_API void PL_load_extensions(PL_extension *ptr)
{
/* ignore flags for now */
while(ptr->predicate_name != NULL) {
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule());
UserCPredicateWithArgs(ptr->predicate_name,(YAP_Bool (*)(void))ptr->function,ptr->arity,YAP_CurrentModule(),0);
ptr++;
}
}
X_API int PL_handle_signals(void)
{
fprintf(stderr,"not implemented\n");
fprintf(stderr,"PL_handle_signals not implemented\n");
return 0;
}
@ -1868,6 +1893,7 @@ PL_free(void *obj)
return YAP_FreeSpaceFromYap(obj);
}
static int
SWI_ctime(void)
{

4
library/yap2swi/yap2swi.h
View File

@ -259,6 +259,10 @@ extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *);
extern X_API int PL_get_string_chars(term_t, char **, int *);
extern X_API int PL_action(int,...);
#define IOSTREAM void
extern X_API int PL_get_stream_handle(term_t,IOSTREAM *);
extern X_API int Sprintf(char *,...);
extern X_API int Sdprintf(char *,...);

6
pl/consult.yap
View File

@ -241,6 +241,7 @@ use_module(M,F,Is) :-
true
),
'$loop'(Stream,Reconsult),
( recorded('$dialect',swi,_) -> '$exec_initialisation_goals' ; true ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$current_module'(Mod,OldModule),
print_message(InfLevel, loaded(EndMsg, File, Mod, T, H)),
@ -313,7 +314,8 @@ use_module(M,F,Is) :-
call(G),
fail.
'$exec_initialisation_goals' :-
'$show_consult_level'(Level),
'$show_consult_level'(Level1),
( recorded('$dialect',swi,_) -> Level is Level1-1 ; Level = Level1),
recorded('$initialisation',do(Level,G),R),
erase(R),
G \= '$',
@ -608,7 +610,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
'$do_error'(instantiation_error, G).
'$process_fn_opt'(extensions(Extensions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,_,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
'$check_fn_extensions'(L,G).
'$check_fn_extensions'(Extensions,G).
'$process_fn_opt'(relative_to(RelTo),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,_,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
'$check_atom'(RelTo,G).
'$process_fn_opt'(access(Access),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,_,FErrors,Solutions,Expand,Debug,G) :- !,

7
pl/directives.yap
View File

@ -1078,8 +1078,11 @@ user_defined_flag(Atom) :-
'$user_flag_value'(F, Val) :-
'$do_error'(type_error(atomic,Val),yap_flag(F,Val)).
'$expects_dialect'(swi) :-
eraseall('$dialect'),
recorda('$dialect',swi,_),
load_files(library('dialect/swi'),[silent(true),if(not_loaded)]).
'$expects_dialect'(yap).
'$expects_dialect'(yap) :-
eraseall('$dialect'),
recorda('$dialect',yap,_).

2
pl/init.yap
View File

@ -144,6 +144,8 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- dynamic user:commons_directory/1.
:- recorda('$dialect',yap,_).
%
% cleanup ensure loaded and recover some data-base space.
%