## print-value-as-nada.pkg
#
# Modified to use Lib7 Lib pp. [dbm, 7/30/03])
# Compiled by:
# src/lib/compiler/front/typer/typer.sublibstipulate
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 Print_Value_As_Lib7 {
#
print_sumtype_represetation_as_nada: pp::Prettyprinter
-> vh::Valcon_Form
-> Void;
print_varhome_as_nada: pp::Prettyprinter -> vh::Varhome -> Void;
print_valcon_as_nada: pp::Prettyprinter -> tdt::Valcon -> Void;
print_var_as_nada: pp::Prettyprinter -> vac::Variable -> Void;
print_debug_decon_as_nada: pp::Prettyprinter
-> syx::Symbolmapstack
-> tdt::Valcon
-> Void;
print_debug_var_as_nada: (id::Inlining_Data -> String)
-> pp::Prettyprinter
-> syx::Symbolmapstack
-> vac::Variable
-> Void;
}; # Api Print_Value_As_Lib7
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 = 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 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 package mtt = more_type_types; # more_type_types is from src/lib/compiler/front/typer/types/more-type-types.pkg# package id = inlining_data; # inlining_data is from src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg Pp = pp::Pp;
include package pp;
include package print_as_nada_junk;
include package variables_and_constructors;
include package type_declaration_types;
herein
package print_value_as_nada
: (weak) Print_Value_As_Lib7 # Print_Value_As_Lib7 is from src/lib/compiler/front/typer/print/print-value-as-nada.pkg {
# internals = typer_control::internals;
internals = log::internals;
fun by f x y
=
f y x;
# pps = pp::lit;
print_typoid_as_nada = print_typoid_as_nada::print_typoid_as_nada;
print_type_as_nada = print_typoid_as_nada::print_type_as_nada;
print_tyfun_as_nada = print_typoid_as_nada::print_tyfun_as_nada;
fun print_varhome_as_nada (pp:Pp) a
=
pp.lit (" [" + (vh::print_varhome a) + "]");
fun print_inlining_data_as_nada inlining_data_to_string (pp:Pp) a
=
pp.lit (" [" + (inlining_data_to_string a) + "]");
fun print_sumtype_represetation_as_nada pp representation
=
pp::lit pp (vh::print_representation representation);
fun print_csig_as_nada pp csig
=
pp::lit pp (vh::print_constructor_api csig);
fun print_valcon_as_nada pp
=
{ fun print_valcon_as_nada' ( VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ print_symbol_as_nada pp name;
if *internals
print_varhome_as_nada pp acc;
fi;
};
print_valcon_as_nada' (VALCON { name, ... } )
=>
print_symbol_as_nada pp name;
end;
print_valcon_as_nada';
};
fun print_debug_decon_as_nada pp dictionary (VALCON { name, form, is_constant, typoid, signature, is_lazy } )
=
{
print_symbol_as_nada
=
print_symbol_as_nada pp;
pp.box {.
pp.txt "VALCON ";
pp.lit "{ name = "; print_symbol_as_nada name; print_comma_newline_as_nada pp;
pp.lit "is_constant = "; pp.lit (bool::to_string is_constant); print_comma_newline_as_nada pp;
pp.lit "typoid = "; print_typoid_as_nada dictionary pp typoid; print_comma_newline_as_nada pp;
pp.lit "is_lazy = "; pp.lit (bool::to_string is_lazy); print_comma_newline_as_nada pp;
pp.lit "Valcon_Form =";
print_sumtype_represetation_as_nada pp form;
print_comma_newline_as_nada pp;
pp.lit "signature = ["; print_csig_as_nada pp signature; pp.lit "] }";
};
};
fun print_sumtype_as_nada
(
dictionary: syx::Symbolmapstack,
VALCON { name, typoid, ... }
)
pp
=
pp.wrap' 0 -1 {.
print_symbol_as_nada pp name;
pp.txt " : ";
print_typoid_as_nada dictionary pp typoid;
pp.cut ();
};
fun print_con_naming_as_nada pp
=
{
fun print_constructor_as_nada (VALCON { name, typoid, form=>vh::EXCEPTION _, ... }, dictionary)
=>
{ pp.box' 0 -1 {.
#
pp.txt "exception "; print_symbol_as_nada pp name;
if (mtt::is_arrow_type typoid)
#
# pp.txt " of ";
pp.txt " ";
print_typoid_as_nada dictionary pp (mtt::domain typoid);
fi;
};
};
print_constructor_as_nada (con, dictionary)
=>
{ exception HIDDEN;
#
visible_valcon_type
=
{ type = tys::sumtype_to_type con;
#
( type_junk::type_equality (
#
fis::find_type_via_symbol_path
#
( dictionary,
symbol_path::SYMBOL_PATH
[ inverse_path::last (type_junk::namepath_of_type type) ],
\\ _ = raise exception HIDDEN
),
type
)
except HIDDEN = FALSE
);
};
if (*internals
or
not visible_valcon_type
)
pp.box' 0 -1 {.
pp.lit "con ";
print_sumtype_as_nada (dictionary, con) pp;
};
fi;
};
end;
print_constructor_as_nada;
};
fun print_var_as_nada pp (PLAIN_VARIABLE { varhome, path, ... } )
=>
{ pp.lit (symbol_path::to_string path);
#
if *internals print_varhome_as_nada pp varhome; fi;
};
print_var_as_nada pp (OVERLOADED_VARIABLE { name, ... } )
=>
print_symbol_as_nada pp (name);
print_var_as_nada pp (errorvar)
=>
pp.lit "<errorvar>";
end;
fun print_debug_var_as_nada inlining_data_to_string pp dictionary
=
{
print_varhome_as_nada = print_varhome_as_nada pp;
print_inlining_data_as_nada = print_inlining_data_as_nada inlining_data_to_string pp;
fun print_debug_var_as_nada' (PLAIN_VARIABLE { varhome, path, vartypoid_ref, inlining_data } )
=>
{ pp.box' 0 -1 {.
pp.lit "PLAIN_VARIABLE";
pp.box {.
pp.lit "( { varhome="; print_varhome_as_nada varhome; print_comma_newline_as_nada pp;
pp.lit "inlining_data="; print_inlining_data_as_nada inlining_data; print_comma_newline_as_nada pp;
pp.lit "path="; pp.lit (symbol_path::to_string path); print_comma_newline_as_nada pp;
pp.lit "vartypoid_ref=REF "; print_typoid_as_nada dictionary pp *vartypoid_ref;
pp.lit "} )";
};
};
};
print_debug_var_as_nada' (OVERLOADED_VARIABLE { name, alternatives, typescheme } )
=>
{ pp.box' 0 -1 {.
pp.lit "OVERLOADED_VARIABLE";
pp.box {.
pp.lit "( { name="; print_symbol_as_nada pp (name); print_comma_newline_as_nada pp;
pp.lit "alternatives=[";
(ppvseq pp 0 ", "
(\\ pp = \\ { indicator, variant } =
{ pp.lit "{ indicator=";print_typoid_as_nada dictionary pp indicator;
print_comma_newline_as_nada pp;
pp.lit " variant =";
print_debug_var_as_nada inlining_data_to_string pp dictionary variant; pp.lit "}";}
)
*alternatives);
pp.lit "]"; print_comma_newline_as_nada pp;
pp.lit "typescheme="; print_tyfun_as_nada dictionary pp typescheme;
pp.lit "} )";
};
};
};
print_debug_var_as_nada' errorvar
=>
pp.lit "<ERRORvar>";
end;
print_debug_var_as_nada';
};
# Is this ever called?
fun print_variable_as_nada pp
=
{
fun print_variable_as_nada' ( dictionary: syx::Symbolmapstack,
PLAIN_VARIABLE { path, varhome, vartypoid_ref, inlining_data }
)
=>
{ pp.box' 0 -1 {.
pp.lit (symbol_path::to_string path);
if *internals print_varhome_as_nada pp varhome; fi;
pp.txt " : "; print_typoid_as_nada dictionary pp (*vartypoid_ref);
};
};
print_variable_as_nada' (dictionary, OVERLOADED_VARIABLE { name, alternatives, typescheme=>TYPESCHEME { body, ... } } )
=>
{ pp.box' 0 -1 {.
print_symbol_as_nada pp (name); pp.txt " : "; print_typoid_as_nada dictionary pp body;
pp.txt " as ";
print_sequence_as_nada
pp
{ sep => \\ pp = pp.txt " ",
pr => \\ pp = \\ { variant, ... } = print_variable_as_nada' (dictionary, variant),
style => CONSISTENT
}
*alternatives;
};
};
print_variable_as_nada'(_, errorvar)
=>
pp.lit "<ERRORvar>";
end;
print_variable_as_nada';
};
}; # package print_value_as_nada
end; # stipulate