## printf-combinator.pkg
# Compiled by:
# src/lib/std/standard.lib# Well-typed "printf" for Mythryl, aka "Unparsing Combinators".
# This code was written by Matthias Blume (2002). Inspiration
# obtained from Olivier Danvy's "Functional Prettyprinting" work.
#
# See src/lib/src/printf-combinator.api for details.### "A man should never be ashamed
### to own he has been in the wrong,
### which is but saying, in other words,
### that he is wiser to-day than he was yesterday."
###
### -- Alexander Pope
stipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkgherein
package printf_combinator
:
Printf_Combinator # Printf_Combinator is from src/lib/src/printf-combinator.api {
Format(X) = List( String ) -> X;
Fragment (X, Y) = Format(X) -> Format(Y);
Glue(X) = Fragment (X, X);
Element (X, T) = Fragment (X, T -> X);
Place = (Int, Int) -> Int;
fun left (a, i) = a - i;
fun center (a, i) = int::quot (a - i, 2);
fun right (a, i) = 0;
stipulate
# Generic padding, trimming, and fitting. Nestability
# is achieved by remembering the current state s, passing
# a new empty one to the fragment, adjusting the output
# from that, and fitting the result back into the remembered
# state. ("States" are string lists and correspond to
# output coming from fragments to the left of the current point.)
#
fun ptf adj pl n fr fm s
=
{ fun work s'
=
{ x' = cat (reverse s');
size = size x';
adj (x', size, n, pl (size, n)) ! s;
};
(fr (fm o work)) [];
};
pad_right = number_string::pad_right ' ';
pad_left = number_string::pad_left ' ';
fun pad0 (s, size, n, off) = pad_right n (pad_left (size - off) s);
fun trim0 (s, _, n, off) = string::substring (s, off, n);
fun pad1 (arg as (s, size, n, _)) = if (n < size ) s; else pad0 arg; fi;
fun trim1 (arg as (s, size, n, _)) = if (n > size ) s; else trim0 arg; fi;
fun fit1 (arg as (_, size, n, _)) = (if (n < size ) trim0; else pad0; fi) arg;
herein
fun format' rcv fr = fr (rcv o reverse) [];
fun format fr = format' cat fr;
fun using convert fm x a
=
fm (convert a ! x);
fun int fm = using int::to_string fm;
fun float fm = using f8b::to_string fm;
fun bool fm = using bool::to_string fm;
fun string fm = using (\\ x => x; end ) fm;
fun string' fm = using string::to_string fm;
fun char fm = using string::from_char fm;
fun char' fm = using char::to_string fm;
fun int' rdx fm = using (int::format rdx) fm;
fun float' rformat fm = using (f8b::format rformat) fm;
fun pad place = ptf pad1 place;
fun trim place = ptf trim1 place;
fun fit place = ptf fit1 place;
end;
fun padl n = pad left n;
fun padr n = pad right n;
fun glue e a fm x
=
e fm x a;
fun nothing fm = fm;
fun text s = glue string s;
fun sp n = pad left n nothing;
fun nl fm = text "\n" fm;
fun tab fm = text "\t" fm;
};
end;
## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.