dcl Next_color ordinal Color;
do Next_color = first (:Color:)
repeat ordinalsucc( Next_color )
until (Next_color = last (:Color:));
display( ordinalname( Next_color ) );
end;
do Next_color = last (:Color:)
repeat ordinalpred( Next_color)
until (Next_color = first(:Color:);
display( ordinalname( Next_color));
end;
最初のループのサンプル出力は次のようになります。
RED ORANGE YELLOW GREEN BLUE INDIGO VIOLET
序数は、配列の下位境界または上位境界を含めて、 配列への索引としては使用できず、変数のエクステントとして定義することもできません。 ただし、BINARYVALUE 組み込み関数を使用して、 序数を 2 進値に変換することは可能です。 この関数が返す値を使用して、 配列の索引を作成したり、エクステントを定義することができます。
たとえば、下記のパッケージでは、配列 usage_count の定義によって 各カラーが使用される回数が保持され、プロシージャー Record_usage によって この配列が更新され、さらにプロシージャー Show_usage によって この配列内の値が表示されます。
Usage: package exports(*);
define ordinal Color ( Red,
Orange,
Yellow,
Green,
Blue,
Indigo,
Violet );
dcl Usage_count( binvalue( first(:Color:))
: binvalue( last(:Color:)) )
static fixed bin(31) init( (*) 0 );
/* first(:Color:) = Red */
/* last(:Color:) = Violet */
Record_usage: proc (Wall_color );
dcl Wall_color type Color parm byvalue;
Usage_count( binvalue(Wall_color) )
= 1 + Usage_count( binvalue(Wall_color) );
end Record_usage;
Show_usage: proc;
dcl Next_color type Color;
do Next_color = Red upthru Violet;
put skip list( ordinalname( Next_color) );
put list( Usage_count( binvalue(Next_color) ));
end;
end Show_usage;
end Usage;
序数を使用すれば、 保守と拡張が容易で、しかも表索引と同じくらい効率的な 関数を作成することができます。
下記の例では、関数 Is_mellow により、 カラーが「柔らかい」かどうかを示すビットが返されます。 もっと多くのカラーが定義される場合は、 SELECT グループに「柔らかい」カラーを追加できます。 テーブルを作成した場合とは異なり、SELECT グループでは、カラーの 順序は DEFINE ステートメントでの順序と同じでなくてもかまいません。 あるいは、カラーを特定の順序に並べる必要はありません。
SELECT グループ内部のステートメントは すべて定数値を返す RETURN ステートメントですから、 コンパイラーが SELECT グループ全体をテーブル参照に変換します。
Is_mellow: proc( Test_color ) returns( bit(1) aligned );
dcl Test_color type Color parm byvalue;
select (Test_color);
when( Yellow, Indigo)
return( '1'b );
otherwise
return( '0'b );
end;
end;
この機能を使用して、ユーザー独自の ORDINALNAME 組み込み関数を作成することも可能です。 この独自の関数は、各序数値について、ユーザーが表示させたい名前を返すことができます。 たとえば、下記の関数 Color_name は、 最初の文字を大文字とする名前に関連付けられたカラー名を返します。
Color_name: proc( Test_color ) returns( char(8) varying );
dcl Test_color type Color parm byvalue;
select (Test_color);
when ( Blue ) return( 'Blue');
when ( Green ) return( 'Green');
when ( Orange ) return( 'Orange');
when ( Red ) return( 'Red');
when ( Yellow ) return( 'Yellow');
otherwise return (");
end;
end;