15.4.837  src/lib/prettyprint/big/src/prettyprint.pkg

## prettyprint.pkg
#
# Compare to:
#     src/lib/prettyprint/simple/simple-prettyprinter.pkg

# Compiled by:
#     src/lib/prettyprint/big/prettyprint.lib


# An implementation of the Prettyprint interface.
#   - This is an (almost) literal copy of the original code in
#     lib/prettyprint/big/examples/old-prettyprint.sml



###            "The gods too are fond of a joke."
###
###                            -- Aristotle


api Prettyprint {
    #
    include Prettyprint_Stream;                         # Prettyprint_Stream    is from   src/lib/prettyprint/big/src/prettyprint-stream.api

    with_prettyprint_device:  Device
                              -> (Stream -> Void)
                              -> Void;

    prettyprint_to_string:  Int
                            -> (Stream -> X -> Void)
                            -> X
                            -> String;
};



package   prettyprint
: (weak)  Prettyprint
{
    Prettyprint_Consumer
        =
        {   consumer:   String -> Void,
            linewidth:  Int,
            flush:      Void -> Void
        };

    package device {

        Device = Prettyprint_Consumer;
        Style  = Void;

        fun same_style _    = TRUE;
        fun push_style _    = ();
        fun pop_style _     = ();
        fun default_style _ = ();

        fun depth _ = NULL;
        fun line_width { consumer, linewidth, flush } = THE linewidth;
        fun text_width _ = NULL;

        fun space ( { consumer, linewidth, flush }, n)
            =
            consumer (number_string::pad_left ' ' n "");

        fun newline  { consumer, linewidth, flush }     = consumer "\n";
        fun string ( { consumer, linewidth, flush }, s) = consumer s;
        fun char   ( { consumer, linewidth, flush }, c) = consumer (str c);
        fun flush    { consumer, linewidth, flush }     = flush();
    };

    package pp
        =
        prettyprint_stream_g (                          # prettyprint_stream_g          def in    src/lib/prettyprint/big/src/prettyprint-stream-g.pkg

            package token  = string_token;              # string_token                  is from   src/lib/prettyprint/big/devices/string-token.pkg
            package device = device;
        );

    include pp;

    fun with_prettyprint_device device (f: pp::Stream -> Void)
        =
        {   stream =   pp::open_stream device;

            f stream;

            pp::close_stream stream;
        };

    fun prettyprint_to_string   linewidth   prettyprint_g   chunk
        =
        {   l =   REF ([] : List( String ));

            fun attach s
                =
                l   :=   s ! *l;

            device
                =
                {   consumer => attach,
                    linewidth,
                    flush => fn()=>(); end 
                };

            with_prettyprint_device
                device
                (fn prettyprint_stream => prettyprint_g prettyprint_stream chunk; end );

            string::cat (list::reverse *l);
        };

}; #  package prettyprint