## standard-prettyprinter-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.pkgherein
generic package standard_prettyprinter_g ( #
# ========================
# # "tt" == "traitful text"
package tt: Traitful_Text; # Traitful_Text is from src/lib/prettyprint/big/src/traitful-text.api package out: Prettyprint_Output_Stream; # Prettyprint_Output_Stream is from src/lib/prettyprint/big/src/out/prettyprint-output-stream.api # out will be something like html_prettyprint_output_stream from src/lib/prettyprint/big/src/out/html-prettyprint-output-stream.pkg sharing tt::Texttraits == out::Texttraits;
)
# : (weak) Standard_Prettyprinter # Standard_Prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.api {
package pp
=
base_prettyprinter_g ( # base_prettyprinter_g is from src/lib/prettyprint/big/src/base-prettyprinter-g.pkg #
package tt = tt; # traitless_text is from src/lib/prettyprint/big/src/traitless-text.pkg package out = out;
);
package typ = pp::typ;
Prettyprint_Output_Stream = pp::Prettyprint_Output_Stream;
Traitful_Text = pp::Traitful_Text;
Texttraits = pp::Texttraits;
Left_Margin_Is == pp::typ::Left_Margin_Is;
package box { # Optional args for 'box' fn.
#
Arg = LEFT_MARGIN_IS typ::Left_Margin_Is
| WIDTH Int
| FORMAT typ::Wrap_Policy
;
};
horizontal = pp::horizontal; # The four precoded box-formatting styles.
vertical = pp::vertical;
normal = pp::normal;
ragged_right = pp::ragged_right;
Prettyprinter_Configuration_Args == pp::typ::Prettyprinter_Configuration_Args;
Private_State = pp::Prettyprinter;
Standard_Prettyprinter
=
{ pp: Private_State,
#
tabstops_are_every: Int,
default_target_box_width: Int,
default_left_margin_is: typ::Left_Margin_Is,
default_wrap_policy: String, # It would be nice to have default_wrap_policy: Wrap_Policy here but I think that will produce nasty circularity issues.
#
box': Int -> Int -> (Void -> Void) -> Void,
wrap': Int -> Int -> (Void -> Void) -> Void,
cbox': Int -> Int -> (Void -> Void) -> Void,
cwrap': Int -> Int -> (Void -> Void) -> Void,
box: (Void -> Void) -> Void,
wrap: (Void -> Void) -> Void,
cbox: (Void -> Void) -> Void,
cwrap: (Void -> Void) -> Void,
flush: Void -> Void,
close: Void -> Void,
break': { ifwrap: { blanks: Int, tab_to: Int },
ifnotwrap: { blanks: Int, tab_to: Int }
}
->
Void,
tab: Void -> Void, #
cut: Void -> Void, #
tab': Int -> Int -> Void, # Emit 'blanks' blanks, then additional blanks until (column % tabstops_are_every) == tab_to.
cut': Int -> Int -> Void, # If wrapped, emit newline, space to left margin of current box, then do save as above.
txt': Int -> Int -> String -> Void,
txt: String -> Void,
ind: Int -> Void, # "ind" == "indent"; changes left margin by given amount, except if arg==0 resets left margin to original value for current box.
lit: String -> Void,
endlit: String -> Void,
newline: Void -> Void,
rulename: String -> Void
};
Prettyprinter = Standard_Prettyprinter;
Pp = Standard_Prettyprinter;
Npp = Null_Or( Standard_Prettyprinter ); # We pass this around pervasively as a flag/conduit for verbose compiler debug output.
fun open_box (pp:Pp, left_margin_is, box_format, target_width)
= pp::open_box (pp.pp, left_margin_is, box_format, target_width);
fun break' (pp:Pp, arg)
= pp::break' (pp.pp, arg);
fun start_box
(pp: Standard_Prettyprinter) #
(args: List( box::Arg ))
=
();
fun make_standard_prettyprinter prettyprint_output_stream options
=
{
(pp::process_mill_options options)
->
{ default_target_box_width,
default_wrap_policy,
default_left_margin_is,
tabstops_are_every
};
pp = pp::make_prettyprinter prettyprint_output_stream options;
#
fun box' blanks tab_to thunk = { pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks, tab_to, tabstops_are_every }, default_wrap_policy, default_target_box_width );
thunk();
pp::shut_box pp;
};
fun wrap' blanks tab_to thunk = { pp::open_box (pp, pp::typ::BOX_RELATIVE { blanks, tab_to, tabstops_are_every }, ragged_right, default_target_box_width );
thunk();
pp::shut_box pp;
};
fun cbox' blanks tab_to thunk = { pp::open_box (pp, pp::typ::CURSOR_RELATIVE { blanks, tab_to, tabstops_are_every }, default_wrap_policy, default_target_box_width );
thunk();
pp::shut_box pp;
};
fun cwrap' blanks tab_to thunk = { pp::open_box (pp, pp::typ::CURSOR_RELATIVE { blanks, tab_to, tabstops_are_every }, ragged_right, default_target_box_width );
thunk();
pp::shut_box pp;
};
box = box' 1 0;
wrap = wrap' 1 0;
cbox = cbox' 1 0;
cwrap = cwrap' 1 0;
fun flush () = { pp::flush_prettyprinter pp; out::flush prettyprint_output_stream; };
fun close () = { pp::close_prettyprinter pp; out::close prettyprint_output_stream; };
fun break'
{ ifwrap: { blanks: Int, tab_to: Int },
ifnotwrap: { blanks: Int, tab_to: Int }
}
=
pp::break' ( pp,
{ ifnotwrap => { blanks => ifnotwrap.blanks, tab_to => ifnotwrap.tab_to, tabstops_are_every },
ifwrap => { blanks => ifwrap.blanks, tab_to => ifwrap.tab_to, tabstops_are_every }
}
);
fun cut' blanks tab_to = { pp::break' ( pp,
{ ifnotwrap => { blanks => 0, tab_to => -1, tabstops_are_every },
ifwrap => { blanks, tab_to, tabstops_are_every }
} );};
fun tab' blanks tab_to = { pp::tab pp { blanks, tab_to, tabstops_are_every }; };
fun ind i = pp::indent (pp, i);
fun cut () = cut' 0 -1;
fun tab () = tab' 1 0;
fun newline () = pp::newline pp;
fun rulename name = pp::set_rulename_for_current_box (pp, name);
##############################################################################
# pp.txt'
#
# The idea with pp.txt' is to replace
# explicit calls to pp::break, pp::tab and pp::newline
# with embedded ' ' '\t' '\n' chars:
#
# pp.txt' blanks tab_go <string>:
# '\t' in <string>: treated as pp.tab 1 0
# '\n' in <string>: treated as pp::newline
# n blanks in <string>: treated as pp::break { ifnotwrap => { blanks => n, tab_to => -1, tabstops_are_every },
# ifwrap => { blanks, tab_to, tabstops_are_every }
# }
fun txt'' (lit: Null_Or(pp::Pp -> String -> Void)) blanks tab_to string # 'lit' will be NULL for 'txt', else THE pp::lit or THE pp::endlit for 'lit'/'endlit'.
=
next 0
where
# If we think of prettyprinter as a simple
# compiler, this is the compiler's lexer,
# breaking up the input string into tokens
# drawn from typ::Phase1_Token.
len = size string;
fun next i
=
if (i < len)
#
c = string::get_byte_as_char (string, i);
case c
'\t' => do_tab i;
'\n' => do_newline i;
' ' => do_blanks (i, i+1);
_ => do_other (i, i+1);
esac;
fi
also
fun do_tab i # Treat each \t in 'string' as a call to pp:tab 4.
=
{ pp::tab pp { blanks => 1, tab_to => 0, tabstops_are_every };
next (i+1);
}
also
fun do_newline i # Treat each \n in 'string' as a call to pp:newline.
=
{ pp::newline pp;
next (i+1);
}
also
fun do_blanks (i, j) # Treat a run of 'n' blanks in 'string' as a call to pp::nonbreakable_blanks (if in lit/endlit) or pp:break { blanks => n, indent_on_wrap => 4 } (if in txt).
=
{ fun do_blanks' (i, j)
=
case lit
THE lit => pp::nonbreakable_blanks pp (j-i); # We're doing a lit or endlit so the blanks turn into a simple typ::BLANKS token.
NULL => pp::break' ( pp, # We're doing a txt so blanks turn into a typ::BREAK.
{ ifnotwrap => { blanks => j-i, tab_to => -1, tabstops_are_every },
ifwrap => { blanks, tab_to, tabstops_are_every }
}
);
esac;
if (j >= len)
#
do_blanks' (i, j);
else
c = string::get_byte_as_char (string, j);
if (c == ' ')
#
do_blanks (i, j+1); # Scan to end of string of blanks.
else
do_blanks' (i, j);
next j;
fi;
fi;
}
also
fun do_other (i, j) # Treat literally a run of non-\n, non-\t, non-blank chars in 'string'.
=
{
fun put_lit (i, j)
=
case lit
NULL => pp::lit pp (string::substring (string, i, j-i)); # We're doing a 'txt', so send plain chars as a typ::LIT.
THE lit => lit pp (string::substring (string, i, j-i)); # We're doing a 'lit' or 'endlit'; send plain chars as a typ::LIT or typ:ENDLIT respectively.
esac;
if (j >= len)
#
put_lit (i, j);
else
c = string::get_byte_as_char (string, j);
if (c != ' '
and c != '\t'
and c != '\n'
)
do_other (i, j+1); # Scan to end of string of plain characters.
else
put_lit (i, j);
next j;
fi;
fi;
};
end; # fun output
txt' = txt'' NULL;
txt = txt'' NULL 0 -1;
lit = txt'' (THE pp::lit) 0 -1;
endlit = txt'' (THE pp::endlit) 0 -1;
{ pp,
tabstops_are_every,
default_target_box_width,
default_left_margin_is,
default_wrap_policy => default_wrap_policy.name, # Circularity issues make it hard to include the complete value here.
box', wrap', cbox', cwrap',
box, wrap, cbox, cwrap,
flush, close,
break',
cut', tab', cut, tab,
newline,
lit, endlit,
ind,
txt, txt',
rulename
};
};
fun make_prettyprinter prettyprint_output_stream options
=
make_standard_prettyprinter prettyprint_output_stream options;
process_mill_options = pp::process_mill_options;
# Next four fns are conveniences for printing standard Mythryl constructs: lists, tuples, records and blocks.
fun listx (pp:Pp) (do_element: X -> Void) title (elements: List(X)) # Print a list as either [ val1, val2, ... ] or
= # [ val1,
case (title, elements) # val2,
# # ...
("", []) => pp.lit "[]"; # ]
#
_ => { pp.box' 0 0 {.
pp.lit title;
pp.txt "[ ";
pp.ind 2;
do_elements elements;
pp.ind 0;
pp.txt " ";
pp.lit "]";
};
}
where
fun do_element' element
=
{ do_element element;
#
pp.endlit ",";
pp.txt " ";
};
fun do_elements [] => ();
do_elements [ element ] => do_element element;
do_elements (element ! rest) => { do_element' element;
do_elements rest;
};
end;
end;
esac;
fun tuple (pp:Pp) title (elements: List( Void -> Void ) ) # Print a tuple as either (val1, val2, ...) or
= # ( val1,
{ pp.box' 0 0 {. # val2,
pp.lit title; # ...
pp.txt "("; # )
pp.ind 2;
do_elements elements;
pp.ind 0;
pp.cut ();
pp.lit ")";
};
}
where
fun do_element' do_element
=
{ do_element();
#
pp.endlit ",";
pp.txt " ";
};
fun do_elements [] => ();
do_elements [ do_element ] => do_element ();
do_elements (do_element ! rest) => { do_element' do_element;
do_elements rest;
};
end;
end;
fun tuplex (pp:Pp) (do_element: X -> Void) title (elements: List(X) ) # Print a tuple as either (val1, val2, ...) or
= # ( val1,
{ pp.box' 0 0 {. # val2,
pp.lit title; # ...
pp.txt "(";
pp.ind 2;
do_elements elements;
pp.ind 0;
pp.cut ();
pp.lit ")";
};
}
where
fun do_element' element
=
{ do_element element;
#
pp.endlit ",";
pp.txt " ";
};
fun do_elements [] => ();
do_elements [ element ] => do_element element;
do_elements (element ! rest) => { do_element' element;
do_elements rest;
};
end;
end;
fun record (pp:Pp) title (pairs: List( (String, Void -> Void) ) ) # Print a record as either { key1 => val1, key2 => val2, ... } or
= # { key1 => val1,
{ pp.box' 0 0 {. # key2 => val2,
pp.lit title; # ...
pp.txt "{ "; # }
pp.ind 2;
do_pairs pairs;
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
}
where
fun do_pair (key, value)
=
pp.box' 0 0 {.
pp.txt key;
if (key != "...") # Special hack to support printing incomplete records: If key is "..." we ignore the value.
pp.ind 4;
pp.break' { ifnotwrap => { blanks => 0, tab_to => -1 },
ifwrap => { blanks => 1, tab_to => 0 }
};
pp.txt " => ";
value ();
fi;
};
fun do_pair' pair
=
{ do_pair pair;
#
pp.endlit ",";
pp.txt " ";
};
fun do_pairs [] => ();
do_pairs [pair] => do_pair pair;
do_pairs (pair ! rest) => { do_pair' pair;
do_pairs rest;
};
end;
end;
fun block (pp:Pp) (expressions: List( Void -> Void ) ) # Print a block as either { exp1; exp2; ... ] or
= # { exp1;
{ pp.box' 0 0 {. # exp2;
pp.txt "{"; # ...
pp.ind 4;
do_expressions expressions;
pp.ind 0;
pp.txt " ";
pp.lit "}";
};
}
where
fun do_expression' do_expression
=
{ do_expression();
#
pp.endlit ";";
pp.txt " ";
};
fun do_expressions [] => ();
do_expressions [ do_expression ] => do_expression ();
do_expressions (do_expression ! rest) => { do_expression' do_expression;
do_expressions rest;
};
end;
end;
##################################################################################################
# Backward compatibility stuff to make standard_prettyprinter a 100% drop-in replacement for base_prettyprinter:
Prettyprint_Output_Stream = pp::Prettyprint_Output_Stream;
Traitful_Text = pp::Traitful_Text;
Texttraits = pp::Texttraits;
Left_Margin_Is == pp::typ::Left_Margin_Is;
fun flush_prettyprinter (pp:Pp) = pp::flush_prettyprinter pp.pp;
fun close_prettyprinter (pp:Pp) = pp::close_prettyprinter pp.pp;
fun shut_box (pp:Pp) = pp::shut_box pp.pp;
fun traitful_text (pp:Pp) s = pp::traitful_text pp.pp s;
fun lit (pp:Pp) s = pp::lit pp.pp s;
fun endlit (pp:Pp) s = pp::endlit pp.pp s;
fun push_texttraits (pp:Pp,ts) = pp::push_texttraits (pp.pp,ts);
fun pop_texttraits (pp:Pp) = pp::pop_texttraits pp.pp;
fun indent (pp:Pp, i) = pp::indent (pp.pp, i);
fun break (pp:Pp) a = pp::break pp.pp a;
fun blank (pp:Pp) i = pp::blank pp.pp i;
fun cut (pp:Pp) = pp::cut pp.pp;
fun newline (pp:Pp) = pp::newline pp.pp;
fun nonbreakable_blanks (pp:Pp) i = pp::nonbreakable_blanks pp.pp i;
fun tab (pp:Pp) i = pp::tab pp.pp i;
fun control (pp:Pp) f = pp::control pp.pp f;
fun nblanks i = pp::nblanks i;
fun set_rulename_for_current_box (pp:Pp, name) = pp::set_rulename_for_current_box (pp.pp, name);
fun get_prettyprint_output_stream (pp:Pp) = pp::get_prettyprint_output_stream pp.pp;
fun with_standard_prettyprinter output_stream pp_args (f: Prettyprinter -> Void) # Compared to the make_standard_prettyprinter() approach, this
= # approach makes it harder to forget to flush+close the prettyprinter.
{ pp = make_standard_prettyprinter output_stream pp_args;
#
f pp;
close_prettyprinter pp;
};
fun seqx
(separator: Void -> Void)
(print_element: X -> Void)
(elements: List(X))
=
print_elements elements
where
fun print_elements [element]
=>
print_element element;
print_elements (element ! rest)
=>
{ print_element element;
separator ();
print_elements rest;
};
print_elements [] => ();
end;
end;
# End of backward compatibility stuff.
##################################################################################################
}; # package standard_prettyprinter
end;