with Ada.Text_IO; use Ada.Text_IO;

procedure Types is

   -----------------------------------------------------------------------------
   -- Record initialization.
   -----------------------------------------------------------------------------
   procedure Test_Point is
      type Point is record
         X : Integer := 0;
         Y : Integer := 0;
      end record;

      Origin_1 : Point;                       -- Default initialization.
      Origin_2 : Point := (0, 0);             -- Explicit, unnamed.
      Origin_3 : Point := (X => 0, Y => 0);   -- Explicit, named.
      Origin_4 : Point := (X => <>, Y => <>); -- Explicit, using defaults.
      Origin_5 : Point := (X | Y => 0);       -- Initialize both values.
      Origin_6 : Point := Point'(0,0);        -- Qualified expression.
   begin
      Put_Line ("Origin: " & Integer'Image (Origin_5.X) & ", "
                & Integer'Image (Origin_5.Y));
   end Test_Point;

   -----------------------------------------------------------------------------
   -- Pointers.
   -----------------------------------------------------------------------------
   procedure Test_Pointer is
      type Month_Type is (Jan, Feb, Mar, Apr, May, Jun,
                          Jul, Aug, Sep, Oct, Nov, Dec);

      type Date is record
         Day : Integer range 1 .. 31;
         Month : Month_Type;
         Year : Integer;
      end record;

      -- Access types are nominally typed, not structurally typed.
      -- If we "own" a type X, we typically also declare an access type named
      -- X_Acc, so that there is a canonical name for the access type to X.
      type Date_Acc is access Date; -- Pointer to Date type.
      type Different_Date_Acc is access Date; -- Different type.

      Null_Date : Date_Acc := null;

      -- Allocate values of the access type using the 'new' keyword.
      D : Date_Acc := new Date;

      -- Constraints can be given when instantiating the type.
      Buffer : access String := new String(1 .. 5);

      -- We can also initialize along with the allocation.
      Hello_Str : access String := new String'("Hello");

      procedure Test_Null (D : Date_Acc; Name : String) is
      begin
         -- Dereferencing of D happens implicitly. Here we can treat D as an
         -- actual Date.
         if D = null then
            Put_Line (Name & " is null");
         else
            Put_Line (Name & " is not null");
         end if;
      end Test_Null;

   begin
      Test_Null (Null_Date, "Null_Date");
      Test_Null (D, "D");
   end Test_Pointer;

   -----------------------------------------------------------------------------
   -- Mutually recursive types.
   --
   -- Similar to C++, we can forward-declare a type to break the loop.
   -----------------------------------------------------------------------------

   procedure Test_MyList is
      type MyList;
      type MyList_Acc is access MyList;

      type MyList is record
         Value : Integer := 0;
         Next  : MyList_Acc := null;
      end record;

      function Cons (X : Integer; L : MyList_Acc) return MyList_Acc is
         Head : MyList_Acc := new MyList;
      begin
         Head.Value := X;
         Head.Next := L;
         return Head;
      end Cons;

      procedure Print_List (L : access constant MyList) is
         Node : access constant MyList := L;
      begin
         Put ("[");
         while Node /= null loop
            Put (Integer'Image (Node.Value) & " ");
            Node := Node.next;
         end loop;
         Put_Line ("]");
      end Print_List;

      InitialList : MyList_Acc := new MyList'(4, null);
      ModifiedList : MyList_Acc;
   begin
      ModifiedList := Cons (1, Cons (2, Cons (3, InitialList)));
      Print_List (ModifiedList);
   end Test_MyList;

begin
   Test_Point;
   Test_Pointer;
   Test_MyList;
end Types;