From 57f5ef8cfc87c78cf9ac2bcc7868b7a9c213081c Mon Sep 17 00:00:00 2001 From: ubu32 Date: Tue, 15 Feb 2011 05:54:19 -0800 Subject: [PATCH] more bug fixes: - make readline use packages, not old YAP code - fix ! over backtrack cps - fix write list --- C/adtdefs.c | 2 + C/c_interface.c | 15 --- C/iopreds.c | 115 +++++++++------- C/readutil.c | 193 --------------------------- C/save.c | 2 + C/stdpreds.c | 22 +--- H/absmi.h | 20 +-- H/amiops.h | 2 +- H/cut_c.h | 5 +- H/yapio.h | 2 + LGPL/Makefile.in | 1 + LGPL/readutil.pl | 242 ++++++++++++++++++++++++++++++++++ Makefile.in | 11 +- include/YapInterface.h | 3 - library/Makefile.in | 1 - library/dialect/swi/fli/swi.c | 40 +----- library/readutil.yap | 63 --------- packages/PLStream/pl-file.c | 5 - 18 files changed, 341 insertions(+), 403 deletions(-) delete mode 100644 C/readutil.c create mode 100644 LGPL/readutil.pl delete mode 100644 library/readutil.yap diff --git a/C/adtdefs.c b/C/adtdefs.c index ab90eb529..1f63058bf 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -1177,6 +1177,8 @@ Yap_StringToDiffList(char *s, Term t) t = Yap_Globalise(t); while (cp > (unsigned char *)s) { + if (ASP < H+1024) + return (CELL)0; t = MkPairTerm(MkIntTerm(*--cp), t); } return t; diff --git a/C/c_interface.c b/C/c_interface.c index 2b40c8e65..0d2dd78dd 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -333,7 +333,6 @@ #include #include "Yap.h" #include "clause.h" -#include "SWI-Stream.h" #include "yapio.h" #include "attvar.h" #if HAVE_STDARG_H @@ -474,7 +473,6 @@ X_API void STD_PROTO(YAP_SetOutputMessage, (void)); X_API int STD_PROTO(YAP_StreamToFileNo, (Term)); X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void)); X_API void STD_PROTO(YAP_FlushAllStreams,(void)); -X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int)); X_API Int STD_PROTO(YAP_CurrentSlot,(void)); X_API Int STD_PROTO(YAP_NewSlots,(int)); X_API Int STD_PROTO(YAP_InitSlot,(Term)); @@ -3027,19 +3025,6 @@ YAP_FlushAllStreams(void) RECOVER_H(); } -X_API Term -YAP_OpenStream(void *fh, char *name, Term nm, int flags) -{ - Term retv; - - BACKUP_H(); - - retv = Yap_OpenStream((FILE *)fh, name, nm, flags); - - RECOVER_H(); - return retv; -} - X_API void YAP_Throw(Term t) { diff --git a/C/iopreds.c b/C/iopreds.c index 78ef6839a..0c82ea403 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -27,7 +27,6 @@ static char SccsId[] = "%W% %G%"; #include "Yap.h" #include "Yatom.h" #include "YapHeap.h" -#include "SWI-Stream.h" #include "yapio.h" #include "eval.h" #include @@ -140,55 +139,6 @@ DefaultEncoding(void) return ENC_ISO_ANSI; } -static int -GetFreeStreamD(void) -{ - int sno; - - for (sno = 0; sno < MaxStreams; ++sno) { - LOCK(Stream[sno].streamlock); - if (Stream[sno].status & Free_Stream_f) { - break; - } - UNLOCK(Stream[sno].streamlock); - } - if (sno == MaxStreams) { - return -1; - } - Stream[sno].encoding = DefaultEncoding(); - return sno; -} - -int -Yap_GetFreeStreamD(void) -{ - return GetFreeStreamD(); -} - -/* used from C-interface */ -int -Yap_GetFreeStreamDForReading(void) -{ - int sno = GetFreeStreamD(); - StreamDesc *s; - - if (sno < 0) return sno; - s = Stream+sno; - s->status |= User_Stream_f|Input_Stream_f; - s->charcount = 0; - s->linecount = 1; - s->linepos = 0; - s->stream_wgetc = get_wchar; - s->encoding = DefaultEncoding(); - if (CharConversionTable != NULL) - s->stream_wgetc_for_read = ISOWGetc; - else - s->stream_wgetc_for_read = s->stream_wgetc; - UNLOCK(s->streamlock); - return sno; -} - - static void unix_upd_stream_info (StreamDesc * s) { @@ -267,6 +217,25 @@ p_always_prompt_user(void) return(TRUE); } +static int +GetFreeStreamD(void) +{ + int sno; + + for (sno = 0; sno < MaxStreams; ++sno) { + LOCK(Stream[sno].streamlock); + if (Stream[sno].status & Free_Stream_f) { + break; + } + UNLOCK(Stream[sno].streamlock); + } + if (sno == MaxStreams) { + return -1; + } + Stream[sno].encoding = DefaultEncoding(); + return sno; +} + static int is_same_tty(YP_File f1, YP_File f2) { @@ -1826,6 +1795,51 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) return(Yap_MkApplTerm(FunctorSyntaxError,7,tf)); } +Term +Yap_StringToTerm(char *s,Term *tp) +{ + IOSTREAM *sno = Sopenmem(&s, NULL, "r"); + Term t; + TokEntry *tokstart; + tr_fr_ptr TR_before_parse; + Term tpos = TermNil; + + if (sno == NULL) + return FALSE; + TR_before_parse = TR; + tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos); + if (tokstart == NIL || tokstart->Tok == Ord (eot_tok)) { + if (tp) { + *tp = MkAtomTerm(AtomEOFBeforeEOT); + } + Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Sclose(sno); + return FALSE; + } else if (Yap_ErrorMessage) { + if (tp) { + *tp = MkAtomTerm(Yap_LookupAtom(Yap_ErrorMessage)); + } + Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Sclose(sno); + return FALSE; + } + t = Yap_Parse(); + TR = TR_before_parse; + if (!t && !Yap_ErrorMessage) { + if (tp) { + t = MkVarTerm(); + *tp = syntax_error(tokstart, sno, &t); + } + Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Sclose(sno); + return FALSE; + } + Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + Sclose(sno); + return t; +} + + Int Yap_FirstLineInParse (void) { @@ -2674,7 +2688,6 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$has_readline", 0, p_has_readline, SafePredFlag|HiddenPredFlag); - Yap_InitReadUtil (); InitPlIO (); #if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H InitReadline(); diff --git a/C/readutil.c b/C/readutil.c deleted file mode 100644 index b6d608bab..000000000 --- a/C/readutil.c +++ /dev/null @@ -1,193 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: readutil.c * -* Last rev: 2/8/06 * -* mods: * -* comments: readutil library support * -* * -*************************************************************************/ -#ifdef SCCS -static char SccsId[] = "%W% %G%"; -#endif - -#include "Yap.h" -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#include "iopreds.h" - -static Int -rl_to_codes(Term TEnd, int do_as_binary, int arity) -{ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); - Int status; - UInt max_inp, buf_sz, sz; - char *buf; - int binary_stream; - - if (sno < 0) - return FALSE; - status = Stream[sno].status; - binary_stream = Stream[sno].status & Binary_Stream_f; - if (status & Eof_Stream_f) { - UNLOCK(Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); - } - max_inp = (ASP-H)/2-1024; - buf = (char *)TR; - buf_sz = (char *)Yap_TrailTop-buf; - while (TRUE) { - if ( buf_sz > max_inp ) { - buf_sz = max_inp; - } - if (do_as_binary && !binary_stream) - Stream[sno].status |= Binary_Stream_f; - sz = Stream[sno].stream_gets(sno, buf_sz, buf); - if (do_as_binary && !binary_stream) - Stream[sno].status &= ~Binary_Stream_f; - if (sz == -1 || sz == 0) { - if (Stream[sno].status & Eof_Stream_f) { - UNLOCK(Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); - } - UNLOCK(Stream[sno].streamlock); - return FALSE; - } - if (Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) { - /* we're done */ - Term end; - if (!(do_as_binary || Stream[sno].status & Eof_Stream_f)) { - UNLOCK(Stream[sno].streamlock); - /* handle CR before NL */ - if (sz-2 >= 0 && buf[sz-2] == 13) - buf[sz-2] = '\0'; - else - buf[sz-1] = '\0'; - } else { - UNLOCK(Stream[sno].streamlock); - } - if (arity == 2) - end = TermNil; - else - end = Deref(XREGS[arity]); - return Yap_unify(ARG2, Yap_StringToDiffList((char *)TR, end)) ; - } - buf += (buf_sz-1); - max_inp -= (buf_sz-1); - if (max_inp <= 0) { - UNLOCK(Stream[sno].streamlock); - Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_line_to_codes/%d", arity); - return FALSE; - } - } -} - -static Int -p_rl_to_codes(void) -{ - return rl_to_codes(TermNil, FALSE, 2); -} - -static Int -p_rl_to_codes2(void) -{ - return rl_to_codes(TermNil, TRUE, 3); -} - -static Int -p_stream_to_codes(void) -{ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); - CELL *HBASE = H; - CELL *h0 = &ARG4; - - if (sno < 0) - return FALSE; - while (!(Stream[sno].status & Eof_Stream_f)) { - /* skip errors */ - Int ch = Stream[sno].stream_getc(sno); - Term t; - if (ch == EOFCHAR) - break; - t = MkIntegerTerm(ch); - h0[0] = AbsPair(H); - *H = t; - H+=2; - h0 = H-1; - if (H >= ASP-1024) { - RESET_VARIABLE(h0); - ARG4 = AbsPair(HBASE); - ARG5 = (CELL)h0; - if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3"); - return FALSE; - } - /* build a legal term again */ - h0 = (CELL *)ARG5; - HBASE = RepPair(ARG4); - } - } - UNLOCK(Stream[sno].streamlock); - if (H == HBASE) - return Yap_unify(ARG2,ARG3); - RESET_VARIABLE(H-1); - Yap_unify(H[-1],ARG3); - return Yap_unify(AbsPair(HBASE),ARG2); - -} - -static Int -p_stream_to_terms(void) -{ - int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); - Term t = Deref(ARG3), tpos = TermNil; - - if (sno < 0) - return FALSE; - while (!(Stream[sno].status & Eof_Stream_f)) { - /* skip errors */ - TokEntry *tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno, &tpos); - if (!Yap_ErrorMessage) - { - Term th = Yap_Parse(); - if (H >= ASP-1024) { - UNLOCK(Stream[sno].streamlock); - Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_terms/3"); - return FALSE; - } - if (!th || Yap_ErrorMessage) - break; - if (th == MkAtomTerm (AtomEof)) { - UNLOCK(Stream[sno].streamlock); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return Yap_unify(t,ARG2); - } else { - t = MkPairTerm(th,t); - } - } - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - } - UNLOCK(Stream[sno].streamlock); - return Yap_unify(t,ARG2); -} - -void -Yap_InitReadUtil(void) -{ - Term cm = CurrentModule; - CurrentModule = READUTIL_MODULE; - Yap_InitCPred("read_line_to_codes", 2, p_rl_to_codes, SyncPredFlag); - Yap_InitCPred("read_line_to_codes", 3, p_rl_to_codes2, SyncPredFlag); - Yap_InitCPred("read_stream_to_codes", 3, p_stream_to_codes, SyncPredFlag); - Yap_InitCPred("read_stream_to_terms", 3, p_stream_to_terms, SyncPredFlag); - CurrentModule = cm; -} - diff --git a/C/save.c b/C/save.c index f09151dc9..b78daa141 100755 --- a/C/save.c +++ b/C/save.c @@ -1753,6 +1753,8 @@ Restore(char *s, char *lib_dir) } Yap_ReOpenLoadForeign(); + /* restore SWI IO */ + initIO (); Yap_InitPlIO(); /* reset time */ Yap_ReInitWallTime(); diff --git a/C/stdpreds.c b/C/stdpreds.c index 3c0829d6e..36acb2d4a 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -727,18 +727,6 @@ strtod(s, pe) #endif -static char *cur_char_ptr; - -static int -get_char_from_string(int s) -{ - if (cur_char_ptr[0] == '\0') - return -1; - cur_char_ptr++; - return cur_char_ptr[-1]; -} - - #ifndef INFINITY #define INFINITY (1.0/0.0) #endif @@ -751,9 +739,9 @@ static Term get_num(char *t) { Term out; - - cur_char_ptr = t; - out = Yap_scan_num(get_char_from_string); + IOSTREAM *smem = Sopenmem(&t, NULL, "r"); + out = Yap_scan_num(smem); + Sclose(smem); /* not ever iso */ if (out == TermNil && yap_flags[LANGUAGE_MODE_FLAG] != 1) { int sign = 1; @@ -779,10 +767,12 @@ get_num(char *t) } } } + /* if (cur_char_ptr[0] == '\0') - return(out); else return(TermNil); + */ + return(out); } static UInt diff --git a/H/absmi.h b/H/absmi.h index f04f094d6..85b13987f 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -1556,26 +1556,28 @@ prune(choiceptr cp) if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); while (B->cp_b < cp) { - if (POP_CHOICE_POINT(cp)) + if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } B = B->cp_b; } - } + if (POP_CHOICE_POINT(B->cp_b)) + { + POP_EXECUTE(); + } #ifdef YAPOR - CUT_prune_to(cp); + CUT_prune_to(cp); #endif /* YAPOR */ - if (SHOULD_CUT_UP_TO(B,cp)) { /* cut ! */ #ifdef TABLING - abolish_incomplete_subgoals(B); + abolish_incomplete_subgoals(B); #endif /* TABLING */ - HB = PROTECT_FROZEN_H(B->cp_b); + HB = PROTECT_FROZEN_H(B->cp_b); #include "trim_trail.h" - B = B->cp_b; - SET_BB(PROTECT_FROZEN_B(B)); - } + B = B->cp_b; + SET_BB(PROTECT_FROZEN_B(B)); + } } static inline diff --git a/H/amiops.h b/H/amiops.h index 6b46ab0ac..e4b4f2844 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -548,7 +548,7 @@ Yap_unify_constant(register Term a, register Term cons) static inline int do_cut(int i) { #ifdef CUT_C - while (POP_CHOICE_POINT(B->cp_b)) { + if (POP_CHOICE_POINT(B->cp_b)) { cut_c_pop(); } #endif diff --git a/H/cut_c.h b/H/cut_c.h index c4a004896..c14c7e82d 100755 --- a/H/cut_c.h +++ b/H/cut_c.h @@ -31,9 +31,8 @@ struct cut_c_str{ } -#define POP_CHOICE_POINT(B) \ -(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)Yap_LocalBase) && ((CELL *)B == (CELL *)Yap_REGS.CUT_C_TOP)) -//(((int)Yap_REGS.CUT_C_TOP != (int)Yap_LocalBase) && ((int)B > (int)Yap_REGS.CUT_C_TOP)) +#define POP_CHOICE_POINT(cp) \ + (((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)Yap_LocalBase) && ((CELL *)(cp) > (CELL *)Yap_REGS.CUT_C_TOP)) #define POP_EXECUTE() \ diff --git a/H/yapio.h b/H/yapio.h index 743b44e0c..253ca99ed 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -23,6 +23,8 @@ #include #include +#include "SWI-Stream.h" + #ifndef YAP_STDIO #define YP_printf printf diff --git a/LGPL/Makefile.in b/LGPL/Makefile.in index 80afa595b..2bf823cdc 100644 --- a/LGPL/Makefile.in +++ b/LGPL/Makefile.in @@ -35,6 +35,7 @@ PROGRAMS= $(srcdir)/base64.pl \ $(srcdir)/prolog_source.pl \ $(srcdir)/prolog_xref.pl \ $(srcdir)/quintus.pl \ + $(srcdir)/readutil.pl \ $(srcdir)/record.pl \ $(srcdir)/settings.pl \ $(srcdir)/shlib.pl \ diff --git a/LGPL/readutil.pl b/LGPL/readutil.pl new file mode 100644 index 000000000..3ce0ca5d2 --- /dev/null +++ b/LGPL/readutil.pl @@ -0,0 +1,242 @@ +/* $Id$ + + Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: jan@swi.psy.uva.nl + WWW: http://www.swi-prolog.org + Copyright (C): 1985-2002, University of Amsterdam + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + As a special exception, if you link this library with other files, + compiled with a Free Software compiler, to produce an executable, this + library does not by itself cause the resulting executable to be covered + by the GNU General Public License. This exception does not however + invalidate any other reasons why the executable file might be covered by + the GNU General Public License. +*/ + +:- module(read_util, + [ read_line_to_codes/2, % +Fd, -Codes (without trailing \n) + read_line_to_codes/3, % +Fd, -Codes, ?Tail + read_stream_to_codes/2, % +Fd, -Codes + read_stream_to_codes/3, % +Fd, -Codes, ?Tail + read_file_to_codes/3, % +File, -Codes, +Options + read_file_to_terms/3 % +File, -Terms, +Options + ]). +:- use_module(library(shlib)). +:- use_module(library(lists), [select/3]). +:- use_module(library(error)). + +/** Read utilities + +This library provides some commonly used reading predicates. As these +predicates have proven to be time-critical in some applications we moved +them to C. For compatibility as well as to reduce system dependency, we +link the foreign code at runtime and fallback to the Prolog +implementation if the shared object cannot be found. +*/ + +:- volatile + read_line_to_codes/2, + read_line_to_codes/3, + read_stream_to_codes/2, + read_stream_to_codes/3. + +link_foreign :- + catch(load_foreign_library(foreign(readutil)), _, fail), !. +link_foreign :- + assertz((read_line_to_codes(Stream, Line) :- + pl_read_line_to_codes(Stream, Line))), + assertz((read_line_to_codes(Stream, Line, Tail) :- + pl_read_line_to_codes(Stream, Line, Tail))), + assertz((read_stream_to_codes(Stream, Content) :- + pl_read_stream_to_codes(Stream, Content))), + assertz((read_stream_to_codes(Stream, Content, Tail) :- + pl_read_stream_to_codes(Stream, Content, Tail))), + compile_predicates([ read_line_to_codes/2, + read_line_to_codes/3, + read_stream_to_codes/2, + read_stream_to_codes/3 + ]). + +:- initialization(link_foreign, now). + + + /******************************* + * LINES * + *******************************/ + +%% read_line_to_codes(+In:stream, -Line:codes) is det. +% +% Read a line of input from In into a list of character codes. +% Trailing newline and or return are deleted. Upon reaching +% end-of-file Line is unified to the atom =end_of_file=. + +pl_read_line_to_codes(Fd, Codes) :- + get_code(Fd, C0), + ( C0 == -1 + -> Codes = end_of_file + ; read_1line_to_codes(C0, Fd, Codes0) + ), + Codes = Codes0. + +read_1line_to_codes(-1, _, []) :- !. +read_1line_to_codes(10, _, []) :- !. +read_1line_to_codes(13, Fd, L) :- !, + get_code(Fd, C2), + read_1line_to_codes(C2, Fd, L). +read_1line_to_codes(C, Fd, [C|T]) :- + get_code(Fd, C2), + read_1line_to_codes(C2, Fd, T). + +%% read_line_to_codes(+Fd, -Line, ?Tail) is det. +% +% Read a line of input as a difference list. This should be used +% to read multiple lines efficiently. On reaching end-of-file, +% Tail is bound to the empty list. + +pl_read_line_to_codes(Fd, Codes, Tail) :- + get_code(Fd, C0), + read_line_to_codes(C0, Fd, Codes0, Tail), + Codes = Codes0. + +read_line_to_codes(-1, _, Tail, Tail) :- !, + Tail = []. +read_line_to_codes(10, _, [10|Tail], Tail) :- !. +read_line_to_codes(C, Fd, [C|T], Tail) :- + get_code(Fd, C2), + read_line_to_codes(C2, Fd, T, Tail). + + + /******************************* + * STREAM (ENTIRE INPUT) * + *******************************/ + +%% read_stream_to_codes(+Stream, -Codes) is det. +%% read_stream_to_codes(+Stream, -Codes, ?Tail) is det. +% +% Read input from Stream to a list of character codes. The version +% read_stream_to_codes/3 creates a difference-list. + +pl_read_stream_to_codes(Fd, Codes) :- + pl_read_stream_to_codes(Fd, Codes, []). +pl_read_stream_to_codes(Fd, Codes, Tail) :- + get_code(Fd, C0), + read_stream_to_codes(C0, Fd, Codes0, Tail), + Codes = Codes0. + +read_stream_to_codes(-1, _, Tail, Tail) :- !. +read_stream_to_codes(C, Fd, [C|T], Tail) :- + get_code(Fd, C2), + read_stream_to_codes(C2, Fd, T, Tail). + + +%% read_stream_to_terms(+Stream, -Terms, ?Tail, +Options) is det. + +read_stream_to_terms(Fd, Terms, Tail, Options) :- + read_term(Fd, C0, Options), + read_stream_to_terms(C0, Fd, Terms0, Tail, Options), + Terms = Terms0. + +read_stream_to_terms(end_of_file, _, Tail, Tail, _) :- !. +read_stream_to_terms(C, Fd, [C|T], Tail, Options) :- + read_term(Fd, C2, Options), + read_stream_to_terms(C2, Fd, T, Tail, Options). + + + /******************************* + * FILE (ENTIRE INPUT) * + *******************************/ + +%% read_file_to_codes(+Spec, -Codes, +Options) is det. +% +% Read the file Spec into a list of Codes. Options is split into +% options for absolute_file_name/3 and open/4. + +read_file_to_codes(Spec, Codes, Options) :- + must_be(proper_list, Options), + ( select(tail(Tail), Options, Options1) + -> true + ; Tail = [], + Options1 = Options + ), + split_options(Options1, file_option, FileOptions, OpenOptions), + absolute_file_name(Spec, + [ access(read) + | FileOptions + ], + Path), + open(Path, read, Fd, OpenOptions), + call_cleanup(read_stream_to_codes(Fd, Codes0, Tail), + close(Fd)), + Codes = Codes0. + + +%% read_file_to_terms(+Spec, -Terms, +Options) is det. +% +% Read the file Spec into a list of terms. Options is split over +% absolute_file_name/3, open/4 and read_term/3. + +read_file_to_terms(Spec, Terms, Options) :- + must_be(proper_list, Options), + ( select(tail(Tail), Options, Options1) + -> true + ; Tail = [], + Options1 = Options + ), + split_options(Options1, file_option, FileOptions, Options2), + split_options(Options2, read_option, ReadOptions, OpenOptions), + absolute_file_name(Spec, + [ access(read) + | FileOptions + ], + Path), + open(Path, read, Fd, OpenOptions), + call_cleanup(read_stream_to_terms(Fd, Terms0, Tail, ReadOptions), + close(Fd)), + Terms = Terms0. + +split_options([], _, [], []). +split_options([H|T], G, File, Open) :- + ( call(G, H) + -> File = [H|FT], + OT = Open + ; Open = [H|OT], + FT = File + ), + split_options(T, G, FT, OT). + + +read_option(module(_)). +read_option(syntax_errors(_)). +read_option(character_escapes(_)). +read_option(double_quotes(_)). +read_option(backquoted_string(_)). + +file_option(extensions(_)). +file_option(file_type(_)). +file_option(file_errors(_)). +file_option(relative_to(_)). +file_option(expand(_)). + + /******************************* + * XREF * + *******************************/ + +:- multifile prolog:meta_goal/2. +:- dynamic prolog:meta_goal/2. +prolog:meta_goal(split_options(_,G,_,_), [G+1]). diff --git a/Makefile.in b/Makefile.in index 0f6d9c53e..a2c8050d6 100755 --- a/Makefile.in +++ b/Makefile.in @@ -60,7 +60,7 @@ YAPSTARTUP=startup.yss # CC=@CC@ MPI_CC=@MPI_CC@ -CPPFLAGS=@CPPFLAGS@ -I. -I$(srcdir)/H -I$(srcdir)/OPTYap -I$(srcdir)/BEAM -I$(srcdir)/MYDDAS +CPPFLAGS=@CPPFLAGS@ -I. -I$(srcdir)/H -I$(srcdir)/include -I$(srcdir)/OPTYap -I$(srcdir)/BEAM -I$(srcdir)/MYDDAS EXECUTABLE_CFLAGS= @CFLAGS@ $(YAP_EXTRAS) $(DEFS) $(CPPFLAGS) CFLAGS= @YAPLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) $(CPPFLAGS) C_INTERF_FLAGS= @YAPLIB_CFLAGS@ $(YAP_EXTRAS) $(DEFS) $(CPPFLAGS) -I$(srcdir)/include @@ -239,7 +239,6 @@ C_SOURCES= \ $(srcdir)/C/load_shl.c $(srcdir)/C/load_dyld.c \ $(srcdir)/C/mavar.c $(srcdir)/C/modules.c $(srcdir)/C/other.c \ $(srcdir)/C/parser.c \ - $(srcdir)/C/readutil.c \ $(srcdir)/C/save.c $(srcdir)/C/scanner.c \ $(srcdir)/C/sort.c $(srcdir)/C/stdpreds.c $(srcdir)/C/sysbits.c \ $(srcdir)/C/threads.c \ @@ -342,7 +341,7 @@ ENGINE_OBJECTS = \ myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \ myddas_util.o myddas_statistics.o myddas_top_level.o \ myddas_wkb2prolog.o modules.o other.o \ - parser.o readutil.o save.o scanner.o sort.o stdpreds.o \ + parser.o save.o scanner.o sort.o stdpreds.o \ sysbits.o threads.o tracer.o \ udi.o rtree.o rtree_udi.o\ unify.o userpreds.o utilpreds.o \ @@ -614,12 +613,6 @@ pl-write.o: $(srcdir)/packages/PLStream/pl-write.c pl-yap.o: $(srcdir)/packages/PLStream/pl-yap.c $(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/packages/PLStream/pl-yap.c -o $@ -iopreds.o : $(srcdir)/C/iopreds.c config.h - $(CC) -c $(CFLAGS) -I$(srcdir)/include $< -o $@ - -scanner.o : $(srcdir)/C/scanner.c config.h - $(CC) -c $(CFLAGS) -I$(srcdir)/include $< -o $@ - # default rule %.o : $(srcdir)/C/%.c config.h $(CC) -c $(CFLAGS) $< -o $@ diff --git a/include/YapInterface.h b/include/YapInterface.h index ff81863f1..12860e4e4 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -406,9 +406,6 @@ extern X_API void PROTO(YAP_FlushAllStreams,(void)); #define YAP_BINARY_STREAM 0x40 #define YAP_SEEKABLE_STREAM 0x80 -/* YAP_Term YAP_OpenStream() */ -extern X_API YAP_Term PROTO(YAP_OpenStream,(void *, CONST char *, YAP_Term, int)); - /* YAP_Term *YAP_NewSlots() */ extern X_API YAP_Int PROTO(YAP_NewSlots,(int)); diff --git a/library/Makefile.in b/library/Makefile.in index bab726884..b7147122d 100644 --- a/library/Makefile.in +++ b/library/Makefile.in @@ -58,7 +58,6 @@ PROGRAMS= \ $(srcdir)/random.yap \ $(srcdir)/r_session.yap \ $(srcdir)/rbtrees.yap \ - $(srcdir)/readutil.yap \ $(srcdir)/regexp.yap \ $(srcdir)/rltree.yap \ $(srcdir)/splay.yap \ diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index f2d38ff03..f52efed9e 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -1683,7 +1683,7 @@ X_API int PL_is_functor(term_t ts, functor_t f) if (YAP_IsApplTerm(t)) { return FunctorOfTerm(t) == (Functor)ff; } else if (YAP_IsPairTerm(t)) { - return FunctorOfTerm(t) == FunctorDot; + return ff == FunctorDot; } else return 0; } @@ -2753,10 +2753,9 @@ int Yap_read_term(term_t t, IOSTREAM *st, term_t vs); int Yap_read_term(term_t t, IOSTREAM *st, term_t vs) { - int sno = Yap_LookupSWIStream(st); Term varnames, out, tpos; - if (!Yap_readTerm(sno, &out, &varnames, NULL, &tpos)) + if (!Yap_readTerm(st, &out, &varnames, NULL, &tpos)) return FALSE; if (!Yap_unify(out, Yap_GetFromSlot(t))) { return FALSE; @@ -2767,46 +2766,19 @@ Yap_read_term(term_t t, IOSTREAM *st, term_t vs) return TRUE; } -Term -Yap_StringToTerm(char *s, Term *tp) -{ - IOSTREAM *stream = Sopen_string(NULL, s, -1, "r"); - int sno; - Term out, tpos; - - if (!stream) - return FALSE; - sno = Yap_LookupSWIStream(stream); - if (sno < 0) - return FALSE; - if (!Yap_readTerm(sno, &out, NULL, tp, &tpos)) { - out = 0L; - } - Yap_CloseStream(sno); - Sclose(stream); - return out; -} - Term Yap_TermToString(Term t, char *s, unsigned int sz, int flags) { - int old_output_stream = Yap_c_output_stream; IOSTREAM *stream = Sopen_string(NULL, s, sz, "w"); - int sno; + int out; if (!stream) return FALSE; - sno = Yap_LookupSWIStream(stream); - - if (sno < 0) - return 0L; - Yap_c_output_stream = sno; Yap_StartSlots(); - Yap_PlWriteToStream (t, sno, flags); - stream->bufp = '\0'; + out = PL_write_term(stream, Yap_InitSlot(t), 1200, 0); Yap_CloseSlots(); - Yap_c_output_stream = old_output_stream; - return EX != NULL; + Sclose(stream); + return out; } Atom diff --git a/library/readutil.yap b/library/readutil.yap deleted file mode 100644 index 699fc7f53..000000000 --- a/library/readutil.yap +++ /dev/null @@ -1,63 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: readutil.yap * -* Last rev: 5/12/99 * -* mods: * -* comments: SWI compatible read utilities * -* * -*************************************************************************/ - -:- module(readutil, [ - read_line_to_codes/2, - read_line_to_codes/3, - read_stream_to_codes/2, - read_stream_to_codes/3, - read_file_to_codes/2, - read_file_to_codes/3, - read_file_to_terms/2, - read_file_to_terms/3 - ]). - - -read_stream_to_codes(Stream, Codes) :- - read_stream_to_codes(Stream, Codes, []). - -read_file_to_codes(File, Codes, _) :- - open(File, read, Stream), - read_stream_to_codes(Stream, Codes, []), - close(Stream). - -read_file_to_codes(File, Codes) :- - open(File, read, Stream), - read_stream_to_codes(Stream, Codes, []), - close(Stream). - -read_file_to_terms(File, Codes, _) :- - open(File, read, Stream), - prolog_read_stream_to_terms(Stream, Codes, []), - close(Stream). - -read_file_to_terms(File, Codes) :- - open(File, read, Stream), - read_stream_to_terms(Stream, Codes, []), - close(Stream). - - -prolog_read_stream_to_terms(Stream, Terms, Terms0) :- - read(Stream, Term), - (Term == end_of_file -> - Terms = Terms0 - ; - Terms = [Term|TermsI], - prolog_read_stream_to_terms(Stream, TermsI, Terms0) - ). - - diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index 910a6c0a4..f4b0633ef 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -362,11 +362,6 @@ initIO() addHTable(streamAliases, (void *)*np, (void *)(intptr_t)i); GD->io_initialised = TRUE; -#if __YAP_PROLOG__ - Yap_LookupSWIStream(Suser_input); - Yap_LookupSWIStream(Suser_output); - Yap_LookupSWIStream(Suser_error); -#endif }