## unparse-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 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 Unparse_Value {
unparse_constructor_representation: pp::Stream
-> vh::Valcon_Form
-> Void;
unparse_varhome: pp::Stream -> vh::Varhome -> Void;
unparse_dcon: pp::Stream -> ty::Valcon -> Void;
unparse_var: pp::Stream -> vac::Variable -> Void;
unparse_variable
:
pp::Stream
->
(syx::Symbolmapstack, vac::Variable)
->
Void;
unparse_debug_dcon
:
pp::Stream
-> syx::Symbolmapstack
-> ty::Valcon
-> Void;
unparse_constructor
:
pp::Stream
-> syx::Symbolmapstack
-> ty::Valcon
-> Void;
unparse_debug_var
:
(id::Inlining_Data -> String)
-> pp::Stream
-> syx::Symbolmapstack
-> vac::Variable
-> Void;
}; # Api Unparse_Value
end;
stipulate
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 fis = find_in_symbolmapstack; # find_in_symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkg # unparse_type is from src/lib/compiler/front/typer/print/unparse-type.pkg# package id = inlining_data; # inlining_data is from src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg include prettyprint;
include unparse_junk;
include variables_and_constructors;
include types;
herein
package unparse_value
: (weak) Unparse_Value
{
internals = typer_control::internals;
fun by f x y
=
f y x;
pps = pp::string;
unparse_type = unparse_type::unparse_type;
unparse_typ = unparse_type::unparse_typ;
unparse_type_scheme = unparse_type::unparse_type_scheme;
fun unparse_varhome stream a
=
pps stream ( " ["
+ (vh::print_varhome a)
+ "]"
);
fun unparse_inlining_data inlining_info_to_string stream a
=
pps stream (" [" + (inlining_info_to_string a) + "]");
fun unparse_constructor_representation stream representation
=
pp::string stream (vh::print_representation representation);
fun unparse_csig stream csig
=
pp::string stream (vh::print_constructor_api csig);
fun unparse_dcon stream
=
unparse_d
where
fun unparse_d ( VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ unparse_symbol stream name;
if *internals unparse_varhome stream acc; fi;
};
unparse_d (VALCON { name, ... } )
=>
unparse_symbol stream name;
end;
end;
fun unparse_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 = "; unparse_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 =";
unparse_constructor_representation
stream
form;
unparse_comma_newline stream;
pps "signature = ["; unparse_csig stream signature; pps "] }";
end_box ();
};
fun unparse_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 " : ";
unparse_type symbolmapstack stream type;
end_box ();
};
fun unparse_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 " : ";
unparse_type symbolmapstack stream type;
end_box ();
};
# Is this ever used?
fun unparse_con_naming stream
=
unparse_constructor
where
(en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
fun unparse_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 " ";
unparse_type symbolmapstack stream (type_types::domain type);
};
fi;
pps ";";
end_box();
};
unparse_constructor (con, symbolmapstack)
=>
{ exception HIDDEN;
visible_dcon_typ
=
{ typ = tys::datatyp_to_typ con;
( type_junk::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 ";
unparse_datatyp (symbolmapstack, con) stream;
pps ";";
end_box ();
fi;
};
end;
end;
fun unparse_var stream (ORDINARY_VARIABLE { varhome, path, ... } )
=>
{ pps stream (symbol_path::to_string path);
if *internals
unparse_varhome stream varhome;
fi;
};
unparse_var stream (OVERLOADED_IDENTIFIER { name, ... } )
=>
unparse_symbol stream (name);
unparse_var stream (errorvar)
=>
pp::string stream "<errorvar>";
end;
fun unparse_debug_var inlining_info_to_string stream symbolmapstack
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... }
=
en_pp stream;
unparse_varhome = unparse_varhome stream;
unparse_inlining_data = unparse_inlining_data inlining_info_to_string stream;
fun unparsedebugvar (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="; unparse_varhome varhome; unparse_comma_newline stream;
pps "inlining_data="; unparse_inlining_data inlining_data; unparse_comma_newline stream;
pps "path="; pps (symbol_path::to_string path); unparse_comma_newline stream;
pps "var_type=REF "; unparse_type symbolmapstack stream *var_type;
pps "} )";
end_box();
end_box();
};
unparsedebugvar (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 "alternative=[";
(ppvseq stream 0 ", "
(fn stream = fn { indicator, variant }
=
{ pps "{ indicator="; unparse_type symbolmapstack stream indicator;
unparse_comma_newline stream;
pps " variant =";
unparse_debug_var inlining_info_to_string stream symbolmapstack variant; pps "}";
}
)
*alternatives);
pps "]"; unparse_comma_newline stream;
pps "type_scheme="; unparse_type_scheme symbolmapstack stream type_scheme; pps "} )";
end_box();
end_box();
};
unparsedebugvar (errorvar) => pps "<ERRORvar>";
end;
unparsedebugvar;
};
fun unparse_variable stream
=
unparse_variable'
where
(en_pp stream) -> { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
fun unparse_variable'
(
symbolmapstack: syx::Symbolmapstack,
ORDINARY_VARIABLE { path, varhome, var_type, inlining_data }
)
=>
{ begin_horizontal_else_vertical_box 0;
pps (symbol_path::to_string path);
if *internals
unparse_varhome stream varhome;
fi;
pps ": ";
unparse_type symbolmapstack stream *var_type;
pps ";";
end_box ();
};
unparse_variable'
(
symbolmapstack,
OVERLOADED_IDENTIFIER { name, alternatives=>REF alternatives, type_scheme=>TYPE_SCHEME { body, ... } }
)
=>
{ begin_horizontal_else_vertical_box 0;
unparse_symbol stream (name);
pps ": ";
unparse_type symbolmapstack stream body;
pps " as ";
unparse_sequence
stream
{ sep => by pp::break { spaces=>1, indent_on_wrap=>0 },
pr => (fn stream = fn { variant, ... } = unparse_variable' (symbolmapstack, variant)),
style => CONSISTENT
}
alternatives;
pps ";";
end_box();
};
unparse_variable' (_, errorvar)
=>
pps "<ERRORvar>;";
end;
end;
}; # package unparse_value
end; # stipulate