Source code in the snobol4 programming language

* ROMAN(N) - Convert integer N to Roman numeral form.
*
*  N must be positive and less than 4000.
*
*  An asterisk appears in the result if N >= 4000.
*
*  The function fails if N is not an integer.

	DEFINE('ROMAN(N)UNITS')              :(ROMAN_END)

*  Get rightmost digit to UNITS and remove it from N.
*  Return null result if argument is null.
ROMAN	N RPOS(1) LEN(1) . UNITS =           :F(RETURN)

*  Search for digit, replace with its Roman form.
*  Return failing if not a digit.
	'0,1I,2II,3III,4IV,5V,6VI,7VII,8VIII,9IX,'  UNITS 
+	BREAK(',') . UNITS                 :F(FRETURN)

*  Convert rest of N and multiply by 10.  Propagate a
*  failure return from recursive call back to caller.
	ROMAN = REPLACE(ROMAN(N), 'IVXLCDM', 'XLCDM**') 
+	UNITS            :S(RETURN) F(FRETURN)
ROMAN_END

*	Testing
	OUTPUT = "1999 = " ROMAN(1999)
	OUTPUT = "  24 = " ROMAN(24)
	OUTPUT = " 944 = " ROMAN(944)

END

*       # Arabic to Roman
        define('roman(n)s,ch,val,str') :(roman_end)
roman   roman = ge(n,4000) n :s(return)
        s = 'M1000 CM900 D500 CD400 C100 XC90 L50 XL40 X10 IX9 V5 IV4 I1 '
rom1    s span(&ucase) . ch break(' ') . val span(' ') = :f(rom2)
        str = str dupl(ch,(n / val))
        n = remdr(n,val) :(rom1)
rom2    roman = str :(return)
roman_end        

*       # Roman to Arabic
        define('arabic(n)s,ch,val,sum,x') :(arabic_end)
arabic  s = 'M1000 D500 C100 L50 X10 V5 I1 '
        n = reverse(n)
arab1   n len(1) . ch = :f(arab2)
        s ch break(' ') . val
        val = lt(val,x) (-1 * val)
        sum = sum + val; x = val :(arab1)
arab2   arabic = sum :(return)
arabic_end        

*       # Test and display
        tstr = '2010 1999 1492 1066 476 '
tloop   tstr break(' ') . year span(' ') = :f(out)
        r = roman(year)
        rstr = rstr year '=' r ' ' 
        astr = astr r '=' arabic(r) ' ' :(tloop)
out     output = rstr; output = astr
end