preliminary support for readutil library (SWI compatible).

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1678 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/adtdefs.c

@@ -862,6 +862,17 @@ Yap_StringToList(char *s)
   return (t);
 }
 
+Term
+Yap_StringToDiffList(char *s, Term t)
+{
+  register unsigned char *cp = (unsigned char *)s + strlen(s);
+
+  while (cp > (unsigned char *)s) {
+    t = MkPairTerm(MkIntTerm(*--cp), t);
+  }
+  return t;
+}
+
 Term
 Yap_StringToListOfAtoms(char *s)
 {

C/init.c

@@ -874,6 +874,7 @@ InitCodes(void)
   Yap_heap_regs->charsio_module = MkAtomTerm(Yap_LookupAtom("charsio"));
   Yap_heap_regs->terms_module = MkAtomTerm(Yap_LookupAtom("terms"));
   Yap_heap_regs->system_module = MkAtomTerm(Yap_LookupAtom("system"));
+  Yap_heap_regs->readutil_module = MkAtomTerm(Yap_LookupAtom("readutil"));
   Yap_InitModules();
 #ifdef BEAM
   Yap_heap_regs->beam_retry_code.opc = Yap_opcode(_retry_eam);

C/iopreds.c

@@ -96,6 +96,8 @@ STATIC_PROTO (int ConsolePutc, (int, int));
 STATIC_PROTO (Int p_setprompt, (void));
 STATIC_PROTO (Int p_prompt, (void));
 STATIC_PROTO (int PlGetc, (int));
+STATIC_PROTO (int DefaultGets, (int,UInt,char*));
+STATIC_PROTO (int PlGets, (int,UInt,char*));
 STATIC_PROTO (int MemGetc, (int));
 STATIC_PROTO (int ISOGetc, (int));
 STATIC_PROTO (int ConsoleGetc, (int));
@@ -290,6 +292,7 @@ p_always_prompt_user(void)
   StreamDesc *s = Stream+StdInStream;
 
   s->status |= Promptable_Stream_f;
+  s->stream_gets = DefaultGets;
 #if USE_SOCKET
   if (s->status & Socket_Stream_f) {
     s->stream_getc = ConsoleSocketGetc;
@@ -320,6 +323,15 @@ is_same_tty(YP_File f1, YP_File f2)
 #endif  
 }
 
+static GetsFunc
+PlGetsFunc(void)
+{
+  if (CharConversionTable)
+      return DefaultGets;
+    else
+      return PlGets;
+}
+
 static void
 InitStdStream (int sno, SMALLUNSGN flags, YP_File file)
 {
@@ -334,6 +346,7 @@ InitStdStream (int sno, SMALLUNSGN flags, YP_File file)
   /* Getting streams to prompt is a mess because we need for cooperation
      between readers and writers to the stream :-(
   */
+  s->stream_gets = PlGetsFunc();
 #if USE_SOCKET
   if (s->status & Socket_Stream_f) {
     /* Console is a socket and socket will prompt */
@@ -370,6 +383,7 @@ InitStdStream (int sno, SMALLUNSGN flags, YP_File file)
       /* we are reading from a file, no need to check for prompts */
       s->stream_putc = FilePutc;
       s->stream_getc = PlGetc;
+      s->stream_gets = PlGetsFunc();
     } 
     switch(sno) {
     case 0:
@@ -1086,6 +1100,7 @@ EOFGetc(int sno)
 	}
     } else {
       s->stream_getc = PlGetc;
+      s->stream_gets = PlGetsFunc();
     }
     if (CharConversionTable != NULL)
       s->stream_getc_for_read = ISOGetc;
@@ -1324,6 +1339,42 @@ PlGetc (int sno)
   return(post_process_read_char(ch, s));
 }
 
+/* standard routine, it should read from anything pointed by a FILE *.
+   It could be made more efficient by doing our own buffering and avoiding
+   post_process_read_char, something to think about */
+static int
+PlGets (int sno, UInt size, char *buf)
+{
+  register StreamDesc *s = &Stream[sno];
+  UInt len;
+
+  if (fgets (buf, size, s->u.file.file) == NULL)
+    return -1;
+  len = strlen(buf);
+  s->charcount += len-1;
+  post_process_read_char(buf[len-2], s);
+  return strlen(buf);
+}
+
+/* standard routine, it should read from anything pointed by a FILE *.
+   It could be made more efficient by doing our own buffering and avoiding
+   post_process_read_char, something to think about */
+static int
+DefaultGets (int sno, UInt size, char *buf)
+{
+  StreamDesc *s = &Stream[sno];
+  int ch;
+  char *pt = buf;
+
+
+  if (!size)
+    return 0;
+  while((ch = *buf++ = s->stream_getc(sno)) != 
+	-1 && ch != 10 && --size); 
+  *buf++ = '\0';
+  return pt-buf;
+}
+
 /* read from memory */
 static int
 MemGetc (int sno)
@@ -1551,6 +1602,7 @@ Yap_InitSocketStream(int fd, socket_info flags, socket_domain domain) {
   st->linepos = 0;
   st->stream_putc = SocketPutc;
   st->stream_getc = SocketGetc;
+  st->stream_gets = DefaultGets;
   if (CharConversionTable != NULL)
     st->stream_getc_for_read = ISOGetc;
   else
@@ -1707,6 +1759,7 @@ p_open (void)
   st->linepos = 0;
   st->stream_putc = FilePutc;
   st->stream_getc = PlGetc;
+  st->stream_gets = PlGetsFunc();
   unix_upd_stream_info (st);
   if (opts != 0) {
     if (opts & 2)
@@ -1719,17 +1772,21 @@ p_open (void)
 	if (st->status & Socket_Stream_f) {
 	  st->stream_putc = SocketPutc;
 	  st->stream_getc = SocketGetc;
+	  st->stream_gets = DefaultGets;
 	} else
 #endif
 	if (st->status & Pipe_Stream_f) {
 	  st->stream_putc = PipePutc;
 	  st->stream_getc = PipeGetc;
+	  st->stream_gets = DefaultGets;
 	} else if (st->status & InMemory_Stream_f) {
 	  st->stream_putc = MemPutc;
 	  st->stream_getc = MemGetc;	  
+	  st->stream_gets = DefaultGets;	  
 	} else {
 	  st->stream_putc = ConsolePutc;
 	  st->stream_getc = PlGetc;
+	  st->stream_gets = PlGetsFunc();
 	}
 	ta[1] = MkAtomTerm(AtomTrue);
 	t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("reposition"),1),1,ta);
@@ -1900,6 +1957,7 @@ p_open_null_stream (void)
   st->linecount = 1;
   st->stream_putc = NullPutc;
   st->stream_getc = PlGetc;
+  st->stream_gets = PlGetsFunc();
   st->stream_getc_for_read = PlGetc;
   st->u.file.user_name = MkAtomTerm (st->u.file.name = Yap_LookupAtom ("/dev/null"));
   t = MkStream (sno);
@@ -1943,6 +2001,7 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
   st->u.file.user_name = file_name;
   st->u.file.file = fd;
   st->linepos = 0;
+  st->stream_gets = PlGetsFunc();
   if (flags & YAP_PIPE_STREAM) {
     st->stream_putc = PipePutc;
     st->stream_getc = PipeGetc;
@@ -1998,6 +2057,7 @@ p_open_pipe_stream (void)
   st->linecount = 1;
   st->stream_putc = PipePutc;
   st->stream_getc = PipeGetc;
+  st->stream_gets = DefaultGets;
   if (CharConversionTable != NULL)
     st->stream_getc_for_read = ISOGetc;
   else
@@ -2017,6 +2077,7 @@ p_open_pipe_stream (void)
   st->linecount = 1;
   st->stream_putc = PipePutc;
   st->stream_getc = PipeGetc;
+  st->stream_gets = DefaultGets;
   if (CharConversionTable != NULL)
     st->stream_getc_for_read = ISOGetc;
   else
@@ -2048,6 +2109,7 @@ open_buf_read_stream(char *nbuf, Int nchars)
   st->linecount = 1;
   st->stream_putc = MemPutc;
   st->stream_getc = MemGetc;
+  st->stream_gets = DefaultGets;
   if (CharConversionTable != NULL)
     st->stream_getc_for_read = ISOGetc;
   else
@@ -2123,6 +2185,7 @@ open_buf_write_stream(char *nbuf, UInt  sz)
   st->linecount = 1;
   st->stream_putc = MemPutc;
   st->stream_getc = MemGetc;
+  st->stream_gets = DefaultGets;
   if (CharConversionTable != NULL)
     st->stream_getc_for_read = ISOGetc;
   else
@@ -2390,6 +2453,12 @@ CheckStream (Term arg, int kind, char *msg)
   return (sno);
 }
 
+int
+Yap_CheckStream (Term arg, int kind, char *msg)
+{
+  return CheckStream(arg, kind, msg);
+}
+
 static Int
 p_check_stream (void)
 {				/* '$check_stream'(Stream,Mode)                  */
@@ -3506,6 +3575,7 @@ p_set_stream_position (void)
       return(FALSE);
     }
     Stream[sno].stream_getc = PlGetc;
+    Stream[sno].stream_gets = PlGetsFunc();
   } else if (FunctorOfTerm (tin) == FunctorStreamEOS) {
     if (IsVarTerm (tp = ArgOfTerm (1, tin))) {
       UNLOCK(Stream[sno].streamlock);
@@ -3528,6 +3598,7 @@ p_set_stream_position (void)
       return(FALSE);
     }
     Stream[sno].stream_getc = PlGetc;
+    Stream[sno].stream_gets = PlGetsFunc();
     /* reset the counters */
     Stream[sno].linepos = 0;
     Stream[sno].linecount = 0;
@@ -5067,7 +5138,7 @@ p_same_file(void) {
       }
     } else if (stat(f2, &buf2) == -1) {
       /* file does not exist, but was opened? Return -1 */
-      return(FALSE);
+      return FALSE;
     }
     return(buf1.st_ino == buf2.st_ino
 #ifdef __LCC__
@@ -5238,6 +5309,7 @@ Yap_InitIOPreds(void)
   Yap_InitCPred ("$same_file", 2, p_same_file, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred ("$float_format", 1, p_float_format, SafePredFlag|SyncPredFlag|HiddenPredFlag);
 
+  Yap_InitReadUtil ();
 #if USE_SOCKET
   Yap_InitSockets ();
 #endif

C/modules.c

@@ -181,6 +181,8 @@ Yap_InitModules(void)
     TERMS_MODULE;
   ModuleName[6] =
     SYSTEM_MODULE;
-  NoOfModules = 7;
+  ModuleName[7] =
+    READUTIL_MODULE;
+  NoOfModules = 8;
   CurrentModule = PROLOG_MODULE;
 }

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.101 2006-05-19 14:31:32 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.102 2006-08-02 18:18:30 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -476,7 +476,8 @@ typedef struct various_codes {
     attributes_module,
     charsio_module,
     terms_module,
-    system_module;
+    system_module,
+    readutil_module;
   void *last_wtime;
   struct pred_entry *pred_goal_expansion;
   struct pred_entry *pred_meta_call;
@@ -758,6 +759,8 @@ struct various_codes *Yap_heap_regs;
 #define  CHARSIO_MODULE           Yap_heap_regs->charsio_module
 #define  TERMS_MODULE             Yap_heap_regs->terms_module
 #define  SYSTEM_MODULE            Yap_heap_regs->system_module
+#define  READUTIL_MODULE          Yap_heap_regs->readutil_module
+#define  READUTIL_MODULE          Yap_heap_regs->readutil_module
 #define  PredGoalExpansion        Yap_heap_regs->pred_goal_expansion
 #define  PredMetaCall             Yap_heap_regs->pred_meta_call
 #define  PredDollarCatch          Yap_heap_regs->pred_dollar_catch

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.74 2006-06-06 14:09:09 tiagosoares Exp $	 *
+* version:      $Id: Yapproto.h,v 1.75 2006-08-02 18:18:30 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -39,6 +39,7 @@ void	STD_PROTO(Yap_MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
 void	STD_PROTO(Yap_PutValue,(Atom,Term));
 void	STD_PROTO(Yap_ReleaseAtom,(Atom));
 Term	STD_PROTO(Yap_StringToList,(char *));
+Term	STD_PROTO(Yap_StringToDiffList,(char *,Term));
 Term	STD_PROTO(Yap_StringToListOfAtoms,(char *));
 
 #define Yap_StartSlots() (*--ASP = MkIntTerm(0))
@@ -260,6 +261,9 @@ Term	STD_PROTO(Yap_MkNewPairTerm,(void));
 /* parser.c */
 Term	STD_PROTO(Yap_Parse,(void));
 
+/* readutil.c */
+void	STD_PROTO(Yap_InitReadUtil,(void));
+
 /* save.c */
 int	STD_PROTO(Yap_SavedInfo,(char *,char *,CELL *,CELL *,CELL *));
 int 	STD_PROTO(Yap_Restore,(char *, char *));

H/iopreds.h

@@ -31,6 +31,8 @@ FILE *rl_instream, *rl_outstream;
 
 #endif
 
+typedef int (*GetsFunc)(int, UInt, char *);
+
 typedef struct stream_desc
   {
     union {
@@ -73,6 +75,7 @@ typedef struct stream_desc
 #endif
     int (* stream_putc)(int, int);  /* function the stream uses for writing */
     int (* stream_getc)(int);       /* function the stream uses for reading */
+    GetsFunc stream_gets;           /* function the stream uses for reading a sequence of characters */
     /* function the stream uses for parser. It may be different if the ISO
        character conversion is on */
     int (* stream_getc_for_read)(int);

H/rheap.h

@@ -11,8 +11,11 @@
 * File:		rheap.h							 *
 * comments:	walk through heap code					 *
 *									 *
-* Last rev:     $Date: 2006-05-17 18:38:11 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-08-02 18:18:30 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.67  2006/05/17 18:38:11  vsc
+* make system library use true file name
+*
 * Revision 1.66  2006/04/28 15:48:33  vsc
 * do locking on streams
 *
@@ -665,6 +668,7 @@ restore_codes(void)
   Yap_heap_regs->charsio_module = AtomTermAdjust(Yap_heap_regs->charsio_module);
   Yap_heap_regs->terms_module = AtomTermAdjust(Yap_heap_regs->terms_module);
   Yap_heap_regs->system_module = AtomTermAdjust(Yap_heap_regs->system_module);
+  Yap_heap_regs->readutil_module = AtomTermAdjust(Yap_heap_regs->readutil_module);
   if (Yap_heap_regs->file_aliases != NULL) {
     Yap_heap_regs->yap_streams =
       (struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);

H/yapio.h

@@ -226,6 +226,7 @@ typedef enum{       /* we accept two domains for the moment, IPV6 may follow */
 } socket_domain;
 
 Term  STD_PROTO(Yap_InitSocketStream,(int, socket_info, socket_domain));
+int   STD_PROTO(Yap_CheckStream,(Term, int, char *));
 int   STD_PROTO(Yap_CheckSocketStream,(Term, char *));
 socket_domain   STD_PROTO(Yap_GetSocketDomain,(int));
 socket_info   STD_PROTO(Yap_GetSocketStatus,(int));

Makefile.in

@@ -152,6 +152,7 @@ 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 \
@@ -213,9 +214,10 @@ ENGINE_OBJECTS = \
 	heapgc.o index.o init.o  inlines.o \
 	iopreds.o depth_bound.o mavar.o \
 	myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
-	myddas_util.o myddas_statistics.o myddas_top_level.o modules.o other.o   \
+	myddas_util.o myddas_statistics.o myddas_top_level.o \
-	parser.o save.o scanner.o sort.o stdpreds.o sysbits.o threads.o \
+	modules.o other.o   \
-	tracer.o \
+	parser.o readutil.o save.o scanner.o sort.o stdpreds.o
+	sysbits.o threads.o tracer.o \
 	unify.o userpreds.o utilpreds.o write.o ypsocks.o ypstdio.o @MPI_OBJS@
 
 C_INTERFACE_OBJECTS = \
@@ -383,6 +385,9 @@ other.o: $(srcdir)/C/other.c
 parser.o: $(srcdir)/C/parser.c
 	$(CC) -c $(C_PARSER_FLAGS) $(srcdir)/C/parser.c -o $@
 
+readutil.o: $(srcdir)/C/readutil.c
+	$(CC) -c $(CFLAGS) $(srcdir)/C/readutil.c -o $@
+
 save.o: $(srcdir)/C/save.c
 	$(CC) -c $(CFLAGS) -DYAP_VERSION=\"$(VERSION)\" -DBIN_DIR=\"$(BINDIR)\" -DLIB_DIR=\"$(YAPLIBDIR)\" $(srcdir)/C/save.c -o $@
 

changes-5.1.html

@@ -16,6 +16,7 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> NEW: a first cut at readutil.yap (request from Stefan Weinbrenner)</li> 
 <li> FIXED: compile | as a disjunction (obs from Ole Edsberg)</li> 
 <li> NEW: rbqueues keeps a simple db queue</li> 
 <li> NEW: cut_up_to_next_disjunction/0 tries to prune until the closest

docs/yap.tex

@@ -190,6 +190,7 @@ Subnodes of Library
 * Pseudo Random:: Pseudo Random Numbers
 * Queues:: Queue Manipulation
 * Random:: Random Numbers
+* Read Utilities:: SWI inspired utilities for fast stream scanning.
 * Red-Black Trees:: Predicates to add, lookup and delete in red-black binary  trees.
 * RegExp:: Regular Expression Manipulation
 * Splay Trees:: Splay Trees
@@ -6809,6 +6810,7 @@ Library, Extensions, Builtins, Top
 * Pseudo Random:: Pseudo Random Numbers
 * Queues:: Queue Manipulation
 * Random:: Random Numbers
+* Read Utilities:: SWI inspired utilities for fast stream scanning.
 * Red-Black Trees:: Predicates to add, lookup and delete in red-black binary  trees.
 * RegExp:: Regular Expression Manipulation
 * Splay Trees:: Splay Trees
@@ -7665,7 +7667,7 @@ Creates a new list with the same elements as @var{Queue}.
 @end table
 
 
-@node Random, Red-Black Trees, Queues, Library
+@node Random, Read Utilities, Queues, Library
 @section Random Number Generator
 @cindex queue
 
@@ -7724,7 +7726,91 @@ random number generator. The integer @code{X} must be in the range
 
 @end table
 
-@node Red-Black Trees, RegExp, Random, Library
+@node Read Utilities, Red-Black Trees, Random, Library
+@section Read Utilities
+
+The @code{readutil} library contains primitives to read lines, files,
+multiple terms, etc.
+
+@table @code
+@item read_line_to_codes(+@var{Stream}, -@var{Codes})
+@findex read_line_to_codes/2
+@snindex read_line_to_codes/2
+@cnindex read_line_to_codes/2
+
+Read the next line of input from @var{Stream} and unify the result with
+@var{Codes} @emph{after} the line has been read.  A line is ended by a
+newline character or end-of-file. Unlike @code{read_line_to_codes/3},
+this predicate removes trailing newline character.
+
+On end-of-file the atom @code{end_of_file} is returned.  See also
+@code{at_end_of_stream/[0,1]}.
+
+@item read_line_to_codes(+@var{Stream}, -@var{Codes}, ?@var{Tail})
+@findex read_line_to_codes/3
+@snindex read_line_to_codes/3
+@cnindex read_line_to_codes/3
+Diference-list version to read an input line to a list of character
+codes.  Reading stops at the newline or end-of-file character, but
+unlike @code{read_line_to_codes/2}, the newline is retained in the
+output.  This predicate is especially useful for readine a block of
+lines upto some delimiter.  The following example reads an HTTP header
+ended by a blank line:
+
+@example
+read_header_data(Stream, Header) :-
+	read_line_to_codes(Stream, Header, Tail),
+	read_header_data(Header, Stream, Tail).
+
+read_header_data("\r\n", _, _) :- !.
+read_header_data("\n", _, _) :- !.
+read_header_data("", _, _) :- !.
+read_header_data(_, Stream, Tail) :-
+	read_line_to_codes(Stream, Tail, NewTail),
+	read_header_data(Tail, Stream, NewTail).
+@end example
+
+@item read_stream_to_codes(+@var{Stream}, -@var{Codes})
+@findex read_stream_to_codes/3
+@snindex read_stream_to_codes/3
+@cnindex read_stream_to_codes/3
+Read all input until end-of-file and unify the result to @var{Codes}.
+
+@item read_stream_to_codes(+@var{Stream}, -@var{Codes}, ?@var{Tail})
+@findex read_stream_to_codes/3
+@snindex read_stream_to_codes/3
+@cnindex read_stream_to_codes/3
+Difference-list version of @code{read_stream_to_codes/2}.
+
+@item read_file_to_codes(+@var{Spec}, -@var{Codes}, +@var{Options})
+@findex read_file_to_codes/3
+@snindex read_file_to_codes/3
+@cnindex read_file_to_codes/3
+Read a file to a list of character codes. Currently ignores
+@var{Options}.
+
+@c  @var{Spec} is a
+@c file-specification for absolute_file_name/3.  @var{Codes} is the
+@c resulting code-list.  @var{Options} is a list of options for
+@c absolute_file_name/3 and open/4.  In addition, the option
+@c \term{tail}{Tail} is defined, forming a difference-list.
+
+@item read_file_to_terms(+@var{Spec}, -@var{Terms}, +@var{Options})
+@findex read_file_to_terms/3
+@snindex read_file_to_terms/3
+@cnindex read_file_to_terms/3
+Read a file to a list of prolog terms (see read/1). @c @var{Spec} is a
+@c file-specification for absolute_file_name/3.  @var{Terms} is the
+@c resulting list of Prolog terms.  @var{Options} is a list of options for
+@c absolute_file_name/3 and open/4.  In addition, the option
+@c \term{tail}{Tail} is defined, forming a difference-list.
+@c \end{description}
+
+@end table
+
+
+
+@node Red-Black Trees, RegExp, Read Utilities, Library
 @section Red-Black Trees
 @cindex Red-Black Trees
 

library/Makefile.in

@@ -43,6 +43,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
 	$(srcdir)/queues.yap \
 	$(srcdir)/random.yap \
 	$(srcdir)/rbtrees.yap \
+	$(srcdir)/readutil.yap \
 	$(srcdir)/regexp.yap \
 	$(srcdir)/splay.yap \
 	$(srcdir)/swi.yap \