# prettyprint-table.pkg
# Compiled by:
# src/lib/compiler/core.sublibapi Unparse_Table {
exception PP_NOT_INSTALLED;
pp_chunk: prettyprint::Stream -> stamp::Stamp -> unsafe::unsafe_chunk::Chunk
-> Void;
install_unparser: List( String ) ->
(prettyprint::Stream -> unsafe::unsafe_chunk::Chunk -> Void) -> Void;
};
package unparse_table
: (weak) Unparse_Table # Unparse_Table is from src/lib/compiler/src/print/prettyprint-table.pkg{
package err= error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg # The following code implements automatic prettyprinting of values.
# The user defines a enum d, then defines a prettyprinter
#
# Dp: ppstream -> d -> Void
#
# over d, perhaps using the Oppen primitives. Then dp is installed
# in the "prettyprint table" via install_unparser. Subsequently, when a value of
# type d comes to be printed out, we get in the table, find dp and
# Apply it to the value. If it is not found, we print the value in
# the default manner.
Chunk = unsafe::unsafe_chunk::Chunk;
exception PP_NOT_INSTALLED;
fun error msg
=
{ err::error_no_file
(err::default_plaint_sink(), REF FALSE)
(0, 0)
err::ERROR
msg
err::null_error_body;
raise exception err::COMPILE_ERROR;
};
stipulate
global_pp_table = REF stamp_map::empty;
herein
fun make_path ([s], p) => symbol_path::SYMBOL_PATH (reverse (symbol::make_type_symbol (s) ! p));
make_path (s ! r, p) => make_path (r, symbol::make_package_symbol (s) ! p);
make_path _ => error "install_unparser: empty path";
end;
fun install_unparser (path_names: List( String ))
(p: prettyprint::Stream -> Chunk -> Void)
=
{ sym_path = make_path (path_names,[]);
typ = find_in_symbolmapstack::find_typ_via_symbol_path ((.symbolmapstack (compiler_state::combined())),
sym_path,
err::error_no_file (err::default_plaint_sink(), REF FALSE) (0, 0));
case typ
#
types::PLAIN_TYP { stamp, ... }
=>
global_pp_table := stamp_map::set (*global_pp_table, stamp, p);
_ => error "install_unparser: nongenerative type constructor";
esac;
};
fun pp_chunk stream (s: stamp::Stamp) (chunk: Chunk)
=
case (stamp_map::get (*global_pp_table, s))
#
THE p => p stream chunk;
NULL => raise exception PP_NOT_INSTALLED;
esac;
end;
}; # package prettyprint_table
# Copyright 1992 by AT&T Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.