diff options
-rw-r--r-- | arrays/arrays.gpr | 5 | ||||
-rw-r--r-- | arrays/src/arrays.adb | 127 | ||||
-rw-r--r-- | basics/basics.gpr | 5 | ||||
-rw-r--r-- | basics/src/main.adb | 108 | ||||
-rw-r--r-- | guess/guess.gpr | 5 | ||||
-rw-r--r-- | guess/src/guess.adb | 20 | ||||
-rw-r--r-- | hello/hello.gpr | 5 | ||||
-rw-r--r-- | hello/src/main.adb | 108 | ||||
-rw-r--r-- | list/list.gpr | 5 | ||||
-rw-r--r-- | list/src/list.adb | 46 | ||||
-rw-r--r-- | more-types/src/types.adb | 116 | ||||
-rw-r--r-- | more-types/types.gpr | 5 | ||||
-rw-r--r-- | records/records.gpr | 5 | ||||
-rw-r--r-- | records/src/records.adb | 28 | ||||
-rw-r--r-- | ring_buffer/ring_buffer.gpr | 5 | ||||
-rw-r--r-- | ring_buffer/src/ring_buffer.adb | 94 | ||||
-rw-r--r-- | stack/src/main.adb | 20 | ||||
-rw-r--r-- | stack/src/stack.adb | 31 | ||||
-rw-r--r-- | stack/src/stack.ads | 26 | ||||
-rw-r--r-- | stack/stack.gpr | 5 | ||||
-rw-r--r-- | tree/src/main.adb | 14 | ||||
-rw-r--r-- | tree/src/tree.adb | 12 | ||||
-rw-r--r-- | tree/src/tree.ads | 18 | ||||
-rw-r--r-- | tree/tree.gpr | 5 | ||||
-rw-r--r-- | typing/src/typing.adb | 131 | ||||
-rw-r--r-- | typing/typing.gpr | 5 |
26 files changed, 954 insertions, 0 deletions
diff --git a/arrays/arrays.gpr b/arrays/arrays.gpr new file mode 100644 index 0000000..3d7ea37 --- /dev/null +++ b/arrays/arrays.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Arrays is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("arrays.adb"); | ||
5 | end Arrays; | ||
diff --git a/arrays/src/arrays.adb b/arrays/src/arrays.adb new file mode 100644 index 0000000..e851fc6 --- /dev/null +++ b/arrays/src/arrays.adb | |||
@@ -0,0 +1,127 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; | ||
3 | |||
4 | procedure Arrays is | ||
5 | ----------------------------------------------------------------------------- | ||
6 | -- Arrays 101. | ||
7 | -- | ||
8 | -- The index is strongly-typed and can be any discrete type. | ||
9 | -- | ||
10 | -- Iterations over the index type are preferred over iterations over specific | ||
11 | -- index values. | ||
12 | ----------------------------------------------------------------------------- | ||
13 | procedure Test_Array is | ||
14 | type My_Int is range 0 .. 1_000; | ||
15 | type Index is range 1 .. 5; | ||
16 | |||
17 | type My_Int_Array is array (Index) of My_Int; | ||
18 | |||
19 | function To_String (A : My_Int_Array) return String is | ||
20 | S : Unbounded_String; | ||
21 | begin | ||
22 | for I in Index loop | ||
23 | S := S & My_Int'Image (A (I)) & " "; | ||
24 | end loop; | ||
25 | return To_String (S); | ||
26 | end To_String; | ||
27 | |||
28 | Arr : My_Int_Array := (2, 3, 5, 7, 11); | ||
29 | -- This array is not actually empty; its size is determined by the range of | ||
30 | -- its index type, which in this example is 1 .. 5. | ||
31 | Empty_Arr : My_Int_Array; | ||
32 | begin | ||
33 | Put_Line ("Arr = " & To_String (Arr)); | ||
34 | Put_Line ("Arr is " & Integer'Image (Arr'Size) & " bytes"); | ||
35 | |||
36 | Put_Line ("Empty_Arr = " & To_String (Empty_Arr)); | ||
37 | Put_Line ("Empty_Arr is " & Integer'Image (Empty_Arr'Size) & " bytes"); | ||
38 | end Test_Array; | ||
39 | |||
40 | ----------------------------------------------------------------------------- | ||
41 | -- Enums as array indices. | ||
42 | ----------------------------------------------------------------------------- | ||
43 | procedure Test_Enum_Array is | ||
44 | type Month is (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec); | ||
45 | type Day is range 1 .. 31; | ||
46 | |||
47 | Month_Days : array (Month) of Day := | ||
48 | (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); | ||
49 | begin | ||
50 | for M in Month loop | ||
51 | Put_Line | ||
52 | (Month'Image (M) & " has " & Day'Image (Month_Days (M)) & " days"); | ||
53 | end loop; | ||
54 | end Test_Enum_Array; | ||
55 | |||
56 | ----------------------------------------------------------------------------- | ||
57 | -- Arrays in ADA are bounds-checked. | ||
58 | ----------------------------------------------------------------------------- | ||
59 | procedure Test_Bounds is | ||
60 | Arr : array (Integer range 1 .. 5) of Integer := (3, 4, 7, 8, 9); | ||
61 | begin | ||
62 | Arr (1) := 17; | ||
63 | Arr (5) := 18; | ||
64 | --Arr (6) := 19; -- Error. | ||
65 | end Test_Bounds; | ||
66 | |||
67 | ----------------------------------------------------------------------------- | ||
68 | -- Use the Range attribute to iterate over an array with an anonymous range. | ||
69 | ----------------------------------------------------------------------------- | ||
70 | procedure Test_Anonymous_Range is | ||
71 | Arr : array (3 .. 7) of Integer := (5, 8, 3, 5, 3); | ||
72 | begin | ||
73 | for I in Arr'Range loop | ||
74 | Put_Line | ||
75 | ("Index " & Integer'Image (I) & " has value " & | ||
76 | Integer'Image (Arr (I))); | ||
77 | end loop; | ||
78 | end Test_Anonymous_Range; | ||
79 | |||
80 | ----------------------------------------------------------------------------- | ||
81 | -- Unconstrained arrays. | ||
82 | -- | ||
83 | -- The size/bounds are provided when creating an instance of the array type. | ||
84 | ----------------------------------------------------------------------------- | ||
85 | procedure Test_Unbounded_Array is | ||
86 | type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); | ||
87 | type Days_Arr is array (Integer range <>) of Day; | ||
88 | |||
89 | Days_Off : Days_Arr := (Sat, Sun); | ||
90 | begin | ||
91 | Put ("Holidays: "); | ||
92 | for D in Days_Off'Range loop | ||
93 | Put (Day'Image (Days_Off (D)) & " "); | ||
94 | end loop; | ||
95 | New_Line; | ||
96 | end Test_Unbounded_Array; | ||
97 | |||
98 | ----------------------------------------------------------------------------- | ||
99 | -- Bounds are automatically inferred from the initialization value. | ||
100 | ----------------------------------------------------------------------------- | ||
101 | procedure Test_Auto_Bounds is | ||
102 | Arr : array (Natural range <>) of Integer := (2, 3, 4); | ||
103 | begin | ||
104 | for I in Arr'First .. Arr'Last loop | ||
105 | Put_Line ("Arr(" & Integer'Image (I) & ") = " & Integer'Image (Arr (I))); | ||
106 | end loop; | ||
107 | end Test_Auto_Bounds; | ||
108 | |||
109 | ----------------------------------------------------------------------------- | ||
110 | -- Array slices. | ||
111 | ----------------------------------------------------------------------------- | ||
112 | procedure Test_Slices is | ||
113 | Str : String := "Hello world"; | ||
114 | begin | ||
115 | Str (7 .. 11) := "there"; | ||
116 | Put_Line (Str); | ||
117 | end Test_Slices; | ||
118 | |||
119 | begin | ||
120 | Test_Array; | ||
121 | Test_Enum_Array; | ||
122 | Test_Bounds; | ||
123 | Test_Anonymous_Range; | ||
124 | Test_Unbounded_Array; | ||
125 | Test_Auto_Bounds; | ||
126 | Test_Slices; | ||
127 | end Arrays; | ||
diff --git a/basics/basics.gpr b/basics/basics.gpr new file mode 100644 index 0000000..a217eed --- /dev/null +++ b/basics/basics.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Basics is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("main.adb"); | ||
5 | end Basics; | ||
diff --git a/basics/src/main.adb b/basics/src/main.adb new file mode 100644 index 0000000..63339ae --- /dev/null +++ b/basics/src/main.adb | |||
@@ -0,0 +1,108 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; | ||
3 | |||
4 | procedure Main is | ||
5 | procedure Read_Number is | ||
6 | N : Integer; | ||
7 | begin | ||
8 | Put_Line ("Please enter a number"); | ||
9 | Get (N); | ||
10 | if N > 0 then | ||
11 | Put_Line ("The number is positive"); | ||
12 | elsif N = 0 then | ||
13 | Put_Line ("The number is zero"); | ||
14 | else | ||
15 | Put_Line ("The number is negative"); | ||
16 | end if; | ||
17 | end Read_Number; | ||
18 | |||
19 | procedure Test_Loop is | ||
20 | N : Integer := 0; | ||
21 | begin | ||
22 | loop | ||
23 | exit when N = 5; | ||
24 | N := N + 1; | ||
25 | Put_Line ("Test loop"); | ||
26 | end loop; | ||
27 | end Test_Loop; | ||
28 | |||
29 | procedure Test_Even_Odd is | ||
30 | begin | ||
31 | for I in 0 .. 10 loop | ||
32 | Put_Line (I'Image & " is " & (if I mod 2 = 1 then "Odd" else "Even")); | ||
33 | end loop; | ||
34 | end Test_Even_Odd; | ||
35 | |||
36 | procedure My_Swap (A : in out Integer; B : in out Integer) is | ||
37 | C : Integer; | ||
38 | begin | ||
39 | C := A; | ||
40 | A := B; | ||
41 | B := C; | ||
42 | end My_Swap; | ||
43 | |||
44 | procedure Test_My_Swap is | ||
45 | A : Integer := 1; | ||
46 | B : Integer := 3; | ||
47 | begin | ||
48 | Put_Line ("Before swap: " & A'Image & B'Image); | ||
49 | My_Swap (A, B); | ||
50 | Put_Line ("After swap: " & A'Image & B'Image); | ||
51 | end Test_My_Swap; | ||
52 | |||
53 | function Fib (N : Integer) return Integer is | ||
54 | F0 : Integer := 0; | ||
55 | F1 : Integer := 1; | ||
56 | F : Integer := 0; | ||
57 | begin | ||
58 | for I in 2 .. N loop | ||
59 | F := F0 + F1; | ||
60 | F0 := F1; | ||
61 | F1 := F; | ||
62 | end loop; | ||
63 | return F; | ||
64 | end Fib; | ||
65 | |||
66 | function Factorial (N : Integer) return Integer is | ||
67 | F : Integer := 1; | ||
68 | begin | ||
69 | for I in 2 .. N loop | ||
70 | F := F * I; | ||
71 | end loop; | ||
72 | return F; | ||
73 | end Factorial; | ||
74 | |||
75 | procedure Test_Functions is | ||
76 | N : Integer; | ||
77 | begin | ||
78 | Put_Line ("Enter a number:"); | ||
79 | Get (N); | ||
80 | Put_Line ("Fib(" & N'Image & ") = " & Fib (N)'Image); | ||
81 | Put_Line ("Factorial(" & N'Image & ") = " & Factorial (N)'Image); | ||
82 | end Test_Functions; | ||
83 | |||
84 | procedure Test_Integers is | ||
85 | type Day is range 1 .. 7; | ||
86 | My_Day : Day := 3; | ||
87 | Other_Day : Day; | ||
88 | begin | ||
89 | for D in Day loop | ||
90 | Put_Line ("Day" & D'Image); | ||
91 | end loop; | ||
92 | Put_Line (My_Day'Image); | ||
93 | Other_Day := My_Day + Day (4); | ||
94 | Put_Line (Other_Day'Image); | ||
95 | end Test_Integers; | ||
96 | |||
97 | begin | ||
98 | -- This is a comment. | ||
99 | Put_Line ("Hello world!"); | ||
100 | |||
101 | Test_Loop; | ||
102 | Test_Even_Odd; | ||
103 | Test_My_Swap; | ||
104 | Test_Integers; | ||
105 | |||
106 | --Read_Number; | ||
107 | Test_Functions; | ||
108 | end Main; | ||
diff --git a/guess/guess.gpr b/guess/guess.gpr new file mode 100644 index 0000000..ee53cfa --- /dev/null +++ b/guess/guess.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Guess is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("guess.adb"); | ||
5 | end Guess; | ||
diff --git a/guess/src/guess.adb b/guess/src/guess.adb new file mode 100644 index 0000000..dc394fa --- /dev/null +++ b/guess/src/guess.adb | |||
@@ -0,0 +1,20 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; | ||
3 | |||
4 | procedure Guess is | ||
5 | Answer : Integer := 47; | ||
6 | Guess : Integer; | ||
7 | begin | ||
8 | loop | ||
9 | Put ("Enter a number: "); | ||
10 | Get (Guess); | ||
11 | if Guess < Answer then | ||
12 | Put_Line ("Too low!"); | ||
13 | elsif Guess > Answer then | ||
14 | Put_Line ("Too high!"); | ||
15 | elsif Guess = Answer then | ||
16 | Put_Line ("Correct!"); | ||
17 | end if; | ||
18 | exit when Guess = Answer; | ||
19 | end loop; | ||
20 | end Guess; | ||
diff --git a/hello/hello.gpr b/hello/hello.gpr new file mode 100644 index 0000000..3f34ae9 --- /dev/null +++ b/hello/hello.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Hello is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("main.adb"); | ||
5 | end Hello; | ||
diff --git a/hello/src/main.adb b/hello/src/main.adb new file mode 100644 index 0000000..c9cb966 --- /dev/null +++ b/hello/src/main.adb | |||
@@ -0,0 +1,108 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; | ||
3 | |||
4 | procedure main is | ||
5 | |||
6 | function Factorial (N : Integer) return Integer is | ||
7 | F : Integer := 1; | ||
8 | begin | ||
9 | for i in 2 .. N loop | ||
10 | F := F * i; | ||
11 | end loop; | ||
12 | return F; | ||
13 | end Factorial; | ||
14 | |||
15 | function Fib (N : Integer) return Integer is | ||
16 | F : array (0 .. N) of Integer; | ||
17 | begin | ||
18 | F (0) := 0; | ||
19 | F (1) := 1; | ||
20 | for I in F'First + 2 .. F'Last loop | ||
21 | F (I) := F (I - 2) + F (I - 1); | ||
22 | end loop; | ||
23 | return F (N); | ||
24 | end Fib; | ||
25 | |||
26 | function Fib_Rec (N : Integer) return Integer is | ||
27 | begin | ||
28 | if N = 0 then | ||
29 | return 0; | ||
30 | elsif N = 1 then | ||
31 | return 1; | ||
32 | else | ||
33 | return Fib_Rec (N - 1) + Fib_Rec (N - 2); | ||
34 | end if; | ||
35 | end Fib_Rec; | ||
36 | |||
37 | procedure Greet_5 is | ||
38 | counter : Integer := 1; | ||
39 | begin | ||
40 | Put_Line ("Greet_5"); | ||
41 | loop | ||
42 | Put_Line ("Counter: " & Integer'Image (counter)); | ||
43 | exit when counter = 5; | ||
44 | counter := counter + 1; | ||
45 | end loop; | ||
46 | end Greet_5; | ||
47 | |||
48 | procedure Greet_With_While is | ||
49 | counter : Integer := 1; | ||
50 | begin | ||
51 | Put_Line ("Greet_With_While"); | ||
52 | while counter <= 5 loop | ||
53 | Put_Line ("Counter: " & Integer'Image (counter)); | ||
54 | counter := counter + 1; | ||
55 | end loop; | ||
56 | end Greet_With_While; | ||
57 | |||
58 | procedure Swap (A, B : in out Integer) is | ||
59 | Tmp : Integer; | ||
60 | begin | ||
61 | Tmp := A; | ||
62 | A := B; | ||
63 | B := Tmp; | ||
64 | end Swap; | ||
65 | |||
66 | procedure Guessing_Game is | ||
67 | Answer : Integer := 47; | ||
68 | Guess : Integer; | ||
69 | begin | ||
70 | loop | ||
71 | Put ("Enter a number: "); | ||
72 | Get (Guess); | ||
73 | if Guess < Answer then | ||
74 | Put_Line ("Too low!"); | ||
75 | elsif Guess > Answer then | ||
76 | Put_Line ("Too high!"); | ||
77 | else | ||
78 | Put_Line ("Correct!"); | ||
79 | exit; | ||
80 | end if; | ||
81 | end loop; | ||
82 | end Guessing_Game; | ||
83 | |||
84 | N : Integer; | ||
85 | X : Integer := 2; | ||
86 | Y : Integer := 3; | ||
87 | |||
88 | begin | ||
89 | Put ("Enter an integer value: "); | ||
90 | Get (N); | ||
91 | if N >= 0 then | ||
92 | Put_Line ("Fib(" & Integer'Image (N) & ") = " & Integer'Image (Fib (N))); | ||
93 | Put_Line | ||
94 | ("Factorial(" & Integer'Image (N) & ") = " & | ||
95 | Integer'Image (Factorial (N))); | ||
96 | else | ||
97 | Put_Line ("Please enter a non-negative integer"); | ||
98 | end if; | ||
99 | |||
100 | Greet_5; | ||
101 | Greet_With_While; | ||
102 | |||
103 | Put_Line ("Swapping " & Integer'Image (X) & " and " & Integer'Image (Y)); | ||
104 | Swap (X, Y); | ||
105 | Put_Line ("X = " & Integer'Image (X) & ", Y = " & Integer'Image (Y)); | ||
106 | |||
107 | Guessing_Game; | ||
108 | end main; | ||
diff --git a/list/list.gpr b/list/list.gpr new file mode 100644 index 0000000..5095383 --- /dev/null +++ b/list/list.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project List is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("list.adb"); | ||
5 | end List; | ||
diff --git a/list/src/list.adb b/list/src/list.adb new file mode 100644 index 0000000..c8910d6 --- /dev/null +++ b/list/src/list.adb | |||
@@ -0,0 +1,46 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | procedure List is | ||
4 | |||
5 | type MyList; | ||
6 | |||
7 | type MyList_Access is access MyList; | ||
8 | |||
9 | type MyList is record | ||
10 | Value : Integer := 0; | ||
11 | Next : MyList_Access := null; | ||
12 | end record; | ||
13 | |||
14 | function Length (XS : access constant MyList) return Integer is | ||
15 | L : Integer := 0; | ||
16 | Node : access constant MyList := XS; | ||
17 | begin | ||
18 | while Node /= null loop | ||
19 | L := L + 1; | ||
20 | Node := Node.Next; | ||
21 | end loop; | ||
22 | return L; | ||
23 | end Length; | ||
24 | |||
25 | procedure Print_List (XS : access constant MyList) is | ||
26 | begin | ||
27 | if XS /= null then | ||
28 | Put (Integer'Image (XS.Value) & " "); | ||
29 | Print_List (XS.Next); | ||
30 | end if; | ||
31 | end Print_List; | ||
32 | |||
33 | function Build_List return MyList_Access is | ||
34 | XS : MyList_Access := new MyList'(1, new MyList'(2, new MyList'(3, null))); | ||
35 | begin | ||
36 | return XS; | ||
37 | end Build_List; | ||
38 | |||
39 | XS : MyList_Access := Build_List; | ||
40 | |||
41 | begin | ||
42 | Put ("List: "); | ||
43 | Print_List (XS); | ||
44 | New_Line; | ||
45 | Put_Line ("The list has length " & Integer'Image (Length (XS))); | ||
46 | end List; | ||
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 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | procedure Types is | ||
4 | |||
5 | ----------------------------------------------------------------------------- | ||
6 | -- Record initialization. | ||
7 | ----------------------------------------------------------------------------- | ||
8 | procedure Test_Point is | ||
9 | type Point is record | ||
10 | X : Integer := 0; | ||
11 | Y : Integer := 0; | ||
12 | end record; | ||
13 | |||
14 | Origin_1 : Point; -- Default initialization. | ||
15 | Origin_2 : Point := (0, 0); -- Explicit, unnamed. | ||
16 | Origin_3 : Point := (X => 0, Y => 0); -- Explicit, named. | ||
17 | Origin_4 : Point := (X => <>, Y => <>); -- Explicit, using defaults. | ||
18 | Origin_5 : Point := (X | Y => 0); -- Initialize both values. | ||
19 | Origin_6 : Point := Point'(0,0); -- Qualified expression. | ||
20 | begin | ||
21 | Put_Line ("Origin: " & Integer'Image (Origin_5.X) & ", " | ||
22 | & Integer'Image (Origin_5.Y)); | ||
23 | end Test_Point; | ||
24 | |||
25 | ----------------------------------------------------------------------------- | ||
26 | -- Pointers. | ||
27 | ----------------------------------------------------------------------------- | ||
28 | procedure Test_Pointer is | ||
29 | type Month_Type is (Jan, Feb, Mar, Apr, May, Jun, | ||
30 | Jul, Aug, Sep, Oct, Nov, Dec); | ||
31 | |||
32 | type Date is record | ||
33 | Day : Integer range 1 .. 31; | ||
34 | Month : Month_Type; | ||
35 | Year : Integer; | ||
36 | end record; | ||
37 | |||
38 | -- Access types are nominally typed, not structurally typed. | ||
39 | -- If we "own" a type X, we typically also declare an access type named | ||
40 | -- X_Acc, so that there is a canonical name for the access type to X. | ||
41 | type Date_Acc is access Date; -- Pointer to Date type. | ||
42 | type Different_Date_Acc is access Date; -- Different type. | ||
43 | |||
44 | Null_Date : Date_Acc := null; | ||
45 | |||
46 | -- Allocate values of the access type using the 'new' keyword. | ||
47 | D : Date_Acc := new Date; | ||
48 | |||
49 | -- Constraints can be given when instantiating the type. | ||
50 | Buffer : access String := new String(1 .. 5); | ||
51 | |||
52 | -- We can also initialize along with the allocation. | ||
53 | Hello_Str : access String := new String'("Hello"); | ||
54 | |||
55 | procedure Test_Null (D : Date_Acc; Name : String) is | ||
56 | begin | ||
57 | -- Dereferencing of D happens implicitly. Here we can treat D as an | ||
58 | -- actual Date. | ||
59 | if D = null then | ||
60 | Put_Line (Name & " is null"); | ||
61 | else | ||
62 | Put_Line (Name & " is not null"); | ||
63 | end if; | ||
64 | end Test_Null; | ||
65 | |||
66 | begin | ||
67 | Test_Null (Null_Date, "Null_Date"); | ||
68 | Test_Null (D, "D"); | ||
69 | end Test_Pointer; | ||
70 | |||
71 | ----------------------------------------------------------------------------- | ||
72 | -- Mutually recursive types. | ||
73 | -- | ||
74 | -- Similar to C++, we can forward-declare a type to break the loop. | ||
75 | ----------------------------------------------------------------------------- | ||
76 | |||
77 | procedure Test_MyList is | ||
78 | type MyList; | ||
79 | type MyList_Acc is access MyList; | ||
80 | |||
81 | type MyList is record | ||
82 | Value : Integer := 0; | ||
83 | Next : MyList_Acc := null; | ||
84 | end record; | ||
85 | |||
86 | function Cons (X : Integer; L : MyList_Acc) return MyList_Acc is | ||
87 | Head : MyList_Acc := new MyList; | ||
88 | begin | ||
89 | Head.Value := X; | ||
90 | Head.Next := L; | ||
91 | return Head; | ||
92 | end Cons; | ||
93 | |||
94 | procedure Print_List (L : access constant MyList) is | ||
95 | Node : access constant MyList := L; | ||
96 | begin | ||
97 | Put ("["); | ||
98 | while Node /= null loop | ||
99 | Put (Integer'Image (Node.Value) & " "); | ||
100 | Node := Node.next; | ||
101 | end loop; | ||
102 | Put_Line ("]"); | ||
103 | end Print_List; | ||
104 | |||
105 | InitialList : MyList_Acc := new MyList'(4, null); | ||
106 | ModifiedList : MyList_Acc; | ||
107 | begin | ||
108 | ModifiedList := Cons (1, Cons (2, Cons (3, InitialList))); | ||
109 | Print_List (ModifiedList); | ||
110 | end Test_MyList; | ||
111 | |||
112 | begin | ||
113 | Test_Point; | ||
114 | Test_Pointer; | ||
115 | Test_MyList; | ||
116 | end Types; | ||
diff --git a/more-types/types.gpr b/more-types/types.gpr new file mode 100644 index 0000000..740bcfd --- /dev/null +++ b/more-types/types.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Types is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("types.adb"); | ||
5 | end Types; | ||
diff --git a/records/records.gpr b/records/records.gpr new file mode 100644 index 0000000..aad6944 --- /dev/null +++ b/records/records.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Records is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("records.adb"); | ||
5 | end Records; | ||
diff --git a/records/src/records.adb b/records/src/records.adb new file mode 100644 index 0000000..f3c60ae --- /dev/null +++ b/records/src/records.adb | |||
@@ -0,0 +1,28 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | procedure Records is | ||
4 | |||
5 | type Month_Type is (January, February, March, April, May, June, July, August, | ||
6 | September, October, November, December); | ||
7 | |||
8 | type Date is record | ||
9 | Day : Integer range 1 .. 31 := 1; | ||
10 | Month : Month_Type := January; | ||
11 | Year : Integer := 1970; | ||
12 | end record; | ||
13 | |||
14 | function To_String (D : Date) return String is | ||
15 | begin | ||
16 | return Month_Type'Image (D.Month) & " " & Integer'Image (D.Day) & ", " & | ||
17 | Integer'Image(D.Year); | ||
18 | end To_String; | ||
19 | |||
20 | Epoch : Date; | ||
21 | Ada_Birthday : Date := (10, December, 1815); | ||
22 | Leap_Day_2020 : Date := (29, February, 2020); | ||
23 | |||
24 | begin | ||
25 | Put_Line ("Epoch is " & To_String (Epoch)); | ||
26 | Put_Line ("Ada's birthday is " & To_String (Ada_Birthday)); | ||
27 | Put_Line ("Leap day 2020: " & To_String (Leap_Day_2020)); | ||
28 | end Records; | ||
diff --git a/ring_buffer/ring_buffer.gpr b/ring_buffer/ring_buffer.gpr new file mode 100644 index 0000000..bac706f --- /dev/null +++ b/ring_buffer/ring_buffer.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Ring_Buffer is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("ring_buffer.adb"); | ||
5 | end Ring_Buffer; | ||
diff --git a/ring_buffer/src/ring_buffer.adb b/ring_buffer/src/ring_buffer.adb new file mode 100644 index 0000000..500ec5c --- /dev/null +++ b/ring_buffer/src/ring_buffer.adb | |||
@@ -0,0 +1,94 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | procedure Ring_Buffer is | ||
4 | |||
5 | type Natural_Array is array (Natural range <>) of Integer; | ||
6 | |||
7 | type Ring_Buffer (Capacity : Natural) is record | ||
8 | Start_Index : Natural := 0; -- TODO: somehow make these 'mod Size'. | ||
9 | Cur_Index : Natural := 0; | ||
10 | Empty : Boolean := True; | ||
11 | -- TODO: the index type should be 'mod Size'. | ||
12 | -- TODO: 0 .. Capacity wastes 1 slot of space. | ||
13 | Buffer : Natural_Array (0 .. Capacity) := (others => 0); | ||
14 | end record; | ||
15 | |||
16 | function Size (RB : Ring_Buffer) return Natural is | ||
17 | begin | ||
18 | if RB.Empty then | ||
19 | return 0; | ||
20 | elsif RB.Cur_Index = RB.Start_Index then | ||
21 | return RB.Capacity; | ||
22 | else | ||
23 | return (RB.Cur_Index - RB.Start_Index) mod RB.Capacity; | ||
24 | end if; | ||
25 | end Size; | ||
26 | |||
27 | function Push (RB : in out Ring_Buffer; Value : Integer) return Boolean is | ||
28 | begin | ||
29 | if Size (RB) = RB.Capacity then | ||
30 | return False; | ||
31 | else | ||
32 | RB.Buffer (RB.Cur_Index) := Value; | ||
33 | RB.Cur_Index := (RB.Cur_Index + 1) mod RB.Capacity; | ||
34 | RB.Empty := False; | ||
35 | return True; | ||
36 | end if; | ||
37 | end Push; | ||
38 | |||
39 | procedure Push (RB : in out Ring_Buffer; Value : Integer) is | ||
40 | unused : Boolean := Push (RB, Value); | ||
41 | begin | ||
42 | return; | ||
43 | end Push; | ||
44 | |||
45 | function Pop (RB : in out Ring_Buffer; Value : out Integer) return Boolean is | ||
46 | begin | ||
47 | if Size (RB) = 0 then | ||
48 | return False; | ||
49 | else | ||
50 | Value := RB.Buffer (RB.Start_Index); | ||
51 | RB.Start_Index := (RB.Start_Index + 1) mod RB.Capacity; | ||
52 | if RB.Start_Index = RB.Cur_Index then | ||
53 | RB.Empty := True; | ||
54 | end if; | ||
55 | return True; | ||
56 | end if; | ||
57 | end Pop; | ||
58 | |||
59 | procedure Pop (RB : in out Ring_Buffer) is | ||
60 | Dummy : Integer; | ||
61 | unused : Boolean := Pop (RB, Dummy); | ||
62 | begin | ||
63 | return; | ||
64 | end Pop; | ||
65 | |||
66 | procedure Print (RB : Ring_Buffer) is | ||
67 | begin | ||
68 | Put ("["); | ||
69 | for I in 0 .. Size (RB) - 1 loop | ||
70 | Put (Integer'Image (RB.Buffer ((RB.Start_Index + I) mod RB.Capacity))); | ||
71 | end loop; | ||
72 | Put_Line ("]"); | ||
73 | end Print; | ||
74 | |||
75 | Capacity : constant Natural := 5; | ||
76 | RB : Ring_Buffer (Capacity); | ||
77 | |||
78 | begin | ||
79 | Push (RB, 1); | ||
80 | Push (RB, 2); | ||
81 | Push (RB, 3); | ||
82 | Push (RB, 4); | ||
83 | Push (RB, 5); | ||
84 | -- Full! | ||
85 | Push (RB, 6); | ||
86 | Push (RB, 7); | ||
87 | -- Make some space. | ||
88 | Pop (RB); | ||
89 | Pop (RB); | ||
90 | -- Push more. | ||
91 | Push (RB, 8); | ||
92 | Push (RB, 9); | ||
93 | Print (RB); | ||
94 | end Ring_Buffer; | ||
diff --git a/stack/src/main.adb b/stack/src/main.adb new file mode 100644 index 0000000..977a46b --- /dev/null +++ b/stack/src/main.adb | |||
@@ -0,0 +1,20 @@ | |||
1 | with Ada.Assertions; use Ada.Assertions; | ||
2 | with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; | ||
3 | with Ada.Text_IO; use Ada.Text_IO; | ||
4 | |||
5 | with Stack; | ||
6 | |||
7 | procedure Main is | ||
8 | package IntStack is new Stack (Integer); | ||
9 | S : IntStack.Stack; | ||
10 | Val : Integer; | ||
11 | begin | ||
12 | Put_Line ("Hello world!"); | ||
13 | for I in 1 .. 5 loop | ||
14 | IntStack.Push (S, I); | ||
15 | end loop; | ||
16 | while not IntStack.Empty (S) loop | ||
17 | Assert (IntStack.Pop (S, Val)); | ||
18 | Put_Line (Val'Image); | ||
19 | end loop; | ||
20 | end Main; | ||
diff --git a/stack/src/stack.adb b/stack/src/stack.adb new file mode 100644 index 0000000..4dc8fb1 --- /dev/null +++ b/stack/src/stack.adb | |||
@@ -0,0 +1,31 @@ | |||
1 | with Ada.Unchecked_Deallocation; | ||
2 | |||
3 | package body Stack is | ||
4 | procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access); | ||
5 | |||
6 | procedure Push (S : in out Stack; Val : T) is | ||
7 | New_Top : Node_Access := new Node; | ||
8 | begin | ||
9 | New_Top.Val := Val; | ||
10 | New_Top.Bottom := S.Top; | ||
11 | S.Top := New_Top; | ||
12 | end Push; | ||
13 | |||
14 | function Pop (S : in out Stack; Val : out T) return Boolean is | ||
15 | Old_Top : Node_Access := S.Top; | ||
16 | begin | ||
17 | if Old_Top /= null then | ||
18 | Val := Old_Top.Val; | ||
19 | S.Top := Old_Top.Bottom; | ||
20 | Free (Old_Top); | ||
21 | return True; | ||
22 | else | ||
23 | return False; | ||
24 | end if; | ||
25 | end Pop; | ||
26 | |||
27 | function Empty (S : Stack) return Boolean is | ||
28 | begin | ||
29 | return S.Top = null; | ||
30 | end Empty; | ||
31 | end Stack; | ||
diff --git a/stack/src/stack.ads b/stack/src/stack.ads new file mode 100644 index 0000000..4f390e3 --- /dev/null +++ b/stack/src/stack.ads | |||
@@ -0,0 +1,26 @@ | |||
1 | generic | ||
2 | type T is private; | ||
3 | package Stack is | ||
4 | type Stack is private; | ||
5 | |||
6 | -- Push a value into the stack. | ||
7 | procedure Push (S : in out Stack; Val : T); | ||
8 | |||
9 | -- Pop a value from the stack. | ||
10 | function Pop (S : in out Stack; Val : out T) return Boolean; | ||
11 | |||
12 | -- Return true if the stack is empty, false otherwise. | ||
13 | function Empty (S : Stack) return Boolean; | ||
14 | private | ||
15 | type Node; | ||
16 | type Node_Access is access Node; | ||
17 | |||
18 | type Node is record | ||
19 | Val : T; | ||
20 | Bottom : Node_Access; | ||
21 | end record; | ||
22 | |||
23 | type Stack is record | ||
24 | Top : Node_Access; | ||
25 | end record; | ||
26 | end Stack; | ||
diff --git a/stack/stack.gpr b/stack/stack.gpr new file mode 100644 index 0000000..70e045c --- /dev/null +++ b/stack/stack.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Stack is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("main.adb"); | ||
5 | end Stack; \ No newline at end of file | ||
diff --git a/tree/src/main.adb b/tree/src/main.adb new file mode 100644 index 0000000..b9ece1a --- /dev/null +++ b/tree/src/main.adb | |||
@@ -0,0 +1,14 @@ | |||
1 | with Ada.Text_IO; use Ada.Text_IO; | ||
2 | |||
3 | with Tree; | ||
4 | |||
5 | procedure Main is | ||
6 | package IntTree is new Tree (Integer); | ||
7 | T : IntTree.Tree_Access := new IntTree.Tree; | ||
8 | begin | ||
9 | T.Left := new IntTree.Tree; | ||
10 | T.Right := new IntTree.Tree; | ||
11 | T.Right.Left := new IntTree.Tree; | ||
12 | |||
13 | Put_Line ("Tree height:" & IntTree.Height (T)'Image); | ||
14 | end Main; | ||
diff --git a/tree/src/tree.adb b/tree/src/tree.adb new file mode 100644 index 0000000..7e4a897 --- /dev/null +++ b/tree/src/tree.adb | |||
@@ -0,0 +1,12 @@ | |||
1 | package body tree is | ||
2 | |||
3 | function Height (T : Tree_Access) return Integer is | ||
4 | begin | ||
5 | if T = null then | ||
6 | return 0; | ||
7 | else | ||
8 | return 1 + Integer'Max (Height (T.Left), Height (T.Right)); | ||
9 | end if; | ||
10 | end Height; | ||
11 | |||
12 | end tree; | ||
diff --git a/tree/src/tree.ads b/tree/src/tree.ads new file mode 100644 index 0000000..1cf26fc --- /dev/null +++ b/tree/src/tree.ads | |||
@@ -0,0 +1,18 @@ | |||
1 | generic | ||
2 | type T is private; | ||
3 | |||
4 | package tree is | ||
5 | |||
6 | type Tree; | ||
7 | type Tree_Access is access Tree; | ||
8 | |||
9 | type Tree is record | ||
10 | Val : T; | ||
11 | Left : Tree_Access; | ||
12 | Right : Tree_Access; | ||
13 | end record; | ||
14 | |||
15 | -- Returns the height of the tree. | ||
16 | function Height (T : Tree_Access) return Integer; | ||
17 | |||
18 | end tree; | ||
diff --git a/tree/tree.gpr b/tree/tree.gpr new file mode 100644 index 0000000..bef680a --- /dev/null +++ b/tree/tree.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Tree is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("main.adb"); | ||
5 | end Tree; | ||
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; | ||
diff --git a/typing/typing.gpr b/typing/typing.gpr new file mode 100644 index 0000000..fdc5051 --- /dev/null +++ b/typing/typing.gpr | |||
@@ -0,0 +1,5 @@ | |||
1 | project Typing is | ||
2 | for Source_Dirs use ("src"); | ||
3 | for Object_Dir use "obj"; | ||
4 | for Main use ("typing.adb"); | ||
5 | end Typing; | ||