15.4.212  src/lib/c-kit/src/parser/stuff/old-pp.pkg

## old-pp.pkg

# Compiled by:
#     src/lib/c-kit/src/parser/c-parser.sublib

# An implementation of the Lib7's pp interface.



###                           "I have had my results for a long time:
###                            but I do not yet know how I am to arrive at them."
###
###                                              --Carl Friedrich Gauss



api Old_Prettyprint {

    Ppstream;

    Prettyprint_Consumer
        =
        { consumer:  String -> Void,
          linewidth:  Int,
          flush:  Void -> Void
        };

    Break_Style
        =
        CONSISTENT | INCONSISTENT;

    exception PP_FAIL  String;

    mk_ppstream:        Prettyprint_Consumer -> Ppstream;
    dest_ppstream:      Ppstream -> Prettyprint_Consumer;
    add_break:          Ppstream -> (Int, Int) -> Void;
    add_newline:        Ppstream -> Void;
    add_string:         Ppstream -> String -> Void;
    begin_block:        Ppstream -> Break_Style -> Int -> Void;
    end_block:          Ppstream -> Void;
    clear_ppstream:     Ppstream -> Void;
    flush_ppstream:     Ppstream -> Void;

    with_prettyprint_device:     Prettyprint_Consumer -> (Ppstream -> Void) -> Void;
    prettyprint_to_string:       Int -> (Ppstream -> X -> Void) -> X -> String;

};

package old_prettyprint:  Old_Prettyprint {             # Old_Prettyprint       is from   src/lib/c-kit/src/parser/stuff/old-pp.pkg

     Prettyprint_Consumer = {
        consumer:   String -> Void,
        linewidth:  Int,
        flush:      Void -> Void
    };

    package dev
      =
      package {
        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 (
            package token = string_token;       # string_token  is from   src/lib/prettyprint/big/devices/string-token.pkg
            package device = dev;
        );

    Ppstream
        =
        STRM  {   consumer:  Prettyprint_Consumer,
                   stream:  pp::Stream
              };


    Break_Style
        =
        CONSISTENT | INCONSISTENT;


    exception PP_FAIL  String;


    fun mk_ppstream pwrpc32
        =
        STRM {
          consumer =>  pwrpc32,
          stream     =>  pp::open_stream pwrpc32
        };


    fun dest_ppstream (STRM { consumer, ... } )
        =
        consumer;


    fun add_break (STRM { stream, ... } ) (spaces, indent_on_wrap)
        =
        pp::break stream { spaces, indent_on_wrap };

    fun add_newline (STRM { stream, ... } )   =   pp::newline stream;
    fun add_string  (STRM { stream, ... } ) s =   pp::string  stream  s;


    fun begin_block (STRM { stream, ... } ) CONSISTENT indent
            =>
            pp::begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE indent);
        begin_block (STRM { stream, ... } ) INCONSISTENT indent
            =>
            pp::begin_indented_wrap_box stream (pp::CURSOR_RELATIVE indent);
    end;


    fun end_block (STRM { stream, ... } )
        =
        pp::end_box stream;


    fun clear_ppstream (STRM { stream, ... } )
        =
        raise exception FAIL "clear_ppstream not implemented";


    fun flush_ppstream (STRM { stream, ... } )
        =
        pp::flush_stream stream;


    fun with_prettyprint_device pwrpc32 f
        =
        {   my (prettyprint_stream as (STRM { stream, ... } ))
                =
                mk_ppstream pwrpc32;
          
            f  prettyprint_stream;

            pp::close_stream  stream;
        };


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

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

            with_prettyprint_device
                {
                    consumer  =>  attach,
                    linewidth =>  wid,
                    flush     =>  fn ()=()
                }

                (fn prettyprint_stream =  prettyprint_g prettyprint_stream chunk);

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

};