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

Merge branch 'master' of ../yap-6.2

This commit is contained in:
Vitor Santos Costa 2010-12-13 12:40:07 +00:00
parent b086d8b5cd 3c4da56af2
commit dffacb814b
31 changed files with 231 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/agc.c
View File

@ -74,6 +74,7 @@ CleanAtomMarkedBit(Atom a)
return (Atom)c;
}
static inline Functor
FuncAdjust(Functor f)
{
@ -111,6 +112,22 @@ AtomAdjust(Atom a)
return(a);
}
static Term AdjustDBTerm(Term, Term *);
static Term
CodeComposedTermAdjust(Term t)
{
Term *base;
if (IsApplTerm(t)) {
base = RepAppl(t);
} else {
base = RepPair(t);
}
return AdjustDBTerm(t, base);
}
#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE
@ -145,7 +162,6 @@ AtomAdjust(Atom a)
#define AtomEntryAdjust(P) (P)
#define GlobalEntryAdjust(P) (P)
#define BlobTermAdjust(P) (P)
#define CodeComposedTermAdjust(P) (P)
#define CellPtoHeapAdjust(P) (P)
#define PtoAtomHashEntryAdjust(P) (P)
#define CellPtoHeapCellAdjust(P) (P)

8
C/cdmgr.c
View File

@ -792,11 +792,13 @@ ConstantTermAdjust (Term t)
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t))
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
else if (IsPairTerm(t))
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
else return t;
} else {
return t;
}
}

22
C/iopreds.c
View File

@ -3489,9 +3489,17 @@ CheckStream (Term arg, int kind, char *msg)
sname = AtomUserOut;
}
}
if (kind & SWI_Stream_f) {
struct io_stream *swi_stream;
if (Yap_get_stream_handle(arg, &swi_stream)) {
sno = LookupSWIStream(swi_stream);
return sno;
}
}
if ((sno = CheckAlias(sname)) == -1) {
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
return(-1);
return -1;
}
} else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) {
arg = ArgOfTerm (1, arg);
@ -4089,7 +4097,15 @@ static Int
p_write2_prio (void)
{ /* '$write'(+Stream,+Flags,?Term) */
int old_output_stream = Yap_c_output_stream;
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2");
Int flags = IntegerOfTerm(Deref(ARG2));
int stream_f;
if (flags & Use_SWI_Stream_f) {
stream_f = Output_Stream_f|SWI_Stream_f;
} else {
stream_f = Output_Stream_f;
}
Yap_c_output_stream = CheckStream (ARG1, stream_f, "write/2");
if (Yap_c_output_stream == -1) {
Yap_c_output_stream = old_output_stream;
return(FALSE);
@ -4098,7 +4114,7 @@ p_write2_prio (void)
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
Yap_StartSlots();
Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), (int) IntOfTerm (Deref (ARG3)));
Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) flags, (int) IntOfTerm (Deref (ARG3)));
Yap_CloseSlots();
Yap_c_output_stream = old_output_stream;
if (EX != 0L) {

2
C/load_aix.c
View File

@ -68,7 +68,7 @@ LoadForeign(StringList ofiles, StringList libs,
strcpy(Yap_ErrorSay," Load Failed: in AIX you must load a single object file");
return LOAD_FAILLED;
}
if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
strcpy(Yap_ErrorSay, " Trying to open unexisting file in LoadForeign ");
return LOAD_FAILLED;
}

4
C/load_aout.c
View File

@ -154,7 +154,7 @@ LoadForeign(StringList ofiles,
while(tmp != NULL) {
strcat(o_files," ");
strcat(o_files,tmp->s);
strcat(o_files,AtomName(tmp->name));
tmp = tmp->next;
}
}
@ -165,7 +165,7 @@ LoadForeign(StringList ofiles,
while(tmp != NULL) {
strcat(l_files," ");
strcat(l_files,tmp->s);
strcat(l_files,AtomName(tmp->name));
tmp = tmp->next;
}
}

4
C/load_coff.c
View File

@ -155,7 +155,7 @@ LoadForeign(StringList ofiles,
while(tmp != NULL) {
strcat(o_files," ");
strcat(o_files,tmp->s);
strcat(o_files,AtomName(tmp->name));
tmp = tmp->next;
}
}
@ -166,7 +166,7 @@ LoadForeign(StringList ofiles,
while(tmp != NULL) {
strcat(l_files," ");
strcat(l_files,tmp->s);
strcat(l_files,AtomName(tmp->name));
tmp = tmp->next;
}
}

6
C/load_dl.c
View File

@ -92,9 +92,9 @@ LoadForeign(StringList ofiles, StringList libs,
while (libs) {
if (!Yap_TrueFileName(libs->s, Yap_FileNameBuf, TRUE)) {
if (!Yap_TrueFileName(AtomName(libs->name), Yap_FileNameBuf, TRUE)) {
/* use LD_LIBRARY_PATH */
strncpy(Yap_FileNameBuf, libs->s, YAP_FILENAME_MAX);
strncpy(Yap_FileNameBuf, AtomName(libs->name), YAP_FILENAME_MAX);
}
#ifdef __osf__
@ -116,7 +116,7 @@ LoadForeign(StringList ofiles, StringList libs,
other routines */
/* dlopen wants to follow the LD_CONFIG_PATH */
if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign");
return LOAD_FAILLED;
}

2
C/load_dld.c
View File

@ -80,7 +80,7 @@ LoadForeign(StringList ofiles, StringList libs,
}
while (ofiles) {
if((error=dld_link(ofiles->s)) !=0) {
if((error=dld_link(AtomName(ofiles->name))) !=0) {
strcpy(Yap_ErrorSay,dld_strerror(error));
return LOAD_FAILLED;
}

9
C/load_dll.c
View File

@ -66,7 +66,7 @@ LoadForeign(StringList ofiles, StringList libs,
while (ofiles) {
HINSTANCE handle;
if (Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE) &&
if (Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE) &&
(handle=LoadLibrary(Yap_FileNameBuf)) != 0)
{
Yap_ErrorSay[0]=~'\0';
@ -84,12 +84,13 @@ LoadForeign(StringList ofiles, StringList libs,
other routines */
while (libs) {
HINSTANCE handle;
char * s = AtomName(libs->name);
if (libs->s[0] == '-') {
strcat(Yap_FileNameBuf,libs->s+2);
if (s[0] == '-') {
strcat(Yap_FileNameBuf,s+2);
strcat(Yap_FileNameBuf,".dll");
} else {
strcpy(Yap_FileNameBuf,libs->s);
strcpy(Yap_FileNameBuf,s);
}
if((handle=LoadLibrary(Yap_FileNameBuf)) == 0)

11
C/load_dyld.c
View File

@ -145,7 +145,7 @@ LoadForeign(StringList ofiles, StringList libs,
void *handle;
/* mydlopen wants to follow the LD_CONFIG_PATH */
if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) {
if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) {
strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign");
return LOAD_FAILLED;
}
@ -163,13 +163,14 @@ LoadForeign(StringList ofiles, StringList libs,
/* load libraries first so that their symbols are available to
other routines */
while (libs) {
if (libs->s[0] == '-') {
char *s = AtomName(lib->name);
if (ls[0] == '-') {
strcpy(Yap_FileNameBuf,"lib");
strcat(Yap_FileNameBuf,libs->s+2);
strcat(Yap_FileNameBuf,s+2);
strcat(Yap_FileNameBuf,".so");
} else {
strcpy(Yap_FileNameBuf,libs->s);
strcpy(Yap_FileNameBuf,s);
}
if((libs->handle=mydlopen(Yap_FileNameBuf)) == NULL)

4
C/load_foreign.c
View File

@ -57,7 +57,7 @@ p_load_foreign(void)
t = TailOfTerm(t);
new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = ofiles;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
new->name = AtomOfTerm(t1);
ofiles = new;
}
@ -69,7 +69,7 @@ p_load_foreign(void)
t = TailOfTerm(t);
new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem));
new->next = libs;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
new->name = AtomOfTerm(t1);
libs = new;
}

11
C/load_shl.c
View File

@ -61,7 +61,7 @@ LoadForeign( StringList ofiles, StringList libs,
int valid_fname;
/* shl_load wants to follow the LD_CONFIG_PATH */
valid_fname = Yap_TrueFileName( ofiles->s, Yap_FileNameBuf, TRUE );
valid_fname = Yap_TrueFileName( AtomName(ofiles->name), Yap_FileNameBuf, TRUE );
if( !valid_fname ) {
strcpy( Yap_ErrorSay, "%% Trying to open non-existing file in LoadForeign" );
@ -89,14 +89,15 @@ LoadForeign( StringList ofiles, StringList libs,
}
while( libs ) {
if( libs->s[0] == '-' ) {
char *s = AtomName(lib->s);
if( s[0] == '-' ) {
strcpy( Yap_FileNameBuf, "lib" );
strcat( Yap_FileNameBuf, libs->s+2 );
strcat( Yap_FileNameBuf, s+2 );
strcat( Yap_FileNameBuf, ".sl" );
}
else {
strcpy( Yap_FileNameBuf, libs->s );
strcpy( Yap_FileNameBuf, s );
}
*(shl_t *)libs->handle = shl_load( Yap_FileNameBuf, BIND_DEFERRED, 0 );

1
C/tracer.c
View File

@ -391,7 +391,6 @@ static Int p_stop_low_level_trace(void)
{
Yap_do_low_level_trace = FALSE;
do_trace_primitives = TRUE;
fprintf(stderr,"vsc_count = %I64d\n",vsc_count);
return(TRUE);
}

2
H/Foreign.h
View File

@ -84,7 +84,7 @@
#define LOAD_FAILLED -1
typedef struct StringListItem {
char *s;
Atom name;
void *handle;
struct StringListItem *next;
} StringListItem, *StringList;

1
H/YapHeap.h
View File

@ -28,6 +28,7 @@ typedef int (*SWI_PutWideFunction)(int, void *);
typedef int (*SWI_GetWideFunction)(void *);
typedef int (*SWI_CloseFunction)(void *);
typedef int (*SWI_FlushFunction)(void *);
typedef int (*SWI_PLGetStreamFunction)(void *);
#include "../include/dswiatoms.h"

1
H/Yapproto.h
View File

@ -461,6 +461,7 @@ void STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void));
/* yap2swi.c */
void STD_PROTO(Yap_swi_install,(void));
void STD_PROTO(Yap_InitSWIHash,(void));
int STD_PROTO(Yap_get_stream_handle,(Term, void *));
/* ypsocks.c */
void STD_PROTO(Yap_InitSockets,(void));

1
H/dglobals.h
View File

@ -187,6 +187,7 @@
#define SWIWidePutc Yap_global->swi_wputc
#define SWIClose Yap_global->swi_close
#define SWIFlush Yap_global->swi_flush
#define SWIGetStream Yap_global->swi_get_stream_f
#define Yap_AllowLocalExpansion Yap_global->allow_local_expansion
#define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion

1
H/hglobals.h
View File

@ -189,6 +189,7 @@ typedef struct worker_shared {
SWI_PutWideFunction swi_wputc;
SWI_CloseFunction swi_close;
SWI_FlushFunction swi_flush;
SWI_PLGetStreamFunction swi_get_stream_f;
int allow_local_expansion;
int allow_global_expansion;

1
H/iglobals.h
View File

@ -187,6 +187,7 @@ static void InitGlobal(void) {
Yap_global->swi_wputc = NULL;
Yap_global->swi_close = NULL;
Yap_global->swi_flush = NULL;
Yap_global->swi_get_stream_f = NULL;
Yap_global->allow_local_expansion = TRUE;
Yap_global->allow_global_expansion = TRUE;

1
H/rglobals.h
View File

@ -198,6 +198,7 @@ static void RestoreGlobal(void) {
#if HAVE_LIBREADLINE

14
H/rheap.h
View File

@ -246,11 +246,13 @@ ConstantTermAdjust (Term t)
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t))
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
else if (IsPairTerm(t))
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
else return t;
} else {
return t;
}
}
/* Now, everything on its place so you must adjust the pointers */
@ -958,8 +960,7 @@ RestoreForeignCode(void)
while (objs != NULL) {
if (objs->next != NULL)
objs->next = (StringList)AddrAdjust((ADDR)objs->next);
if (objs->s != NULL)
objs->s = (char *)AddrAdjust((ADDR)objs->s);
objs->name = AtomAdjust(objs->name);
objs = objs->next;
}
if (f_code->libs != NULL)
@ -968,8 +969,7 @@ RestoreForeignCode(void)
while (libs != NULL) {
if (libs->next != NULL)
libs->next = (StringList)AddrAdjust((ADDR)libs->next);
if (libs->s != NULL)
libs->s = (char *)AddrAdjust((ADDR)libs->s);
libs->name = AtomAdjust(libs->name);
libs = libs->next;
}
if (f_code->f != NULL)

13
H/yapio.h
View File

@ -334,12 +334,13 @@ Atom STD_PROTO(Yap_LookupWideAtom,(wchar_t *));
#define YAP_SEEKABLE_STREAM 0x80
#define Quote_illegal_f 1
#define Ignore_ops_f 2
#define Handle_vars_f 4
#define Use_portray_f 8
#define To_heap_f 16
#define Unfold_cyclics_f 32
#define Quote_illegal_f 0x01
#define Ignore_ops_f 0x02
#define Handle_vars_f 0x04
#define Use_portray_f 0x08
#define To_heap_f 0x10
#define Unfold_cyclics_f 0x20
#define Use_SWI_Stream_f 0x40
/* write.c */
void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int));

1
include/SWI-Prolog.h
View File

@ -698,6 +698,7 @@ typedef struct SWI_IO {
void *put_w;
void *flush_s;
void *close_s;
void *get_stream_handle;
} swi_io_struct;
/* SWI stream info */

14
library/dialect/swi.yap
View File

@ -225,6 +225,20 @@ goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io.
goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io.
goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io.
goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io.
goal_expansion(nl(A),system:swi_nl(A)) :- swi_io.
goal_expansion(nl,system:swi_nl) :- swi_io.
goal_expansion(write(A),write_term(user_output,A,[swi(true)])) :- swi_io.
goal_expansion(write(S,A),write_term(S,A,[swi(true)])) :- swi_io.
goal_expansion(writeq(A),write_term(user_output,A,[swi(true),quoted(true)])) :- swi_io.
goal_expansion(writeq(S,A),write_term(S,A,[swi(true),quoted(true)])) :- swi_io.
goal_expansion(display(A),write_term(user_output,A,[swi(true),ignore_ops(true)])) :- swi_io.
goal_expansion(display(S,A),write_term(S,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io.
goal_expansion(write_canonical(A),write_term(user_output,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io.
goal_expansion(write_canonical(S,A),write_term(S,A,[swi(true),ignore_ops(true)])) :- swi_io.
goal_expansion(print(A),write_term(user_output,A,[swi(true),portray(true),numbervars(true)])) :- swi_io.
goal_expansion(print(S,A),write_term(S,A,[swi(true),portray(true),numbervars(true)])) :- swi_io.
goal_expansion(write_term(A,Opts),write_term(user_output,A,Opts,[swi(true)|Opts])) :- swi_io.
goal_expansion(write_term(S,A,Opts),write_term(S,A,[swi(true)|Opts])) :- swi_io, \+ member(swi(_), Opts).
% make sure we also use

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

@ -3103,6 +3103,16 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio)
SWIWidePutc = swio->put_w;
SWIFlush = swio->flush_s;
SWIClose = swio->close_s;
SWIGetStream = swio->get_stream_handle;
}
typedef int (*GetStreamF)(term_t, IOSTREAM **s);
int
Yap_get_stream_handle(Term t0, void *s){
term_t t = (term_t)YAP_InitSlot(t0);
GetStreamF f = (GetStreamF)SWIGetStream;
return (*f)(t,s);
}

1
misc/GLOBALS
View File

@ -210,6 +210,7 @@ SWI_GetWideFunction swi_wgetc SWIWideGetc =NULL
SWI_PutWideFunction swi_wputc SWIWidePutc =NULL
SWI_CloseFunction swi_close SWIClose =NULL
SWI_FlushFunction swi_flush SWIFlush =NULL
SWI_PLGetStreamFunction swi_get_stream_f SWIGetStream =NULL
// stack overflow expansion/gc control
int allow_local_expansion Yap_AllowLocalExpansion =TRUE

46
packages/PLStream/pl-file.c
View File

@ -509,14 +509,13 @@ noent:
#define get_stream_handle(t, sp, flags) \
get_stream_handle__LD(t, sp, flags PASS_LD)
int
X_API int
PL_get_stream_handle(term_t t, IOSTREAM **s)
{ GET_LD
return get_stream_handle(t, s, SH_ERRORS|SH_ALIAS);
}
int
X_API int
PL_unify_stream_or_alias(term_t t, IOSTREAM *s)
{ GET_LD
int rval;
@ -4215,6 +4214,7 @@ PRED_IMPL("copy_stream_data", 2, copy_stream_data2, 0)
}
/*******************************
* PUBLISH PREDICATES *
*******************************/
@ -4307,13 +4307,47 @@ BeginPredDefs(file)
EndPredDefs
#if __YAP_PROLOG__
static pl_Sgetc(IOSTREAM *s)
static int
pl_Sgetc(IOSTREAM *s)
{
return Sgetc(s);
}
/* copied by VSC */
static word
pl_nl1(term_t stream)
{ IOSTREAM *s;
if ( getOutputStream(stream, &s) )
{ Sputcode('\n', s);
return streamStatus(s);
}
fail;
}
static word
pl_nl(void)
{ return pl_nl1(0);
}
static const PL_extension foreigns[] = {
FRG("swi_nl", 0, pl_nl, ISO),
FRG("swi_nl", 1, pl_nl1, ISO),
/* DO NOT ADD ENTRIES BELOW THIS ONE */
FRG((char *)NULL, 0, NULL, 0)
};
static int
get_stream_handle_no_errors(term_t t, IOSTREAM **s)
{ GET_LD
return get_stream_handle(t, s, SH_ALIAS);
}
static void
init_yap_extras()
init_yap_extras(void)
{
swi_io_struct swiio;
@ -4324,11 +4358,13 @@ init_yap_extras()
swiio.put_w = Sputcode;
swiio.flush_s = Sflush;
swiio.close_s = Sclose;
swiio.get_stream_handle = get_stream_handle_no_errors;
PL_YAP_InitSWIIO(&swiio);
initCharTypes();
initFiles();
initGlob();
PL_register_extensions(PL_predicates_from_file);
PL_register_extensions(foreigns);
fileerrors = TRUE;
SinitStreams();
}

11
pl/boot.yap
View File

@ -461,9 +461,14 @@ true :- true.
'$$compile'(G1, G0, N, HeadMod).
'$prepare_term'(G, V, Pos, G0, G1, BodyMod, SourceMod, Source) :-
( get_value('$syntaxcheckflag',on) ->
'$check_term'(Source, V, Pos, BodyMod) ; true ),
'$precompile_term'(G, G0, G1, BodyMod, SourceMod).
'$precompile_term'(G, G0, G1, BodyMod, SourceMod),
(
get_value('$syntaxcheckflag',on)
->
'$check_term'(G0, V, Pos, Source, BodyMod)
;
true
).
% process an input clause
'$$compile'(G, G0, L, Mod) :-

14
pl/checker.yap
View File

@ -120,20 +120,22 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$values'('$syntaxcheckmultiple',O,N).
'$check_term'(T,_,P,M) :-
'$check_term'(T,_,P,_Source,M) :-
get_value('$syntaxcheckdiscontiguous',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_discontiguous'(F,A,NM), fail.
'$check_term'(T,_,P,M) :-
'$check_term'(T,_,P,_Source,M) :-
get_value('$syntaxcheckmultiple',on),
'$xtract_head'(T,M,NM,_,F,A),
'$handle_multiple'(F,A,NM), fail.
'$check_term'(T,VL,P,_) :-
'$check_term'(T,VL,P,_Source,_) :-
get_value('$syntaxchecksinglevar',on),
( '$chk_binding_vars'(T),
'$sv_list'(VL,Sv) ->
'$sv_warning'(Sv,T) ), fail.
'$check_term'(_,_,_,_).
'$sv_list'(VL,Sv)
->
'$sv_warning'(Sv,T)
), fail.
'$check_term'(_,_,_,_,_).
'$chk_binding_vars'(V) :- var(V), !, V = '$V'(_).
'$chk_binding_vars'('$V'(off)) :- !.

2
pl/tabling.yap
View File

@ -14,7 +14,7 @@
:- meta_predicate
table(:),
is_tabled(:),
tabling_mode(:),
tabling_mode(:,?),
abolish_table(:),
show_table(:),
table_statistics(:),

139
pl/yio.yap
View File

@ -29,13 +29,6 @@ open(File0,Mode,Stream) :-
'$expand_filename'(Expansion, File0, File),
'$open'(File, Mode, Stream, 16, Encoding, File0).
/* meaning of flags for '$write' is
1 quote illegal atoms
2 ignore operator declarations
4 output '$VAR'(N) terms as A, B, C, ...
8 use portray(_)
*/
close(V) :- var(V), !,
'$do_error'(instantiation_error,close(V)).
close(File) :-
@ -229,21 +222,23 @@ open(F,T,S,Opts) :-
'$check_opt_write'(attributes(T), G) :- !,
'$check_write_attributes'(T, G).
'$check_opt_write'(cycles(T), G) :- !,
'$check_cycles_arg'(T, G).
'$check_boolean'(T, write_option, cycles(T), G).
'$check_opt_write'(quoted(T), G) :- !,
'$check_write_quoted_arg'(T, G).
'$check_boolean'(T, write_option, quoted(T), G).
'$check_opt_write'(ignore_ops(T), G) :- !,
'$check_write_ignore_ops_arg'(T, G).
'$check_opt_write'(numbervars(T), G) :- !,
'$check_write_numbervars_arg'(T, G).
'$check_opt_write'(portrayed(T), G) :- !,
'$check_write_portrayed'(T, G).
'$check_opt_write'(portray(T), G) :- !,
'$check_write_portrayed'(T, G).
'$check_opt_write'(priority(T), G) :- !,
'$check_priority_arg'(T, G).
'$check_boolean'(T, write_option, ignore_ops(T), G).
'$check_opt_write'(max_depth(T), G) :- !,
'$check_write_max_depth'(T, G).
'$check_opt_write'(numbervars(T), G) :- !,
'$check_boolean'(T, write_option, ignore_ops(T), G).
'$check_opt_write'(portrayed(T), G) :- !,
'$check_boolean'(T, write_option, portrayed(T), G).
'$check_opt_write'(portray(T), G) :- !,
'$check_boolean'(T, write_option, portray(T), G).
'$check_opt_write'(priority(T), G) :- !,
'$check_priority_arg'(T, G).
'$check_opt_write'(swi(T), G) :- !,
'$check_boolean'(T, write_option, swi(T), G).
'$check_opt_write'(A, G) :-
'$do_error'(domain_error(write_option,A),G).
@ -329,40 +324,12 @@ open(F,T,S,Opts) :-
'$check_write_attributes'(X,G) :-
'$do_error'(domain_error(write_option,attributes(X)),G).
'$check_write_quoted_arg'(X, G) :- var(X), !,
'$check_boolean'(X, _, _, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_write_quoted_arg'(true,_) :- !.
'$check_write_quoted_arg'(false,_) :- !.
'$check_write_quoted_arg'(X,G) :-
'$do_error'(domain_error(write_option,write_quoted(X)),G).
'$check_cycles_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_cycles_arg'(true,_) :- !.
'$check_cycles_arg'(false,_) :- !.
'$check_cycles_arg'(X,G) :-
'$do_error'(domain_error(write_option,cycles(X)),G).
'$check_write_ignore_ops_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_write_ignore_ops_arg'(true,_) :- !.
'$check_write_ignore_ops_arg'(false,_) :- !.
'$check_write_ignore_ops_arg'(X,G) :-
'$do_error'(domain_error(write_option,ignore_ops(X)),G).
'$check_write_numbervars_arg'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_write_numbervars_arg'(true,_) :- !.
'$check_write_numbervars_arg'(false,_) :- !.
'$check_write_numbervars_arg'(X,G) :-
'$do_error'(domain_error(write_option,numbervars(X)),G).
'$check_write_portrayed'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
'$check_write_portrayed'(true,_) :- !.
'$check_write_portrayed'(false,_) :- !.
'$check_write_portrayed'(X,G) :-
'$do_error'(domain_error(write_option,portrayed(X)),G).
'$check_boolean'(true,_,_,_) :- !.
'$check_boolean'(false,_,_,_) :- !.
'$check_boolean'(X,B,T,G) :-
'$do_error'(domain_error(B,T),G).
'$check_write_max_depth'(X, G) :- var(X), !,
'$do_error'(instantiation_error,G).
@ -520,19 +487,20 @@ read_term(Stream, T, Options) :-
'$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
atom_codes(Name, Na).
nl(Stream) :- '$put'(Stream,10).
nl :- current_output(Stream), '$put'(Stream,10), fail.
nl.
/* meaning of flags for '$write' is
1 quote illegal atoms
2 ignore operator declarations
4 output '$VAR'(N) terms as A, B, C, ...
8 use portray(_)
flags are defined in yapio.h
*/
nl(Stream) :- '$put'(Stream,10).
nl :- current_output(Stream), '$put'(Stream,10), fail.
nl.
write(T) :- '$write'(4, T).
writeln(T) :-
@ -563,6 +531,15 @@ write_canonical(Stream,T) :-
fail.
write_canonical(_,_).
print(T) :- '$write'(12,T), fail.
print(_).
print(Stream,T) :-
'$write'(Stream,12,T),
fail.
print(_,_).
write_term(T,Opts) :-
'$check_io_opts'(Opts, write_term(T,Opts)),
'$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks),
@ -579,42 +556,49 @@ write_term(S, T, Opts) :-
fail.
write_term(_,_,_).
'$process_wt_opts'([], Flag, Flag, 1200, []).
'$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 1,
FlagI is Flag0 \/ 0x01,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 30,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 16,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 15,
FlagI is Flag0 /\ \0x01,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 2,
FlagI is Flag0 \/ 0x02,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 39,
FlagI is Flag0 /\ \0x02,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 4,
FlagI is Flag0 \/ 0x04,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 27,
FlagI is Flag0 /\ \0x04,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 8,
FlagI is Flag0 \/ 0x08,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 23,
FlagI is Flag0 /\ \0x08,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portray(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 8,
FlagI is Flag0 \/ 0x08,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([portray(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ 23,
FlagI is Flag0 /\ \0x08,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 0x20,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ \0x20,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([swi(true)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 \/ 0x40,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([swi(false)|Opts], Flag0, Flag, Priority, CallBacks) :-
FlagI is Flag0 /\ \0x40,
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
'$process_wt_opts'([attributes(_)|Opts], Flag0, Flag, Priority, CallBacks) :-
'$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks).
@ -632,15 +616,6 @@ write_term(_,_,_).
'$process_wt_callbacks'(Cs).
print(T) :- '$write'(12,T), fail.
print(_).
print(Stream,T) :-
'$write'(Stream,12,T),
fail.
print(_,_).
format(T) :-
format(T, []).