## old-prettyprinter.pkg
#
# An implementation of Mythryl's prettyprinter interface.
# Compiled by:
# src/lib/prettyprint/big/prettyprinter.lib### "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_Prettyprinter {
Ppstream;
Prettyprint_Consumer
=
{ consumer: String -> Void,
flush: Void -> Void,
close: Void -> Void
};
Break_Style
=
CONSISTENT | INCONSISTENT;
exception PP_FAIL String;
make_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_prettyprinter: Prettyprint_Consumer -> (Ppstream -> Void) -> Void;
prettyprint_to_string: (Ppstream -> Void) -> String;
};
package old_prettyprinter
: Old_Prettyprinter
{
Prettyprint_Consumer
=
{ consumer: String -> Void,
flush: Void -> Void,
close: Void -> Void
};
package out # "out" == "prettyprinter output stream"
=
package {
Prettyprint_Output_Stream = Prettyprint_Consumer;
Texttraits = Void;
#
fun same_texttraits _ = TRUE;
fun push_texttraits _ = ();
fun pop_texttraits _ = ();
fun default_texttraits _ = ();
# fun depth _ = NULL;
# fun text_width _ = NULL;
fun put_blanks ( { consumer, flush, close }, n) = consumer (number_string::pad_left ' ' n "");
fun put_newline { consumer, flush, close } = consumer "\n";
fun put_string ( { consumer, flush, close }, s) = consumer s;
fun put_char ( { consumer, flush, close }, c) = consumer (str c);
fun flush { consumer, flush, close } = flush();
fun close { consumer, flush, close } = close();
};
package pp
=
base_prettyprinter_g ( # base_prettyprinter_g is from src/lib/prettyprint/big/src/base-prettyprinter-g.pkg package tt = traitless_text; # traitless_text is from src/lib/prettyprint/big/src/traitless-text.pkg package out = out;
);
Ppstream
=
STRM { consumer: Prettyprint_Consumer,
pp: pp::Prettyprinter
};
Break_Style
=
CONSISTENT | INCONSISTENT;
exception PP_FAIL String;
fun make_ppstream output_stream
=
STRM {
consumer => output_stream,
pp => pp::make_prettyprinter output_stream []
};
fun dest_ppstream (STRM { consumer, ... } )
=
consumer;
fun add_break (STRM { pp, ... } ) (blanks, indent_on_wrap)
=
pp::break pp { blanks, indent_on_wrap };
fun add_newline (STRM { pp, ... } ) = pp::newline pp;
fun add_string (STRM { pp, ... } ) s = pp::lit pp s;
fun begin_block (STRM { pp, ... } ) CONSISTENT indent
=>
pp::open_box (pp, pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::normal, 100 ); # '4' used to be 'indent', before indent became tabstop.
begin_block (STRM { pp, ... } ) INCONSISTENT indent
=>
pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 }, pp::normal, 100 ); # ditto
end;
fun end_block (STRM { pp, ... } )
=
pp::shut_box pp;
fun clear_ppstream (STRM { pp, ... } )
=
raise exception DIE "clear_ppstream not implemented";
fun flush_ppstream (STRM { pp, ... } )
=
pp::flush_prettyprinter pp;
fun with_prettyprinter output_stream f
=
{ (make_ppstream output_stream) -> (prettyprinter as (STRM { pp, ... } ));
#
f prettyprinter;
pp::close_prettyprinter pp;
};
fun prettyprint_to_string prettyprint_fn
=
{ l = REF ([] : List( String ));
#
fun consumer s
=
l := s ! *l;
with_prettyprinter
{
consumer,
flush => \\ ()=(),
close => \\ ()=()
}
prettyprint_fn;
string::cat (list::reverse *l);
};
};