--* From BMT%WATSON.vnet.ibm.com@yktvmv.watson.ibm.com  Fri Aug 12 17:47:54 1994
--* Received: from yktvmv-ob.watson.ibm.com by asharp.watson.ibm.com (AIX 3.2/UCB 5.64/930311)
--*           id AA19722; Fri, 12 Aug 1994 17:47:54 -0400
--* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3)
--*    with BSMTP id 9153; Fri, 12 Aug 94 17:47:57 EDT
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id <A.BMT.NOTE.VAGENT2.7751.Aug.12.17:47:56.-0400>
--*           for asbugs@watson; Fri, 12 Aug 94 17:47:57 -0400
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id 7745; Fri, 12 Aug 1994 17:47:56 EDT
--* Received: from spadserv.watson.ibm.com by yktvmv.watson.ibm.com
--*    (IBM VM SMTP V2R3) with TCP; Fri, 12 Aug 94 17:47:55 EDT
--* Received: by spadserv.watson.ibm.com (AIX 3.2/UCB 5.64/900524)
--*           id AA14626; Fri, 12 Aug 1994 17:45:40 -0400
--* Date: Fri, 12 Aug 1994 17:45:40 -0400
--* From: bmt@spadserv.watson.ibm.com
--* X-External-Networks: yes
--* Message-Id: <9408122145.AA14626@spadserv.watson.ibm.com>
--* To: asbugs@watson.ibm.com
--* Subject: [5] [Free: j]Bug: unhandled iteration form

--@ Fixed  by:  PAB   Fri Aug 12 20:09:05 EDT 1994 
--@ Tested by:  romnum.as 
--@ Summary:    added code in gf_gener 


-- Command line: asharp -b /spad/mnt/rios/asharp nformat.as
-- Version: 0.36.2
-- Original bug file name: nformat.as

#include "axiom.as"
NUMFMT ==> NumberFormats;

PI ==> PositiveInteger;

I ==> Integer;

C ==> Character;

S ==> String;

V ==> PrimitiveArray;

+++ NumberFormats provides function to format and read arabic and roman numbers,
+++ and to convert numbers to strings.
RomanNumberFormats: with {
        formatRoman: PI -> S;
        scanRoman: S -> PI;
}
== add {
        import from S;
        import from List S;
        import from I;
        import from SingleInteger;
        import from NonNegativeInteger;
        units := ["","I","II","III","IV","V","VI","VII","VIII","IX"];
        tens := ["","X","XX","XXX","XL","L","LX","LXX","LXXX","XC"];
        hunds := ["","C","CC","CCC","CD","D","DC","DCC","DCCC","CM"];
        umin := minIndex units;
        tmin := minIndex tens;
        hmin := minIndex hunds;
        romval:V I := new(256::NonNegativeInteger,- 1$Integer);
        import from C;
        romval ord char(" ") := 0;
        romval ord char("I") := 1;
        romval ord char("V") := 5;
        romval ord char("X") := 10;
        romval ord char("L") := 50;
        romval ord char("C") := 100;
        romval ord char("D") := 500;
        romval ord char("M") := 1000;
        thou := char "M";
        plen := char "(";
        pren := char ")";
        ichar := char "I";
        formatRoman (pn:PI):S == {
                local j,i: SingleInteger;
                n := pn::Integer;
                d := n rem 10@Integer + umin;
                n := n quo 10@Integer;
                s := units d;
                zero? n => s;
                d := n rem 10@Integer + tmin;
                n := n quo 10@Integer;
                s := concat(tens d,s);
                zero? n => s;
                d := n rem 10@Integer + hmin;
                n := n quo 10@Integer;
                s := concat(hunds d,s);
                zero? n => s;
                d := n rem 10@Integer;
                n := n quo 10@Integer;
                s := concat(new(d::NonNegativeInteger,thou),s);
                zero? n => s;
                import from UniversalSegment(SingleInteger);
                for (free i) in 2@SingleInteger.. while not (zero? n) repeat {
                        d := n rem 10@Integer;
                        n := n quo 10@Integer;
                        zero? d => iterate;
                        m0:S :=
                          concat(new(i::Integer::NonNegativeInteger,plen),
                            concat("I",new(i::Integer::NonNegativeInteger,pren)));
                        mm := concat([m0 for (free j) in 1..(d::SingleInteger)]$List(S));
                        if 0 < #s then s := concat(" ",s);
                        s := concat(mm,s);
                }
                s;
        }

        scanRoman (s:S):PI == {
                local k:SingleInteger;
                import from UniversalSegment SingleInteger;
                s := upperCase s;
                tot:I := 0;
                Max:I := 0;
                i:I := maxIndex s;
                while not (i < minIndex s) repeat {
                        c := s i;
                        i := i - 1$Integer;
                        n := romval ord c;
                        if n < 0$Integer then {
                                c = pren => {
                                        nprens:PI := 1;
                                        while c = pren and not (i < minIndex s)
                                          repeat {
                                                c := s i;
                                                i := i - 1$Integer;
                                                c = pren => nprens := nprens + 1;
                                        }
                                        c = ichar => {
                                                for (free k) in 1..(nprens::Integer::SingleInteger)
                                                  while not (i < minIndex s)
                                                  repeat {
                                                        c := s i;
                                                        i := i - 1$Integer;
                                                        c ~= plen =>
                                                           error "Improper Roman numeral: unbalanced ')'";
                                                }
                                                n :=
                                                  (10 ^ (nprens + 2))@Integer;
                                        }
                                        error "Improper Roman numeral: (x)";
                                }
                                error (["Improper character in Roman numeral: ",c::S])$ErrorFunctions;
                        }
                        n < Max => tot := tot - n;
                        tot := tot + n;
                        Max := n;
                }
                tot < 0$Integer => error(["Improper Roman numeral: ",convert(tot)@S])$ErrorFunctions;
                tot::PositiveInteger;
        }

}