Initial commitHEADmain

1 files changed, 131 insertions, 0 deletions

diff --git a/typing/src/typing.adb b/typing/src/typing.adb
new file mode 100644
index 0000000..876c5db
--- /dev/null
+++ b/typing/src/typing.adb
@@ -0,0 +1,131 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Typing is
+  -- Notes:
+  -- Every "built-in" type in Ada is defined with facilities generally available
+  -- to the user.
+
+  ------------------------------------------------------------------------------
+  -- Ranged integers.
+  ------------------------------------------------------------------------------
+  type My_Int is range -1 .. 20;
+
+  function Overflow (X : My_Int) return My_Int is
+  begin
+    return X + 1;
+  end Overflow;
+
+  procedure Test_My_Int is
+    -- N overflows.
+    --N : My_Int := Overflow (My_Int'Last);
+
+    -- C is equal to (12 + 15) / 2 = 13.
+    -- The reason C does not overflow is that type-level overflows are performed
+    -- at specific boundaries for efficiency reasons, in this case when the
+    -- result of the computation is assigned to the variable C. The value 13 is
+    -- within the range of My_Int, so we do not get an overflow exception in this
+    -- case.
+    A : My_Int := 12;
+    B : My_Int := 15;
+    C : My_Int := (A + B) / 2;
+  begin
+    for I in My_int loop
+      Put_Line (My_Int'Image (I));
+    end loop;
+
+    --Put_Line ("My_Int N = " & My_Int'Image (N));
+    Put_Line ("My_Int C = " & My_Int'Image (C));
+  end Test_My_Int;
+
+  ------------------------------------------------------------------------------
+  -- Unsigned integers / modular types.
+  ------------------------------------------------------------------------------
+  type Mod_Int is mod 5;
+
+  procedure Test_Mod_Int is
+    A : Mod_Int := 2;
+    B : Mod_Int := 4;
+    C : Mod_Int := A + B; -- C = 1. No overflow, implicit mod operation.
+  begin
+    Put_Line ("Mod_Int C = " & Mod_Int'Image (C));
+  end Test_Mod_Int;
+
+  ------------------------------------------------------------------------------
+  -- Enumerations.
+  ------------------------------------------------------------------------------
+  type Days is (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday);
+
+  procedure Test_Days is
+  begin
+    for D in Days loop
+      Put (Days'Image (D));
+      case D is
+        when Monday .. Friday => Put_Line (" -> weekday");
+        when Saturday .. Sunday => Put_Line (" -> weekend");
+      end case;
+    end loop;
+  end Test_Days;
+
+  ------------------------------------------------------------------------------
+  -- Floats with ranges.
+  ------------------------------------------------------------------------------
+  type T_Norm is new Float range -1.0 .. +1.0;
+
+  procedure Test_T_Norm is
+    A : T_Norm := 0.5;
+  begin
+    Put_Line ("A = " & T_Norm'Image (A));
+  end Test_T_Norm;
+
+  ------------------------------------------------------------------------------
+  -- Casting.
+  ------------------------------------------------------------------------------
+  type Meters is new Float;
+  type Miles is new Float;
+
+  procedure Test_Units is
+    Dist_Imperial : Miles;
+    Dist_Metric : constant Meters := 100.0;
+  begin
+    Dist_Imperial := Miles (Dist_Metric) / 1609.0;
+    Put_Line (Meters'Image (Dist_Metric) & " meters is " & Miles'Image (Dist_Imperial) & " miles");
+  end Test_Units;
+
+  ------------------------------------------------------------------------------
+  -- Derived types.
+  --
+  -- Derived types introduce a new type and usually constrain the parent type.
+  ------------------------------------------------------------------------------
+  type SSN is new Integer range 0 .. 999_99_9999;
+
+  procedure Test_SSN is
+    X : SSN := 111_22_3333;
+  begin
+    Put_Line("SSN X = " & SSN'Image (X));
+  end Test_SSN;
+
+  ------------------------------------------------------------------------------
+  -- Subtypes types.
+  --
+  -- Subtypes express constraints without introducing a new type.
+  -- Constraints are enforced at runtime.
+  ------------------------------------------------------------------------------
+  subtype Weekend_Days is Days range Saturday .. Sunday;
+
+  procedure Test_Subtypes is
+    A : Weekend_Days := Saturday;
+    B : Days := A; -- OK.
+  begin
+    Put_Line ("Day B is " & Days'Image (B));
+    --A := Monday; -- Runtime exception.
+  end Test_Subtypes;
+
+begin
+  Test_My_Int;
+  Test_Mod_Int;
+  Test_Days;
+  Test_T_Norm;
+  Test_Units;
+  Test_SSN;
+  Test_Subtypes;
+end Typing;