diff options
Diffstat (limited to 'typing/src')
-rw-r--r-- | typing/src/typing.adb | 131 |
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 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | procedure Typing is | ||
4 | -- Notes: | ||
5 | -- Every "built-in" type in Ada is defined with facilities generally available | ||
6 | -- to the user. | ||
7 | |||
8 | ------------------------------------------------------------------------------ | ||
9 | -- Ranged integers. | ||
10 | ------------------------------------------------------------------------------ | ||
11 | type My_Int is range -1 .. 20; | ||
12 | |||
13 | function Overflow (X : My_Int) return My_Int is | ||
14 | begin | ||
15 | return X + 1; | ||
16 | end Overflow; | ||
17 | |||
18 | procedure Test_My_Int is | ||
19 | -- N overflows. | ||
20 | --N : My_Int := Overflow (My_Int'Last); | ||
21 | |||
22 | -- C is equal to (12 + 15) / 2 = 13. | ||
23 | -- The reason C does not overflow is that type-level overflows are performed | ||
24 | -- at specific boundaries for efficiency reasons, in this case when the | ||
25 | -- result of the computation is assigned to the variable C. The value 13 is | ||
26 | -- within the range of My_Int, so we do not get an overflow exception in this | ||
27 | -- case. | ||
28 | A : My_Int := 12; | ||
29 | B : My_Int := 15; | ||
30 | C : My_Int := (A + B) / 2; | ||
31 | begin | ||
32 | for I in My_int loop | ||
33 | Put_Line (My_Int'Image (I)); | ||
34 | end loop; | ||
35 | |||
36 | --Put_Line ("My_Int N = " & My_Int'Image (N)); | ||
37 | Put_Line ("My_Int C = " & My_Int'Image (C)); | ||
38 | end Test_My_Int; | ||
39 | |||
40 | ------------------------------------------------------------------------------ | ||
41 | -- Unsigned integers / modular types. | ||
42 | ------------------------------------------------------------------------------ | ||
43 | type Mod_Int is mod 5; | ||
44 | |||
45 | procedure Test_Mod_Int is | ||
46 | A : Mod_Int := 2; | ||
47 | B : Mod_Int := 4; | ||
48 | C : Mod_Int := A + B; -- C = 1. No overflow, implicit mod operation. | ||
49 | begin | ||
50 | Put_Line ("Mod_Int C = " & Mod_Int'Image (C)); | ||
51 | end Test_Mod_Int; | ||
52 | |||
53 | ------------------------------------------------------------------------------ | ||
54 | -- Enumerations. | ||
55 | ------------------------------------------------------------------------------ | ||
56 | type Days is (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday); | ||
57 | |||
58 | procedure Test_Days is | ||
59 | begin | ||
60 | for D in Days loop | ||
61 | Put (Days'Image (D)); | ||
62 | case D is | ||
63 | when Monday .. Friday => Put_Line (" -> weekday"); | ||
64 | when Saturday .. Sunday => Put_Line (" -> weekend"); | ||
65 | end case; | ||
66 | end loop; | ||
67 | end Test_Days; | ||
68 | |||
69 | ------------------------------------------------------------------------------ | ||
70 | -- Floats with ranges. | ||
71 | ------------------------------------------------------------------------------ | ||
72 | type T_Norm is new Float range -1.0 .. +1.0; | ||
73 | |||
74 | procedure Test_T_Norm is | ||
75 | A : T_Norm := 0.5; | ||
76 | begin | ||
77 | Put_Line ("A = " & T_Norm'Image (A)); | ||
78 | end Test_T_Norm; | ||
79 | |||
80 | ------------------------------------------------------------------------------ | ||
81 | -- Casting. | ||
82 | ------------------------------------------------------------------------------ | ||
83 | type Meters is new Float; | ||
84 | type Miles is new Float; | ||
85 | |||
86 | procedure Test_Units is | ||
87 | Dist_Imperial : Miles; | ||
88 | Dist_Metric : constant Meters := 100.0; | ||
89 | begin | ||
90 | Dist_Imperial := Miles (Dist_Metric) / 1609.0; | ||
91 | Put_Line (Meters'Image (Dist_Metric) & " meters is " & Miles'Image (Dist_Imperial) & " miles"); | ||
92 | end Test_Units; | ||
93 | |||
94 | ------------------------------------------------------------------------------ | ||
95 | -- Derived types. | ||
96 | -- | ||
97 | -- Derived types introduce a new type and usually constrain the parent type. | ||
98 | ------------------------------------------------------------------------------ | ||
99 | type SSN is new Integer range 0 .. 999_99_9999; | ||
100 | |||
101 | procedure Test_SSN is | ||
102 | X : SSN := 111_22_3333; | ||
103 | begin | ||
104 | Put_Line("SSN X = " & SSN'Image (X)); | ||
105 | end Test_SSN; | ||
106 | |||
107 | ------------------------------------------------------------------------------ | ||
108 | -- Subtypes types. | ||
109 | -- | ||
110 | -- Subtypes express constraints without introducing a new type. | ||
111 | -- Constraints are enforced at runtime. | ||
112 | ------------------------------------------------------------------------------ | ||
113 | subtype Weekend_Days is Days range Saturday .. Sunday; | ||
114 | |||
115 | procedure Test_Subtypes is | ||
116 | A : Weekend_Days := Saturday; | ||
117 | B : Days := A; -- OK. | ||
118 | begin | ||
119 | Put_Line ("Day B is " & Days'Image (B)); | ||
120 | --A := Monday; -- Runtime exception. | ||
121 | end Test_Subtypes; | ||
122 | |||
123 | begin | ||
124 | Test_My_Int; | ||
125 | Test_Mod_Int; | ||
126 | Test_Days; | ||
127 | Test_T_Norm; | ||
128 | Test_Units; | ||
129 | Test_SSN; | ||
130 | Test_Subtypes; | ||
131 | end Typing; | ||