## printf-field.pkg
# Compiled by:
# src/lib/std/standard.lib# This module defines types and
# routines that are common to both
# the 'sfprintf' and 'scan' packages.
### "The most powerful designs are always
### the result of a continuous process
### of simplification and refinement."
###
### -- Kevin Mullet
stipulate
package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkgherein
package printf_field: (weak)
api {
# Precompiled format specifiers:
Sign
= DEFAULT_SIGN # Default: put a sign on negative numbers
| ALWAYS_SIGN # "+" always has sign (+ or -)
| BLANK_SIGN; # " " put a blank in the sign field for positive numbers
Neg_Sign
= MINUS_SIGN # Default: use "-" for negative numbers
| TILDE_SIGN; # "~" use "~" for negative numbers
Field_Flags
=
{ sign: Sign,
neg_char: Neg_Sign,
zero_pad: Bool,
base: Bool,
left_justify: Bool,
large: Bool
};
Field_Width
=
NO_PAD | WIDTH Int;
Float_Format
= F_FORMAT # "%f"
| E_FORMAT Bool # "%e" or "%E"
| G_FORMAT Bool; # "%g" or "%G"
Printf_Field_Type
= OCTAL_FIELD
| INT_FIELD
| HEX_FIELD
| CAP_HEX_FIELD
| BINARY_FIELD
| CHAR_FIELD
| BOOL_FIELD
| STRING_FIELD
| FLOAT_FIELD { prec: Int, format: Float_Format };
Printf_Field
= RAW Substring
| CHAR_SET Char -> Bool
| FIELD ((Field_Flags, Field_Width, Printf_Field_Type));
Printf_Arg
= QUICKSTRING quickstring__premicrothread::Quickstring
| LINT large_int::Int
| INT int::Int
| LUNT large_unt::Unt
| UNT unt::Unt
| UNT8 one_byte_unt::Unt
| BOOL Bool
| CHAR Char
| STRING String
| FLOAT f8b::Float
| LEFT ((Int, Printf_Arg)) # Left justify in field of given width.
| RIGHT ((Int, Printf_Arg)); # Right justify in field of given width.
exception BAD_FORMAT String; # Bad format string
scan_field: Substring -> ((Printf_Field, Substring));
}
{
package ss = substring; # substring is from src/lib/std/substring.pkg package sc = number_string; # number_string is from src/lib/std/src/number-string.pkg # Precompiled format specifiers:
Sign
= DEFAULT_SIGN # Default: put a sign on negative numbers
| ALWAYS_SIGN # "+" always has sign (+ or -)
| BLANK_SIGN; # " " put a blank in the sign field for positive numbers
Neg_Sign
= MINUS_SIGN # Default: use "-" for negative numbers
| TILDE_SIGN; # "~" use "~" for negative numbers
Field_Flags
=
{ sign: Sign,
neg_char: Neg_Sign,
zero_pad: Bool,
base: Bool,
left_justify: Bool,
large: Bool
};
Field_Width = NO_PAD | WIDTH Int;
Float_Format
= F_FORMAT # "%f"
| E_FORMAT Bool # "%e" or "%E"
| G_FORMAT Bool; # "%g" or "%G"
Printf_Field_Type
= OCTAL_FIELD
| INT_FIELD
| HEX_FIELD
| CAP_HEX_FIELD
| CHAR_FIELD
| BOOL_FIELD
| BINARY_FIELD
| STRING_FIELD
| FLOAT_FIELD { prec: Int, format: Float_Format };
Printf_Field
= RAW Substring
| CHAR_SET Char -> Bool
| FIELD ((Field_Flags, Field_Width, Printf_Field_Type));
Printf_Arg
= QUICKSTRING quickstring__premicrothread::Quickstring
| LINT large_int::Int
| INT int::Int
| LUNT large_unt::Unt
| UNT unt::Unt
| UNT8 one_byte_unt::Unt
| BOOL Bool
| CHAR Char
| STRING String
| FLOAT f8b::Float
| LEFT (Int, Printf_Arg) # Left justify in field of given width.
| RIGHT (Int, Printf_Arg) # Right justify in field of given width.
;
exception BAD_FORMAT String; # Bad format string
# String to int conversions:
my dec_to_int: sc::Reader (Char, Substring) -> sc::Reader (int::Int, Substring)
=
int::scan sc::DECIMAL;
# Scan a field specification.
#
# Assume that the previous character in the
# base string was "%" and that the first
# character in the substring format_string
# is not "%".
#
fun scan_field_spec format_string
=
{
my (format_string, flags)
=
do_flags
(
format_string,
{ sign => DEFAULT_SIGN,
neg_char => MINUS_SIGN,
zero_pad => FALSE,
base => FALSE,
left_justify => FALSE,
large => FALSE
}
)
where
fun do_flags (ss, flags: Field_Flags)
=
case (ss::getc ss, flags)
#
(THE(' ', ss'), { sign=>ALWAYS_SIGN, ... } )
=>
raise exception BAD_FORMAT "Forbidden blank in format string";
(THE(' ', ss'), _)
=>
do_flags (
ss',
{ sign => BLANK_SIGN,
neg_char => flags.neg_char,
zero_pad => flags.zero_pad,
base => flags.base,
left_justify => flags.left_justify,
large => flags.large
}
);
(THE('+', ss'), { sign=>BLANK_SIGN, ... } )
=>
raise exception BAD_FORMAT "Forbidden '+' in format string";
(THE('+', ss'), _)
=>
do_flags (
ss',
{ sign => ALWAYS_SIGN,
neg_char => flags.neg_char,
zero_pad => flags.zero_pad,
base => flags.base,
left_justify => flags.left_justify,
large => flags.large
}
);
(THE('~', ss'), _)
=>
do_flags (
ss',
{ sign => flags.sign,
neg_char => TILDE_SIGN,
zero_pad => flags.zero_pad,
base => flags.base,
left_justify => flags.left_justify,
large => flags.large
}
);
(THE('-', ss'), _)
=>
do_flags (
ss',
{ sign => flags.sign,
neg_char => MINUS_SIGN,
zero_pad => flags.zero_pad,
base => flags.base,
left_justify => TRUE,
large => flags.large
}
);
(THE('#', ss'), _)
=>
do_flags (
ss',
{ sign => flags.sign,
neg_char => flags.neg_char,
zero_pad => flags.zero_pad,
base => TRUE,
left_justify => flags.left_justify,
large => flags.large
}
);
(THE('0', ss'), _)
=>
( ss',
{ sign => flags.sign,
neg_char => flags.neg_char,
zero_pad => TRUE,
base => flags.base,
left_justify => flags.left_justify,
large => flags.large
}
);
_ => (ss, flags);
esac;
end; # where
my (wid, format_string)
=
if (char::is_digit (the (ss::first format_string)))
#
(the (dec_to_int ss::getc format_string))
->
(n, format_string);
(WIDTH n, format_string);
else
(NO_PAD, format_string);
fi;
my (type, format_string)
=
case (ss::getc format_string)
#
THE ('d', ss) => (INT_FIELD, ss);
THE ('X', ss) => (CAP_HEX_FIELD, ss);
THE ('x', ss) => (HEX_FIELD, ss);
THE ('o', ss) => (OCTAL_FIELD, ss);
THE ('c', ss) => (CHAR_FIELD, ss);
THE ('s', ss) => (STRING_FIELD, ss);
THE ('B', ss) => (BOOL_FIELD, ss);
THE ('b', ss) => (BINARY_FIELD, ss);
THE ('.', ss)
=>
{ # NOTE: "." ought to be allowed
# for d, X, x, o and s formats
# as it is in ANSI C.
# XXX BUGGO FIXME
(the (dec_to_int ss::getc ss))
->
(n, ss);
my (format, ss)
=
case (ss::getc ss)
#
THE ('E', ss) => (E_FORMAT TRUE, ss);
THE ('e', ss) => (E_FORMAT FALSE, ss);
THE ('f', ss) => (F_FORMAT, ss);
THE ('G', ss) => (G_FORMAT TRUE, ss);
THE ('g', ss) => (G_FORMAT FALSE, ss);
THE ( c , ss) => raise exception BAD_FORMAT ("Unsupported char '" + char::to_string c + "' in format string");
_ => raise exception BAD_FORMAT "Incomplete format string";
esac;
(FLOAT_FIELD { prec => n, format }, ss);
};
THE ('E', ss) => (FLOAT_FIELD { prec => 6, format => E_FORMAT TRUE }, ss);
THE ('e', ss) => (FLOAT_FIELD { prec => 6, format => E_FORMAT FALSE }, ss);
THE ('f', ss) => (FLOAT_FIELD { prec => 6, format => F_FORMAT }, ss);
THE ('G', ss) => (FLOAT_FIELD { prec => 6, format => G_FORMAT TRUE }, ss);
THE ('g', ss) => (FLOAT_FIELD { prec => 6, format => G_FORMAT FALSE }, ss);
THE (c, ss) => raise exception BAD_FORMAT ("Unsupported char '" + char::to_string c + "' in format string");
_ => raise exception BAD_FORMAT "Incomplete format string";
esac;
(FIELD (flags, wid, type), format_string);
}; # fun scan_field_spec
fun scan_field format_string
=
case (ss::getc format_string )
#
THE ('%', format_string')
=>
(RAW (ss::make_slice (format_string, 0, THE 1)), format_string');
_ => scan_field_spec format_string;
esac;
};
end;