9.9.2 I/O on Lists of Character Codes

This example is taken from the SICStus Prolog library (simplified, but operational). A stream for writing is opened where the written characters are placed in a buffer. When the stream is closed, a code-list is made from the contents of the buffer. The example illustrates the use of user definable streams.

The open_buf_stream() function opens a stream where the characters are put in a buffer. The stream is closed by stream_to_chars(), which returns the list constructed on the heap.

                               
% example.pl
     
     foreign(open_buf_stream, '$open_buf_stream'(-address('SP_stream'))).
     foreign(stream_to_chars, '$stream_to_chars'(+address('SP_stream'),
                                                 -term)).
     
     foreign_resource(example, [open_buf_stream,stream_to_chars]).
     
     :- load_foreign_resource(example).
     
     %% with_output_to_chars(+Goal, -Chars)
     %% runs Goal with current_output set to a list of characters
     
     with_output_to_chars(Goal, Chars) :-
             '$open_buf_stream'(StreamCode),
             stream_code(Stream, StreamCode),
             current_output(CurrOut),
             set_output(Stream),
             call_and_reset(Goal, Stream, CurrOut, StreamCode, Chars).
     
     call_and_reset(Goal, Stream, CurrOut, StreamCode, Chars) :-
             call(Goal), !,
             put(0),
             '$stream_to_chars'(StreamCode, Chars),
             reset_stream(Stream, CurrOut).
     call_and_reset(_, Stream, CurrOut, _, _) :-
             reset_stream(Stream, CurrOut).
     
     reset_stream(Stream, CurrOut) :-
             set_output(CurrOut),
             close(Stream).

                            
/* example.c */
     
     #include <sicstus/sicstus.h>
     
     struct open_chars {
       char *chars;       /* character buffer */
       int index;         /* current insertion point */
       int size;
     };
     
     #define INIT_BUFSIZE 512
     
     static int lputc(c, buf)
          int c;
          struct open_chars *buf;
     {
       if (buf->index == buf->size)  /* grow buffer if necessary */
         {
           buf->size *= 2;
           buf->chars = (char *)realloc(buf->chars, buf->size);
         }
       return (buf->chars[buf->index++] = c);
     }
     
     static int lwclose(buf)
          struct open_chars *buf;
     {
       free(buf->chars);
       free(buf);
       return 0;
     }

                            
/* example.c */
     
     void open_buf_stream(streamp)
          SP_stream **streamp;
     {
       struct open_chars *buf;
     
       /* Allocate buffer, create stream & return stream code */
     
       buf = (struct open_chars *)malloc(sizeof(struct open_chars));
       SP_make_stream(buf, NULL, lputc, NULL, NULL, NULL, lwclose,
                      streamp);
     
       buf->chars = (char *)malloc(INIT_BUFSIZE);
       buf->size = INIT_BUFSIZE;
       buf->index = 0;
     }
     
     void stream_to_chars(streamp, head)
          SP_stream *streamp;
          SP_term_ref head;
     {
       SP_term_ref tail = SP_new_term_ref();
       struct open_chars *buf = (struct open_chars *)streamp->user_handle;
     
       /* Make a list of character codes out of the buffer */
     
       SP_put_string(tail, "[]");
       SP_put_list_chars(head, tail, buf->chars);
     }