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 --- stack/src/main.adb | 20 ++++++++++++++++++++ stack/src/stack.adb | 31 +++++++++++++++++++++++++++++++ stack/src/stack.ads | 26 ++++++++++++++++++++++++++ 3 files changed, 77 insertions(+) create mode 100644 stack/src/main.adb create mode 100644 stack/src/stack.adb create mode 100644 stack/src/stack.ads (limited to 'stack/src') 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 @@ +with Ada.Assertions; use Ada.Assertions; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Text_IO; use Ada.Text_IO; + +with Stack; + +procedure Main is + package IntStack is new Stack (Integer); + S : IntStack.Stack; + Val : Integer; +begin + Put_Line ("Hello world!"); + for I in 1 .. 5 loop + IntStack.Push (S, I); + end loop; + while not IntStack.Empty (S) loop + Assert (IntStack.Pop (S, Val)); + Put_Line (Val'Image); + end loop; +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 @@ +with Ada.Unchecked_Deallocation; + +package body Stack is + procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access); + + procedure Push (S : in out Stack; Val : T) is + New_Top : Node_Access := new Node; + begin + New_Top.Val := Val; + New_Top.Bottom := S.Top; + S.Top := New_Top; + end Push; + + function Pop (S : in out Stack; Val : out T) return Boolean is + Old_Top : Node_Access := S.Top; + begin + if Old_Top /= null then + Val := Old_Top.Val; + S.Top := Old_Top.Bottom; + Free (Old_Top); + return True; + else + return False; + end if; + end Pop; + + function Empty (S : Stack) return Boolean is + begin + return S.Top = null; + end Empty; +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 @@ +generic + type T is private; +package Stack is + type Stack is private; + + -- Push a value into the stack. + procedure Push (S : in out Stack; Val : T); + + -- Pop a value from the stack. + function Pop (S : in out Stack; Val : out T) return Boolean; + + -- Return true if the stack is empty, false otherwise. + function Empty (S : Stack) return Boolean; +private + type Node; + type Node_Access is access Node; + + type Node is record + Val : T; + Bottom : Node_Access; + end record; + + type Stack is record + Top : Node_Access; + end record; +end Stack; -- cgit v1.2.3