format.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- format.sa: Formatting a string a la printf
-- Author: Benedict A. Gomes <gomes@icsi.berkeley.edu>
-- Author: Holger Klawitter <holger@icsi.berkeley.edu>
-- Copyright (C) 1996, International Computer Science Institute
-- $Id: format.sa,v 1.12 1996/09/10 23:46:23 gomes Exp $
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
abstract class $FMT
abstract class $FMT -- > INT, FLT, FLTD, STR, CHAR, BOOL
-- Formattable classes inherit from this type.
is
fmt( fmt: STR ): STR;
-- Arg fmt: contains the format information.
-- Returns: a formatter version of self.
end; -- abstract class $FMT
class FMT < $STR
class FMT < $STR
--PURPOSE: It is convenient to generate formatted output with a
-- printf-like command, especially when text and values are closely
-- interspersed. The Sather way for this is creating an object of
-- type FMT and printing it out immeduately. The first argument of all
-- FMT creations is a formatting string. All pairs of angle brackets
-- "<" ">" are considered as format expressions and passed to the
-- corresponding object to format itself.
--
--EXAMPLES:
-- #FMT( "<> + <> %> <###>", 1,2,0 ) returns "1 + 2 > 0"
-- #FMT( "<+###.##>", 3.14159 ) returns " +3.14"
-- #FMT( "<##.##e##>", 3.14159 ) returns " 3.14e00"
-- #FMT( "<^#####>", "left" ) returns "left "
-- #FMT( "<F*###^###>", false ) returns "*false*"
--GENERAL SYNTAX:
-- fmt-expr -> "<" [selector] [options] pad-expr [options] ">"
-- selector -> positive integer ":"
-- pad-expr -> [sign] padding [prec-pad] | anchor-pad
-- anchor-pad -> [filling] padding
-- filling -> "F" followed by any single character.
-- sign -> "+" or "-".
-- padding -> hash-chars ["^" hash-chars]
-- hash_chars -> arbitrary number of "#".
-- prec-pad -> "." followed by an arbitrary number of "#".
--RESTRICTIONS:
-- * Exponents are possible and considered as an option to floating
-- point numbers.
-- * Options can be used by user defined classes to feature special
-- print formats. User defined options should always start with a
-- lower case letter.
-- * Only numbers can have precisions.
-- * Fillings are not (yet) allowed with numbers.
-- * Precision and anchors cannot be used together.
--CLASSES:
-- (in format.sa)
-- $FMT : Base class for formatible objects.
-- FMT : The core class of the formating engine.
-- (calls fmt(STR):STR in the objects)
-- (in base_format.sa)
-- $FLT : Aritificial base class for FLT and FLTD.
-- BASE_FORMAT : "Strategy" for output of Basic types.
-- (called by the basic classes themselves)
-- FMT_NUMBERS : Formatting routines for numbers.
-- (included by BASE_FORMAT)
--SEE ALSO:
-- A tutorial and more information for the format classes can be
-- found under:
-- http://www.icsi.berkeley.edu/~sather/Documentation/Library/Format/format.html
--
is
include FMT_ERROR_FLAGS;
readonly attr str: STR;
-- the result of the formatting process.
-- Routines to be called from outside:
create(f: STR,a0: $FMT): SAME is
a: ARRAY{$FMT} := |a0|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5,a6: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5,a6|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5,a6,a7: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5,a6,a7|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5,a6,a7,a8: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5,a6,a7,a8|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5,a6,a7,a8,a9: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5,a6,a7,a8,a9|;
return(new.parse(f,a));
end;
create(f: STR,a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10: $FMT): SAME is
a: ARRAY{$FMT} := |a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10|;
return(new.parse(f,a));
end;
create(f: STR): SAME is
-- Should never be used... some special case?
a: ARRAY{$FMT} := #(0);
return(new.parse(f,a));
end;
format(f: STR,a: ARRAY{$FMT}): SAME is
-- Generic version to process an arbitrary number of formattable
-- objects. Interface for `parse'.
return(new.parse(f,a));
end;
-- Internal routines
const -- States when parsing the format expression:
s_norm, -- scanning a plain string
s_prct, -- scanning when '%' found
s_cfmt, -- scanning C style format
s_sfmt, -- scanning Sather format
s_esc; -- scanning something in a sather format behind a single '%'
private parse( s: STR, args: ARRAY{$FMT} ): SAME
-- The core routine of the formatter.
is
sz ::= s.length;
str := "";
fmt ::= "";
state ::= s_norm;
pos ::= 0;
cur_arg ::= 0;
next: CHAR;
loop
until!( pos >= sz );
next := s[pos];
case state
when s_norm then
case next
when '%' then
state := s_prct
when '<' then
state := s_sfmt
else
str := str + next
end
when s_prct then
assert fmt = "";
case next
when '%','<','>' then
str := str + next;
state := s_norm;
when 'd','i','o','u','x','X','f','E','e','g','G','c','s' then
str := str + cformat( "%" + next, args, inout cur_arg );
state := s_norm;
else
fmt := "%" + next;
state := s_cfmt;
end
when s_cfmt then
case next
when 'd','i','o','u','x','X','f','E','e','g','G','c','s' then
str := str + cformat( fmt + next, args, inout cur_arg );
state := s_norm;
fmt := ""
else
fmt := fmt + next;
end;
when s_sfmt then
case next
when '%' then
state := s_esc
when '>' then
str := str + sformat( fmt, args, inout cur_arg );
state := s_norm;
fmt := "";
else
fmt := fmt + next
end
when s_esc then
fmt := fmt + next;
state := s_sfmt;
end; -- case state
pos := pos + 1
end; -- loop
if state /= s_norm then
str := str + err(unexpected_end_format,
"Unexpected end of format in \""+s+"\"." ).str;
end;
return self
end; -- parse
-- Processing Sather style formats
private sformat( s: STR, args: ARRAY{$FMT}, inout argnum: INT ): STR
-- Processing one Sather style format expression
-- Returns the string representation of the `next' object.
is
sz ::= s.length;
p ::= 0;
num ::= 0;
is_position ::= false;
loop
until!( p >= sz );
next ::= s[p];
if next = ':' then
is_position := true;
break!;
end;
until!( ~ next.is_digit );
num := num * 10 + next.int - '0'.int;
p := p + 1
end;
if is_position then
s := s.substring( p+1, sz-p-1 );
num := num - 1
else
num := argnum
end;
if num >= args.size then
return err(illegal_arg_number,"Illegal argument number '"
+ (num+1).str + "'.").str;
end;
argnum := num + 1;
return do_fmt(args[num],s);
end; -- sformat
private do_fmt( ob: $FMT, fmt: STR ): STR
-- Hook for later additions to format classes.
is
return ob.fmt(fmt)
end; -- do_fmt
-- Processing C style formats
private cformat( s: STR, args: ARRAY{$FMT}, inout argnum:INT ): STR
-- Processing one C style format expression.
-- Returns the string representation of the `next' object.
is
sz ::= s.length;
p ::= 1;
num ::= 0;
is_position ::= false;
loop
until!( p>=sz );
next ::= s[p];
if next = '$' then
is_position := true;
break!;
end;
until!( ~ next.is_digit );
num := num * 10 + next.int - '0'.int;
p := p + 1;
end;
if is_position then
s := "%" + s.substring( p+1, sz-p-1 );
num := num - 1;
else
num := argnum
end;
if num>=args.size then
return err(illegal_arg_number,"Illegal argument number '"
+ (num+1).str + "'.").str;
end;
argnum := num + 1;
return sprintf( s, args[num] );
end; --cformat
private sprintf( fmt: STR, ob: $FMT ): STR
-- Interface to "sprintf" in C.
is
buf ::= #FSTR(512); -- buffer for C program to write to.
cptr: EXT_OB; -- temp variable to convert char*'s properly.
char: CHAR := fmt[fmt.length-1]; -- letter of '%' expression
--res: INT; -- result of C sprintf.
--Unused due to incompaibilities between SYS5 and BSD.
--sprintf returns `char*' in BSD and `int' in SYS5.
typecase ob
when INT then
check_type( "INT", "diouxX", char );
i ::= ob; -- ensure correct boxing
SYS::inlined_C("sprintf(#buf->arr_part,#fmt->arr_part,#i);");
when CHAR then
check_type( "CHAR", "diouxXc", char );
c ::= ob;
SYS::inlined_C("sprintf(#buf->arr_part,#fmt->arr_part,#c);");
when FLT then
check_type( "FLT", "fgGeE", char );
f ::= ob;
SYS::inlined_C("sprintf(#buf->arr_part,#fmt->arr_part,#f);");
when FLTD then
check_type( "FLTD", "fgGeE", char );
f2 ::= ob;
SYS::inlined_C("sprintf(#buf->arr_part,#fmt->arr_part,#f2);");
when STR then
check_type( "STR", "s", char );
s ::= ob.fstr;
SYS::inlined_C("sprintf(#buf->arr_part,#fmt->arr_part,#s->arr_part);");
else
return err(bad_type,"'%' expression got unexpected type.").str;
end;
--if res <= 0 then
-- return err(sprintf_failed,"C style formatter \""+fmt+"\" failed.").str;
--end;
-- Ensure passing the correct size to the result.
SYS::inlined_C( "#cptr=#buf->arr_part;" );
return STR::create_from_c_string(cptr);
end; -- c_sprintf
private check_type( typename: STR, expect: STR, got: CHAR )
-- Checks whether the character `got' is legal for type of type
-- `typename'. `expect' is the list of legal letters.
-- Raises an expection if the check fails.
is
if expect.search( got ) < 0 then
raise #FMT_ERROR( wrong_type, typename + " needs \"" + expect
+ "\" but got '" + got + "'." );
end;
end; -- check_type
private err( errno: INT, s: STR ): FMT_ERROR
-- Generic error function for convenience.
is
return #FMT_ERROR( errno, s );
end; -- err
end; -- class FMT
class FMT_ERROR_FLAGS
class FMT_ERROR_FLAGS
-- Enumeration of possible errors raised by FMT
is
const
not_supported, -- Wait for next release :-)
wrong_type, -- Argument type conflicts with C style letter.
bad_type, -- Type does not support C style format.
unexpected_end_format,-- Format expression without proper end.
malformed_format, -- Syntax error in Sather style format.
illegal_arg_number, -- Argumentnumber bigger than number of args.
sprintf_failed; -- sprintf returned an error.
end; -- class FMT_ERROR_FLAGS
immutable class FMT_ERROR < $STR
immutable class FMT_ERROR < $STR
-- Errors raised by FMT belong to this class.
is
include FMT_ERROR_FLAGS;
shared raise_exceptions: BOOL := false;
-- Most of the exceptions are returned instead of the string translation
-- of the number. If this flag is set to 'true' all exceptions are being
-- raised for user processing.
-- NEVER touch this variable from within a library!
create(err:INT,s:STR): SAME
is
res: FMT_ERROR := error(err).str(s);
if raise_exceptions then raise res end;
return res;
end; -- create
create(s:STR): SAME
is
return create(malformed_format,s)
end; -- create
readonly attr error: INT;
-- Error type as defined in FMT_ERROR_FLAGS.
readonly attr str: STR;
-- Literal message for the user providing more information.
end; -- class FMT_ERROR