## yprint-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 = 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 Print_Value_As_Lib7 {
#
print_datatyp_represetation_as_nada: pp::Stream
-> vh::Valcon_Form
-> Void;
print_varhome_as_nada: pp::Stream -> vh::Varhome -> Void;
print_dcon_as_nada: pp::Stream -> ty::Valcon -> Void;
print_var_as_nada: pp::Stream -> vac::Variable -> Void;
print_debug_decon_as_nada: pp::Stream
-> syx::Symbolmapstack
-> ty::Valcon
-> Void;
print_debug_var_as_nada: (id::Inlining_Data -> String)
-> pp::Stream
-> 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 = 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# package id = inlining_data; # inlining_data is from src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg include prettyprint;
include print_as_nada_junk;
include variables_and_constructors;
include 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;
fun by f x y
=
f y x;
pps = pp::string;
print_type_as_nada = print_type_as_nada::print_type_as_nada;
print_typ_as_nada = print_type_as_nada::print_typ_as_nada;
print_tyfun_as_nada = print_type_as_nada::print_tyfun_as_nada;
fun print_varhome_as_nada stream a
=
pps stream (" [" + (vh::print_varhome a) + "]");
fun print_inlining_info_as_nada inlining_info_to_string stream a
=
pps stream (" [" + (inlining_info_to_string a) + "]");
fun print_datatyp_represetation_as_nada stream representation
=
pp::string stream (vh::print_representation representation);
fun print_csig_as_nada stream csig
=
pp::string stream (vh::print_constructor_api csig);
fun print_dcon_as_nada stream
=
{ fun print_dcon_as_nada' ( VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ print_symbol_as_nada stream name;
if *internals
print_varhome_as_nada stream acc;
fi;
};
print_dcon_as_nada' (VALCON { name, ... } )
=>
print_symbol_as_nada stream name;
end;
print_dcon_as_nada';
};
fun print_debug_decon_as_nada stream dictionary (VALCON { name, form, is_constant, type, signature, is_lazy } )
=
{ (en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
print_symbol_as_nada
=
print_symbol_as_nada stream;
begin_horizontal_else_vertical_box 3;
pps "VALCON";
break { spaces=>0, indent_on_wrap=>0 };
pps "{ name = "; print_symbol_as_nada name; print_comma_newline_as_nada stream;
pps "is_constant = "; pps (bool::to_string is_constant); print_comma_newline_as_nada stream;
pps "type = "; print_type_as_nada dictionary stream type; print_comma_newline_as_nada stream;
pps "is_lazy = "; pps (bool::to_string is_lazy); print_comma_newline_as_nada stream;
pps "Valcon_Form =";
print_datatyp_represetation_as_nada stream form;
print_comma_newline_as_nada stream;
pps "signature = ["; print_csig_as_nada stream signature; pps "] }";
end_box()
;};
fun print_datatyp_as_nada
(
dictionary: syx::Symbolmapstack,
VALCON { name, type, ... }
)
stream
=
{ (en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
#
begin_wrap_box 0;
print_symbol_as_nada stream name; pps " : "; print_type_as_nada dictionary stream type;
end_box()
;};
fun print_con_naming_as_nada stream
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... }
=
en_pp stream;
fun print_constructor_as_nada (VALCON { name, type, form=>vh::EXCEPTION _, ... }, dictionary)
=>
{ begin_horizontal_else_vertical_box 0;
pps "exception "; print_symbol_as_nada stream name;
if (type_types::is_arrow_type type)
# pps " of ";
pps " ";
print_type_as_nada dictionary stream (type_types::domain type);
fi;
end_box();
};
print_constructor_as_nada (con, dictionary)
=>
{ exception HIDDEN;
visible_dcon_typ
=
{ typ = tys::datatyp_to_typ con;
( type_junk::typ_equality (
fis::find_typ_via_symbol_path
( dictionary,
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 ";
print_datatyp_as_nada (dictionary, con) stream;
end_box ();
fi;
};
end;
print_constructor_as_nada;
};
fun print_var_as_nada stream (ORDINARY_VARIABLE { varhome, path, ... } )
=>
{ pps stream (symbol_path::to_string path);
if *internals print_varhome_as_nada stream varhome; fi;
};
print_var_as_nada stream (OVERLOADED_IDENTIFIER { name, ... } )
=>
print_symbol_as_nada stream (name);
print_var_as_nada stream (errorvar)
=>
pp::string stream "<errorvar>";
end;
fun print_debug_var_as_nada inlining_info_to_string stream dictionary
=
{ (en_pp stream)
->
{ begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
print_varhome_as_nada = print_varhome_as_nada stream;
print_inlining_info_as_nada = print_inlining_info_as_nada inlining_info_to_string stream;
fun print_debug_var_as_nada' (ORDINARY_VARIABLE { varhome, path, var_type, inlining_data } )
=>
{ begin_horizontal_else_vertical_box 0;
pps "ORDINARY_VARIABLE";
begin_horizontal_else_vertical_box 3;
pps "( { varhome="; print_varhome_as_nada varhome; print_comma_newline_as_nada stream;
pps "inlining_data="; print_inlining_info_as_nada inlining_data; print_comma_newline_as_nada stream;
pps "path="; pps (symbol_path::to_string path); print_comma_newline_as_nada stream;
pps "var_type=REF "; print_type_as_nada dictionary stream *var_type;
pps "} )";
end_box();
end_box();
};
print_debug_var_as_nada' (OVERLOADED_IDENTIFIER { name, alternatives, type_scheme } )
=>
{ begin_horizontal_else_vertical_box 0;
pps "OVERLOADED_IDENTIFIER";
begin_horizontal_else_vertical_box 3;
pps "( { name="; print_symbol_as_nada stream (name); print_comma_newline_as_nada stream;
pps "alternatives=[";
(ppvseq stream 0 ", "
(fn stream = fn { indicator, variant } =
{ pps "{ indicator=";print_type_as_nada dictionary stream indicator;
print_comma_newline_as_nada stream;
pps " variant =";
print_debug_var_as_nada inlining_info_to_string stream dictionary variant; pps "}";}
)
*alternatives);
pps "]"; print_comma_newline_as_nada stream;
pps "type_scheme="; print_tyfun_as_nada dictionary stream type_scheme; pps "} )";
end_box();
end_box();
};
print_debug_var_as_nada' errorvar
=>
pps "<ERRORvar>";
end;
print_debug_var_as_nada';
};
# Is this ever called?
fun print_variable_as_nada stream
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... } = en_pp stream;
fun print_variable_as_nada' ( dictionary: syx::Symbolmapstack,
ORDINARY_VARIABLE { path, varhome, var_type, inlining_data }
)
=>
{ begin_horizontal_else_vertical_box 0;
pps (symbol_path::to_string path);
if *internals print_varhome_as_nada stream varhome; fi;
pps " : "; print_type_as_nada dictionary stream (*var_type);
end_box ();
};
print_variable_as_nada' (dictionary, OVERLOADED_IDENTIFIER { name, alternatives, type_scheme=>TYPE_SCHEME { body, ... } } )
=>
{ begin_horizontal_else_vertical_box 0;
print_symbol_as_nada stream (name); pps " : "; print_type_as_nada dictionary stream body;
pps " as ";
print_sequence_as_nada
stream
{ sep => by pp::break { spaces=>1, indent_on_wrap=>0 },
pr => (fn stream = fn { variant, ... } = print_variable_as_nada'(dictionary, variant)),
style => CONSISTENT
}
*alternatives;
end_box();
};
print_variable_as_nada'(_, errorvar) => pps "<ERRORvar>";
end;
print_variable_as_nada';
};
}; # package print_value_as_nada
end; # stipulate