## unparse-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 Unparse_Value {
unparse_constructor_representation: pp::Prettyprinter
-> vh::Valcon_Form
-> Void;
unparse_varhome: pp::Prettyprinter -> vh::Varhome -> Void;
unparse_valcon: pp::Prettyprinter -> tdt::Valcon -> Void;
unparse_var: pp::Prettyprinter -> vac::Variable -> Void;
unparse_variable
:
pp::Prettyprinter
-> (syx::Symbolmapstack, vac::Variable)
-> Void
;
unparse_debug_valcon
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> tdt::Valcon
-> Void
;
unparse_constructor
:
pp::Prettyprinter
-> syx::Symbolmapstack
-> tdt::Valcon
-> Void
;
unparse_debug_var
:
(id::Inlining_Data -> String)
-> pp::Prettyprinter
-> syx::Symbolmapstack
-> vac::Variable
-> Void
;
}; # Api Unparse_Value
end;
stipulate
package fis = find_in_symbolmapstack; # find_in_symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package mtt = more_type_types; # more_type_types is from src/lib/compiler/front/typer/types/more-type-types.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 tc = typer_control; # typer_control is from src/lib/compiler/front/typer/basics/typer-control.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package tys = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg package uj = unparse_junk; # unparse_junk is from src/lib/compiler/front/typer/print/unparse-junk.pkg package ut = unparse_type; # unparse_type is from src/lib/compiler/front/typer/print/unparse-type.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# package id = inlining_data; # inlining_data is from src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg Pp = pp::Pp;
unparse_typoid = ut::unparse_typoid;
unparse_type = ut::unparse_type;
unparse_typescheme = ut::unparse_typescheme;
herein
package unparse_value
: (weak) Unparse_Value
{
# internals = tc::internals;
internals = log::internals;
fun by f x y
=
f y x;
fun unparse_varhome (pp:Pp) a
=
pp.lit ( " ["
+ (vh::print_varhome a)
+ "]"
);
fun unparse_inlining_data inlining_data_to_string (pp:Pp) a
=
pp.lit (" [" + (inlining_data_to_string a) + "]");
fun unparse_constructor_representation (pp:Pp) representation
=
pp.lit (vh::print_representation representation);
fun unparse_csig (pp:Pp) csig
=
pp.lit (vh::print_constructor_api csig);
fun unparse_valcon (pp:Pp)
=
unparse_d
where
fun unparse_d ( tdt::VALCON { name, form => vh::EXCEPTION acc, ... } )
=>
{ uj::unparse_symbol pp name;
#
if *internals unparse_varhome pp acc; fi;
};
unparse_d (tdt::VALCON { name, ... } )
=>
uj::unparse_symbol pp name;
end;
end;
fun unparse_debug_valcon (pp:Pp) symbolmapstack (tdt::VALCON { name, form, is_constant, typoid, signature, is_lazy } )
=
{ unparse_symbol = uj::unparse_symbol pp;
#
pp.box {. pp.rulename "uvb1";
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 = "; unparse_typoid 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 =";
unparse_constructor_representation
pp
form;
pp.txt ", \n";
pp.lit "signature = [";
unparse_csig pp signature;
pp.lit "] }";
};
};
fun unparse_constructor (pp:Pp) symbolmapstack (tdt::VALCON { name, form, is_constant, typoid, signature, is_lazy } )
=
{ unparse_symbol = uj::unparse_symbol pp;
#
pp.box {. pp.rulename "uvb2";
unparse_symbol name;
pp.lit " : ";
unparse_typoid symbolmapstack pp typoid;
};
};
fun unparse_sumtype
(
symbolmapstack: syx::Symbolmapstack,
tdt::VALCON { name, typoid, ... }
)
pp
=
pp.wrap' 0 -1 {. pp.rulename "uvw1";
uj::unparse_symbol pp name;
pp.lit " : ";
unparse_typoid symbolmapstack pp typoid;
};
# Is this ever used?
fun unparse_con_naming pp
=
unparse_constructor
where
fun unparse_constructor (tdt::VALCON { name, typoid, form=>vh::EXCEPTION _, ... }, symbolmapstack)
=>
{ pp.box' 0 -1 {. pp.rulename "uvb3";
#
pp.lit "exception ";
uj::unparse_symbol pp name;
if (mtt::is_arrow_type typoid)
#
pp.lit " ";
unparse_typoid symbolmapstack pp (mtt::domain typoid);
fi;
pp.endlit ";";
};
};
unparse_constructor (con, symbolmapstack)
=>
{ exception HIDDEN;
#
visible_valcon_type
=
{ type = tys::sumtype_to_type con;
( type_junk::type_equality (
fis::find_type_via_symbol_path
( symbolmapstack,
syp::SYMBOL_PATH
[ ip::last (type_junk::namepath_of_type type) ],
\\ _ = raise exception HIDDEN
),
type
)
except
HIDDEN = FALSE
);
};
if (*internals
or
not visible_valcon_type
)
pp.wrap' 0 -1 {. pp.rulename "uvw2";
pp.lit "con ";
unparse_sumtype (symbolmapstack, con) pp;
pp.endlit ";";
};
fi;
};
end;
end;
fun unparse_var pp (vac::PLAIN_VARIABLE { varhome, path, ... } )
=>
{ pp.lit (syp::to_string path);
#
if *internals
unparse_varhome pp varhome;
fi;
};
unparse_var pp (vac::OVERLOADED_VARIABLE { name, ... } )
=>
uj::unparse_symbol pp (name);
unparse_var pp (errorvar)
=>
pp.lit "<errorvar>";
end;
fun unparse_debug_var inlining_data_to_string pp symbolmapstack
=
{ unparse_varhome = unparse_varhome pp;
unparse_inlining_data = unparse_inlining_data inlining_data_to_string pp;
fun unparsedebugvar (vac::PLAIN_VARIABLE { varhome, path, vartypoid_ref, inlining_data } )
=>
{ pp.box' 0 -1 {. pp.rulename "uvb4";
#
pp.lit "PLAIN_VARIABLE";
pp.box {. pp.rulename "uvb4b";
#
pp.lit "( { varhome="; unparse_varhome varhome; pp.txt ", \n";
pp.lit "inlining_data="; unparse_inlining_data inlining_data; pp.txt ", \n";
pp.lit "path="; pp.lit (syp::to_string path); pp.txt ", \n";
pp.lit "vartypoid_ref=REF "; unparse_typoid symbolmapstack pp *vartypoid_ref;
pp.lit "} )";
};
};
};
unparsedebugvar (vac::OVERLOADED_VARIABLE { name, alternatives, typescheme } )
=>
{ pp.box' 0 -1 {. pp.rulename "uvb5";
#
pp.lit "vac::OVERLOADED_VARIABLE";
pp.box {. pp.rulename "uvb5b";
#
pp.lit "( { name="; uj::unparse_symbol pp (name); pp.txt ", \n";
pp.lit "alternative=[";
(uj::ppvseq pp 0 ", "
(\\ pp = \\ { indicator, variant }
=
{ pp.lit "{ indicator="; unparse_typoid symbolmapstack pp indicator;
pp.txt ", \n";
pp.lit " variant =";
unparse_debug_var inlining_data_to_string pp symbolmapstack variant;
pp.lit "}";
}
)
*alternatives);
pp.lit "]";
pp.txt ", \n";
pp.lit "typescheme=";
unparse_typescheme symbolmapstack pp typescheme;
pp.lit "} )";
};
};
};
unparsedebugvar (errorvar) => pp.lit "<ERRORvar>";
end;
unparsedebugvar;
};
fun unparse_variable pp
=
unparse_variable'
where
fun unparse_variable'
(
symbolmapstack: syx::Symbolmapstack,
vac::PLAIN_VARIABLE { path, varhome, vartypoid_ref, inlining_data }
)
=>
{ pp.box' 0 -1 {. pp.rulename "uvb6";
#
pp.lit (syp::to_string path);
if *internals
unparse_varhome pp varhome;
fi;
pp.lit ": ";
unparse_typoid symbolmapstack pp *vartypoid_ref;
pp.endlit ";";
};
};
unparse_variable'
(
symbolmapstack,
vac::OVERLOADED_VARIABLE { name, alternatives=>REF alternatives, typescheme=>tdt::TYPESCHEME { body, ... } }
)
=>
{ pp.box' 0 -1 {. pp.rulename "uvb7";
uj::unparse_symbol pp (name);
pp.lit ": ";
unparse_typoid symbolmapstack pp body;
pp.lit " as ";
uj::unparse_sequence
pp
{ separator => \\ pp = pp.txt " ",
print_one => \\ pp = \\ { variant, ... } = unparse_variable' (symbolmapstack, variant),
breakstyle => uj::ALIGN
}
alternatives;
pp.endlit ";";
};
};
unparse_variable' (_, errorvar)
=>
pp.lit "<ERRORvar>;";
end;
end;
}; # package unparse_value
end; # stipulate