## latex-print-value.pkg
# Compiled by:
#
src/lib/compiler/front/typer/typer.sublib# Modified to use Lib7 Lib pp. [dbm, 7/30/03])
stipulate
package id = inlining_data; # inlining_data is from
src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from
src/lib/prettyprint/big/src/standard-prettyprinter.pkg package syx = symbolmapstack; # symbolmapstack is from
src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tdt = type_declaration_types; # type_declaration_types is from
src/lib/compiler/front/typer-stuff/types/type-declaration-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::Prettyprinter
-> vh::Valcon_Form
-> Void;
latex_print_varhome: pp::Prettyprinter -> vh::Varhome -> Void;
latex_print_valcon: pp::Prettyprinter -> tdt::Valcon -> Void;
latex_print_var: pp::Prettyprinter -> vac::Variable -> Void;
latex_print_variable
:
pp::Prettyprinter
-> (syx::Symbolmapstack, vac::Variable)
-> Void
;
latex_print_debug_valcon
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> tdt::Valcon
-> Void
;
latex_print_constructor
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> tdt::Valcon
-> Void
;
latex_print_debug_var
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> vac::Variable
-> Void
;
latex_print_inlining_data
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> id::Inlining_Data
-> 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 id = inlining_data; # inlining_data is from
src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg package ip = inverse_path; # inverse_path is from
src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from
src/lib/prettyprint/big/src/standard-prettyprinter.pkg package syp = symbol_path; # symbol_path is from
src/lib/compiler/front/typer-stuff/basics/symbol-path.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 tdt = type_declaration_types; # type_declaration_types is from
src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package uj = unparse_junk; # unparse_junk is from
src/lib/compiler/front/typer/print/unparse-junk.pkg package mtt = more_type_types; # more_type_types is from
src/lib/compiler/front/typer/types/more-type-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.pkg # latex_print_type is from
src/lib/compiler/front/typer/print/latex-print-type.pkg Pp = pp::Pp;
include package type_declaration_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;
latex_print_some_type = latex_print_type::latex_print_some_type;
latex_print_type = latex_print_type::latex_print_type;
latex_print_typescheme = latex_print_type::latex_print_typescheme;
fun latex_print_varhome (pp:Pp) a
=
pp.lit ( " ["
+ (vh::print_varhome a)
+ "]"
);
fun latex_print_inlining_data pp symbolmapstack inlining_data
=
{ (id::get_inlining_data_for_prettyprinting inlining_data)
->
(baseop, typoid);
pp.box {.
pp.lit "{";
pp.ind 4;
pp.box {.
pp.lit "baseop =>";
pp.txt " ";
pp.lit baseop;
pp.endlit ",";
};
pp.txt " ";
pp.box {.
pp.lit "typoid =>";
pp.txt " ";
latex_print_some_type symbolmapstack pp typoid;
};
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
};
fun latex_print_constructor_representation (pp:Pp) representation
=
pp.lit (vh::print_representation representation);
fun latex_print_csig (pp:Pp) csig
=
pp.lit (vh::print_constructor_api csig);
fun latex_print_valcon pp
=
latex_print_d
where
fun latex_print_d ( VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ uj::unparse_symbol pp name;
#
if *internals
latex_print_varhome pp acc;
fi;
};
latex_print_d (VALCON { name, ... } )
=>
uj::unparse_symbol pp name;
end;
end;
fun latex_print_debug_valcon pp symbolmapstack (VALCON { name, form, is_constant, typoid, signature, is_lazy } )
=
{ unparse_symbol = uj::unparse_symbol pp;
#
pp.box {. pp.rulename "lpv1";
pp.lit "VALCON";
pp.cut ();
pp.lit "{ name = "; unparse_symbol name; pp.txt ", \n";
pp.lit "is_constant = "; pp.lit (bool::to_string is_constant); pp.txt ", \n";
pp.lit "typoid = "; latex_print_some_type symbolmapstack pp typoid; pp.txt ", \n";
pp.lit "is_lazy = "; pp.lit (bool::to_string is_lazy); pp.txt ", \n";
pp.lit "pick_valcon_form =";
latex_print_constructor_representation
pp
form;
pp.txt ", \n";
pp.lit "signature = ["; latex_print_csig pp signature; pp.lit "] }";
};
};
fun latex_print_constructor pp symbolmapstack (VALCON { name, form, is_constant, typoid, signature, is_lazy } )
=
{ unparse_symbol = uj::unparse_symbol pp;
#
pp.box {. pp.rulename "lpv2";
#
unparse_symbol name;
pp.txt " : ";
latex_print_some_type symbolmapstack pp typoid;
};
};
fun latex_print_sumtype
(
symbolmapstack: syx::Symbolmapstack,
VALCON { name, typoid, ... }
)
pp
=
pp.wrap' 0 -1 {. pp.rulename "lptw7";
uj::unparse_symbol pp name;
pp.txt " : ";
latex_print_some_type symbolmapstack pp typoid;
};
# Is this ever used?
fun latex_print_con_naming pp
=
latex_print_constructor
where
fun latex_print_constructor (VALCON { name, typoid, form=>vh::EXCEPTION _, ... }, symbolmapstack)
=>
{ pp.box' 0 -1 {. pp.rulename "lpv3";
#
pp.txt "exception ";
uj::unparse_symbol pp name;
if (mtt::is_arrow_type typoid)
#
pp.txt " ";
latex_print_some_type symbolmapstack pp (mtt::domain typoid);
fi;
pp.endlit ";";
};
};
latex_print_constructor (con, symbolmapstack)
=>
{ exception HIDDEN;
#
visible_valcon_type
=
{ type = tys::sumtype_to_type con;
( tys::type_equality (
fis::find_type_via_symbol_path
( symbolmapstack,
syp::SYMBOL_PATH
[ ip::last (tys::namepath_of_type type) ],
\\ _ = raise exception HIDDEN
),
type
)
except
HIDDEN = FALSE
);
};
if (*internals
or
not visible_valcon_type
)
pp.box' 0 -1 {. pp.rulename "lpv4";
pp.txt "con ";
latex_print_sumtype (symbolmapstack, con) pp;
pp.endlit ";";
};
fi;
};
end;
end;
fun latex_print_var (pp:Pp) (vac::PLAIN_VARIABLE { varhome, path, ... } )
=>
{ pp.txt (syp::to_string path);
#
if *internals
latex_print_varhome pp varhome;
fi;
};
latex_print_var pp (vac::OVERLOADED_VARIABLE { name, ... } )
=>
uj::unparse_symbol pp (name);
latex_print_var (pp:Pp) (errorvar)
=>
pp.lit "<errorvar>";
end;
fun latex_print_debug_var (pp:Pp) symbolmapstack
=
{
latex_print_varhome = latex_print_varhome pp;
latex_print_inlining_data = latex_print_inlining_data pp symbolmapstack;
fun latexprintdebugvar (vac::PLAIN_VARIABLE { varhome, path, vartypoid_ref, inlining_data } )
=>
{ pp.box' 0 -1 {. pp.rulename "lpv5";
pp.lit "vac::PLAIN_VARIABLE";
pp.box {. pp.rulename "lpv6";
pp.lit "( { varhome="; latex_print_varhome varhome; pp.txt ", \n";
pp.lit "inlining_data="; latex_print_inlining_data inlining_data; pp.txt ", \n";
pp.lit "path="; pp.lit (syp::to_string path); pp.txt ", \n";
pp.lit "vartypoid_ref=REF "; latex_print_some_type symbolmapstack pp *vartypoid_ref;
pp.endlit "} )";
};
};
};
latexprintdebugvar (vac::OVERLOADED_VARIABLE { name, alternatives, typescheme } )
=>
{ pp.box' 0 -1 {. pp.rulename "lpv7";
pp.lit "vac::OVERLOADED_VARIABLE";
pp.box {. pp.rulename "lpv8";
pp.lit "( { name="; uj::unparse_symbol pp (name); pp.txt ", \n";
pp.lit "alternatives=[";
(uj::ppvseq pp 0 ", "
(\\ pp = \\ { indicator, variant } =
{ pp.lit "{ indicator="; latex_print_some_type symbolmapstack pp indicator;
pp.txt ", \n";
pp.lit " variant =";
latex_print_debug_var pp symbolmapstack variant;
pp.lit "}";
pp.cut ();
}
)
*alternatives);
pp.lit "]";
pp.txt ", \n";
pp.lit "typescheme=";
latex_print_typescheme symbolmapstack pp typescheme;
pp.lit "} )";
};
};
};
latexprintdebugvar errorvar
=>
pp.lit "<ERRORvar>";
end;
latexprintdebugvar;
};
fun latex_print_variable (pp:Pp)
=
latexprintvariable
where
#
fun latexprintvariable ( symbolmapstack: syx::Symbolmapstack,
vac::PLAIN_VARIABLE { path, varhome, vartypoid_ref, inlining_data }
)
=>
{ pp.box' 0 -1 {. pp.rulename "lpv9";
pp.lit (syp::to_string path);
if *internals
latex_print_varhome pp varhome;
#
pp.lit "inlining_data =>";
pp.txt " ";
latex_print_inlining_data pp symbolmapstack inlining_data;
fi;
pp.txt ": ";
latex_print_some_type symbolmapstack pp *vartypoid_ref;
pp.endlit ";";
};
};
latexprintvariable (symbolmapstack, vac::OVERLOADED_VARIABLE { name, alternatives, typescheme=>TYPESCHEME { body, ... } } )
=>
{ pp.box' 0 -1 {. pp.rulename "lpv10";
uj::unparse_symbol pp name;
pp.txt ": ";
latex_print_some_type symbolmapstack pp body;
pp.txt " as ";
uj::unparse_sequence pp { separator => (\\ pp = pp::break pp { blanks=>1, indent_on_wrap=>0 }),
print_one => (\\ pp = \\ { variant, ... } = latexprintvariable (symbolmapstack, variant)),
breakstyle => uj::ALIGN
}
*alternatives;
pp.endlit ";";
};
};
latexprintvariable (_, errorvar)
=>
pp.lit "<ERRORvar>;";
end;
end;
}; # package latex_print_value
end; # stipulate