## 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 = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.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.pkg Pp = pp::Pp;
herein
package unparse_junk
: (weak) Unparse_Junk # Unparse_Junk is from src/lib/compiler/front/typer/print/unparse-junk.api {
fun unparse_sequence0 pp
(
separator: pp::Prettyprinter -> Void,
print_one,
elements
)
=
pr_elements elements
where
fun pr_elements [el]
=>
print_one pp el;
pr_elements (el ! rest)
=>
{ print_one pp el;
separator pp;
pr_elements rest;
};
pr_elements []
=>
();
end;
end;
Break_Style = ALIGN
| WRAP
;
fun open_style_box style pp indent
=
case style
#
ALIGN => pp::open_box (pp, indent, pp::normal, 100 );
WRAP => pp::open_box (pp, indent, pp::ragged_right, 100 );
esac;
fun unparse_sequence # This should be phased out, replaced by 'seq' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api pp
{ separator: pp::Prettyprinter -> Void,
print_one: pp::Prettyprinter -> X -> Void,
breakstyle: Break_Style
}
(elements: List(X))
=
{ open_style_box breakstyle pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
unparse_sequence0 pp (separator, print_one, elements);
pp::shut_box pp;
};
fun unparse_closed_sequence # This should be phased out, replaced by 'seq' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api pp
{ front: pp::Prettyprinter -> Void,
separator: pp::Prettyprinter -> Void,
back: pp::Prettyprinter -> Void,
print_one: pp::Prettyprinter -> X -> Void,
breakstyle: Break_Style
}
(elems: List(X))
=
{ pp.box {. pp.rulename "ujb1";
front pp;
open_style_box breakstyle pp (pp::typ::CURSOR_RELATIVE { blanks => 1, tab_to => 0, tabstops_are_every => 4 });
unparse_sequence0 pp (separator, print_one, elems);
pp::shut_box pp;
back pp;
};
};
fun unparse_symbol (pp:Pp) (s: s::Symbol)
=
pp.lit (s::name s);
string_depth = control_print::string_depth;
heap_string = print_junk::heap_string;
fun unparse_mlstring' (pp:Pp) = pp.lit o print_junk::print_heap_string';
fun unparse_mlstring (pp:Pp) = pp.lit o print_junk::print_heap_string;
fun unparse_integer (pp:Pp) = pp.lit o print_junk::print_integer;
fun ppvseq (pp:Pp) indent (separator: String) pr elements # This should be phased out, replaced by 'seq' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api =
{ fun print_elements [element]
=>
pr pp element;
print_elements (element ! rest)
=>
{ pr pp element;
pp.lit separator;
pp.newline();
print_elements rest;
};
print_elements []
=>
();
end;
pp.cbox {. pp.rulename "ujcb1";
print_elements elements;
};
};
fun ppvlist (pp:Pp) (header, separator, print_item, items) # This should be phased out, replaced by 'seq' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api =
case items
#
NIL => ();
first ! rest
=>
{ pp.lit header;
print_item pp first;
apply
(\\ x
=
{ pp.txt separator;
print_item pp x;
}
)
rest;
};
esac;
fun ppvlist' (pp:Pp) (header, separator, print_item, items) # This should be phased out, replaced by 'seq' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api =
case items
#
NIL => ();
first ! rest
=>
{ print_item pp header first;
#
apply
(\\ x
=
{ pp.txt " ";
print_item pp separator x;
}
)
rest;
};
esac;
# Debug print functions
fun unparse_int_path (pp:Pp)
=
unparse_closed_sequence
pp
{ front => (\\ pp = pp.lit "["),
separator => (\\ pp = { pp.txt ", "; pp.cut (); } ),
back => (\\ pp = pp.lit "]"),
breakstyle => WRAP,
print_one => (\\ pp = pp.lit o int::to_string)
};
fun unparse_symbol_path (pp:Pp) (sp: symbol_path::Symbol_Path)
=
pp.lit (symbol_path::to_string sp);
fun unparse_inverse_path pp (inverse_path::INVERSE_PATH path: inverse_path::Inverse_Path)
=
unparse_closed_sequence
pp
{ front => (\\ pp = pp.lit "<"),
separator => (\\ pp = (pp.lit "::")),
back => (\\ pp = pp.lit ">"),
breakstyle => WRAP,
print_one => unparse_symbol
}
(reverse 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 (pp:Pp) (i: Int)
=
pp.lit (int::to_string i);
fun newline_indent pp i
=
{ linewidth = 10000;
#
pp::break pp { blanks => linewidth, indent_on_wrap => i };
};
fun newline_apply (pp:Pp) f
=
g
where
fun g [] => ();
g [element] => f pp element;
g (element ! rest) => { f pp element;
pp.newline();
g rest;
};
end;
end;
fun break_apply pp f
=
g
where
fun g [] => ();
g [el] => f pp el;
g (el ! rest) => { f pp el; pp::break pp { blanks=>1, indent_on_wrap=>0 }; g rest;};
end;
end;
fun unparse_array (pp:Pp) ( f: pp::Prettyprinter -> X -> Void, # This should be phased out, replaced by 'list' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api a: Rw_Vector(X)
)
=
{
fun loop i
=
{ element = rw_vector::get (a, i);
#
pp.lit (int::to_string i);
pp.txt ": ";
f pp element;
pp.txt' 0 -1 " ";
loop (i+1);
};
pp.wrap' 0 -1 {. pp.rulename "ujw1";
#
loop 0
except
exceptions::INDEX_OUT_OF_BOUNDS = ();
};
};
fun by f x y
=
f y x;
fun unparse_tuple (pp:Pp) f # This should be phased out, replaced by 'tuple' or such (or something new if required) in src/lib/prettyprint/big/src/standard-prettyprinter.api =
unparse_closed_sequence
pp
{ front => \\ pp = pp.lit "(",
back => \\ pp = pp.lit ")",
print_one => f,
breakstyle => WRAP,
separator => \\ pp = { pp.lit ", ";
pp::break pp { blanks=>0, indent_on_wrap=>0 };
}
};
}; # package unparse_junk
end;