From 727e3c59346da4f91284b34b4c18f2e0ba155e53 Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Sat, 9 Aug 2025 16:03:28 +0200 Subject: Initial commit --- typing/src/typing.adb | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 typing/src/typing.adb (limited to 'typing/src/typing.adb') 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; -- cgit v1.2.3