From 3c4da56af2fe818cdb7bf7f82bc360790a977162 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 13 Dec 2010 12:38:37 +0000 Subject: [PATCH] allow write to find out about SWI streams in SWI mode. --- C/iopreds.c | 22 +++++- H/YapHeap.h | 1 + H/Yapproto.h | 1 + H/dglobals.h | 1 + H/hglobals.h | 1 + H/iglobals.h | 1 + H/rglobals.h | 1 + H/yapio.h | 13 ++-- include/SWI-Prolog.h | 1 + library/dialect/swi.yap | 12 +++ library/dialect/swi/fli/swi.c | 10 +++ misc/GLOBALS | 1 + packages/PLStream/pl-file.c | 18 +++-- pl/yio.yap | 139 ++++++++++++++-------------------- 14 files changed, 126 insertions(+), 96 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index 61e884450..923bfb4a0 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -3487,9 +3487,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); @@ -4087,7 +4095,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); @@ -4096,7 +4112,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) { diff --git a/H/YapHeap.h b/H/YapHeap.h index ec52098d2..fe815007a 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -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" diff --git a/H/Yapproto.h b/H/Yapproto.h index f5e0812c0..055075eca 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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)); diff --git a/H/dglobals.h b/H/dglobals.h index b65cf8a51..36d72d2b4 100644 --- a/H/dglobals.h +++ b/H/dglobals.h @@ -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 diff --git a/H/hglobals.h b/H/hglobals.h index c14707c6f..1e60fbbf0 100644 --- a/H/hglobals.h +++ b/H/hglobals.h @@ -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; diff --git a/H/iglobals.h b/H/iglobals.h index 24e0db95d..978c91658 100644 --- a/H/iglobals.h +++ b/H/iglobals.h @@ -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; diff --git a/H/rglobals.h b/H/rglobals.h index 304992160..81d3bb0e2 100644 --- a/H/rglobals.h +++ b/H/rglobals.h @@ -198,6 +198,7 @@ static void RestoreGlobal(void) { + #if HAVE_LIBREADLINE diff --git a/H/yapio.h b/H/yapio.h index 6cb463f09..6483a0b34 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -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)); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 6c2863b30..a3b301169 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -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 */ diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 65a9e3417..a31997aa7 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -227,6 +227,18 @@ goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- 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 diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 337c797ff..fd4a45264 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -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); } diff --git a/misc/GLOBALS b/misc/GLOBALS index c1df5ec57..4313b1f87 100644 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -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 diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index ae4aa4cfe..c36e064b7 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -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; @@ -4308,7 +4307,8 @@ BeginPredDefs(file) EndPredDefs #if __YAP_PROLOG__ -static pl_Sgetc(IOSTREAM *s) +static int +pl_Sgetc(IOSTREAM *s) { return Sgetc(s); } @@ -4328,7 +4328,7 @@ pl_nl1(term_t stream) } static word -pl_nl() +pl_nl(void) { return pl_nl1(0); } @@ -4339,6 +4339,13 @@ static const PL_extension foreigns[] = { 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(void) { @@ -4351,6 +4358,7 @@ init_yap_extras(void) 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(); diff --git a/pl/yio.yap b/pl/yio.yap index 9472e01f2..200e185b0 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -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, []).