Objects 1
MC logo

Objects 1

Ada Code Examples

<<Function Rename 2 Download Sequnce Abstract Class>>
with Gnat.Io; use Gnat.Io;
procedure Obj1 is
   -- Type of counter objects.  It is an object only in that it is "tagged,"
   -- which means that it has extra space assigned by the system to retain
   -- its dynamic type (just like Java objects and C++ objects with virtual
   -- functions).
   type Counter is tagged record
      Count: Integer := 0;
   end record;

   -- Operations on counter objects.  The attribute 'Class essentially means,
   -- "and derived classes, too".  If it were omitted, the call Inc(A)
   -- below (for A which is the derived type accumulator) would be illegal.

   -- Print the Counter.
   procedure Put(C: Counter'Class) is
   end Put;

   -- Increment the counter by 1.
   procedure Inc(C: in out Counter'Class) is
      C.Count := C.Count + 1;
   end Inc;

   -- Limited counters will not increment past a certain maximum.
   type Limited_Counter is new Counter with record
      Limit: Integer := 1;
   end record;

   -- Operations for Limited_Counter

   -- Set the limit.
   procedure Limit_To(LC: in out Limited_Counter'Class; L: Integer) is
      LC.Limit := L;
      if LC.Count > L then LC.Count := L; end if;
   end Limit_To;

   -- Increment.
   procedure Inc(LC: in out Limited_Counter'Class) is
      if LC.Count > LC.Limit then LC.Count := LC.Limit; end if;
   end Inc;

   -- Accumulator objects can be incremented by an arbitrary amount (not
   -- just one!  Wow!)  This requires no additional data fields.
   type Accumulator is new Counter with null record;

   -- Operation specific to Accumulator: Increment by arbitrary amount.
   procedure Inc(C: in out Accumulator'Class; Amt: Integer) is
      C.Count := C.Count + Amt;
   end Inc;

   -- Some example variables.
   C: Counter;
   L: Limited_Counter;
   A: Accumulator;

   Limit_To(L, 3); Inc(LC => L); Inc(LC => L);
                   Inc(LC => L); Inc(LC => L); Inc(LC => L);
   Inc(A, 4);
   Put(A); Put(" "); Put(L); Put(" "); Put(C); New_Line;
end Obj1;

-- Note: I needed LC => L to get it to resolve Inc.  This is absurd, but I
-- have not figured out if there's something different I need to declare, or
-- the language is just absurd on this point.
<<Function Rename 2 Sequnce Abstract Class>>