## unparse-junk.pkg
# Compiled by:
# src/lib/compiler/front/typer/typer.sublibstipulate
package s: (weak) Symbol # Symbol is from src/lib/compiler/front/basics/map/symbol.api = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package pp = prettyprint; # prettyprint is from src/lib/prettyprint/big/src/prettyprint.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package sp = symbol_path; # symbol_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkgherein
package unparse_junk
: (weak) Unparse_Junk # Unparse_Junk is from src/lib/compiler/front/typer/print/unparse-junk.api {
pps = pp::string;
fun unparse_sequence0 ppstream ( sep: pp::Stream -> Void, pr, elems)
=
pr_elems elems
where
fun pr_elems [el]
=>
pr ppstream el;
pr_elems (el ! rest)
=>
{ pr ppstream el;
sep ppstream;
pr_elems rest;
};
pr_elems []
=>
();
end;
end;
Break_Style
=
CONSISTENT | INCONSISTENT;
fun open_style_box style
=
case style
CONSISTENT => pp::begin_indented_horizontal_else_vertical_box;
INCONSISTENT => pp::begin_indented_wrap_box;
esac;
fun unparse_sequence
ppstream
{ sep: pp::Stream -> Void,
pr: pp::Stream -> X -> Void,
style: Break_Style
}
(elems: List(X))
=
{ open_style_box style ppstream (pp::CURSOR_RELATIVE 0);
unparse_sequence0 ppstream (sep, pr, elems);
pp::end_box ppstream;
};
fun unparse_closed_sequence
ppstream
{ front: pp::Stream -> Void,
sep: pp::Stream -> Void,
back: pp::Stream -> Void,
pr: pp::Stream -> X -> Void,
style: Break_Style
}
(elems: List(X))
=
{ pp::begin_horizontal_else_vertical_box ppstream;
front ppstream;
open_style_box style ppstream (pp::CURSOR_RELATIVE 0);
unparse_sequence0 ppstream (sep, pr, elems);
pp::end_box ppstream;
back ppstream;
pp::end_box ppstream;
};
fun unparse_symbol ppstream (s: s::Symbol)
=
pp::string ppstream (s::name s);
string_depth = control_print::string_depth;
heap_string = print_junk::heap_string;
fun unparse_mlstring' ppstream = pp::string ppstream o print_junk::print_heap_string';
fun unparse_mlstring ppstream = pp::string ppstream o print_junk::print_heap_string;
fun unparse_integer ppstream = pp::string ppstream o print_junk::print_integer;
fun ppvseq ppstream indent (separator: String) pr elements
=
{ fun print_elements [element]
=>
pr ppstream element;
print_elements (element ! rest)
=>
{ pr ppstream element;
pp::string ppstream separator;
pp::newline ppstream;
print_elements rest;
};
print_elements []
=>
();
end;
pp::begin_indented_horizontal_else_vertical_box ppstream (pp::CURSOR_RELATIVE indent);
print_elements elements;
pp::end_box ppstream;
};
fun ppvlist stream (header, separator, print_item, items)
=
case items
NIL => ();
first ! rest
=>
{ pp::string stream header;
print_item stream first;
apply
(fn x
=
{ pp::newline stream;
pp::string stream separator;
print_item stream x;
}
)
rest;
};
esac;
fun ppvlist' stream (header, separator, print_item, items)
=
case items
NIL => ();
first ! rest
=>
{ print_item stream header first;
apply
(fn x
=
{ pp::newline stream;
print_item stream separator x;
}
)
rest;
};
esac;
# Debug print functions
fun unparse_int_path ppstream
=
unparse_closed_sequence
ppstream
{ front => (fn pps = pp::string pps "["),
sep => (fn pps = { pp::string pps ", "; pp::break pps { spaces=>0, indent_on_wrap=>0 }; } ),
back => (fn pps = pp::string pps "]"),
style => INCONSISTENT,
pr => (fn pps = pp::string pps o int::to_string)
};
fun unparse_symbol_path ppstream (sp: symbol_path::Symbol_Path)
=
pp::string ppstream (symbol_path::to_string sp);
fun unparse_inverse_path ppstream (inverse_path::INVERSE_PATH path: inverse_path::Inverse_Path)
=
unparse_closed_sequence
ppstream
{ front => (fn pps = pp::string pps "<"),
sep => (fn pps = (pp::string pps ".")),
back => (fn pps = pp::string pps ">"),
style => INCONSISTENT,
pr => unparse_symbol
}
path;
/* find_path: Convert inverse symbolic path names
to a printable string in the context
of a dictionary.
Its arguments are the inverse symbolic path, a check predicate on static
semantic values, and a lookup function mapping paths to their namings
(if any) in an dictionary and raising Dictionary::UNBOUND on paths with no
naming.
It looks up each suffix of the path name, going from shortest to longest
suffix, in the current dictionary until it finds one whose lookup value
satisfies the check predicate. It then converts that suffix to a string.
If it doesn't find any suffix, the full path (reversed, i.e. in the
normal order) and the boolean value FALSE are returned, otherwise the
suffix and TRUE are returned.
Example:
Given a::b::t as a path, and a lookup function for an
dictionary, this function tries:
t
b::t
a::b::t
If none of these work, it returns ?.a::b::t
Note: the symbolic path is passed in reverse order because that is
the way all symbolic path names are stored within static semantic chunks.
*/
result_id = s::make_package_symbol "<result_package>";
return_id = s::make_package_symbol "<return_package>";
fun find_path (ip::INVERSE_PATH p: ip::Inverse_Path, check, get): ( (List( s::Symbol ), Bool))
=
{ fun try (name ! untried, tried)
=>
( if ((s::eq (name, result_id)) or (s::eq (name, return_id)))
try (untried, tried);
else
{ element = get (sp::SYMBOL_PATH (name ! tried));
if (check element)
(name ! tried, TRUE);
else try (untried, name ! tried);
fi;
}
except
symbolmapstack::UNBOUND
=
try (untried, name ! tried);
fi
);
try([], tried)
=>
(tried, FALSE);
end;
try (p, []);
};
fun unparse_int stream (i: Int)
=
pps stream (int::to_string i);
fun unparse_comma stream
=
pps stream ", ";
fun unparse_comma_newline stream
=
{ unparse_comma stream;
pp::newline stream;
};
fun newline_indent stream i
=
{ linewidth = 10000;
pp::break stream { spaces => linewidth, indent_on_wrap => i };
};
fun newline_apply stream f
=
g
where
fun g [] => ();
g [element] => f stream element;
g (element ! rest) => { f stream element; pp::newline stream; g rest;};
end;
end;
fun break_apply stream f
=
g
where
fun g [] => ();
g [el] => f stream el;
g (el ! rest) => { f stream el; pp::break stream { spaces=>1, indent_on_wrap=>0 }; g rest;};
end;
end;
# For conciseness, construct and return versions
# of the common prettyprint fns in which 'stream'
# is implicit:
fun en_pp stream # "en" for ... "enclose" ...?
=
{ begin_horizontal_else_vertical_box => (fn indent = pp::begin_indented_horizontal_else_vertical_box stream (pp::CURSOR_RELATIVE indent)), # CONSISTENT
begin_wrap_box => (fn indent = pp::begin_indented_wrap_box stream (pp::CURSOR_RELATIVE indent)), # INCONSISTENT
end_box => .{ pp::end_box stream; } ,
pps => pp::string stream,
break => fn nsp_offset = pp::break stream nsp_offset,
newline => .{ pp::newline stream; }
};
fun unparse_array stream ( f: pp::Stream -> X -> Void,
a: Rw_Vector(X)
)
=
{ my { begin_horizontal_else_vertical_box, begin_wrap_box, pps, break, end_box, ... }
=
en_pp stream;
fun loop i
=
{ element
=
rw_vector::get (a, i);
pps (int::to_string i);
pps ": ";
f stream element;
break { spaces=>1, indent_on_wrap=>0 };
loop (i+1);
};
begin_wrap_box 0;
loop 0
except
(exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) = ();
end_box();
};
fun by f x y
=
f y x;
fun unparse_tuple stream f
=
unparse_closed_sequence
stream
{ front => by pps "(",
back => by pps ")",
pr => f,
style => INCONSISTENT,
sep => fn stream = { pps stream ", ";
pp::break stream { spaces=>0, indent_on_wrap=>0 };
}
};
}; # package unparse_junk
end;