15.4.834  src/lib/prettyprint/big/src/prettyprint-debug-g.pkg

## prettyprint-debug-g.pkg
## All rights reserved.

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

# A wrapper for the prettyprint_stream_g, which dumps the current pp state prior
# to each operation.

stipulate
    package fil =  file__premicrothread;                                        # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    generic package prettyprint_debug_g (

        pp:  api {    include Prettyprint_Stream;                               # Prettyprint_Stream    is from   src/lib/prettyprint/big/src/prettyprint-stream.api
                    dump: ((fil::Output_Stream, Stream)) -> Void;
             }
    )
    : (weak)
    api {
        include Prettyprint_Stream;                                             # Prettyprint_Stream    is from   src/lib/prettyprint/big/src/prettyprint-stream.api

        debug_stream:  Ref(  fil::Output_Stream );
    }
    {
        Device =  pp::Device;
        Stream =  pp::Stream;
        Token  =  pp::Token;
        Style  =  pp::Style;

        Indent == pp::Indent;

        Prettyprinter
            =
            { stream:    Stream,

              align:    (Void -> Void) -> Void,
              wrap:     (Void -> Void) -> Void,

              align':    Int -> (Void -> Void) -> Void,
              wrap':     Int -> (Void -> Void) -> Void,

              flush:     Void -> Void,
              close:     Void -> Void,

              lit:       String -> Void,        # Output string literally -- no chars receive special treatment.
              out:       String -> Void,        # '\r'     == break { spaces => 3, indent_on_wrap => 0 }
              put:       String -> Void # n blanks == break { spaces => n, indent_on_wrap => 4 }
            };  

        debug_stream
            =
            REF fil::stderr;

        fun debug name f stream arg
            =
            {   fil::write(*debug_stream, cat ["*** ", name, ": "]);
                pp::dump (*debug_stream, stream);
                fil::flush *debug_stream;
                f stream arg;
            };

        fun debug' name f stream
            =
            {   fil::write(*debug_stream, cat ["*** ", name, ": "]);
                pp::dump  (*debug_stream, stream);
                fil::flush  *debug_stream;
                f stream;
            };

        open_stream  = pp::open_stream;
        flush_stream = debug' "flush_stream" pp::flush_stream;
        close_stream = debug' "close_stream" pp::close_stream;
        get_device   = pp::get_device;

        begin_horizontal_box    = debug' "begin_horizontal_box"     pp::begin_horizontal_box;
        begin_vertical_box    = debug' "begin_vertical_box"     pp::begin_vertical_box;
        begin_horizontal_else_vertical_box   = debug' "begin_horizontal_else_vertical_box"    pp::begin_horizontal_else_vertical_box;
        begin_wrap_box  = debug' "begin_wrap_box"   pp::begin_wrap_box;
        begin_wrap'_box = debug' "begin_wrap'_box"  pp::begin_wrap'_box;

        begin_indented_vertical_box    = debug "begin_indented_vertical_box"   pp::begin_indented_vertical_box;
        begin_indented_horizontal_else_vertical_box   = debug "begin_indented_horizontal_else_vertical_box"  pp::begin_indented_horizontal_else_vertical_box;
        begin_indented_wrap_box  = debug "begin_indented_wrap_box" pp::begin_indented_wrap_box;
        begin_indented_wrap'_box = debug "open_indented_box"     pp::begin_indented_wrap'_box;

        # XXX BUGGO FIXME 2007-09 CrT: No debug support for these yet:
        horizontal_box    = debug' "horizontal_box"     pp::horizontal_box;
        vertical_box    = debug' "vertical_box"     pp::vertical_box;
        horizontal_else_vertical_box   = debug' "horizontal_else_vertical_box"    pp::horizontal_else_vertical_box;
        wrap_box  = debug' "wrap_box"   pp::wrap_box;
        wrap'_box = debug' "wrap'_box"  pp::wrap'_box;


        end_box   = debug' "end_box" pp::end_box;

        token   = debug "token"  pp::token;
        string  = debug "string" pp::string;

        push_style = pp::push_style;
        pop_style  = pp::pop_style;

        break   = debug "break"    pp::break;
        space   = debug "space"    pp::space;
        cut     = debug' "cut"     pp::cut;
        newline = debug' "newline" pp::newline;
        nonbreakable_spaces = debug "nonbreakable_spaces"  pp::nonbreakable_spaces;
        control = debug "control"  pp::control;

    };
end;


## COPYRIGHT (c) 2005 John Reppy (http://www.cs.uchicago.edu/~jhr)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.