Initial commitHEADmain

1 files changed, 116 insertions, 0 deletions

diff --git a/more-types/src/types.adb b/more-types/src/types.adb
new file mode 100644
index 0000000..4e7590f
--- /dev/null
+++ b/more-types/src/types.adb
@@ -0,0 +1,116 @@
+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;