--* From SUTOR%WATSON.vnet.ibm.com@yktvmh.watson.ibm.com  Wed Jun 30 11:54:03 1993
--* Received: from yktvmh.watson.ibm.com by radical.watson.ibm.com (AIX 3.2/UCB 5.64/900524)
--*           id AA13673; Wed, 30 Jun 1993 11:54:03 -0400
--* X-External-Networks: yes
--* Received: from watson.vnet.ibm.com by yktvmh.watson.ibm.com (IBM VM SMTP V2R3)
--*    with BSMTP id 7891; Wed, 30 Jun 93 11:54:53 EDT
--* Received: from YKTVMH by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id <A.SUTOR.NOTE.VAGENT2.0818.Jun.30.11:54:52.-0400>
--*           for asbugs@watson; Wed, 30 Jun 93 11:54:53 -0400
--* Received: from YKTVMH by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id 0816; Wed, 30 Jun 1993 11:54:52 EDT
--* Received: from bengals.watson.ibm.com by yktvmh.watson.ibm.com
--*    (IBM VM SMTP V2R3) with TCP; Wed, 30 Jun 93 11:54:51 EDT
--* Received: by bengals.watson.ibm.com (AIX 3.2/UCB 5.64/930311)
--*           id AA31407; Wed, 30 Jun 1993 11:54:53 -0400
--* Date: Wed, 30 Jun 1993 11:54:53 -0400
--* From: sutor@bengals.watson.ibm.com (Robert S. Sutor)
--* Message-Id: <9306301554.AA31407@bengals.watson.ibm.com>
--* To: asbugs@watson.ibm.com
--* Subject: executable dumps core [roman.as][current]

--@ Fixed  by:  PAB   Thu Oct 14 22:35:08 1993 
--@ Tested by:  fix339.as 
--@ Summary:    fixed by other changes 


--+ The following program dumps core when it runs.
--+ It should be compiled via asharp -D TestRun -r.
#include "aslib.as"

macro {
    SI == SingleInteger;
    I  == Integer;
    C  == Character;
    S  == String;
    V  == Array;
}


RomanFormat: with {
        formatRoman:  I -> S;
            ++ FormatRoman(n) forms a Roman numeral string from an integer n.
        scanRoman:    S -> I;
            ++ ScanRoman(s) forms an integer from a Roman numeral string s.
}
== add {
        macro si(x) == (retract(x)@SI);

        units:V S := array("","I","II","III","IV","V","VI","VII","VIII","IX");
        tens :V S := array("","X","XX","XXX","XL","L","LX","LXX","LXXX","XC");
        hunds:V S := array("","C","CC","CCC","CD","D","DC","DCC","DCCC","CM");
        umin : I := 1;
        tmin : I := 1;
        hmin : I := 1;
        romval:V I := new(tfs, -1) where tfs : SI := 256;
        set!(romval, ord(" ")$C, 0);
        set!(romval, ord("I")$C, 1);
        set!(romval, ord("V")$C, 5);
        set!(romval, ord("X")$C, 10);
        set!(romval, ord("L")$C, 50);
        set!(romval, ord("C")$C, 100);
        set!(romval, ord("D")$C, 500);
        set!(romval, ord("M")$C, 1000);
        thou:C  := "M";
        plen:C  := "(";
        pren:C  := ")";
        ichar:C := "I";

        formatRoman(n : I) : S == {
            if n < 1 then
                error "First argument to FormatRoman must be positive.";

            -- Units
            d : SI := si((n rem 10) + umin);
            n := n quo 10;
            s : S := units.d;

            zero? n => s;

            -- Tens
            d := si((n rem 10) + tmin);
            n := n quo 10;
            s := concat(tens.d, s);
            zero? n => s;

            -- Hundreds
            d := si((n rem 10) + hmin);
            n := n quo 10;
            s := concat(hunds.d, s);
            zero? n => s;

            -- Thousands
            d := si(n rem 10);
            n := n quo 10;
            s := concat(new(d, thou), s);
            zero? n => s;

            -- Ten thousand and higher
            for i in 2.. while not zero? n repeat {
                -- Coefficient of 10**(i+2)
                d := si(n rem 10);
                n := n quo 10;
                if zero? d then iterate;
                m0:String := concat(new(i,plen),concat("I",new(i,pren)));
                mm : String := "";
                for j in 1..d repeat mm := concat(mm, m0);
                -- strictly speaking the blank is gratuitous
                if #s > 0 then s := concat(" ", s);
                s  := concat(mm, s);
            }
            s;
        }

        -- scanRoman
        --
        -- The Algorithm:
        --    Read number from right to left.  When the current
        --    numeral is lower in magnitude than the previous maximum
        --    then subtract otherwise add.
        --    Shift left and repeat until done.

        scanRoman(s : S) : I == {
            s      := map!(upper, s);
            tot: I := 0;
            Max: I := 0;
            i:  SI := # s;
            while i >= 1 repeat {
                -- Read a single roman digit
                c := s.i;
                i := i-1;
                n := romval ord c;
                -- (I)=1000, ((I))=10000, (((I)))=100000, etc
                if n < 0 then {
                    c ~= pren =>
                        error concat("Improper character in Roman numeral: ",
                            new(1$SI,c)$S);
                    nprens: I := 1;
                    while c = pren and i >= 1 repeat {
                       c := s.i;
                       i := i-1;
                       if c = pren then nprens := nprens+1;
                    }
                    c ~= ichar =>
                       error "Improper Roman numeral: (x)";
                    k : I := nprens;
                    while (k > 0) and (i >= 1) repeat {
                       c := s.i;
                       i := i-1;
                       k := k-1;
                       c ~= plen =>
                          error "Improper Roman numeral: unbalanced ')'";
                    }
                    n := 10^(nprens + 2);
                }
                if n < Max then
                    tot := tot - n;
                else {
                    tot := tot + n;
                    Max := n;
                }
            }
            return tot;
        }
}

#if TestRun
f(): Integer == {
    import RomanFormat;
    import Integer;
    import Outport;

--  print(formatRoman(1))();
    print(formatRoman(2))();
--  print(formatRoman(3))();
--  print(formatRoman(4))();
--  print(formatRoman(5))();
--  print(formatRoman(10))();
--  print(formatRoman(11))();
--  print(formatRoman(100))();
--  print(formatRoman(111))();
--  print(formatRoman(1110))();
--  print(formatRoman(1993))();
    3;
}
f();
#endif