summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--arrays/arrays.gpr5
-rw-r--r--arrays/src/arrays.adb127
-rw-r--r--basics/basics.gpr5
-rw-r--r--basics/src/main.adb108
-rw-r--r--guess/guess.gpr5
-rw-r--r--guess/src/guess.adb20
-rw-r--r--hello/hello.gpr5
-rw-r--r--hello/src/main.adb108
-rw-r--r--list/list.gpr5
-rw-r--r--list/src/list.adb46
-rw-r--r--more-types/src/types.adb116
-rw-r--r--more-types/types.gpr5
-rw-r--r--records/records.gpr5
-rw-r--r--records/src/records.adb28
-rw-r--r--ring_buffer/ring_buffer.gpr5
-rw-r--r--ring_buffer/src/ring_buffer.adb94
-rw-r--r--stack/src/main.adb20
-rw-r--r--stack/src/stack.adb31
-rw-r--r--stack/src/stack.ads26
-rw-r--r--stack/stack.gpr5
-rw-r--r--tree/src/main.adb14
-rw-r--r--tree/src/tree.adb12
-rw-r--r--tree/src/tree.ads18
-rw-r--r--tree/tree.gpr5
-rw-r--r--typing/src/typing.adb131
-rw-r--r--typing/typing.gpr5
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 @@
1project Arrays is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("arrays.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
3
4procedure 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
119begin
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;
127end 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 @@
1project Basics is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("main.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
3
4procedure 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
97begin
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;
108end 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 @@
1project Guess is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("guess.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
3
4procedure Guess is
5 Answer : Integer := 47;
6 Guess : Integer;
7begin
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;
20end 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 @@
1project Hello is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("main.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
3
4procedure 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
88begin
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;
108end 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 @@
1project List is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("list.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3procedure 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
41begin
42 Put ("List: ");
43 Print_List (XS);
44 New_Line;
45 Put_Line ("The list has length " & Integer'Image (Length (XS)));
46end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3procedure 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
112begin
113 Test_Point;
114 Test_Pointer;
115 Test_MyList;
116end 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 @@
1project Types is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("types.adb");
5end 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 @@
1project Records is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("records.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3procedure 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
24begin
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));
28end 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 @@
1project Ring_Buffer is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("ring_buffer.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3procedure 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
78begin
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);
94end 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 @@
1with Ada.Assertions; use Ada.Assertions;
2with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
3with Ada.Text_IO; use Ada.Text_IO;
4
5with Stack;
6
7procedure Main is
8 package IntStack is new Stack (Integer);
9 S : IntStack.Stack;
10 Val : Integer;
11begin
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;
20end 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 @@
1with Ada.Unchecked_Deallocation;
2
3package 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;
31end 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 @@
1generic
2 type T is private;
3package 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;
14private
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;
26end 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 @@
1project Stack is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("main.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3with Tree;
4
5procedure Main is
6 package IntTree is new Tree (Integer);
7 T : IntTree.Tree_Access := new IntTree.Tree;
8begin
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);
14end 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 @@
1package 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
12end 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 @@
1generic
2 type T is private;
3
4package 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
18end 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 @@
1project Tree is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("main.adb");
5end 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 @@
1with Ada.Text_IO; use Ada.Text_IO;
2
3procedure 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
123begin
124 Test_My_Int;
125 Test_Mod_Int;
126 Test_Days;
127 Test_T_Norm;
128 Test_Units;
129 Test_SSN;
130 Test_Subtypes;
131end 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 @@
1project Typing is
2 for Source_Dirs use ("src");
3 for Object_Dir use "obj";
4 for Main use ("typing.adb");
5end Typing;