## core-prettyprinter-debug-g.pkg
#
# Compiled by:
# src/lib/prettyprint/big/prettyprinter.libstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package l2s = list_to_string; # list_to_string is from src/lib/src/list-to-string.pkg package ptf = sfprintf; # sfprintf is from src/lib/src/sfprintf.pkgherein
# This generic is invoked (only) from
#
# src/lib/prettyprint/big/src/core-prettyprinter-g.pkg #
generic package core_prettyprinter_debug_g ( #
# =============================
# # "tt" == "traitful text"
package typ: Core_Prettyprinter_Types; # Core_Prettyprinter_Types is from src/lib/prettyprint/big/src/core-prettyprinter-types.api # core_prettyprinter_types_g is form src/lib/prettyprint/big/src/core-prettyprinter-types-g.pkg )
: (weak)
api {
# break_policy_to_string: typ::Break_Policy -> String;
left_margin_is_to_string: typ::Left_Margin_Is -> String;
phase1_token_to_string: typ::Phase1_Token -> String;
phase1_tokens_to_string: List(typ::Phase1_Token) -> String;
phase2_token_to_string: typ::b::Phase2_Token -> String;
phase2_tokens_to_string: List(typ::b::Phase2_Token) -> String;
phase3_token_to_string: typ::c::Phase3_Token -> String;
phase3_tokens_to_string: List(typ::c::Phase3_Token) -> String;
phase4_token_to_string: typ::d::Phase4_Token -> String;
phase4_tokens_to_string: List(typ::d::Phase4_Token) -> String;
phase4_lines_to_string: List( List(typ::d::Phase4_Token)) -> String;
break_to_string: typ::Break -> String;
prettyprint_prettyprinter: (fil::Output_Stream, typ::Prettyprinter) -> Void;
}
# Core_Prettyprinter_Debug
# where Break_Policy == typ::Break_Policy
# also Left_Margin == typ::Left_Margin_Is
# also Phase1_Token == typ::Phase1_Token
# also Prettyprinter == typ::Prettyprinter
{
Pp = typ::Prettyprinter;
# *** DEBUGGING FUNCTIONS ***
# fun break_policy_to_string typ::NONE => "NONE";
# break_policy_to_string typ::ALL => "ALL";
# break_policy_to_string typ::ALL_OR_NONE => "ALL_OR_NONE";
# break_policy_to_string typ::AS_NEEDED => "AS_NEEDED";
# end;
fun left_margin_is_to_string (typ::BOX_RELATIVE { blanks, tab_to, tabstops_are_every }) => sprintf "(BOX_RELATIVE { blanks=>%d, tab_to=>%d, tabstops_are_every=>%d })" blanks tab_to tabstops_are_every;
left_margin_is_to_string (typ::CURSOR_RELATIVE { blanks, tab_to, tabstops_are_every }) => sprintf "(CURSOR_RELATIVE { blanks=>%d, tab_to=>%d, tabstops_are_every=>%d })" blanks tab_to tabstops_are_every;
end;
fun phase1_token_to_string token
=
case token
typ::BLANKS i => sprintf "BLANKS %d" i;
typ::LIT s => sprintf "LIT \"%s\"" s;
typ::ENDLIT s => sprintf "ENDLIT \"%s\"" s;
typ::TAB t => sprintf "TAB { tab_to => %d, tabstops_are_every %d }" t.tab_to t.tabstops_are_every;
typ::PUSH_TT _ => "PUSH_TT";
typ::POP_TT => "POP_TT";
typ::CONTROL _ => "CONTROL";
typ::NEWLINE => "NEWLINE";
typ::INDENT i => sprintf "INDENT %d" i;
typ::BREAK b => sprintf "BREAK { ifnotwrap => { blanks=>%d, tab_to=>%d, tabstops_are_every=>%d }, ifwrap => { blanks => %d tab_to=>%d, tabstops_are_every=>%d }, wrap=>%B }"
b.ifnotwrap.blanks b.ifnotwrap.tab_to b.ifnotwrap.tabstops_are_every
b.ifwrap.blanks b.ifwrap.tab_to b.ifwrap.tabstops_are_every *b.wrap;
typ::BOX box => sprintf "BOX#%d{%d%s}" box.id *box.actual_width (*box.is_multiline ?? "M" :: "");
esac;
fun phase1_tokens_to_string tokens
=
string::join' "[ " ", " " ]" (map phase1_token_to_string tokens);
fun phase2_token_to_string token
=
case token
typ::b::BLANKS i => sprintf "BLANKS %d" i;
typ::b::LIT s => sprintf "LIT \"%s\"" s;
typ::b::ENDLIT s => sprintf "ENDLIT \"%s\"" s;
typ::b::PUSH_TT _ => "PUSH_TT";
typ::b::POP_TT => "POP_TT";
typ::b::CONTROL _ => "CONTROL";
typ::b::NEWLINE => "NEWLINE";
esac;
fun phase2_tokens_to_string tokens
=
string::join' "[ " ", " " ]" (map phase2_token_to_string tokens);
fun phase3_token_to_string token
=
case token
typ::c::BLANKS i => sprintf "BLANKS %d" i;
typ::c::LIT s => sprintf "LIT \"%s\"" s;
typ::c::PUSH_TT _ => "PUSH_TT";
typ::c::POP_TT => "POP_TT";
typ::c::CONTROL _ => "CONTROL";
typ::c::NEWLINE => "NEWLINE";
esac;
fun phase3_tokens_to_string tokens
=
string::join' "[ " ", " " ]" (map phase3_token_to_string tokens);
fun phase4_token_to_string token
=
case token
typ::d::BLANKS i => sprintf "BLANKS %d" i;
typ::d::LIT s => sprintf "LIT \"%s\"" s;
typ::d::PUSH_TT _ => "PUSH_TT";
typ::d::POP_TT => "POP_TT";
typ::d::CONTROL _ => "CONTROL";
esac;
fun phase4_tokens_to_string tokens
=
string::join' "[ " ", " " ]" (map phase4_token_to_string tokens);
fun phase4_lines_to_string lines
=
{ (sprintf "(%d lines): " (list::length lines)) +
string::join' "[ " " (newline)\n" " ]" (map phase4_tokens_to_string lines);
};
fun break_to_string (b: typ::Break)
=
{ "BREAK {"
+ " wrap=" + (bool::to_string *b.wrap)
+ (sprintf " ifnotwrap => { blanks => %d, tab_to => %d, tabstops_are_every => %d }," b.ifnotwrap.blanks b.ifnotwrap.tab_to b.ifnotwrap.tabstops_are_every)
+ (sprintf " ifwrap => { blanks => %d, tab_to => %d, tabstops_are_every => %d }" b.ifwrap.blanks b.ifwrap.tab_to b.ifwrap.tabstops_are_every)
+ " }";
};
fun prettyprint_prettyprinter (out_stream, pp: typ::Prettyprinter) # Prettyprint pp contents for debugging.
=
{ print "BEGIN\n";
#
printf' (
"box_nesting = %3d\n",
[ ptf::INT *pp.box_nesting
]
);
print "Expression:\n";
case *pp.nested_boxes
#
[] => print_box *pp.box "";
x => case (reverse x)
#
bot ! rest => print_box bot "";
_ => raise exception DIE "impossible";
esac;
esac;
print "\n";
print "END\n";
}
where
fun print string
=
fil::write (out_stream, string);
fun printf' (format, items)
=
print (ptf::sprintf' format items);
# fun format_box_stack_element_to_string (format, box_indent, target_width)
# =
# ptf::sprintf' "(%s, %d, %d)" [ptf::STR (break_policy_to_string format), ptf::INT box_indent, ptf::INT target_width];
fun print_list format_element []
=>
print "[]";
print_list format_element my_list
=>
print (
l2s::list_to_string'
#
{ first => "[\n ",
last => "]",
between => "\n ",
to_string => format_element
}
#
my_list
);
end;
fun print_box (box: typ::Box) prefix
=
{ print (prefix + "Box");
print (" id = " + (int::to_string box.id));
print (" left_margin_is = " + (left_margin_is_to_string box.left_margin_is));
print (" target_width = " + (int::to_string box.target_width));
print (" actual_width = " + (int::to_string *box.actual_width));
print (" is_multiline = " + (bool::to_string *box.is_multiline));
print (" wrap_policy = " + box.wrap_policy.name);
#
print (" reversed_contents len = " + (int::to_string (list::length *box.reversed_contents)));
print (" contents len = " + (int::to_string (list::length *box.contents)));
print ":\n";
print_tokens *box.contents (prefix + " ")
where
fun print_tokens [] _
=>
();
print_tokens (token ! rest) prefix
=>
{ case token
#
typ::BLANKS n
=>
print (prefix + "BLANKS " + (int::to_string n) + "\n");
typ::LIT string
=>
print (prefix + "LIT '" + string + "'\n");
typ::ENDLIT string
=>
print (prefix + "ENDLIT '" + string + "'\n");
typ::TAB t
=>
printf "%sTAB { tab_to=>%d, tabstops_are_every=>%d }\n" prefix t.tab_to t.tabstops_are_every;
typ::INDENT i
=>
{ print (prefix + "indent " + (int::to_string i) + "\n");
};
typ::BREAK b
=>
{ print (prefix + break_to_string b + "\n");
};
typ::PUSH_TT _ => print (prefix + "PUSH_TT ...\n");
typ::POP_TT => print (prefix + "POP_TT\n");
typ::NEWLINE => print (prefix + "NEWLINE\n");
typ::CONTROL _ => print (prefix + "CONTROL ...\n");
typ::BOX box => { print (prefix + "BOX:\n");
print_box box (prefix + " ");
};
esac;
print_tokens rest prefix;
};
end; # fun print_tokens
end; # where
print (prefix + "Box");
print (" id = " + (int::to_string box.id));
print " DONE.\n";
};
end;
};
end;
## COPYRIGHT (c) 2005 John Reppy (http://www.cs.uchicago.edu/~jhr)
## All rights reserved.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.