/*  STOW.P  */


section $-stow =>
        stow_to,
        unstow_from;


/*
SPECIFICATION
-------------


This file defines procedures for saving data to, and reading from,
files. They are based on the same idea as LIB DATAFILE (from which
I built them).

The idea is that you open a file by calling (for example):
    stow_to( filename ) -> c;

You can then save arbitrary data items to this file by doing, e.g.,
    c( a );
    c( [% p, q, 1 %] );
    c( retina );
Conceptually, each data item is stored on a new ``line'', and can be
read back without getting mixed up with any of the others.

When your file is complete, call
    c( termin );
to close it.

You can then read back the data items, in order, by reversing this
process:
    unstow_from( filename ) -> r;
    r()=>
    r()=>
    r()=>

The successive calls of 'r' will return the data items saved; when there
are no more left, 'r' will return termin.


PUBLIC stow_to( filename );

Filename must be a string. stow_to returns a consumer, c. Every time c
is called, it will save its argument to the named file. To close
the file, call c(termin).

Example:
    stow_to( 'mydata.' ) -> keep;
    keep(1);
    keep(2);
    keep( { [a b 1.2 3 {4} ] } );
    keep(termin);


PUBLIC unstow_from( filename );

unstow_from returns a repeater, r. Every time r is called, it will
return the next piece of data in the file. If there is none left,
it will return termin; sunsequent calls will provoke an error.

Example:
    unstow_from( 'mydata.' ) -> get;

Calls of get() will return the data written by keep.
*/


/*
IMPLEMENTATION
--------------

This is based on LIB DATAFILE. stow_to(f) returns stow(%C%), where
C is a character consumer to f; unstow_from(f) returns unstow(%R%),
where R is an item repeater for f.

stow and unstow are the main writing routines; they perform
initialisations, and then call fwrite and fread respectively.

This library comes with a HELP file, HELP STOW. Make sure the two are
kept in step.
*/


vars stow, unstow, fread, fwrite; /*forward*/


define global stow_to( filename );
    lvars filename;
    stow(% discout( filename ) %);
enddefine;


define global unstow_from( filename );
    lvars filename;
    unstow(% incharitem(discin(filename)) %);
enddefine;


define stow( _x, consumer );
    lvars _x, consumer;

    lvars saved_cucharout;
    cucharout -> saved_cucharout;

    vars charsonline=0;

    procedure(c,consumer);
        lvars c, consumer;
        consumer(c);
        1 + charsonline -> charsonline;
    endprocedure(% consumer %) -> cucharout;

    if _x = termin then
        pr(_x);
    else
        fwrite( _x );
        nl(1);
    endif;

    saved_cucharout -> cucharout;
enddefine;


define fwrite( _x );
    lvars x;

    if charsonline > 60 then nl(1); 0 -> charsonline endif;
    sp(1);
    if _x.isnumber or _x.isword then             
        pr(_x);
    elseif _x.islist then
        spr("zl"); pr(length(_x));
        applist(_x,fwrite);
    elseif _x.isstring then
        spr("zs"); pr(datalength(_x));
        appdata(_x,fwrite);
    elseif _x.isvector then
        spr("zv"); pr(datalength(_x));
        appdata(_x,fwrite);
    elseif _x.isprocedure then
        pr("za"); fwrite(boundslist(_x)); appdata(arrayvector(_x),fwrite);
    elseif _x.isref then
        pr("zr"); fwrite(cont(_x));
    elseif _x.isboolean then
        spr("zb");
        if _x then pr("true"); else pr("false"); endif;
    else
        spr("zc"); pr(dataword(_x)); appdata(_x,fwrite);
    endif;
enddefine;


define unstow( repeater );
    lvars repeater;

    vars rditem;
    repeater -> rditem;
    fread();
enddefine;


define fread();
    lvars _x, _t _n key;

    rditem() -> _x;

    if _x == "zl" then
        .rditem -> _t;
        nil -> _x;
        repeat _t times
            cons(.fread,_x) -> _x;
        endrepeat;
        rev(_x) -> _x;
        elseif _x == "zp" then
        conspair(.fread,.fread) -> _x;
    elseif _x == "zs" then
        .rditem -> _t;
        inits(_t) -> _x;
        for _n from 1 to _t do
            .fread -> fast_subscrs(_n,_x);
        endfor;
    elseif _x == "zv" then
        .rditem -> _t;
        initv(_t) -> _x;
        for _n from 1 to _t do
            .fread -> fast_subscrv(_n,_x);
        endfor;
    elseif _x == "za" then
        newarray(fread()) -> _x;
        datalength(arrayvector(_x)) -> _t;
        for _n from 1 to _t do
            .fread -> fast_subscrv(_n,arrayvector(_x));
        endfor;
    elseif _x == "zr" then
        consref(.fread) -> _x;
    elseif _x == "zb" then
        valof(.fread) -> _x;
    elseif _x == "zc" then
        ;;; get dataword and check for valid key - R. Evans Jan 83
        fread() -> _t;
        key_of_dataword(_t) -> key;
        unless key then
            mishap('Unknown dataword encountered in datafile\n' ><
                   ';;;          (recordclass declaration not loaded?)', [^(_t)]);
        endunless;
        repeat length(class_spec(key)) times .fread endrepeat;
        apply(class_cons(key)) -> _x
    endif;
    _x;
enddefine;


endsection;