: vector ( ...n"- )
  here [ &, times ] dip : .data ` swap ` + ` @ ` do ` ; ;
: .I  dup     @ ^buffer'add ;
: .V  dup 1 + @ ^buffer'add ;
: .X  dup 2 + @ ^buffer'add ;

[ .I .X       drop ]
[ .V .I .I .I drop ]
[ .V .I .I    drop ]
[ .V .I       drop ]
[ .V          drop ]
[ .I .V       drop ]
[ .I .I .I    drop ]
[ .I .I       drop ]
[ .I          drop ]
&drop
10 vector .digit

: record ( an- )
  10 /mod dup [ [ over 2 + ] dip record ] &drop if .digit ;
: toRoman   ( n-a )
  here ^buffer'set
  dup 1 3999 within 0 =
  [ "EX LIMITO!\n" ] [ "IVXLCDM" swap record here ] if ;


/* repunit_primes.wren */

import "./gmp" for Mpz
import "./math" for Int
import "./fmt" for Fmt
import "./str" for Str

var limit = 2700
var primes = Int.primeSieve(limit)

for (b in 2..36) {
    var rPrimes = []
    for (p in primes) {
        var s = Mpz.fromStr(Str.repeat("1", p), b)
        if (s.probPrime(15) > 0) rPrimes.add(p)
    }
    Fmt.print("Base $2d: $n", b, rPrimes)
}


addsub: function [x y]->
    @[x+y x-y]

a: 33
b: 12

result: addsub a b

print [a "+" b "=" result\0]
print [a "-" b "=" result\1]


//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

fun addsub
(
  x: int, y: int
) : (int, int) = (x+y, x-y)

(* ****** ****** *)

implement
main0 () = let
  val (sum, diff) = addsub (33, 12)
in
  println! ("33 + 12 = ", sum);
  println! ("33 - 12 = ", diff);
end (* end of [main0] *)


addsub(x, y) {
  return [x + y, x - y]
}


roman: procedure
arg number

/* handle only 1 to 3999, else return ? */
if number >= 4000 | number <= 0 then return "?"

romans = "   M  CM   D  CD   C  XC  L  XL  X IX  V IV  I"
arabic = "1000 900 500 400 100  90 50  40 10  9  5  4  1"

result = ""
do i = 1 to words(romans)
  do while number >= word(arabic,i)
    result = result || word(romans,i)
    number = number - word(arabic,i)
  end
end
return result


arabic = [1000, 900, 500, 400, 100, 90, 50,  40,  10,  9,  5,   4,  1]
roman  = ["M", "CM", "D", "CD", "C" ,"XC", "L", "XL" ,"X", "IX", "V", "IV", "I"]

see "2009 = " + toRoman(2009) + nl
see "1666 = " + toRoman(1666) + nl
see "3888 = " + toRoman(3888) + nl

func toRoman val
     result = ""
     for i = 1 to 13
         while val >= arabic[i]
               result = result + roman[i]
               val = val - arabic[i]
         end
      next
      return result


Func _AddSub($iX, $iY)
Local $aReturn[2]
$aReturn[0] = $iX + $iY
$aReturn[1] = $iX - $iY
Return $aReturn
EndFunc


' Return multiple values
RECORD multi
    LOCAL num
    LOCAL s$[2]
END RECORD

FUNCTION f(n) TYPE multi_type
    LOCAL r = { 0 } TYPE multi_type
    r.num = n
    r.s$[0] = "Hitchhiker's Guide"
    r.s$[1] = "Douglas Adams"
    RETURN r
END FUNCTION

DECLARE rec TYPE multi_type
rec = f(42)
PRINT rec.num
PRINT rec.s$[0]
PRINT rec.s$[1]


Symbols = { 1=>'I', 5=>'V', 10=>'X', 50=>'L', 100=>'C', 500=>'D', 1000=>'M' }
Subtractors = [ [1000, 100], [500, 100], [100, 10], [50, 10], [10, 1], [5, 1], [1, 0] ]

def roman(num)
  return Symbols[num]  if Symbols.has_key?(num)
  Subtractors.each do |cutPoint, subtractor|
    return roman(cutPoint) + roman(num - cutPoint)      if num >  cutPoint
    return roman(subtractor) + roman(num + subtractor)  if num >= cutPoint - subtractor and num < cutPoint
  end
end

[1990, 2008, 1666].each do |i|
  puts "%4d => %s" % [i, roman(i)]
end


#include<stdio.h>

typedef struct{
	int integer;
	float decimal;
	char letter;
	char string[100];
	double bigDecimal;
}Composite;

Composite example()
{
	Composite C = {1, 2.3, 'a', "Hello World", 45.678};
	return C;
}

int main()
{
	Composite C = example();

	printf("Values from a function returning a structure : { %d, %f, %c, %s, %f}\n", C.integer, C.decimal, C.letter, C.string, C.bigDecimal);

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

class ReturnMultipleValues
{
    static void Main()
    {
        var values = new[] { 4, 51, 1, -3, 3, 6, 8, 26, 2, 4 };
        int max, min;
        MinMaxNum(values, out max, out min);

        Console.WriteLine("Min: {0}\nMax: {1}", min, max);
    }

    static void MinMaxNum(IEnumerable<int> nums, out int max, out int min)
    {
        var sortedNums = nums.OrderBy(num => num).ToArray();
        max = sortedNums.Last();
        min = sortedNums.First();
    }
}


struct RomanNumeral {
    symbol: &'static str,
    value: u32
}

const NUMERALS: [RomanNumeral; 13] = [
    RomanNumeral {symbol: "M",  value: 1000},
    RomanNumeral {symbol: "CM", value: 900},
    RomanNumeral {symbol: "D",  value: 500},
    RomanNumeral {symbol: "CD", value: 400},
    RomanNumeral {symbol: "C",  value: 100},
    RomanNumeral {symbol: "XC", value: 90},
    RomanNumeral {symbol: "L",  value: 50},
    RomanNumeral {symbol: "XL", value: 40},
    RomanNumeral {symbol: "X",  value: 10},
    RomanNumeral {symbol: "IX", value: 9},
    RomanNumeral {symbol: "V",  value: 5},
    RomanNumeral {symbol: "IV", value: 4},
    RomanNumeral {symbol: "I",  value: 1}
];

fn to_roman(mut number: u32) -> String {
    let mut min_numeral = String::new();
    for numeral in NUMERALS.iter() {
        while numeral.value <= number {
            min_numeral = min_numeral + numeral.symbol;
            number -= numeral.value;
        }
    }
    min_numeral
}

fn main() {
    let nums = [2014, 1999, 25, 1666, 3888];
    for &n in nums.iter() {
        // 4 is minimum printing width, for alignment
        println!("{:2$} = {}", n, to_roman(n), 4);
    }
}


#include <algorithm>
#include <array>
#include <cstdint>
#include <iostream>
#include <tuple>

std::tuple<int, int> minmax(const int * numbers, const std::size_t num) {
   const auto maximum = std::max_element(numbers, numbers + num);
   const auto minimum = std::min_element(numbers, numbers + num);
   return std::make_tuple(*minimum, *maximum) ;
}

int main( ) {
   const auto numbers = std::array<int, 8>{{17, 88, 9, 33, 4, 987, -10, 2}};
   int min{};
   int max{};
   std::tie(min, max) = minmax(numbers.data(), numbers.size());
   std::cout << "The smallest number is " << min << ", the biggest " << max << "!\n" ;
}


Function Addsub( x, y )
Return { x+y, x-y }


val romanDigits = Map(
  1 -> "I", 5 -> "V",
  10 -> "X", 50 -> "L",
  100 -> "C", 500 -> "D",
  1000 -> "M",
  4 -> "IV", 9 -> "IX",
  40 -> "XL", 90 -> "XC",
  400 -> "CD", 900 -> "CM")
val romanDigitsKeys = romanDigits.keysIterator.toList sortBy (x => -x)
def toRoman(n: Int): String = romanDigitsKeys find (_ >= n) match {
  case Some(key) => romanDigits(key) + toRoman(n - key)
  case None => ""
}


(define (to-roman n)
  (format "[email protected]" n))


(defn quot-rem [m n] [(quot m n) (rem m n)])

; The following prints 3 2.
(let [[q r] (quot-rem 11 3)]
  (println q)
  (println r))


% Returning multiple values (along with type parameterization)
% was actually invented with CLU.

% Do note that the procedure is actually returning multiple
% values; it's not returning a tuple and unpacking it.
% That doesn't exist in CLU.

% For added CLU-ness, this function is fully general, requiring
% only that its arguments support addition and subtraction in any way

add_sub = proc [T,U,V,W: type] (a: T, b: U) returns (V, W)
          signals (overflow)
          where T has add: proctype (T,U) returns (V) signals (overflow),
                      sub: proctype (T,U) returns (W) signals (overflow)
    return (a+b, a-b) resignal overflow
end add_sub

% And actually using it
start_up = proc ()
    add_sub_int = add_sub[int,int,int,int] % boring, but does what you'd expect
    po: stream := stream$primary_output()

    % returning two values from the function
    sum, diff: int := add_sub_int(33, 12)

    % print out both
    stream$putl(po, "33 + 12 = " || int$unparse(sum))
    stream$putl(po, "33 - 12 = " || int$unparse(diff))
end start_up


# Returns the first and last characters of string.
function(firstlast string first last)
  # f = first character.
  string(SUBSTRING "${string}" 0 1 f)

  # g = last character.
  string(LENGTH "${string}" length)
  math(EXPR index "${length} - 1")
  string(SUBSTRING "${string}" ${index} 1 g)

  # Return both characters.
  set("${first}" "${f}" PARENT_SCOPE)
  set("${last}" "${g}" PARENT_SCOPE)
endfunction(firstlast)

firstlast("Rosetta Code" begin end)
message(STATUS "begins with ${begin}, ends with ${end}")


$ include "seed7_05.s7i";
  include "stdio.s7i";
  include "wrinum.s7i";

const proc: main is func
  local
    var integer: number is 0;
  begin
    for number range 1 to 3999 do
      writeln(str(ROMAN, number));
    end for;
  end func;


function RomanNumeralsEncode number
	put [
		(1, "I"),
		(4, "IV"),
		(5, "V"),
		(9, "IX"),
		(10, "X"),
		(40, "XL"),
		(50, "L"),
		(90, "XC"),
		(100, "C"),
		(400, "CD"),
		(500, "D"),
		(900, "CM"),
		(1000, "M")
	] into values

	repeat for index = each item of (the number of items in values)..1
		put item index of values into pair
		repeat while number is greater than or equal to the first item of pair
			put the second item of pair after numerals
			subtract the first item of pair from number
		end repeat
	end repeat
	return numerals
end RomanNumeralsEncode


       identification division.
       program-id. multiple-values.

       environment division.
       configuration section.
       repository.
           function multiples
           function all intrinsic.

       REPLACE ==:linked-items:== BY ==
       01 a usage binary-long.
       01 b pic x(10).
       01 c usage float-short.
       ==
       ==:record-item:== BY ==
       01 master.
          05 ma usage binary-long.
          05 mb pic x(10).
          05 mc usage float-short.
       ==.

       data division.
       working-storage section.
       :linked-items:

       :record-item:

       procedure division.
       sample-main.

       move 41 to a
       move "aaaaabbbbb" to b
       move function e to c

       display "Original: " a ", " b ", " c
       call "subprogram" using a b c
       display "Modified: " a ", " b ", " c

       move multiples() to master
       display "Multiple: " ma ", " mb ", " mc

       goback.
       end program multiple-values.

      *> subprogram
       identification division.
       program-id. subprogram.

       data division.
       linkage section.
       :linked-items:

       procedure division using a b c.
       add 1 to a
       inspect b converting "a" to "b"
       divide 2 into c
       goback.
       end program subprogram.

      *> multiples function
       identification division.
       function-id. multiples.

       data division.
       linkage section.
       :record-item:

       procedure division returning master.
       move 84 to ma
       move "multiple" to mb
       move function pi to mc
       goback.
       end function multiples.


examples := [2008, 1666, 1990];

for example in examples loop
    print( roman_numeral(example) );
end loop;

proc roman_numeral( n );
    R := [[1000, 'M'], [900, 'CM'], [500, 'D'], [400, 'CD'], [100, 'C'], [90, 'XC'], [50, 'L'], [40, 'XL'], [10, 'X'], [9, 'IX'], [5, 'V'], [4, 'IV'], [1, 'I']];
    roman := '';
    for numeral in R loop
        while n >= numeral(1) loop
            n := n - numeral(1);
            roman := roman + numeral(2);
        end loop;
    end loop;
    return roman;
end;


(define encodeGlyphs
  ACC 0 _ -> ACC
  ACC N [Glyph Value | Rest] -> (encodeGlyphs (@s ACC Glyph) (- N Value) [Glyph Value | Rest]) where (>= N Value)
  ACC N [Glyph Value | Rest] -> (encodeGlyphs ACC N Rest)
)

(define encodeRoman
  N -> (encodeGlyphs "" N ["M" 1000 "CM" 900 "D" 500 "CD" 400 "C" 100 "XC" 90 "L" 50 "XL" 40 "X" 10 "IX" 9 "V" 5 "IV" 4 "I" 1])
)


include "cowgol.coh";

# In Cowgol, subroutines can simply define multiple output parameters.
sub MinMax(arr: [uint8], len: intptr): (min: uint8, max: uint8) is
    min := 255;
    max := 0;
    while len > 0 loop
        len := len - 1;
        var cur := [arr];
        if min > cur then min := cur; end if;
        if max < cur then max := cur; end if;
        arr := @next arr;
    end loop;

    # Values are also returned automatically.
end sub;

# Example of usage:
var nums: uint8[] := {23, 65, 33, 12, 95, 5, 32, 91, 135, 25, 8};
var least: uint8;
var most: uint8;

# Accept two output parameters from a function
(least, most) := MinMax(&nums[0], @sizeof nums);

print("Min: "); print_i8(least); print_nl();
print("Max: "); print_i8(most); print_nl();


import std.stdio, std.typecons, std.algorithm;

mixin template ret(string z) {
    mixin({
        string res;

        auto r = z.split(" = ");
        auto m = r[0].split(", ");
        auto s = m.join("_");

        res ~= "auto " ~ s ~ " = " ~ r[1] ~ ";";
        foreach(i, n; m){
            res ~= "auto " ~ n ~ " = " ~ s ~ "[" ~ i.to!string ~ "];\n";
        }
        return res;
    }());
}

auto addSub(T)(T x, T y) {
    return tuple(x + y, x - y);
}

void main() {
    mixin ret!q{ a, b = addSub(33, 12) };

    writefln("33 + 12 = %d\n33 - 12 = %d", a, b);
}


func arabic2roman(num, roman='') {
    static lookup = [
        :M:1000, :CM:900, :D:500,
        :CD:400, :C:100,  :XC:90,
        :L:50,   :XL:40,  :X:10,
        :IX:9,   :V:5,    :IV:4,
        :I:1
    ];
    lookup.each { |pair|
        while (num >= pair.second) {
            roman += pair.first;
            num -= pair.second;
        }
    }
    return roman;
}
say("1990 in roman is " + arabic2roman(1990));
say("2008 in roman is " + arabic2roman(2008));
say("1666 in roman is " + arabic2roman(1666));


BEGIN

    TEXT PROCEDURE TOROMAN(N); INTEGER N;
    BEGIN
        PROCEDURE P(WEIGHT,LIT); INTEGER WEIGHT; TEXT LIT;
        BEGIN
            WHILE N >= WEIGHT DO
            BEGIN
                T :- T & LIT;
                N := N - WEIGHT;
            END WHILE;
        END P;
        TEXT T; T :- NOTEXT;
        P( 1000, "M"  );
        P(  900, "CM" );
        P(  500, "D"  );
        P(  400, "CD" );
        P(  100, "C"  );
        P(   90, "XC" );
        P(   50, "L"  );
        P(   40, "XL" );
        P(   10, "X"  );
        P(    9, "IX" );
        P(    5, "V"  );
        P(    4, "IV" );
        P(    1, "I"  );
        TOROMAN :- T;
    END TOROMAN;

    INTEGER Y;
    FOR Y := 1990, 2008, 1666 DO
    BEGIN
        OUTTEXT("YEAR ");
        OUTINT(Y, 4);
        OUTTEXT(" => ");
        OUTTEXT(TOROMAN(Y));
        OUTIMAGE;
    END FOR;

END PROGRAM;


program ReturnMultipleValues;

{$APPTYPE CONSOLE}

procedure GetTwoValues(var aParam1, aParam2: Integer);
begin
  aParam1 := 100;
  aParam2 := 200;
end;

var
  x, y: Integer;
begin
  GetTwoValues(x, y);
  Writeln(x);
  Writeln(y);
end.


func divRem(x, y) {
    (x / y, x % y)
}


* 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


function-returning-multiple-values:
     10 20

!print !print function-returning-multiple-values


(define (plus-minus x y)
    (values (+ x y) (- x y)))
(plus-minus 3 4)
    → 7
     -1

(define (plus-minus x y)
    (list (+ x y) (- x y)))
(plus-minus 3 4)
    → (7 -1)


MyFunc(INTEGER i1,INTEGER i2) := FUNCTION
  RetMod := MODULE
    EXPORT INTEGER Add  := i1 + i2;
    EXPORT INTEGER Prod := i1 * i2;
  END;
  RETURN RetMod;
END;

//Reference each return value separately:
MyFunc(3,4).Add;
MyFunc(3,4).Prod;


--
-- This only works under Oracle and has the limitation of 1 to 3999

SQL> SELECT to_char(1666, 'RN') urcoman, to_char(1666, 'rn') lcroman FROM dual;

URCOMAN         LCROMAN
--------------- ---------------
        MDCLXVI         mdclxvi


some_feature: TUPLE
	do
		Result := [1, 'j', "r"]
	end


import system'routines;
import extensions;

extension op
{
    MinMax(ref int minVal, ref int maxVal)
    {
        var ordered := self.ascendant();

        minVal := ordered.FirstMember;
        maxVal := ordered.LastMember
    }
}

public program()
{
    var values := new int[]{4, 51, 1, -3, 3, 6, 8, 26, 2, 4};

    values.MinMax(ref int min, ref int max);

    console.printLine("Min: ",min," Max: ",max)
}


defmodule RC do
  def addsub(a, b) do
    {a+b, a-b}
  end
end

{add, sub} = RC.addsub(7, 4)
IO.puts "Add: #{add},\tSub: #{sub}"


def digits: [(M:1000"1"), (CM:900"1"), (D:500"1"), (CD:400"1"), (C:100"1"), (XC:90"1"), (L:50"1"), (XL:40"1"), (X:10"1"), (IX:9"1"), (V:5"1"), (IV:4"1"), (I:1"1")];
templates encodeRoman
  @: 1;
  '$ -> #;' !
  when <$digits([email protected])::value..> do
    $digits([email protected])::key !
    $ - $digits([email protected])::value -> #
  when <1..> do
    @:[email protected] + 1;
    $ -> #
end encodeRoman

1990 -> encodeRoman -> !OUT::write
'
' -> !OUT::write
2008 -> encodeRoman -> !OUT::write
'
' -> !OUT::write
1666 -> encodeRoman -> !OUT::write


% Put this code in return_multi.erl and run it as "escript return_multi.erl"

-module(return_multi).

main(_) ->
        {C, D, E} = multiply(3, 4),
        io:format("~p ~p ~p~n", [C, D, E]).

multiply(A, B) ->
        {A * B, A + B, A - B}.


PROGRAM RETURN_VALUES

PROCEDURE SUM_DIFF(A,B->C,D)
   C=A+B
   D=A-B
END PROCEDURE

BEGIN
   SUM_DIFF(5,3->SUM,DIFF)
   PRINT("Sum is";SUM)
   PRINT("Difference is";DIFF)
END PROGRAM


include std\console.e --only for any_key, to help make running this program easy on windows GUI

integer aWholeNumber = 1
atom aFloat = 1.999999
sequence aSequence = {3, 4}
sequence result = {} --empty initialized sequence

function addmultret(integer first, atom second, sequence third)--takes three kinds of input, adds them all into one element of the..
    return (first + second + third[1]) + third[2] & (first * second * third[1]) * third[2] --..output sequence and multiplies them into..
end function --..the second element

result = addmultret(aWholeNumber, aFloat, aSequence) --call function, assign what it gets into result - {9.999999, 23.999988}
? result
any_key()


proc to_roman {i} {
    set map {1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I}
    foreach {value roman} $map {
        while {$i >= $value} {
            append res $roman
            incr i -$value
        }
    }
    return $res
}


PROGRAM:DEC2ROM
:"="→Str1
:Lbl ST
:ClrHome
:Disp "NUMBER TO"
:Disp "CONVERT:"
:Input A
:If fPart(A) or A≠abs(A)
:Then
:Goto PI
:End
:A→B
:While B≥1000
:Str1+"M"→Str1
:B-1000→B
:End
:If B≥900
:Then
:Str1+"CM"→Str1
:B-900→B
:End
:If B≥500
:Then
:Str1+"D"→Str1
:B-500→B
:End
:If B≥400
:Then
:Str1+"CD"?Str1
:B-400→B
:End
:While B≥100
:Str1+"C"→Str1
:B-100→B
:End
:If B≥90
:Then
:Str1+"XC"→Str1
:B-90→B
:End
:If B≥50
:Then
:Str1+"L"→Str1
:B-50→B
:End
:If B≥40
:Then
:Str1+"XL"→Str1
:B-40→B
:End
:While B≥10
:Str1+"X"→Str1
:B-10→B
:End
:If B≥9
:Then
:Str1+"IX"→Str1
:B-9→B
:End
:If B≥5
:Then
:Str1+"V"→Str1
:B-5→B
:End
:If B≥4
:Then
:Str1+"IV"→Str1
:B-4→B
:End
:While B>0
:Str1+"I"→Str1
:B-1→B
:End
:ClrHome
:Disp A
:Disp Str1
:Stop
:Lbl PI
:ClrHome
:Disp "THE NUMBER MUST"
:Disp "BE A POSITIVE"
:Disp "INTEGER."
:Pause
:Goto ST


let addSub x y = x + y, x - y

let sum, diff = addSub 33 12
printfn "33 + 12 = %d" sum
printfn "33 - 12 = %d" diff


USING: io kernel math prettyprint ;
IN: script

: */ ( x y -- x*y x/y )
    [ * ] [ / ] 2bi ;

15 3 */

[ "15 * 3 = " write . ]
[ "15 / 3 = " write . ] bi*


[\[email protected][email protected]*@@/]f: { in: a b, out: a*b a/b }
6 2f;! .` ,.   { 3 12 }


OPTION BASE 0
DIM arabic(12), roman$(12)

FOR i = 0 TO 12
    READ arabic(i), roman$(i)
NEXT i

DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"
DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V",  4, "IV", 1, "I"

FUNCTION toRoman$(value)
    LET result$ = ""
    FOR i = 0 TO 12
        DO WHILE value >= arabic(i)
           LET result$ = result$ & roman$(i)
           LET value = value - arabic(i)
        LOOP
    NEXT i
    LET toRoman$ = result$
END FUNCTION

!Testing
PRINT "2009 = "; toRoman$(2009)
PRINT "1666 = "; toRoman$(1666)
PRINT "3888 = "; toRoman$(3888)
END


: muldiv ( a b -- a*b a/b )
  2dup / >r * r> ;


module multiple_values
implicit none
type res
  integer :: p, m
end type

contains

function addsub(x,y) result(r)
  integer :: x, y
  type(res) :: r
  r%p = x+y
  r%m = x-y
end function
end module

program main
  use multiple_values
  print *, addsub(33, 22)
end program


' FB 1.05.0 Win64

' One way to return multiple values is to use ByRef parameters for the additional one(s)
Function tryOpenFile (fileName As String, ByRef fileNumber As Integer) As Boolean
   Dim result As Integer
   fileNumber = FreeFile
   result = Open(fileName For Input As # fileNumber)
   If result <> 0 Then
     fileNumber = 0
     Return False
   Else
     Return True
   End If
End Function

Dim fn As Integer
Var b = tryOpenFile("xxx.zyz", fn) '' this file doesn't exist
Print b, fn
b = tryOpenFile("input.txt", fn) '' this file does exist
Print b, fn
Close # fn

' Another way is to use a user defined type

Type FileOpenInfo
  opened As Boolean
  fn As Integer
End Type

Function tryOpenFile2(fileName As String) As FileOpenInfo
   Dim foi As FileOpenInfo
   foi.fn = FreeFile
   Dim result As Integer
   result = Open(fileName For Input As # foi.fn)
   If  result <> 0 Then
     foi.fn = 0
     foi.opened = False
   Else
     foi.Opened = True
   End If
   Return foi
End Function

Print
Var foi = tryOpenFile2("xxx.zyz")
Print foi.opened, foi.fn
foi = tryOpenFile2("input.txt")
Print foi.opened, foi.fn
Close # foi.fn

Print
Print "Press any key to quit"
Sleep


$$ MODE TUSCRIPT
LOOP arab_number="1990'2008'1666"
roman_number = ENCODE (arab_number,ROMAN)
PRINT "Arabic number ",arab_number, " equals ", roman_number
ENDLOOP


// Roman numerals/Encode

const weightsSymbols: [number, string][] =
  [[1000, 'M'], [900, 'CM'], [500, 'D'], [400, 'CD'], [100, 'C'], [90, 'XC'],
  [50, 'L'], [40, 'XL'], [10, 'X'], [9, 'IX'], [5, 'V'], [4, 'IV'], [1, 'I']];
// 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded
// with these symbols.

function toRoman(n: number): string {
  var roman = ""; // Result
  for (i = 0; i <= 12 && n > 0; i++) {
    var w = weightsSymbols[i][0];
    while (n >= w) {
      roman += weightsSymbols[i][1];
      n -= w;
    }
  }
  return roman;
}

console.log(toRoman(1990)); // MCMXC
console.log(toRoman(2022)); // MMXXII
console.log(toRoman(3888)); // MMMDCCCLXXXVIII


divMod[a, b] := [a div b, a mod b]

[num, remainder] = divMod[10, 3]


def addsub( x, y ) = (x + y, x - y)

val (sum, difference) = addsub( 33, 12 )

println( sum, difference, addsub(33, 12) )


include "ConsoleWindow"

local fn ReturnMultipleValues( strIn as Str255, strOut as ^Str255, letterCount as ^long )
dim as Str255 s

// Test if incoming string is empty, and exit function if it is
if strIn[0] == 0 then exit fn

// Prepend this string to incoming string and return it
s = "Here is your original string: "
strOut.nil$ = s + strIn

// Get length of combined string and return it
// Note: In FutureBasic string[0] is interchangeable with Len(string)
letterCount.nil& = strIn[0] + s[0]
end fn

dim as Str255 outStr
dim as long   outCount

fn ReturnMultipleValues( "Hello, World!", @outStr, @outCount )
print outStr; ". The combined strings have"; outCount; " letters in them."


func addsub(x, y int) (int, int) {
  return x + y, x - y
}


Push 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000
                                       ' Initialize array
For i = 12 To 0 Step -1
  @(i) = Pop()
Next
                                       ' Calculate and print numbers
Print 1999, : Proc _FNroman (1999)
Print 2014, : Proc _FNroman (2014)
Print 1666, : Proc _FNroman (1666)
Print 3888, : Proc _FNroman (3888)

End

_FNroman Param (1)                     ' ( n --)
  Local (1)                            ' Define [email protected]
                                       ' Try all numbers in array
  For [email protected] = 12 To 0 Step -1
    Do While [email protected] > @([email protected]) - 1            ' Several occurences of same number?
      GoSub (([email protected] + 1) * 10)            ' Print roman digit
      [email protected] = [email protected] - @([email protected])                  ' Decrement number
    Loop
  Next

  Print                                ' Terminate line
Return
                                       ' Print roman digits
 10 Print "I";  : Return
 20 Print "IV"; : Return
 30 Print "V";  : Return
 40 Print "IX"; : Return
 50 Print "X";  : Return
 60 Print "XL"; : Return
 70 Print "L";  : Return
 80 Print "XC"; : Return
 90 Print "C";  : Return
100 Print "CD"; : Return
110 Print "D";  : Return
120 Print "CM"; : Return
130 Print "M";  : Return


roman() {
    local values=( 1000 900 500 400 100 90 50 40 10 9 5 4 1 )
    local roman=(
        [1000]=M [900]=CM [500]=D [400]=CD
         [100]=C  [90]=XC  [50]=L  [40]=XL
          [10]=X   [9]=IX   [5]=V   [4]=IV
           [1]=I
    )
    local nvmber=""
    local num=$1
    for value in ${values[@]}; do
        while (( num >= value )); do
            nvmber+=${roman[value]}
            ((num -= value))
        done
    done
    echo $nvmber
}

for test in 1999 24 944 1666 2008; do
    printf "%d = %s\n" $test $(roman $test)
done


def addSub(x,y) {
 [
  sum: x+y,
  difference: x-y
 ]
}


FUNCTION Addsub( x, y )
   RETURN { x + y, x - y }


string to_roman(int n)
  requires (n > 0 && n < 5000)
{
  const int[] weights = {1000, 900, 500, 400, 100, 90,
                         50, 40, 10, 9, 5, 4, 1};
  const string[] symbols = {"M","CM","D","CD","C","XC","L",
                            "XL","X","IX","V","IV","I"};

  var roman = "", count = 0;
  foreach (var w in weights) {
    while (n >= w) {
      roman += symbols[count];
      n -= w;
    }
    if (n == 0)
      break;
    count++;
  }
  return roman;
}

void main() {
  print("%s\n", to_roman(455));
  print("%s\n", to_roman(3456));
  print("%s\n", to_roman(2488));
}


procedure retList() # returns as ordered list
return [1,2,3]
end

procedure retSet()             # returns as un-ordered list
insert(S := set(),3,1,2)
return S
end

procedure retLazy()            # return as a generator
suspend 1|2|3
end

procedure retTable()           # return as a table
T := table()
T["A"] := 1
T["B"] := 2
T["C"] := 3
return T
end

record retdata(a,b,c)

procedure retRecord()          # return as a record, least general method
return retdata(1,2,3)
end


Private Function roman(n As Integer) As String
    roman = WorksheetFunction.roman(n)
End Function
Public Sub main()
    s = [{10, 2016, 800, 2769, 1666, 476, 1453}]
    For Each x In s
        Debug.Print roman(CInt(x)); " ";
    Next x
End Sub


// Main program for testing the function
//
do {
    #1 = Get_Num("Number to convert: ", STATLINE)
    Call("NUM_TO_ROMAN")
    Num_Type(#1, NOCR) Message(" = ") Reg_Type(1) Type_Newline
} while (Reg_Size(1))
Return

// Convert numeric value into Roman number
//  #1 = number to convert; on return: T-reg(1) = Roman number
//
:NUM_TO_ROMAN:
    Reg_Empty(1)                        // @1 = Results (Roman number)
    if (#1 < 1) { Return }              // non-positive numbers return empty string

    Buf_Switch(Buf_Free)
    Ins_Text("M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1")

    BOF
    #2 = #1
    Repeat(ALL) {
        Search("|A|[|A]", ADVANCE+ERRBREAK)         // get next item from conversion list
        Reg_Copy_Block(20, CP-Chars_Matched, CP)    // @20 = Letter(s) to be inserted
        #11 = Num_Eval()                            // #11 = magnitude (1000...1)
        while (#2 >= #11) {
            Reg_Set(1, @20, APPEND)
            #2 -= #11
        }
    }
    Buf_Quit(OK)
Return


import java.util.List;
import java.util.ArrayList;
import java.util.Map;
import java.util.HashMap;

// =============================================================================
public class RReturnMultipleVals {
  public static final String K_lipsum = "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.";
  public static final Long   K_1024   = 1024L;
  public static final String L        = "L";
  public static final String R        = "R";

  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  public static void main(String[] args) throws NumberFormatException{
    Long nv_;
    String sv_;
    switch (args.length) {
      case 0:
        nv_ = K_1024;
        sv_ = K_lipsum;
        break;
      case 1:
        nv_ = Long.parseLong(args[0]);
        sv_ = K_lipsum;
        break;
      case 2:
        nv_ = Long.parseLong(args[0]);
        sv_ = args[1];
        break;
      default:
        nv_ = Long.parseLong(args[0]);
        sv_ = args[1];
        for (int ix = 2; ix < args.length; ++ix) {
          sv_ = sv_ + " " + args[ix];
        }
        break;
    }

    RReturnMultipleVals lcl = new RReturnMultipleVals();

    Pair<Long, String> rvp = lcl.getPairFromPair(nv_, sv_); // values returned in a bespoke object
    System.out.println("Results extracted from a composite object:");
    System.out.printf("%s, %s%n%n", rvp.getLeftVal(), rvp.getRightVal());

    List<Object> rvl = lcl.getPairFromList(nv_, sv_); // values returned in a Java Collection object
    System.out.println("Results extracted from a Java Colections \"List\" object:");
    System.out.printf("%s, %s%n%n", rvl.get(0), rvl.get(1));

    Map<String, Object> rvm = lcl.getPairFromMap(nv_, sv_); // values returned in a Java Collection object
    System.out.println("Results extracted from a Java Colections \"Map\" object:");
    System.out.printf("%s, %s%n%n", rvm.get(L), rvm.get(R));
  }
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  // Return a bespoke object.
  // Permits any number and type of value to be returned
  public <T, U> Pair<T, U> getPairFromPair(T vl_, U vr_) {
    return new Pair<T, U>(vl_, vr_);
  }
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  // Exploit Java Collections classes to assemble a collection of results.
  // This example uses java.util.List
  public List<Object> getPairFromList(Object nv_, Object sv_) {
    List<Object> rset = new ArrayList<Object>();
    rset.add(nv_);
    rset.add(sv_);
    return rset;
  }
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  // Exploit Java Collections classes to assemble a collection of results.
  // This example uses java.util.Map
  public Map<String, Object> getPairFromMap(Object nv_, Object sv_) {
    Map<String, Object> rset = new HashMap<String, Object>();
    rset.put(L, nv_);
    rset.put(R, sv_);
    return rset;
  }

  // ===========================================================================
  private static class Pair<L, R> {
    private L leftVal;
    private R rightVal;

    public Pair(L nv_, R sv_) {
      setLeftVal(nv_);
      setRightVal(sv_);
    }
    public void setLeftVal(L nv_) {
      leftVal = nv_;
    }
    public L getLeftVal() {
      return leftVal;
    }
    public void setRightVal(R sv_) {
      rightVal = sv_;
    }
    public R getRightVal() {
      return rightVal;
    }
  }
}


Function toRoman(value) As String
    Dim arabic As Variant
    Dim roman As Variant

    arabic = Array(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
    roman = Array("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")

    Dim i As Integer, result As String

    For i = 0 To 12
        Do While value >= arabic(i)
            result = result + roman(i)
            value = value - arabic(i)
        Loop
    Next i

    toRoman = result
End Function

Sub Main()
    MsgBox toRoman(Val(InputBox("Number, please")))
End Sub


//returns array with three values
var arrBind = function () {
  return [1, 2, 3]; //return array of three items to assign
};

//returns object with three named values
var objBind = function () {
  return {foo: "abc", bar: "123", baz: "zzz"};
};

//keep all three values
var [a, b, c] = arrBind();//assigns a => 1, b => 2, c => 3
//skip a value
var [a, , c] = arrBind();//assigns a => 1, c => 3
//keep final values together as array
var [a, ...rest] = arrBind();//assigns a => 1, rest => [2, 3]

//same return name
var {foo, bar, baz} = objBind();//assigns foo => "abc", bar => "123", baz => "zzz"
//different return name (ignoring baz)
var {baz: foo, buz: bar} = objBind();//assigns baz => "abc", buz => "123"
//keep rest of values together as object
var {foo, ...rest} = objBind();//assigns foo => "abc, rest => {bar: "123", baz: "zzz"}


# To produce a stream:
def addsub(x; y): (x + y), (x - y);

# To produce an array:
def add_subtract(x; y): [ x+y, x-y ];


PROGRAM "romanenc"
VERSION "0.0000"

DECLARE FUNCTION Entry()
INTERNAL FUNCTION ToRoman$(aValue%%)

' 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded with these symbols.

FUNCTION Entry()
  PRINT ToRoman$(1990) ' MCMXC
  PRINT ToRoman$(2018) ' MMXVIII
  PRINT ToRoman$(3888) ' MMMDCCCLXXXVIII
END FUNCTION

FUNCTION ToRoman$(aValue%%)
  DIM weights%%[12]
  DIM symbols$[12]

  weights%%[0] = 1000
  weights%%[1] = 900
  weights%%[2] = 500
  weights%%[3] = 400
  weights%%[4] = 100
  weights%%[5] = 90
  weights%%[6] = 50
  weights%%[7] = 40
  weights%%[8] = 10
  weights%%[9] = 9
  weights%%[10] = 5
  weights%%[11] = 4
  weights%%[12] = 1

  symbols$[0] = "M"
  symbols$[1] = "CM"
  symbols$[2] = "D"
  symbols$[3] = "CD"
  symbols$[4] = "C"
  symbols$[5] = "XC"
  symbols$[6] = "L"
  symbols$[7] = "XL"
  symbols$[8] = "X"
  symbols$[9] = "IX"
  symbols$[10] = "V"
  symbols$[11] = "IV"
  symbols$[12] = "I"

  destination$ = ""
  i@@ = 0
  DO WHILE (i@@ <= 12) AND (aValue%% > 0)
    DO WHILE aValue%% >= weights%%[i@@]
      destination$ = destination$ + symbols$[i@@]
      aValue%% = aValue%% - weights%%[i@@]
    LOOP
    i@@ = i@@ + 1
  LOOP
  RETURN destination$
END FUNCTION
END PROGRAM


function addsub(x, y)
  return x + y, x - y
end


// version 1.0.6

/* implicitly returns a Pair<Int, Int>*/
fun minmax(ia: IntArray) = ia.min() to ia.max()

fun main(args: Array<String>) {
    val ia = intArrayOf(17, 88, 9, 33, 4, 987, -10, 2)
    val(min, max) = minmax(ia) // destructuring declaration
    println("The smallest number is $min")
    println("The largest  number is $max")
}


{def foo
 {lambda {:n}
  {cons {- :n 1} {+ :n 1}}}}       // two values
-> foo

{foo 10}
-> (9 11)

{def bar
 {lambda {:n}
  {A.new {- :n 1} :n {+ :n 1} }}}  // three values and more
-> bar

{bar 10}
-> [9,10,11]


(defun roman (n)
    (define roman-numerals '((1000 "m") (900 "cm") (500 "d") (400 "cd") (100 "c") (90 "xc") (50 "l") (40 "xl") (10 "x") (9 "ix") (5 "v") (4 "iv") (1 "i")))
    (defun romanize (arabic-numeral numerals roman-numeral)
        (if (= arabic-numeral 0)
            roman-numeral
            (if (>= arabic-numeral (caar numerals))
                (romanize (- arabic-numeral (caar numerals)) numerals (string-append roman-numeral (cadar numerals)))
                (romanize arabic-numeral (cdr numerals) roman-numeral))))
    (romanize n roman-numerals ""))

; test the function:
(display (mapcar roman '(10 2016 800 2769 1666 476 1453)))


define multi_value() => {
	return (:'hello word',date)
}
// shows that single method call will return multiple values
// the two values returned are assigned in order to the vars x and y
local(x,y) = multi_value

'x: '+#x
'\ry: '+#y


data$ ="5 6 7 22 9 3 4 8 7 6 3 -5 2 1 8 9"

a$ =minMax$( data$)
print " Minimum was "; word$( a$, 1, " "); " & maximum was "; word$( a$, 2, " ")

end

function minMax$( i$)
min = 1E6
max =-1E6
i =1
do
    t$    =word$( i$, i, " ")
    if t$ ="" then exit do
    v     =val( t$)
    min   =min( min, v)
    max   =max( max, v)
    i =i +1
loop until 0
minMax$ =str$( min) +" " +str$( max)
end function


define combine(a: Integer, b: String): Tuple[Integer, String]
{
  return <[a, b]>
}


<xsl:stylesheet  version="1.0"    xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:template match="/data/number">
        <xsl:call-template name="for">
               <xsl:with-param name="stop">13</xsl:with-param>
        	<xsl:with-param name="value"><xsl:value-of select="@value"></xsl:value-of></xsl:with-param>
        </xsl:call-template>
    </xsl:template>

    <xsl:template name="for">
      <xsl:param name="start">1</xsl:param>
      <xsl:param name="stop">1</xsl:param>
      <xsl:param name="step">1</xsl:param>
      <xsl:param name="value">1</xsl:param>
      <xsl:text/>
      <xsl:choose>
      <xsl:when test="($value > /data/roman
/numeral[@pos=$start]/@value or $value = /data/roman
/numeral[@pos=$start]/@value) ">
          <xsl:value-of select="/data/roman
/numeral[@pos=$start]/@letter"/>
          <xsl:call-template name="for">
          <xsl:with-param name="stop">
            <xsl:value-of select="$stop"/>
          </xsl:with-param>
          <xsl:with-param name="start">
            <xsl:value-of select="$start"/>
          </xsl:with-param>
          <xsl:with-param name="value">
          	<xsl:value-of select="$value - /data/roman/numeral[@pos=$start]/@value"/>
          </xsl:with-param>
        </xsl:call-template>
      </xsl:when>
      <xsl:otherwise>
        <xsl:if test="$start < $stop">
        <xsl:call-template name="for">
          <xsl:with-param name="stop">
            <xsl:value-of select="$stop"/>
          </xsl:with-param>
          <xsl:with-param name="start">
            <xsl:value-of select="$start + $step"/>
          </xsl:with-param>
          <xsl:with-param name="value">
          	<xsl:value-of select="$value"/>
          </xsl:with-param>
        </xsl:call-template>
        </xsl:if>
      </xsl:otherwise>
      </xsl:choose>
    </xsl:template>
</xsl:stylesheet>


function addsub( a, b )
    return a+b, a-b
end

s, d = addsub( 7, 5 )
print( s, d )


> sumprod := ( a, b ) -> (a + b, a * b):
> sumprod( x, y );
                               x + y, x y

> sumprod( 2, 3 );
                                  5, 6


addsub [x_,y_]:= List [x+y,x-y]
addsub[4,2]


  function [a,b,c]=foo(d)
    a = 1-d;
    b = 2+d;
    c = a+b;
  end;
  [x,y,z] = foo(5)


roman$ = "M, CM, D, CD, C, XC, L, XL, X, IX, V, IV, I"
decml$ = "1000, 900, 500, 400, 100, 90, 50,  40,  10,  9,  5,   4,  1"

sub toRoman$(value)
    local res$, i, roman$(1), decml$(1), long

    long = token(roman$, roman$(), ", ")
    long = token(decml$, decml$(), ", ")

    for i=1 to long
        while(value >= val(decml$(i)))
            res$ = res$ + roman$(i)
            value = value - val(decml$(i))
        wend
    next i
    return res$
end sub

print 400, " ", toRoman$(400)
print 1990, " ", toRoman$(1990)
print 2008, " ", toRoman$(2008)
print 2009, " ", toRoman$(2009)
print 1666, " ", toRoman$(1666)
print 3888, " ", toRoman$(3888)
//Output:
// 400 = CD
// 1990 = MCMXC
// 2008 = MMVIII
// 2009 = MMIX
// 1666 = MDCLXVI
// 3888 = MMMDCCCLXXXVIII


:- module addsub.

:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module int, list, string.

main(!IO) :-
    command_line_arguments(Args, !IO),
    filter_map(to_int, Args, CleanArgs),
    (length(CleanArgs, 2) ->
        X = det_index1(CleanArgs,1),
        Y = det_index1(CleanArgs,2),
        addsub(X, Y, S, D),
        format("%d + %d = %d\n%d - %d = %d\n",
               [i(X), i(Y), i(S), i(X), i(Y), i(D)], !IO)
    ;
        write_string("Please pass two integers on the command line.\n", !IO)
    ).

:- pred addsub(int::in, int::in, int::out, int::out) is det.
addsub(X, Y, S, D) :-
    S = X + Y,
    D = X - Y.

:- end_module addsub.


using System;
using System.Console;
using Nemerle.Assertions;

module MultReturn
{
    MinMax[T] (ls : list[T]) : T * T
      where T : IComparable
      requires ls.Length > 0 otherwise throw ArgumentException("An empty list has no extreme values.")
    {
        def greaterOf(a, b) { if (a.CompareTo(b) > 0) a else b }
        def lesserOf(a, b)  { if (a.CompareTo(b) < 0) a else b }

        (ls.FoldLeft(ls.Head, lesserOf), ls.FoldLeft(ls.Head, greaterOf)) // packing tuple
    }

    Main() : void
    {
        def nums = [1, 34, 12, -5, 4, 0];
        def (min, max) = MinMax(nums);                                   // unpacking tuple
        WriteLine($"Min of nums = $min; max of nums = $max");
    }
}


program: decimal_roman
  input: 12
  output: 'XII'


function printroman () {
  local -a conv
  local number=$1 div rom num out
  conv=(I 1 IV 4 V 5 IX 9 X 10 XL 40 L 50 XC 90 C 100 CD 400 D 500 CM 900 M 1000)
  for num rom in ${(Oa)conv}; do
    (( div = number / num, number = number % num ))
    while (( div-- > 0 )); do
      out+=$rom
    done
  done
  echo $out
}


/* NetRexx */
options replace format comments java crossref symbols nobinary

-- =============================================================================
class RReturnMultipleVals public
  properties constant
    L = 'L'
    R = 'R'
    K_lipsum = 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.'
    K_1024 = 1024

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method RReturnMultipleVals() public
    return

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method main(args = String[]) public static
    arg = Rexx(args)
    parse arg nv_ sv_ .
    if \nv_.datatype('n') then nv_ = K_1024
    if sv_ = '' then sv_ = K_lipsum

    lcl = RReturnMultipleVals()

    rvr = lcl.getPair(nv_, sv_) -- multiple values returned as a string.  Use PARSE to extract values
    parse rvr val1 val2
    say 'Results extracted from a NetRexx string:'
    say val1',' val2
    say

    rvr = lcl.getPairFromRexx(nv_, sv_) -- values returned in a NetRexx indexed string
    say 'Results extracted from a NetRexx "indexed string":'
    say rvr[L]',' rvr[R]
    say

    rvp = lcl.getPairFromPair(nv_, sv_) -- values returned in a bespoke object
    say 'Results extracted from a composite object:'
    say rvp.getLeftVal',' rvp.getRightVal
    say

    rvl = lcl.getPairFromList(nv_, sv_) -- values returned in a Java Collection "List" object
    say 'Results extracted from a Java Colections "List" object:'
    say rvl.get(0)',' rvl.get(1)
    say

    rvm = lcl.getPairFromMap(nv_, sv_) -- values returned in a Java Collection "Map" object
    say 'Results extracted from a Java Colections "Map" object:'
    say rvm.get(L)',' rvm.get(R)
    say

    return

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- returns the values in a NetRexx string.
  --  Caller can the power of PARSE to extract the results
  method getPair(nv_, sv_) public returns Rexx
    return nv_ sv_

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- Return the values as members of a NetRexx indexed string
  method getPairFromRexx(nv_, sv_) public returns Rexx
    rval = ''
    rval[L] = nv_
    rval[R] = sv_
    return rval

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- Return a bespoke object.
  -- Permits any number and type of value to be returned
  method getPairFromPair(nv_, sv_) public returns RReturnMultipleVals.Pair
    rset = RReturnMultipleVals.Pair(nv_, sv_)
    return rset

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- Exploit Java Collections classes to assemble a collection of results.
  -- This example uses java.util.List
  method getPairFromList(nv_, sv_) public returns java.util.List
    rset = ArrayList()
    rset.add(nv_)
    rset.add(sv_)
    return rset

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  -- This example uses java.util.Map
  method getPairFromMap(nv_, sv_) public returns java.util.Map
    rset = HashMap()
    rset.put(L, nv_)
    rset.put(R, sv_)
    return rset

-- =============================================================================
class RReturnMultipleVals.Pair dependent

  properties indirect
    leftVal
    rightVal

  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method Pair(nv_ = parent.K_1024, sv_ = parent.K_lipsum) public
    setLeftVal(nv_)
    setRightVal(sv_)
    return


proc addsub(x, y: int): (int, int) =
  (x + y, x - y)

var (a, b) = addsub(12, 15)


class Program {
  function : Main(args : String[]) ~ Nil {
    a := IntHolder->New(3); b := IntHolder->New(7);
    Addon(a,b);
    a->Get()->PrintLine(); b->Get()->PrintLine();
  }

  function : Addon(a : IntHolder, b : IntHolder) ~ Nil {
    a->Set(a->Get() + 2); b->Set(b->Get() + 13);
  }
}


import: date

: returnFourValues 12 13 14 15 ;
: returnOneObject  [ 12, 13, 14, 15, [16, 17 ], Date now, 1.2, "abcd" ] ;

"Showing four values returned on the parameter stack:" println
returnFourValues .s clr

"\nShowing one object containing four values returned on the parameter stack:" println
returnOneObject .s clr


r = addsub(3, 4)
say r[1] r[2]

::routine addsub
  use arg x, y
  return .array~of(x + y, x - y)


'============
class vector4
'============

float w,x,y,z

method values(float fw,fx,fy,fz)
this <= fw, fx, fy, fz
end method

method values(vector4 *v)
this <= v.w, v.x, v.y, v.z
end method

method values() as vector4
return this
end method

method ScaledValues(float fw,fx,fy,fz) as vector4
static vector4 v
v <= w*fw, x*fx, y*fy, z*fz
return v
end method

method ShowValues() as string
string cm=","
return w cm x cm y cm z
end method

end class

vector4 aa,bb

bb.values = 1,2,3,4

aa.values = bb.Values()

print aa.ShowValues() 'result 1,2,3,4

aa.values = bb.ScaledValues(100,100,-100,100)

print aa.ShowValues() 'result 100,200,-300,400


sub foo {
    my ($a, $b) = @_;
    return $a + $b, $a * $b;
}


function stuff()
    return {"PI",'=',3.1415926535}
end function
{string what, integer op, atom val} = stuff()


function addsub($x, $y) {
  return array($x + $y, $x - $y);
}


(de addsub (X Y)
   (list (+ X Y) (- X Y)) )


array(int) addsub(int x, int y)
{
    return ({ x+y, x-y });
}

[int z, int w] = addsub(5,4);


   define structure 1 h,
                      2 a (10) float;
   declare i fixed binary;

sub: procedure (a, b) returns (type(h));
   declare (a, b) float;
   declare p type (h);
   do i = 1 to 10;
      p.a(i) = i;
   end;
   return (p);
end sub;


To run:
Start up.
Compute a product and a quotient given 15 and 3.
Write "The product is " then the product on the console.
Write "The quotient is " then the quotient on the console.
Wait for the escape key.
Shut down.

A product is a number.

To compute a product and a quotient given a number and another number:
Put the number times the other number into the product.
Put the number divided by the other number into the quotient.


function multiple-value ($a, $b) {
    [pscustomobject]@{
        a = $a
        b = $b
    }
}
$m =  multiple-value "value" 1
$m.a
$m.b


;An array, map, or list can be used as a parameter to a procedure and in the
;process contain values to be returned as well.
Procedure example_1(x, y, Array r(1))  ;array r() will contain the return values
  Dim r(2) ;clear and resize the array
  r(0) = x + y  ;return these values in the array
  r(1) = x - y
  r(2) = x * y
EndProcedure

;A pointer to memory or a structured variable may also be returned to reference
;multiple return values (requiring the memory to be manually freed afterwards).
Procedure example_2(x, y)
  Protected *result.POINT = AllocateMemory(SizeOf(POINT))
  *result\x = x
  *result\y = y

  ProcedureReturn *result ;*result points to a 'POINT' structure containing x and y
EndProcedure

If OpenConsole()
  Dim a(5)
  example_1(6, 5, a()) ;a() now contains {11, 1, 30}
  PrintN("Array returned with {" + Str(a(0)) + ", " + Str(a(1)) + ", " + Str(a(2)) + "}")

  Define *aPoint.POINT
  *aPoint = example_2(6, 5) ;*aPoint references structured memory containing {6, 5}

  PrintN("structured memory holds: (" + Str(*aPoint\x) + ", " + Str(*aPoint\y) + ")")
   FreeMemory(*aPoint) ;freememory

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


Welcome to Quackery.

Enter "leave" to leave the shell.

/O> [ 2dup + unrot * ] is +* ( a b --> a+b a*b )
... 12 23 +*
...

Stack: 35 276

/O>


addsub <- function(x, y) list(add=(x + y), sub=(x - y))


#lang racket
(values 4 5)

(define (my-values . return-list)
  (call/cc
   (lambda (return)
     (apply return return-list))))


sub addmul($a, $b) {
    $a + $b, $a * $b
}

my ($add, $mul) = addmul 3, 7;


define multiReturn use $v
   $v each

3 multiReturn


let addsub = (x, y) => {
  (x + y, x - y)
}

let (sum, difference) = addsub(33, 12)

Js.log2("33 + 12 = ", sum)
Js.log2("33 - 12 = ", difference)


: addSubtract ( xy-nm )
  2over - [ + ] dip ;


/*REXX program shows and displays examples of multiple  RETURN  values  from a function.*/
numeric digits 70                                /*the default is:    NUMERIC DIGITS 9  */
parse arg a b .                                  /*obtain two numbers from command line.*/
if a=='' | a==","  then a= 82                    /*Not specified?  Then use the default.*/
if b=='' | b==","  then b= 20                    /* "      "         "   "   "     "    */
say '     a ='  a                                /*display the first number to the term.*/
say '     b ='  b                                /*   "     "  second   "    "  "    "  */
say copies('═', 50)                              /*display a separator line  "  "    "  */
z= arithmetics(a, b)                             /*call the function:   arithmetics     */
parse var z  abut sum diff rem div Idiv prod pow /*obtain the function's returned values*/
say '    || ='  abut                             /*display   abutment   to the terminal.*/
say '     + ='  sum                              /*   "        sum       "  "     "     */
say '     - ='  diff                             /*   "     difference   "  "     "     */
say '    // ='  rem                              /*   "     remainder    "  "     "     */
say '     / ='  div                              /*   "      quotient    "  "     "     */
say '     % ='  Idiv                             /*   "   int. quotient  "  "     "     */
say '     * ='  prod                             /*   "       product    "  "     "     */
say '    ** ='  pow                              /*   "        power     "  "     "     */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
arithmetics: procedure;  parse arg x,y;  return  x||y  x+y  x-y  x//y  x/y  x%y  x*y  x**y


Func AddSub x,y
     Return [ x+y, x-y ]


a$ = timeInfo$()
print " UTC:";word$(a$,1,"|")
print "Date:";word$(a$,2,"|")
print "Time:";word$(a$,3,"|")
wait
function timeInfo$()
utc$ = word$(word$(httpget$("http://tycho.usno.navy.mil/cgi-bin/timer.pl"),1,"UTC"),2,"<BR>") ' Universal time
d$   = date$()
t$  = time$()
timeInfo$ = utc$;"|";d$;"|";t$
end function


fn multi_hello() -> (&'static str, i32) {
    ("Hello",42)
}

fn main() {
    let (str,num)=multi_hello();
    println!("{},{}",str,num);
}


def addSubMult(x: Int, y: Int) = (x + y, x - y, x * y)


(define (addsub x y)
  (values (+ x y) (- x y)))


$ include "seed7_05.s7i";

const proc: sumAndDiff (in integer: x, in integer: y, inout integer: sum, inout integer: diff) is func
  begin
    sum := x + y;
    diff := x - y;
 end func;

const proc: main is func
  local
    var integer: sum is 0;
    var integer: diff is 0;
  begin
    sumAndDiff(5, 3, sum, diff);
    writeln("Sum: " <& sum);
    writeln("Diff: " <& diff);
  end func;


set [quotient,remainder] to quotientAndRemainder(13,4)

put !"The quotient of 13 ÷ 4 is: [[quotient]] with remainder: [[remainder]]"

to handle quotientAndRemainder of num, divisor
	return [num div divisor, num rem divisor]
end quotientAndRemainder


func foo(a,b) {
    return (a+b, a*b);
}


foo multipleValuesInto:[:a :b |
   Transcript show:a; cr.
   Transcript show:b; cr.
]


func addsub(x: Int, y: Int) -> (Int, Int) {
  return (x + y, x - y)
}


proc addsub {x y} {
    list [expr {$x+$y}] [expr {$x-$y}]
}


@(define func (x y z))
@  (bind w "discarded")
@  (bind (x y z) ("a" "b" "c"))
@(end)


#!/bin/sh
funct1() {
  a=$1
  b=`expr $a + 1`
  echo $a $b
}

values=`funct1 5`

set $values
x=$1
y=$2
echo "x=$x"
echo "y=$y"


def getstrs (int n)
        decl string<> input

        while (> n 0)
                out ": " console
                append (in string console) input
                dec n
        end while

        return input
end getstrs

decl int amount
out "how many strings do you want to enter? " console
set amount (in int console)

decl string<> ret
set ret (getstrs amount)

out endl ret endl console


Type Contact
    Name As String
    firstname As String
    Age As Byte
End Type

Function SetContact(N As String, Fn As String, A As Byte) As Contact
    SetContact.Name = N
    SetContact.firstname = Fn
    SetContact.Age = A
End Function

'For use :
Sub Test_SetContact()
Dim Cont As Contact

    Cont = SetContact("SMITH", "John", 23)
    Debug.Print Cont.Name & " " & Cont.firstname & ", " & Cont.Age & " years old."
End Sub


*!* Return multiple values from a function
*!* The simplest way is to pass the parameters by reference
*!* either by SET UDFPARMS TO REFERENCE, or prefix the variables with @.
LOCAL a, b
a = 5
b = 6
? "Sum =", AddUp(@a, @b)    && Displays 11
? "a =", a, "b =", b        && Displays 4, 5
? "Sum =", AddUp(@a, @b)    && Displays 9

FUNCTION AddUp(n1, n2)
LOCAL n
n = n1 + n2
n1 = n1 - 1
n2 = n2 - 1
RETURN n
ENDFUNC


var splitName = Fn.new { |fullName| fullName.split(" ") }

var names = splitName.call("George Bernard Shaw")
System.print("First name: %(names[0]), middle name: %(names[1]) and surname: %(names[2]).")


include c:\cxpl\codes;          \intrinsic 'code' declarations

proc Rect2Polar(X,Y,A,D);       \Return two polar coordinate values
real X,Y,A,D;
[A(0):= ATan2(Y,X);
 D(0):= Sqrt(X*X+Y*Y);
]; \Rect2Polar

real Ang, Dist;
[Rect2Polar(4.0, 3.0, @Ang, @Dist);  \("@" is a new feature similar to 'addr')
RlOut(0, Ang);
RlOut(0, Dist);
CrLf(0);
]


foo:
    ld hl,&ABCD
    ld bc,&FFFF
    ret


V roman_values = [(‘I’, 1), (‘IV’, 4), (‘V’, 5), (‘IX’, 9), (‘X’, 10),
                  (‘XL’, 40), (‘L’, 50), (‘XC’, 90), (‘C’, 100),
                  (‘CD’, 400), (‘D’, 500), (‘CM’, 900), (‘M’, 1000)]

F roman_value(=roman)
   V total = 0
   L(symbol, value) reversed(:roman_values)
      L roman.starts_with(symbol)
         total += value
         roman = roman[symbol.len..]
   R total

L(value) [‘MCMXC’, ‘MMVIII’, ‘MDCLXVI’]
   print(value‘ = ’roman_value(value))


*        Roman numerals Decode -   17/04/2019
ROMADEC  CSECT
         USING  ROMADEC,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=A(NV))   do i=1 to hbound(vals)
         LR     R1,R6                i
         SLA    R1,3                 ~
         LA     R4,VALS-L'VALS(R1)   @vals(i)
         MVC    X,0(R4)              x=vals(i)
         SR     R9,R9                prev=0
         ST     R9,Y                 y=0
         LA     R7,L'X               j=1
       DO WHILE=(C,R7,GE,=A(1))      do j=length(x) to 1 by -1
         LA     R4,X-1                 @x
         AR     R4,R7                  +j
         MVC    C,0(R4)                c=substr(x,j,1)
       IF   CLI,C,NE,C' ' THEN         if c^=' ' then
         SR     R1,R1                  r1=0
         LA     R2,1                   k=1
       DO WHILE=(C,R2,LE,=A(L'ROMAN))   do k=1 to length(roman)
         LA     R3,ROMAN-1               @roman
         AR     R3,R2                    +k
       IF   CLC,0(L'C,R3),EQ,C THEN      if substr(roman,k,1)=c
         LR     R1,R2                      index=k
         B      REINDEX                    leave k
       ENDIF    ,                        endif
         LA     R2,1(R2)                 k=k+1
       ENDDO    ,                      enddo k
REINDEX  EQU    *                      r1=index(roman,c)
         SLA    R1,2                   ~
         L      R8,DECIM-4(R1)         n=decim(index(roman,c))
       IF    CR,R8,LT,R9 THEN          if n<prev then
         LCR    R8,R8                    n=-n
       ENDIF    ,                      endif
         L      R2,Y                     y
         AR     R2,R8                    +n
         ST     R2,Y                     y=y+n
         LR     R9,R8                    prev=n
       ENDIF    ,                      endif
         BCTR   R7,0                   j--
       ENDDO    ,                    enddo j
         MVC    PG(8),X              x
         L      R1,Y                 y
         XDECO  R1,XDEC              edit y
         MVC    PG+12(4),XDEC+8      output y
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
NV       EQU    (X-VALS)/L'VALS
ROMAN    DC     CL7'MDCLXVI'
DECIM    DC     F'1000',F'500',F'100',F'50',F'10',F'5',F'1'
VALS     DC     CL8'XIV',CL8'CMI',CL8'MIC',CL8'MCMXC',CL8'MDCLXVI'
         DC     CL8'MMVIII',CL8'MMXIX',CL8'MMMCMXCV'
X        DS     CL(L'VALS)
Y        DS     F
C        DS     CL1
PG       DC     CL80'........ -> ....'
XDEC     DS     CL12
         REGEQU
         END    ROMADEC


		org	100h
		jmp	test
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Takes a zero-terminated Roman numeral string in BC
		;; and returns 16-bit integer in HL.
		;; All registers destroyed.
roman:		dcx	b
romanfindend:	inx	b	; load next character
		ldax	b
		inr	e
		ana	a	; are we there yet
		jnz	romanfindend
		lxi	h,0	; zero HL to hold the total
		push	h	; stack holds the previous roman numeral
romanloop:	dcx	b	; get next roman numeral
		ldax	b	; (work backwards)
		call	romandgt
		jc	romandone	; carry set = not Roman anymore
		xthl		; load previous roman numeral
		call	cmpdehl	; DE < HL?
		mov	h,d	; in any case, DE is now the previous
		mov	l,e	; Roman numeral
		xthl		; bring back the total
		jnc	romanadd
		mov	a,d	; DE (current) < HL (previous)
		cma		; so this Roman digit must be subtracted
		mov	d,a	; from the total.
		mov	a,e	; so we negate it before adding it
		cma		; two's complement: -de = (~de)+1
		mov	e,a
		inx	d
romanadd:	dad	d	; add to running total
		jmp	romanloop
romandone:	pop	d	; remove temporary variable from stack
		ret
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; 16-bit compare DE with HL, set flags
		;; accordingly. A destroyed.
cmpdehl:	mov	a,d
		cmp	h
		rnz
		mov	a,e
		cmp	l
		ret
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Takes a single Roman 'digit' in A,
		;; and returns its value in DE (0 if invalid)
		;; All other registers preserved.
romandgt:	push	h	; preserve hl for the caller
		lxi	h,romantab
		mvi	e,7	; e=counter
romandgtl:	cmp	m	; check table entry
		jz	romanfound
		inx	h	; move to next table entry
		inx	h
		inx	h
		dcr	e	; decrease counter
		jnz	romandgtl
		pop	h	; we didn't find it
		stc		; set carry
		ret		; return with DE=0
romanfound:	inx	h	; we did find it
		mov	e,m	; load it into DE
		inx	h
		mov	d,m
		pop	h
		ana	a	; clear carry
		ret
romantab:	db	'I',1,0	; 16-bit little endian values
		db	'V',5,0
		db	'X',10,0
		db	'L',50,0
		db	'C',100,0
		db	'D',0f4h,1
		db	'M',0e8h,3
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; The following is testing and I/O code.
test:		mvi	c,10	; read string from console
		lxi	d,bufdef
		call	5
		mvi	c,9	; print newline
		lxi	d,nl
		call	5
		lxi	b,buf	; run `roman' on the input string
		call	roman	; the result is now in hl
		lxi	d,-10000
		call	numout	; print 10000s digit
		lxi	d,-1000
		call	numout	; print 1000s digit
		lxi	d,-100
		call 	numout	; print 100s digit
		lxi	d,-10
		call 	numout	; print 10s digit
		lxi	d,-1	; ...print 1s digit
numout:		mvi	a,-1
		push	h
numloop:	inr	a
		pop	b
		push	h
		dad	d
		jc	numloop
		adi	'0'
		mvi	c,2
		mov	e,a
		call	5
		pop	h
		ret
nl:		db	13,10,'$'
bufdef:		db	16,0
buf:		ds	17


CARD FUNC DecodeRomanDigit(CHAR c)
  IF c='I THEN RETURN (1)
  ELSEIF c='V THEN RETURN (5)
  ELSEIF c='X THEN RETURN (10)
  ELSEIF c='L THEN RETURN (50)
  ELSEIF c='C THEN RETURN (100)
  ELSEIF c='D THEN RETURN (500)
  ELSEIF c='M THEN RETURN (1000)
  FI
RETURN (0)

CARD FUNC DecodeRomanNumber(CHAR ARRAY s)
  CARD res,curr,prev
  BYTE i

  res=0 prev=0 i=s(0)
  WHILE i>0
  DO
    curr=DecodeRomanDigit(s(i))
    IF curr<prev THEN
      res==-curr
    ELSE
      res==+curr
    FI
    prev=curr
    i==-1
  OD
RETURN (res)

PROC Test(CHAR ARRAY s)
  CARD n

  n=DecodeRomanNumber(s)
  PrintF("%S=%U%E",s,n)
RETURN

PROC Main()
  Test("MCMXC")
  Test("MMVIII")
  Test("MDCLXVI")
  Test("MMMDCCCLXXXVIII")
  Test("MMMCMXCIX")
RETURN


Pragma Ada_2012;
Pragma Assertion_Policy( Check );

With
Unchecked_Conversion,
Ada.Text_IO;

Procedure Test_Roman_Numerals is

    -- We create an enumeration of valid characters, note that they are
    -- character-literals, this is so that we can use literal-strings,
    -- and that their size is that of Integer.
    Type Roman_Digits is ('I', 'V', 'X', 'L', 'C', 'D', 'M' )
    with Size => Integer'Size;

    -- We use a representation-clause ensure the proper integral-value
    -- of each individual character.
    For Roman_Digits use
      (
    'I' => 1,
    'V' => 5,
    'X' => 10,
    'L' => 50,
    'C' => 100,
    'D' => 500,
    'M' => 1000
      );

    -- To convert a Roman_Digit to an integer, we now only need to
    -- read its value as an integer.
    Function Convert is new Unchecked_Conversion
      (	Source => Roman_Digits,	Target => Integer );

    -- Romena_Numeral is a string of Roman_Digit.
    Type Roman_Numeral is array (Positive range <>) of Roman_Digits;

    -- The Numeral_List type is used herein only for testing
    -- and verification-data.
    Type Numeral_List is array (Positive range <>) of
      not null access Roman_Numeral;

    -- The Test_Cases subtype ensures that Test_Data and Validation_Data
    -- both contain the same number of elements, and that the indecies
    -- are the same; essentially the same as:
    --
    --    pragma Assert( Test_Data'Length = Validation_Data'Length
    --		   AND Test_Data'First = Validation_Data'First);

    subtype Test_Cases is Positive range 1..14;

    Test_Data : constant Numeral_List(Test_Cases):=
      (
       New Roman_Numeral'("III"),	-- 3
       New Roman_Numeral'("XXX"),	-- 30
       New Roman_Numeral'("CCC"),	-- 300
       New Roman_Numeral'("MMM"),	-- 3000

       New Roman_Numeral'("VII"),	-- 7
       New Roman_Numeral'("LXVI"),	-- 66
       New Roman_Numeral'("CL"),	-- 150
       New Roman_Numeral'("MCC"),	-- 1200

       New Roman_Numeral'("IV"),	-- 4
       New Roman_Numeral'("IX"),	-- 9
       New Roman_Numeral'("XC"),	-- 90

       New Roman_Numeral'("ICM"),	-- 901
       New Roman_Numeral'("CIM"),	-- 899

       New Roman_Numeral'("MDCLXVI")	-- 1666
      );

    Validation_Data : constant array(Test_Cases) of Natural:=
      (	3, 30, 300, 3000,
	7, 66, 150, 1200,
	4, 9, 90,
	901, 899,
	1666
      );

    -- In Roman numerals, the subtractive form [IV = 4] was used
    -- very infrequently, the most common form was the addidive
    -- form [IV = 6]. (Consider military logistics and squads.)

    -- SUM returns the Number, read in the additive form.
    Function Sum( Number : Roman_Numeral ) return Natural is
    begin
	Return Result : Natural:= 0 do
	    For Item of Number loop
		    Result:= Result + Convert( Item );
	    end loop;
	End Return;
    end Sum;

    -- EVAL returns Number read in the subtractive form.
    Function Eval( Number : Roman_Numeral ) return Natural is
	Current : Roman_Digits:= 'I';
    begin
	Return Result : Natural:= 0 do
	    For Item of Number loop
		if Current < Item then
		    Result:= Convert(Item) - Result;
		    Current:= Item;
		else
		    Result:= Result + Convert(Item);
		end if;
	    end loop;
	End Return;
    end Eval;

    -- Display the given Roman_Numeral via Text_IO.
    Procedure Put( S: Roman_Numeral ) is
    begin
	For Ch of S loop
	    declare
		-- The 'Image attribute returns the character inside
		-- single-quotes; so we select the character itself.
		C : Character renames Roman_Digits'Image(Ch)(2);
	    begin
		Ada.Text_IO.Put( C );
	    end;
	end loop;
    end;

    -- This displays pass/fail dependant on the parameter.
    Function PF ( Value : Boolean ) Return String is
    begin
	Return Result : String(1..4):= ( if Value then"pass"else"fail" );
    End PF;

Begin
    Ada.Text_IO.Put_Line("Starting Test:");

    for Index in Test_Data'Range loop
	declare
	    Item  : Roman_Numeral renames Test_Data(Index).all;
	    Value : constant Natural := Eval(Item);
	begin
	    Put( Item );

	    Ada.Text_IO.Put( ASCII.HT & "= ");
	    Ada.Text_IO.Put( Value'Img );
	    Ada.Text_IO.Put_Line( ASCII.HT & '[' &
			  PF( Value = Validation_Data(Index) )& ']');
	end;
    end loop;

    Ada.Text_IO.Put_Line("Testing complete.");
End Test_Roman_Numerals;


    PROC roman to int = (STRING roman) INT:
    BEGIN
        PROC roman digit value = (CHAR roman digit) INT:
            (roman digit = "M" | 1000 |:
             roman digit = "D" |  500 |:
             roman digit = "C" |  100 |:
             roman digit = "L" |   50 |:
             roman digit = "X" |   10 |:
             roman digit = "V" |    5 |:
             roman digit = "I" |    1);

        INT result := 0, previous value := 0, run := 0;

        FOR i FROM LWB roman TO UPB roman
        DO
            INT value = roman digit value(roman[i]);
            IF previous value = value THEN
                run +:= value
            ELSE
                IF previous value < value THEN
                    result -:= run
                ELSE
                    result +:= run
                FI;
                run := previous value := value
            FI
        OD;

        result +:= run
    END;

    MODE TEST = STRUCT (STRING input, INT expected output);

    [] TEST roman test = (
        ("MMXI",    2011), ("MIM",     1999),
        ("MCMLVI",  1956), ("MDCLXVI", 1666),
        ("XXCIII",    83), ("LXXIIX",    78),
        ("IIIIX",      6)
    );

    print(("Test input  Value   Got", newline, "--------------------------", newline));
    FOR i FROM LWB roman test TO UPB roman test
    DO
        INT output = roman to int(input OF roman test[i]);
        printf(($g, n (12 - UPB input OF roman test[i]) x$, input OF roman test[i]));
        printf(($g(5), 1x, g(5), 1x$, expected output OF roman test[i], output));
        printf(($b("ok", "not ok"), 1l$, output = expected output OF roman test[i]))
    OD


begin
    % decodes a roman numeral into an integer                                %
    % there must be at least one blank after the numeral                     %
    % This takes a lenient view on roman numbers so e.g. IIXX is 18 - see    %
    % the Discussion                                                         %
    integer procedure romanToDecimal ( string(32) value roman ) ;
    begin
        integer   decimal, rPos, currDigit, nextDigit, seqValue;
        string(1) rDigit;

        % the roman number is a sequence of sequences of roman digits        %
        % if the previous sequence is of higher value digits than the next,  %
        %    the higher value is added to the overall value                  %
        % if the previous seequence is of lower value, it is subtracted      %
        % e.g. MCMLXII                                                       %
        %      the sequences are M, C, M, X, II                              %
        %          M is added, C subtracted, M added, X added and II added   %

        % get the value of a sequence of roman digits                        %
        integer procedure getSequence ;
            if rDigit = " " then begin
                % end of the number                                          %
                0
                end
            else begin
                % have another sequence                                      %
                integer sValue;
                sValue := 0;
                while roman( rPos // 1 ) = rDigit do begin
                    sValue := sValue + currDigit;
                    rPos   := rPos + 1;
                end while_have_same_digit ;
                % remember the next digit                                    %
                rDigit     := roman( rPos // 1 );
                % result is the sequence value                               %
                sValue
             end getSequence ;

        % convert a roman digit into its decimal equivalent                  %
        % an invalid digit will terminate the program, " " is 0              %
        integer procedure getValue( string(1) value romanDigit ) ;
            if      romanDigit = "m" or romanDigit = "M" then 1000
            else if romanDigit = "d" or romanDigit = "D" then  500
            else if romanDigit = "c" or romanDigit = "C" then  100
            else if romanDigit = "l" or romanDigit = "L" then   50
            else if romanDigit = "x" or romanDigit = "X" then   10
            else if romanDigit = "v" or romanDigit = "V" then    5
            else if romanDigit = "i" or romanDigit = "I" then    1
            else if romanDigit = " "                     then    0
            else begin
                write( s_w := 0, "Invalid roman digit: """, romanDigit, """" );
                assert false;
                0
            end getValue ;

        % get the first sequence                                             %
        decimal   := 0;
        rPos      := 0;
        rDigit    := roman( rPos // 1 );
        currDigit := getValue( rDigit );
        seqValue  := getSequence;

        % handle the sequences                                               %
        while rDigit not = " " do begin
            % have another sequence                                          %
            nextDigit := getValue( rDigit );
            if currDigit < nextDigit
            then % prev digit is lower  % decimal := decimal - seqValue
            else % prev digit is higher % decimal := decimal + seqValue
            ;
            currDigit := nextDigit;
            seqValue  := getSequence;
        end while_have_a_roman_digit ;

        % add the final sequence                                             %
        decimal + seqValue
    end roman ;

    % test the romanToDecimal routine                                        %

    procedure testRoman ( string(32) value romanNumber ) ;
        write( i_w := 5, romanNumber, romanToDecimal( romanNumber ) );

    testRoman( "I"        );    testRoman( "II"       );
    testRoman( "III"      );    testRoman( "IV"       );
    testRoman( "V"        );    testRoman( "VI"       );
    testRoman( "VII"      );    testRoman( "VIII"     );
    testRoman( "IX"       );    testRoman( "IIXX"     );
    testRoman( "XIX"      );    testRoman( "XX"       );
    write( "..." );
    testRoman( "MCMXC"    );
    testRoman( "MMVIII"   );
    testRoman( "MDCLXVI"  );

end.


/* Parse Roman Numerals

   Nigel Galloway March 16th., 2012
*/
grammar ParseRN ;

options {
	language = Java;
}
@members {
int rnValue;
int ONE;
}

parseRN:	({rnValue = 0;} rn NEWLINE {System.out.println($rn.text + " = " + rnValue);})*
	;

rn	:	(Thousand {rnValue += 1000;})* hundreds? tens? units?;

hundreds:	{ONE = 0;} (h9 | h5) {if (ONE > 3) System.out.println ("Too many hundreds");};
h9	:	Hundred {ONE += 1;} (FiveHund {rnValue += 400;}| Thousand {rnValue += 900;}|{rnValue += 100;} (Hundred {rnValue += 100; ONE += 1;})*);
h5	:	FiveHund {rnValue += 500;} (Hundred {rnValue += 100; ONE += 1;})*;

tens	:	{ONE = 0;} (t9 | t5) {if (ONE > 3) System.out.println ("Too many tens");};
t9	:	Ten {ONE += 1;} (Fifty {rnValue += 40;}| Hundred {rnValue += 90;}|{rnValue += 10;} (Ten {rnValue += 10; ONE += 1;})*);
t5	:	Fifty {rnValue += 50;} (Ten {rnValue += 10; ONE += 1;})*;

units	:	{ONE = 0;} (u9 | u5) {if (ONE > 3) System.out.println ("Too many ones");};
u9	:	One {ONE += 1;} (Five {rnValue += 4;}| Ten {rnValue += 9;}|{rnValue += 1;} (One {rnValue += 1; ONE += 1;})*);
u5	:	Five {rnValue += 5;} (One {rnValue += 1; ONE += 1;})*;

One	:	'I';
Five	:	'V';
Ten	:	'X';
Fifty	:	'L';
Hundred:	'C';
FiveHund:	'D';
Thousand:	'M' ;
NEWLINE:	'\r'? '\n' ;


fromRoman←{
    rmn←(⎕A,⎕A,'*')[(⎕A,⎕UCS 96+⍳26)⍳⍵]     ⍝ make input uppercase
    dgt←↑'IVXLCDM' (1 5 10 50 100 500 1000) ⍝ values of roman digits
    ~rmn∧.∊⊂dgt[1;]:⎕SIGNAL 11              ⍝ domain error if non-roman input
    map←dgt[2;dgt[1;]⍳rmn]                  ⍝ map digits to values
    +/map×1-2×(2</map),0                    ⍝ subtractive principle
}


------------- INTEGER VALUE OF A ROMAN STRING ------------

-- romanValue :: String -> Int
on romanValue(s)
    script roman
        property mapping : [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ¬
            ["C", 100], ["XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ¬
            ["V", 5], ["IV", 4], ["I", 1]]

        -- Value of first Roman glyph + value of remaining glyphs
        -- toArabic :: [Char] -> Int
        on toArabic(xs)
            -- transcribe :: (String, Number) -> Maybe (Number, [String])
            script transcribe
                on |λ|(pair)
                    set {r, v} to pair
                    if isPrefixOf(characters of r, xs) then

                        -- Value of this matching glyph, with any remaining glyphs
                        {v, drop(length of r, xs)}
                    else
                        {}
                    end if
                end |λ|
            end script

            if 0 < length of xs then
                set parsed to concatMap(transcribe, mapping)
                (item 1 of parsed) + toArabic(item 2 of parsed)
            else
                0
            end if
        end toArabic
    end script

    toArabic(characters of s) of roman
end romanValue

--------------------------- TEST -------------------------
on run
    map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})

    --> {1990, 1666, 2008}
end run

-------------------- GENERIC FUNCTIONS -------------------

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & (|λ|(item i of xs, i, xs))
        end repeat
    end tell
    if {text, string} contains class of xs then
        acc as text
    else
        acc
    end if
end concatMap

-- drop :: Int -> [a] -> [a]
-- drop :: Int -> String -> String
on drop(n, xs)
    set c to class of xs
    if script is not c then
        if string is not c then
            if n < length of xs then
                items (1 + n) thru -1 of xs
            else
                {}
            end if
        else
            if n < length of xs then
                text (1 + n) thru -1 of xs
            else
                ""
            end if
        end if
    else
        take(n, xs) -- consumed
        return xs
    end if
end drop

-- isPrefixOf :: [a] -> [a] -> Bool
-- isPrefixOf :: String -> String -> Bool
on isPrefixOf(xs, ys)
    -- isPrefixOf takes two lists or strings and returns
    --  true if and only if the first is a prefix of the second.
    script go
        on |λ|(xs, ys)
            set intX to length of xs
            if intX < 1 then
                true
            else if intX > length of ys then
                false
            else if class of xs is string then
                (offset of xs in ys) = 1
            else
                set {xxt, yyt} to {uncons(xs), uncons(ys)}
                ((item 1 of xxt) = (item 1 of yyt)) and ¬
                    |λ|(item 2 of xxt, item 2 of yyt)
            end if
        end |λ|
    end script
    go's |λ|(xs, ys)
end isPrefixOf

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
    set lng to |length|(xs)
    if 0 = lng then
        missing value
    else
        if (2 ^ 29 - 1) as integer > lng then
            if class of xs is string then
                set cs to text items of xs
                {item 1 of cs, rest of cs}
            else
                {item 1 of xs, rest of xs}
            end if
        else
            set nxt to take(1, xs)
            if {} is nxt then
                missing value
            else
                {item 1 of nxt, xs}
            end if
        end if
    end if
end uncons


 10  LET R$ = "MCMXCIX"
 20  GOSUB 100 PRINT "ROMAN NUMERALS DECODED"
 30  LET R$ = "MMXII"
 40  GOSUB 100
 50  LET R$ = "MDCLXVI"
 60  GOSUB 100
 70  LET R$ = "MMMDCCCLXXXVIII"
 80  GOSUB 100
 90  END
 100  PRINT M$R$,
 110  LET M$ =  CHR$ (13)
 120  GOSUB 150"ROMAN NUMERALS DECODE given R$"
 130  PRINT N;
 140  RETURN
 150  IF  NOT C THEN  GOSUB 250INITIALIZE
 160  LET J = 0
 170  LET N = 0
 180  FOR I =  LEN (R$) TO 1 STEP  - 1
 190      LET P = J
 200      FOR J = 1 TO C
 210          IF  MID$ (C$,J,1) <  >  MID$ (R$,I,1) THEN  NEXT J
 220      IF J <  = C THEN N = N + R(J) * ((J >  = P) * 2 - 1)
 230  NEXT I
 240  RETURN
 250  READ C$
 260  LET C =  LEN (C$)
 270  DIM R(C)
 280  FOR I = 0 TO C
 290  READ R(I)
 300      NEXT I
 310  RETURN
 320  DATA "IVXLCDM",0,1,5,10,50,100,500,1000


syms: #[ M: 1000, D: 500, C: 100, L: 50, X: 10, V: 5, I: 1 ]

fromRoman: function [roman][
	ret: 0
	loop 0..(size roman)-2 'ch [
		fst: roman\[ch]
		snd: roman\[ch+1]
		valueA: syms\[fst]
		valueB: syms\[snd]

		if? valueA < valueB -> ret: ret - valueA
	 	else				-> ret: ret + valueA
	]
	return ret + syms\[last roman]
]

loop ["MCMXC" "MMVIII" "MDCLXVI"] 'r -> print [r "->" fromRoman r]


Roman_Decode(str){
	res := 0
	Loop Parse, str
	{
		n := {M: 1000, D:500, C:100, L:50, X:10, V:5, I:1}[A_LoopField]
		If ( n > OldN ) && OldN
			res -= 2*OldN
		res += n, oldN := n
	}
	return res
}

test = MCMXC|MMVIII|MDCLXVI
Loop Parse, test, |
   res .= A_LoopField "`t= " Roman_Decode(A_LoopField) "`r`n"
clipboard := res


# syntax: GAWK -f ROMAN_NUMERALS_DECODE.AWK
BEGIN {
    leng = split("MCMXC MMVIII MDCLXVI",arr," ")
    for (i=1; i<=leng; i++) {
      n = arr[i]
      printf("%s = %s\n",n,roman2arabic(n))
    }
    exit(0)
}
function roman2arabic(r,  a,i,p,q,u,ua,una,unr) {
    r = toupper(r)
    unr = "MDCLXVI" # each Roman numeral in descending order
    una = "1000 500 100 50 10 5 1" # and its Arabic equivalent
    split(una,ua," ")
    i = split(r,u,"")
    a = ua[index(unr,u[i])]
    while (--i) {
      p = index(unr,u[i])
      q = index(unr,u[i+1])
      a += ua[p] * ((p>q) ? -1 : 1)
    }
    return( (a>0) ? a : "" )
}


function romToDec (roman$)
    num = 0
    prenum = 0
    for i = length(roman$) to 1 step -1
        x$ = mid(roman$, i, 1)
        n = 0
        if x$ = "M" then n = 1000
        if x$ = "D" then n = 500
        if x$ = "C" then n = 100
        if x$ = "L" then n = 50
        if x$ = "X" then n = 10
        if x$ = "V" then n = 5
        if x$ = "I" then n = 1

        if n < preNum then num -= n else num += n
        preNum = n
    next i

    return num
end function

#Testing
print "MCMXCIX = "; romToDec("MCMXCIX")     #1999
print "MDCLXVI = "; romToDec("MDCLXVI")     #1666
print "XXV     = "; romToDec("XXV")         #25
print "CMLIV   = "; romToDec("CMLIV")       #954
print "MMXI    = "; romToDec("MMXI")        #2011


@echo off
setlocal enabledelayedexpansion

::Testing...
call :toArabic MCMXC
echo MCMXC = !arabic!
call :toArabic MMVIII
echo MMVIII = !arabic!
call :toArabic MDCLXVI
echo MDCLXVI = !arabic!
call :toArabic CDXLIV
echo CDXLIV = !arabic!
call :toArabic XCIX
echo XCIX = !arabic!
pause>nul
exit/b 0

::The "function"...
:toArabic
set roman=%1
set arabic=
set lastval=
	%== Alternative for counting the string length ==%
set leng=-1
for /l %%. in (0,1,1000) do set/a leng+=1&if "!roman:~%%.,1!"=="" goto break
:break
set /a last=!leng!-1
for /l %%i in (!last!,-1,0) do (
	set n=0
	if /i "!roman:~%%i,1!"=="M" set n=1000
	if /i "!roman:~%%i,1!"=="D" set n=500
	if /i "!roman:~%%i,1!"=="C" set n=100
	if /i "!roman:~%%i,1!"=="L" set n=50
	if /i "!roman:~%%i,1!"=="X" set n=10
	if /i "!roman:~%%i,1!"=="V" set n=5
	if /i "!roman:~%%i,1!"=="I" set n=1

	if !n! lss !lastval! (
		set /a arabic-=n
	) else (
		set /a arabic+=n
	)
	set lastval=!n!
)
goto :EOF


      PRINT "MCMXCIX", FNromandecode("MCMXCIX")
      PRINT "MMXII", FNromandecode("MMXII")
      PRINT "MDCLXVI", FNromandecode("MDCLXVI")
      PRINT "MMMDCCCLXXXVIII", FNromandecode("MMMDCCCLXXXVIII")
      END

      DEF FNromandecode(roman$)
      LOCAL i%, j%, p%, n%, r%()
      DIM r%(7) : r%() = 0,1,5,10,50,100,500,1000
      FOR i% = LEN(roman$) TO 1 STEP -1
        j% = INSTR("IVXLCDM", MID$(roman$,i%,1))
        IF j%=0 ERROR 100, "Invalid character"
        IF j%>=p% n% += r%(j%) ELSE n% -= r%(j%)
        p% = j%
      NEXT
      = n%


get "libhdr"

let roman(s) = valof
$(  let digit(ch) = valof
    $(  let ds = table 'm','d','c','l','x','v','i'
        let vs = table 1000,500,100,50,10,5,1
        for i=0 to 6
            if ds!i=(ch|32) then resultis vs!i
        resultis 0
    $)
    let acc = 0
    for i=1 to s%0
    $(  let d = digit(s%i)
        if d=0 then resultis 0
        test i<s%0 & d<digit(s%(i+1))
            do acc := acc-d
            or acc := acc+d
    $)
    resultis acc
$)

let show(s) be writef("%S: %N*N", s, roman(s))

let start() be
$(  show("MCMXC")
    show("MDCLXVI")
    show("MMVII")
    show("MMXXI")
$)


⟨ToArabic⇐A⟩ ← {
  c ← "IVXLCDM"         # Characters
  v ← ⥊ (10⋆↕4) ×⌜ 1‿5  # Their values
  A ⇐ +´∘(⊢×¯1⋆<⟜«) v ⊏˜ c ⊐ ⊢
}


#include <stdio.h>

int digits[26] = { 0, 0, 100, 500, 0, 0, 0, 0, 1, 1, 0, 50, 1000, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0, 10, 0, 0 };

/* assuming ASCII, do upper case and get index in alphabet. could also be
        inline int VALUE(char x) { return digits [ (~0x20 & x) - 'A' ]; }
   if you think macros are evil */
#define VALUE(x) digits[(~0x20 & (x)) - 'A']

int decode(const char * roman)
{
        const char *bigger;
        int current;
        int arabic = 0;
        while (*roman != '\0') {
                current = VALUE(*roman);
                /*      if (!current) return -1;
                        note: -1 can be used as error code; Romans didn't even have zero
                */
                bigger = roman;

                /* look for a larger digit, like IV or XM */
                while (VALUE(*bigger) <= current && *++bigger != '\0');

                if (*bigger == '\0')
                        arabic += current;
                else {
                        arabic += VALUE(*bigger);
                        while (roman < bigger)
                                arabic -= VALUE(* (roman++) );
                }

                roman ++;
        }
        return arabic;
}

int main()
{
        const char * romans[] = { "MCmxC", "MMVIII", "MDClXVI", "MCXLUJ" };
        int i;

        for (i = 0; i < 4; i++)
                printf("%s\t%d\n", romans[i], decode(romans[i]));

        return 0;
}


using System;
using System.Collections.Generic;

namespace Roman
{
    internal class Program
    {
        private static void Main(string[] args)
        {
            // Decode and print the numerals.
            Console.WriteLine("{0}: {1}", "MCMXC", Decode("MCMXC"));
            Console.WriteLine("{0}: {1}", "MMVIII", Decode("MMVIII"));
            Console.WriteLine("{0}: {1}", "MDCLXVI", Decode("MDCLXVI"));
        }

        // Dictionary to hold our numerals and their values.
        private static readonly Dictionary<char, int> RomanDictionary = new Dictionary<char, int>
                                                                            {
                                                                                {'I', 1},
                                                                                {'V', 5},
                                                                                {'X', 10},
                                                                                {'L', 50},
                                                                                {'C', 100},
                                                                                {'D', 500},
                                                                                {'M', 1000}
                                                                            };

        private static int Decode(string roman)
        {
            /* Make the input string upper-case,
             * because the dictionary doesn't support lower-case characters. */
            roman = roman.ToUpper();

            /* total = the current total value that will be returned.
             * minus = value to subtract from next numeral. */
            int total = 0, minus = 0;

            for (int i = 0; i < roman.Length; i++) // Iterate through characters.
            {
                // Get the value for the current numeral. Takes subtraction into account.
                int thisNumeral = RomanDictionary[roman[i]] - minus;

                /* Checks if this is the last character in the string, or if the current numeral
                 * is greater than or equal to the next numeral. If so, we will reset our minus
                 * variable and add the current numeral to the total value. Otherwise, we will
                 * subtract the current numeral from the next numeral, and continue. */
                if (i >= roman.Length - 1 ||
                    thisNumeral + minus >= RomanDictionary[roman[i + 1]])
                {
                    total += thisNumeral;
                    minus = 0;
                }
                else
                {
                    minus = thisNumeral;
                }
            }

            return total; // Return the total.
        }
    }
}


#include <exception>
#include <string>
#include <iostream>
using namespace std;

namespace Roman
{
	int ToInt(char c)
	{
		switch (c)
		{
			case 'I':  return 1;
			case 'V':  return 5;
			case 'X':  return 10;
			case 'L':  return 50;
			case 'C':  return 100;
			case 'D':  return 500;
			case 'M':  return 1000;
		}
		throw exception("Invalid character");
	}

	int ToInt(const string& s)
	{
		int retval = 0, pvs = 0;
		for (auto pc = s.rbegin(); pc != s.rend(); ++pc)
		{
			const int inc = ToInt(*pc);
			retval += inc < pvs ? -inc : inc;
			pvs = inc;
		}
		return retval;
	}
}

int main(int argc, char* argv[])
{
	try
	{
		cout << "MCMXC = " << Roman::ToInt("MCMXC") << "\n";
		cout << "MMVIII = " << Roman::ToInt("MMVIII") << "\n";
		cout << "MDCLXVI = " << Roman::ToInt("MDCLXVI") << "\n";
	}
	catch (exception& e)
	{
		cerr << e.what();
		return -1;
	}
	return 0;
}


shared void run() {

	value numerals = map {
		'I' -> 1,
		'V' -> 5,
		'X' -> 10,
		'L' -> 50,
		'C' -> 100,
		'D' -> 500,
		'M' -> 1000
	};

	function toHindu(String roman) {
		variable value total = 0;
		for(i->c in roman.indexed) {
			assert(exists currentValue = numerals[c]);
			/* Look at the next letter to see if we're looking
			 at a IV or CM or whatever. If so subtract the
			 current number from the total. */
			if(exists next = roman[i + 1],
				exists nextValue = numerals[next],
				currentValue < nextValue) {
				total -= currentValue;
			} else {
				total += currentValue;
			}
		}
		return total;
	}

	assert(toHindu("I") == 1);
	assert(toHindu("II") == 2);
	assert(toHindu("IV") == 4);
	assert(toHindu("MDCLXVI") == 1666);
	assert(toHindu("MCMXC") == 1990);
	assert(toHindu("MMVIII") == 2008);
}


;; Incorporated some improvements from the alternative implementation below
(defn ro2ar [r]
  (->> (reverse (.toUpperCase r))
       (map {\M 1000 \D 500 \C 100 \L 50 \X 10 \V 5 \I 1})
       (partition-by identity)
       (map (partial apply +))
       (reduce #(if (< %1 %2) (+ %1 %2) (- %1 %2)))))

;; alternative
(def numerals { \I 1, \V 5, \X 10, \L 50, \C 100, \D 500, \M 1000})
(defn from-roman [s]
  (->> s .toUpperCase
    (map numerals)
    (reduce (fn [[sum lastv] curr] [(+ sum curr (if (< lastv curr) (* -2 lastv) 0)) curr]) [0,0])
    first))


roman = cluster is decode
    rep = null

    digit_value = proc (c: char) returns (int) signals (invalid)
        if c < 'a' then c := char$i2c(char$c2i(c) + 32) end
        if     c = 'm' then return(1000)
        elseif c = 'd' then return(500)
        elseif c = 'c' then return(100)
        elseif c = 'l' then return(50)
        elseif c = 'x' then return(10)
        elseif c = 'v' then return(5)
        elseif c = 'i' then return(1)
        else signal invalid
        end
    end digit_value

    decode = proc (s: string) returns (int) signals (invalid)
        acc: int := 0
        for i: int in int$from_to(1, string$size(s)) do
            d: int := digit_value(s[i])
            if i < string$size(s) cand d < digit_value(s[i+1]) then
                acc := acc - d
            else
                acc := acc + d
            end
        end resignal invalid
        return(acc)
    end decode
end roman

start_up = proc ()
    po: stream := stream$primary_output()
    tests: array[string] := array[string]$
        ["MCMXC", "mdclxvi", "MmViI", "mmXXi", "INVALID"]

    for test: string in array[string]$elements(tests) do
        stream$puts(po, test || ": ")
        stream$putl(po, int$unparse(roman$decode(test))) except when invalid:
            stream$putl(po, "not a valid Roman numeral!")
        end
    end
end start_up


      IDENTIFICATION DIVISION.
      PROGRAM-ID.  UNROMAN.
      DATA DIVISION.
      WORKING-STORAGE SECTION.
      01  filler.
        03  i              pic 9(02) comp.
        03  j              pic 9(02) comp.
        03  k              pic 9(02) comp.
        03  l              pic 9(02) comp.
      01  inp-roman.
        03  inp-rom-ch     pic x(01) occurs 20 times.
      01  inp-roman-digits.
        03  inp-rom-digit  pic 9(01) occurs 20 times.
      01  ws-search-idx        pic 9(02) comp.
      01  ws-tbl-table-def.
        03  filler pic x(05) value '1000M'.
        03  filler pic x(05) value '0500D'.
        03  filler pic x(05) value '0100C'.
        03  filler pic x(05) value '0050L'.
        03  filler pic x(05) value '0010X'.
        03  filler pic x(05) value '0005V'.
        03  filler pic x(05) value '0001I'.
      01  filler redefines ws-tbl-table-def.
        03  ws-tbl-roman      occurs 07 times indexed by rx.
          05  ws-tbl-rom-val  pic 9(04).
          05  ws-tbl-rom-ch   pic x(01).
      01  ws-number           pic s9(05) value 0.
      01  ws-number-pic       pic zzzz9-.

      PROCEDURE DIVISION.
          accept inp-roman
          perform
          until inp-roman = ' '
            move zeroes to inp-roman-digits
            perform
            varying i from 1 by +1 until inp-rom-ch (i) = ' '
              set rx to 1
              search ws-tbl-roman
                at end
                  move 0 to inp-rom-digit (i)
                when ws-tbl-rom-ch (rx) = inp-rom-ch (i)
                  set inp-rom-digit (i) to rx
              end-search
            end-perform
            compute l = i - 1
            move 0 to ws-number
            perform
            varying i from 1 by +1
            until i > l or inp-rom-digit (i) = 0
              compute j = inp-rom-digit (i)
              compute k = inp-rom-digit (i + 1)
              if ws-tbl-rom-val (k)
              >  ws-tbl-rom-val (j)
                compute ws-number
                =      ws-number
                -      ws-tbl-rom-val (j)
              else
                compute ws-number
                =      ws-number
                +      ws-tbl-rom-val (j)
              end-if
            end-perform
            move ws-number to ws-number-pic
            display '----------'
            display 'roman=' inp-roman
            display 'arabic=' ws-number-pic
            if i < l or ws-number = 0
              display 'invalid/incomplete roman numeral at pos 'i
                      ' found ' inp-rom-ch (i)
            end-if
            accept inp-roman
          end-perform
          stop run
          .
      END PROGRAM UNROMAN.


roman_to_demical = (s) ->
  # s is well-formed Roman Numeral >= I
  numbers =
    M: 1000
    D: 500
    C: 100
    L: 50
    X: 10
    V: 5
    I: 1

  result = 0
  for c in s
    num = numbers[c]
    result += num
    if old_num < num
      # If old_num exists and is less than num, then
      # we need to subtract it twice, once because we
      # have already added it on the last pass, and twice
      # to conform to the Roman convention that XC = 90,
      # not 110.
      result -= 2 * old_num
    old_num = num
  result

tests =
  IV: 4
  XLII: 42
  MCMXC: 1990
  MMVIII: 2008
  MDCLXVI: 1666

for roman, expected of tests
  dec = roman_to_demical(roman)
  console.log "error" if dec != expected
  console.log "#{roman} = #{dec}"


(defun mapcn (chars nums string)
  (loop as char across string as i = (position char chars) collect (and i (nth i nums))))

(defun parse-roman (R)
  (loop with nums = (mapcn "IVXLCDM" '(1 5 10 50 100 500 1000) R)
        as (A B) on nums if A sum (if (and B (< A B)) (- A) A)))


include "cowgol.coh";
include "argv.coh";

# Decode the Roman numeral in the given string.
# Returns 0 if the string does not contain a valid Roman numeral.
sub romanToDecimal(str: [uint8]): (rslt: uint16) is
    # Look up a Roman digit
    sub digit(char: uint8): (val: uint16) is
        # Definition of Roman numerals
        record RomanDigit is
            char: uint8;
            value: uint16;
        end record;

        var digits: RomanDigit[] := {
            {'I',1}, {'V',5}, {'X',10}, {'L',50},
            {'C',100}, {'D',500}, {'M',1000}
        };

        char := char & ~32; # make uppercase

        # Look up given digit
        var i: @indexof digits := 0;
        while i < @sizeof digits loop
            val := digits[i].value;
            if digits[i].char == char then
                return;
            end if;
            i := i + 1;
        end loop;
        val := 0;
    end sub;

    rslt := 0;
    while [str] != 0 loop
        var cur := digit([str]); # get value of current digit
        if cur == 0 then rslt := 0; return; end if; # stop when invalid
        str := @next str;
        if digit([str]) > cur then
            # a digit followed by a larger digit should be subtracted from
            # the total
            rslt := rslt - cur;
        else
            rslt := rslt + cur;
        end if;
    end loop;
end sub;

# Read a Roman numeral from the command line and print its output
ArgvInit();
var argmt := ArgvNext();
if argmt == (0 as [uint8]) then
    # No argument
    print("No argument\n");
    ExitWithError();
end if;

print_i16(romanToDecimal(argmt));
print_nl();


import std.regex, std.algorithm;

int toArabic(in string s) /*pure nothrow*/ {
    static immutable weights = [1000, 900, 500, 400, 100,
                                90, 50, 40, 10, 9, 5, 4, 1];
    static immutable symbols = ["M","CM","D","CD","C","XC",
                                "L","XL","X","IX","V","IV","I"];

    int arabic;
    foreach (m; s.matchAll("CM|CD|XC|XL|IX|IV|[MDCLXVI]".regex))
        arabic += weights[symbols.countUntil(m.hit)];
    return arabic;
}

void main() {
    assert("MCMXC".toArabic == 1990);
    assert("MMVIII".toArabic == 2008);
    assert("MDCLXVI".toArabic == 1666);
}


program RomanNumeralsDecode;

{$APPTYPE CONSOLE}

function RomanToInteger(const aRoman: string): Integer;
  function DecodeRomanDigit(aChar: Char): Integer;
  begin
    case aChar of
      'M', 'm': Result := 1000;
      'D', 'd': Result := 500;
      'C', 'c': Result := 100;
      'L', 'l': Result := 50;
      'X', 'x': Result := 10;
      'V', 'v': Result := 5;
      'I', 'i': Result := 1
    else
      Result := 0;
    end;
  end;

var
  i: Integer;
  lCurrVal: Integer;
  lLastVal: Integer;
begin
  Result := 0;

  lLastVal := 0;
  for i := Length(aRoman) downto 1 do
  begin
    lCurrVal := DecodeRomanDigit(aRoman[i]);
    if lCurrVal < lLastVal then
      Result := Result - lCurrVal
    else
      Result := Result + lCurrVal;
    lLastVal := lCurrVal;
  end;
end;

begin
  Writeln(RomanToInteger('MCMXC'));    // 1990
  Writeln(RomanToInteger('MMVIII'));   // 2008
  Writeln(RomanToInteger('MDCLXVI'));  // 1666
end.


rom_digs$[] = [ "M" "D" "C" "L" "X" "V" "I" ]
rom_vals[] = [ 1000 500 100 50 10 5 1 ]
#
func rom2int rom_numb$ . val .
  val = 0
  for dig$ in strchars rom_numb$
    for i range len rom_digs$[]
      if rom_digs$[i] = dig$
        v = rom_vals[i]
      .
    .
    val += v
    if old_v < v
      val -= 2 * old_v
    .
    old_v = v
  .
.
call rom2int "MCMXC" v
print v
call rom2int "MMVIII" v
print v
call rom2int "MDCLXVI" v
print v


MapChar(STRING1 c) := CASE(c,'M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1,0);

RomanDecode(STRING s) := FUNCTION
  dsS := DATASET([{s}],{STRING Inp});
  R := { INTEGER2 i; };

  R Trans1(dsS le,INTEGER pos) := TRANSFORM
    SELF.i := MapChar(le.Inp[pos]) * IF ( MapChar(le.Inp[pos]) < MapChar(le.Inp[pos+1]), -1, 1 );
  END;

  RETURN SUM(NORMALIZE(dsS,LENGTH(TRIM(s)),Trans1(LEFT,COUNTER)),i);
END;

RomanDecode('MCMLIV');   //1954
RomanDecode('MCMXC');    //1990
RomanDecode('MMVIII');   //2008
RomanDecode('MDCLXVI');  //1666
RomanDecode('MDLXVI');   //1566