## latex-print-value.pkg
## Copyright 2003 by The SML/NJ Fellowship
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# Modified to use Lib7 Lib pp. [dbm, 7/30/03])
stipulate
package ii = inlining_information; # inlining_information is from src/lib/compiler/front/typer-stuff/basics/inlining-information.pkg package pp = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package ty = types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package vac = variables_and_constructors; # variables_and_constructors is from src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
api Latex_Print_Value {
backslash_latex_special_chars: String -> String;
latex_print_constructor_representation: pp::Stream
-> vh::Valcon_Form
-> Void;
latex_print_varhome: pp::Stream -> vh::Varhome -> Void;
latex_print_dcon: pp::Stream -> ty::Valcon -> Void;
latex_print_var: pp::Stream -> vac::Variable -> Void;
latex_print_variable
:
pp::Stream
->
(syx::Symbolmapstack, vac::Variable)
->
Void;
latex_print_debug_dcon
:
pp::Stream
->
syx::Symbolmapstack
->
ty::Valcon -> Void;
latex_print_constructor
:
pp::Stream
->
syx::Symbolmapstack
->
ty::Valcon -> Void;
latex_print_debug_var
:
(ii::Inlining_Information -> String)
-> pp::Stream
-> syx::Symbolmapstack
-> vac::Variable
-> Void;
};
end;
stipulate
package fis = find_in_symbolmapstack; # find_in_symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg package pp = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tys = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg # latex_print_type is from src/lib/compiler/front/typer/print/latex-print-type.pkg # package ii = inlining_info
include prettyprint;
include unparse_junk;
include variables_and_constructors;
include types;
herein
package latex_print_value
: (weak) Latex_Print_Value
{
internals = typer_control::internals;
# La/TeX wants all literal underlines backslashed
# (otherwise they denote subscripting), and similarly
# for $ % # { } so we need a function to do
# s/([$%#{}_])/\\\1/g:
#
fun backslash_latex_special_chars string
=
string::implode (quote_em ( string::explode string, [] ))
where
fun quote_em ([], done)
=>
reverse done;
quote_em (c ! rest, done)
=>
case c
'\'' => quote_em (rest, '_' ! '\\' ! '_' ! '\\' ! 'e' ! 'm' ! 'i' ! 'r' ! 'p' ! '_' ! '\\' ! '_' ! '\\' ! done);
'!' => quote_em (rest, '_' ! '\\' ! '_' ! '\\' ! 'g' ! 'n' ! 'a' ! 'b' ! '_' ! '\\' ! '_' ! '\\' ! done);
'_' => quote_em (rest, c ! '\\' ! done);
'$' => quote_em (rest, c ! '\\' ! done);
'&' => quote_em (rest, c ! '\\' ! done);
'%' => quote_em (rest, c ! '\\' ! done);
'#' => quote_em (rest, c ! '\\' ! done);
'@' => quote_em (rest, c ! '\\' ! done);
'{' => quote_em (rest, c ! '\\' ! done);
'}' => quote_em (rest, c ! '\\' ! done);
_ => quote_em (rest, c ! done);
esac;
end;
end;
fun by f x y
=
f y x;
pps = pp::string;
latex_print_some_type = latex_print_type::latex_print_some_type;
latex_print_type = latex_print_type::latex_print_type;
latex_print_type_scheme = latex_print_type::latex_print_type_scheme;
fun latex_print_varhome stream a
=
pps stream ( " ["
+ (vh::print_varhome a)
+ "]"
);
fun latex_print_inlining_info inlining_info_to_string stream a
=
pps stream (" [" + (inlining_info_to_string a) + "]");
fun latex_print_constructor_representation stream representation
=
pp::string stream (vh::print_representation representation);
fun latex_print_csig stream csig
=
pp::string stream (vh::print_constructor_api csig);
fun latex_print_dcon stream
=
latex_print_d
where
fun latex_print_d ( VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ unparse_symbol stream name;
if *internals
latex_print_varhome stream acc;
fi;
};
latex_print_d (VALCON { name, ... } )
=>
unparse_symbol stream name;
end;
end;
fun latex_print_debug_dcon stream symbolmapstack (VALCON { name, form, is_constant, type, signature, is_lazy } )
=
{ (en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
unparse_symbol = unparse_symbol stream;
begin_horizontal_else_vertical_box 3;
pps "VALCON";
break { spaces=>0, indent_on_wrap=>0 };
pps "{ name = "; unparse_symbol name; unparse_comma_newline stream;
pps "is_constant = "; pps (bool::to_string is_constant); unparse_comma_newline stream;
pps "type = "; latex_print_some_type symbolmapstack stream type; unparse_comma_newline stream;
pps "is_lazy = "; pps (bool::to_string is_lazy); unparse_comma_newline stream;
pps "pick_valcon_form =";
latex_print_constructor_representation
stream
form;
unparse_comma_newline stream;
pps "signature = ["; latex_print_csig stream signature; pps "] }";
end_box ();
};
fun latex_print_constructor stream symbolmapstack (VALCON { name, form, is_constant, type, signature, is_lazy } )
=
{ (en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
unparse_symbol = unparse_symbol stream;
begin_horizontal_else_vertical_box 3;
unparse_symbol name;
pps " : ";
latex_print_some_type symbolmapstack stream type;
end_box ();
};
fun latex_print_datatyp
(
symbolmapstack: syx::Symbolmapstack,
VALCON { name, type, ... }
)
stream
=
{ (en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
#
begin_wrap_box 0;
unparse_symbol stream name; pps " : ";
latex_print_some_type symbolmapstack stream type;
end_box ();
};
# Is this ever used?
fun latex_print_con_naming stream
=
latex_print_constructor
where
my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... }
=
en_pp stream;
fun latex_print_constructor (VALCON { name, type, form=>vh::EXCEPTION _, ... }, symbolmapstack)
=>
{ begin_horizontal_else_vertical_box 0;
pps "exception ";
unparse_symbol stream name;
if (type_types::is_arrow_type type)
{ pps " ";
latex_print_some_type symbolmapstack stream (type_types::domain type);
};
fi;
pps ";";
end_box();
};
latex_print_constructor (con, symbolmapstack)
=>
{ exception HIDDEN;
visible_dcon_typ
=
{ typ = tys::datatyp_to_typ con;
( tys::typ_equality (
fis::find_typ_via_symbol_path
( symbolmapstack,
symbol_path::SYMBOL_PATH
[ inverse_path::last (type_junk::typ_path typ) ],
fn _ = raise exception HIDDEN
),
typ
)
except
HIDDEN = FALSE
);
};
if (*internals
or
not visible_dcon_typ
)
begin_horizontal_else_vertical_box 0;
pps "con ";
latex_print_datatyp (symbolmapstack, con) stream;
pps ";";
end_box ();
fi;
};
end;
end;
fun latex_print_var stream (ORDINARY_VARIABLE { varhome, path, ... } )
=>
{ pps stream (symbol_path::to_string path);
if *internals
latex_print_varhome stream varhome;
fi;
};
latex_print_var stream (OVERLOADED_IDENTIFIER { name, ... } )
=>
unparse_symbol stream (name);
latex_print_var stream (errorvar)
=>
pp::string stream "<errorvar>";
end;
fun latex_print_debug_var inlining_info_to_string stream symbolmapstack
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... } = en_pp stream;
latex_print_varhome = latex_print_varhome stream;
latex_print_inlining_info = latex_print_inlining_info inlining_info_to_string stream;
fun latexprintdebugvar (ORDINARY_VARIABLE { varhome, path, var_type, inlining_info } )
=>
{ begin_horizontal_else_vertical_box 0;
pps "ORDINARY_VARIABLE";
begin_horizontal_else_vertical_box 3;
pps "( { varhome="; latex_print_varhome varhome; unparse_comma_newline stream;
pps "inlining_info="; latex_print_inlining_info inlining_info; unparse_comma_newline stream;
pps "path="; pps (symbol_path::to_string path); unparse_comma_newline stream;
pps "var_type=REF "; latex_print_some_type symbolmapstack stream *var_type;
pps "} )";
end_box();
end_box();
};
latexprintdebugvar (OVERLOADED_IDENTIFIER { name, alternatives, type_scheme } )
=>
{ begin_horizontal_else_vertical_box 0;
pps "OVERLOADED_IDENTIFIER";
begin_horizontal_else_vertical_box 3;
pps "( { name="; unparse_symbol stream (name); unparse_comma_newline stream;
pps "alternatives=[";
(ppvseq stream 0 ", "
(fn stream = fn { indicator, variant } =
{ pps "{ indicator="; latex_print_some_type symbolmapstack stream indicator;
unparse_comma_newline stream;
pps " variant =";
latex_print_debug_var inlining_info_to_string stream symbolmapstack variant; pps "}";})
*alternatives);
pps "]"; unparse_comma_newline stream;
pps "type_scheme="; latex_print_type_scheme symbolmapstack stream type_scheme; pps "} )";
end_box();
end_box();
};
latexprintdebugvar errorvar
=>
pps "<ERRORvar>";
end;
latexprintdebugvar;
};
fun latex_print_variable stream
=
latexprintvariable
where
(en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
fun latexprintvariable ( symbolmapstack: syx::Symbolmapstack,
ORDINARY_VARIABLE { path, varhome, var_type, inlining_info }
)
=>
{ begin_horizontal_else_vertical_box 0;
pps (symbol_path::to_string path);
if *internals
latex_print_varhome stream varhome;
fi;
pps ": ";
latex_print_some_type symbolmapstack stream *var_type;
pps ";";
end_box ();
};
latexprintvariable (symbolmapstack, OVERLOADED_IDENTIFIER { name, alternatives, type_scheme=>TYPE_SCHEME { body, ... } } )
=>
{ begin_horizontal_else_vertical_box 0;
unparse_symbol stream name;
pps ": ";
latex_print_some_type symbolmapstack stream body;
pps " as ";
unparse_sequence stream { sep => by pp::break { spaces=>1, indent_on_wrap=>0 },
pr => (fn stream = fn { variant, ... } = latexprintvariable (symbolmapstack, variant)),
style => CONSISTENT
}
*alternatives;
pps ";";
end_box();
};
latexprintvariable(_, errorvar)
=>
pps "<ERRORvar>;";
end;
end;
}; # package latex_print_value
end; # stipulate