Re: Expressive Case Statements (long source)

[tmoran@bix.com (Tom Moran)]

-- Do you like this approach?  Here's the example of usage:
--     condition       condition entry
--      stub                stub
--       ------------------------------------------
--       c1  | T   T   T   T   F   F   F   F
--       ----|--------------------------------------
--       c2  | T   T   F   F   F   F   T   T
--       ----|--------------------------------------
--       c3  | T   F   T   F   F   T   T   F
--       ----|-------------------------------------
--       ==========================================
--       A1  | X   X   X                   X
--       ----|--------------------------------------
--       A2  |     X   X
--       ----|--------------------------------------
--       A3  | X       X            X
--       ----|--------------------------------------
--    Action               Action Entry
--      Stub                   Stub
with Ada.Text_IO,
     Decision_Table_3D;
procedure testdt is
  package DT is new Decision_Table_3D(Boolean, Boolean, Boolean,
                                      "FT", "FT", "FT");
  A1, A2, A3 : DT.Categories;
  function I(S : in DT.Abbreviations) return DT.Cell_Indices renames
DT.Index;
  Situation : DT.Cell_Indices;
  Example_Value : Integer := 2;
begin
  DT.Define(A1, (I("TTT"), I("TTF"), I("TFT"),           I("FTF")));
  DT.Define(A2, (          I("TTF"), I("TFT")));
  DT.Define(A3, (I("TTT"),           I("TFT"), I("FFT")));
  Ada.Text_IO.Put_Line("Now do Decision Table");
  Situation := (True, Example_Value > 1, Example_Value < 3);
  if DT.Is_In(A1, Situation) then
    Ada.Text_IO.Put_Line("do action 1");
  end if;
  if DT.Is_In(A2, Situation) then
    Ada.Text_IO.Put_Line("do action 2");
  end if;
  if DT.Is_In(A3, Situation) then
    Ada.Text_IO.Put_Line("do action 3");
  end if;
end testdt;

-- Then the code to support it:

-- 3-Dimensional Decision Table support
-- Tom Moran 9/2/98
-- For three Booleans, for instance, types Indices_i would be Boolean,
-- (as in the example above) but they could be another enumerated type
-- if needed.  Extension to 2D or 4D or more is clear and not onerous.
--   If desired, Abbreviations can be used (as in the example above).
-- Abbrev_i need only be specified if function Index is to be
-- used, in which case Abbrev_i must be a string indexed from 1,
-- containing one unique character for value of Indices_i, in the
-- enumeration'pos order.  For instance, if Indices_1 is boolean,
-- and is to be abbreviated with TF, set Abbrev_1 to "FT".  If you
-- prefer No and Yes, use "NY" instead.

generic

  type Indices_1 is (<>);
  type Indices_2 is (<>);
  type Indices_3 is (<>);
  Abbrev_1 : String := "";
  Abbrev_2 : String := "";
  Abbrev_3 : String := "";

package Decision_Table_3D is

  type Cell_Indices is record
    A : Indices_1;
    B : Indices_2;
    C : Indices_3;
  end record;

  type Indices_List is array(integer range <>) of Cell_Indices;

  type Categories is private;

  Changed_Definition,
  Undefined     : Exception;

  procedure Define(Category : in out Categories;
                   True_List: in     Indices_List);
  -- raises Changed_Definition if Category has already been Define'd
  -- with a different definition.

  function Is_In(Category : in Categories;
                 Index    : in Cell_Indices) return Boolean;
  -- returns True iff Index is in the True_List used to Define this
Category.
  -- raises Undefined if the Category has not been Define'd.

  subtype Abbreviations is String(1 .. 3);

  function Index(S : in Abbreviations) return Cell_Indices;
  -- raises Constraint_Error if S has an illegitimate (not specified
  -- in appropriate Abbrev_1, _2, or _3) character.

private

  type Truth_Tables is array(Indices_1, Indices_2, Indices_3) of
Boolean;

  type Categories is record
    Is_Defined : Boolean := False;
    Truth_Table : Truth_Tables;
  end record;

end Decision_Table_3D;

with Ada.Strings.Fixed;
package body Decision_Table_3D is

  procedure Define(Category : in out Categories;
                   True_List: in     Indices_List) is
  -- raises Changed_Definition if Category has already been Define'd
  -- with a different definition.
    X : Truth_Tables := (others=>(others=>(others=>False)));
  begin
    for i in True_List'range loop
      X(True_List(i).A, True_List(i).B, True_List(i).C) := True;
    end loop;
    if Category.Is_Defined and then X /= Category.Truth_Table then
      raise Changed_Definition;
    else
      Category.Truth_Table := X;
    end if;
    Category.Is_Defined := True;
  end Define;

  function Is_In(Category : in Categories;
                 Index    : in Cell_Indices) return Boolean is
  -- returns True iff Index is in the True_List used to Define this
Category.
  -- raises Undefined if the Category has not been Define'd.
  begin
    if not Category.Is_Defined then raise Undefined;end if;
    return Category.Truth_Table(Index.A, Index.B, Index.C);
  end Is_In;

  function Index(S : in Abbreviations) return Cell_Indices is
  -- raises Constraint_Error if S has an illegitimate (not specified
  -- in appropriate Abbrev_1, _2, or _3) character.
  use Ada.Strings.Fixed;
  begin
    return (A=>Indices_1'val(Index(Abbrev_1, S(1 .. 1))-1),
            B=>Indices_2'val(Index(Abbrev_2, S(2 .. 2))-1),
            C=>Indices_3'val(Index(Abbrev_3, S(3 .. 3))-1));
  end Index;

end Decision_Table_3D;
------------------------------ end