7 files changed, 15 insertions(+), 934 deletions(-)
M janusada/prepare.bat
R src/hauki-containers-doubly_linked_lists.adb =>
R src/hauki-containers-doubly_linked_lists.ads =>
R src/hauki-containers.ads =>
R src/hauki.ads =>
M src/input.adb
M src/input.ads
M janusada/prepare.bat +2 -0
@@ 1,6 1,7 @@
set januspath=C:\Jnt312a\rts\console
set ahvenpath=C:\work\ahven-h\lib_obj
+set haukipath=C:\work\hauki\lib_obj
REM *** SOURCE ***
cd src
@@ 10,6 11,7 @@ mkdir ..\lib_obj
rem mkdir ..\com_obj
jmanager Add_Project (..\lib_obj\,JDLib)
jmanager Add_Link (..\lib_obj\,JDLib,%januspath%, JNT_RTS_CONSOLE)
+jmanager Add_Link (..\lib_obj\,JDLib, %haukipath%,HaukiLib)
cd ..
REM *** TESTS ***
R src/hauki-containers-doubly_linked_lists.adb => +0 -615
@@ 1,615 0,0 @@
---
--- Copyright (c) 2006-2008 Tero Koskinen <tero.koskinen@iki.fi>
---
--- Permission to use, copy, modify, and distribute this software for any
--- purpose with or without fee is hereby granted, provided that the above
--- copyright notice and this permission notice appear in all copies.
---
--- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
--- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
--- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
--- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
--- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
--- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
--- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---
-
-with Ada.Unchecked_Deallocation;
-
-package body Hauki.Containers.Doubly_Linked_Lists is
-
- function Cursor_In_Container (Container : List; Position : Cursor)
- return Boolean
- is
- begin
- return Position.First_Item = Container.First;
- end Cursor_In_Container;
-
- function Create_Nodes (Count : Count_Type; New_Item : Element_Type)
- return Node_Access is
- Current : Node_Access := null;
- First : Node_Access := null;
- Counter : Count_Type := 0;
- begin
- if Count = 0 then
- return null;
- end if;
-
- loop
- exit when Counter = Count;
- Current :=
- new Node'(Prev => Current, Next => null, Data => New_Item);
- if First = null then
- First := Current;
- else
- Current.Prev.Next := Current;
- end if;
- First.Prev := Current;
- Counter := Counter + 1;
- end loop;
- return First;
- exception
- when Storage_Error =>
- -- Storage error, removing allocated nodes
- Current := First;
- loop
- exit when Current = null;
- First := Current.Next;
- Remove (First);
- Current := First;
- end loop;
- raise;
- end Create_Nodes;
-
- procedure Remove (Ptr : Node_Access) is
- procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access);
- My_Ptr : Node_Access := Ptr;
- begin
- Ptr.Next := null;
- Ptr.Prev := null;
- Free (My_Ptr);
- end Remove;
-
- function "=" (Left, Right : List) return Boolean is
- Left_C, Right_C : Cursor;
- begin
- if Left.Size /= Right.Size then
- return False;
- end if;
-
- Left_C := First (Left);
- Right_C := First (Right);
-
- loop
- exit when Left_C = No_Element or Right_C = No_Element;
- if Left_C.Ptr.Data /= Right_C.Ptr.Data then
- return False;
- end if;
-
- Next (Left_C);
- Next (Right_C);
- end loop;
-
- return True;
- end "=";
-
- procedure Delete (Container : in out List;
- Position : Cursor;
- Count : Count_Type := 1) is
- Current : Node_Access;
- First_Valid : Node_Access := Container.First;
- Prev_Valid : Node_Access := Container.First;
- Counter : Count_Type := 0;
- begin
- if Container.Size = 0 then
- raise Program_Error;
- elsif Position = No_Element then
- raise Constraint_Error;
- elsif Count = 0 then
- return;
- end if;
-
- Current := Position.Ptr;
-
- if Current = Container.First then
- loop
- exit when Counter = Count or Current = null;
- First_Valid := Current.Next;
- Remove (Current);
- Current := First_Valid;
- Counter := Counter + 1;
- end loop;
- Container.First := First_Valid;
- if Container.First = null then
- Container.Last := null;
- else
- Container.First.Prev := null;
- end if;
- elsif Current = Container.Last then
- Current := Container.Last;
- Container.Last := Current.Prev;
- Container.Last.Next := null;
- Remove (Current);
- Counter := 1;
- else
- Prev_Valid := Current.Prev;
- loop
- exit when Counter = Count or Current = null;
- First_Valid := Current.Next;
- Remove (Current);
- Current := First_Valid;
- Counter := Counter + 1;
- end loop;
- Prev_Valid.Next := First_Valid;
- if First_Valid /= null then
- First_Valid.Prev := Prev_Valid;
- else
- Container.Last := Prev_Valid;
- end if;
- end if;
-
- Container.Size := Container.Size - Counter;
- end Delete;
-
- procedure Insert (Container : in out List;
- Before : Cursor;
- New_Item : Element_Type;
- Count : Count_Type := 1) is
- New_Position : Cursor;
- begin
- Insert (Container, Before, New_Item, New_Position, Count);
- end Insert;
-
- procedure Insert (Container : in out List;
- Before : Cursor;
- New_Item : Element_Type;
- Position : out Cursor;
- Count : Count_Type := 1) is
- New_Node : Node_Access;
- Last_New_Node : Node_Access;
- begin
- if Count = 0 then
- Position := No_Element;
- return;
- end if;
-
- if Before /= No_Element and
- not Cursor_In_Container (Container, Before) then
- raise Program_Error;
- end if;
-
- New_Node := Create_Nodes (Count, New_Item);
- -- New_Node.Prev points to the last of the created nodes.
- Last_New_Node := New_Node.Prev;
- New_Node.Prev := null;
-
- -- Note: Order of the assignments matter!
- -- List empty?
- if Container.First = null then
- Container.First := New_Node;
- Container.Last := Last_New_Node;
- Container.First.Prev := null;
- -- Inserting at the beginning of the list?
- elsif Before.Ptr = Container.First then
- Last_New_Node.Next := Container.First;
- Container.First.Prev := Last_New_Node;
- Container.First := New_Node;
- Container.First.Prev := null;
- -- Inserting at the end of the list?
- elsif Before.Ptr = null then
- Container.Last.Next := New_Node;
- New_Node.Prev := Container.Last;
- Container.Last := Last_New_Node;
- -- Inserting in the middle of the list
- else
- declare
- Previous_Node : Node_Access := Before.Ptr.Prev;
- begin
- Previous_Node.Next := New_Node;
- Before.Ptr.Prev := Last_New_Node;
- Last_New_Node.Next := Before.Ptr;
- New_Node.Prev := Previous_Node;
- end;
- end if;
- Position := Cursor'(Ptr => New_Node, First_Item => Container.First);
- Container.Size := Container.Size + Count;
- end Insert;
-
--- procedure Insert (Container : in out List;
--- Before : in Cursor;
--- Position : out Cursor;
--- Count : in Count_Type := 1) is
--- New_Element : Element_Type := Element_Type'(Element_Type);
--- begin
--- Insert (Container => Container,
--- Before => Before,
--- New_Item => New_Element,
--- Position => Position,
--- Count => Count);
--- end Insert;
-
- procedure Prepend (Container : in out List;
- New_Item : Element_Type;
- Count : Count_Type := 1) is
- begin
- Insert (Container, First (Container), New_Item, Count);
- end Prepend;
-
- procedure Append (Container : in out List;
- New_Item : Element_Type;
- Count : Count_Type := 1) is
- begin
- Insert (Container, No_Element, New_Item, Count);
- end Append;
-
- procedure Clear (Container : in out List) is
- Current_Node : Node_Access := Container.First;
- Next_Node : Node_Access := null;
- begin
- while Current_Node /= null loop
- Next_Node := Current_Node.Next;
- Remove (Current_Node);
- Current_Node := Next_Node;
- end loop;
-
- Container.First := null;
- Container.Last := null;
- Container.Size := 0;
- end Clear;
-
- procedure Delete_First (Container : in out List) is
- Temp_Node : Node_Access;
- begin
- if Container.Size = 0 then
- raise List_Empty;
- end if;
-
- Temp_Node := Container.First;
- Container.First := Container.First.Next;
- if Container.First /= null then
- Container.First.Prev := null;
- else
- Container.Last := null;
- end if;
-
- Remove (Temp_Node);
- Container.Size := Container.Size - 1;
- end Delete_First;
-
- procedure Delete_Last (Container : in out List) is
- Temp_Node : Node_Access;
- begin
- if Container.Size = 0 then
- raise List_Empty;
- end if;
-
- Temp_Node := Container.Last;
-
- Container.Last := Temp_Node.Prev;
- if Container.Last /= null then
- Container.Last.Next := null;
- else
- Container.First := null;
- end if;
-
- Remove (Temp_Node);
- Container.Size := Container.Size - 1;
- end Delete_Last;
-
- procedure Splice (Target : in out List;
- Before : in Cursor;
- Source : in out List) is
- New_Node : constant Node_Access := Source.First;
- begin
- if Source.Size = 0 or Source.First = Target.First then
- return;
- end if;
- if Before = No_Element then
- if Target.Last = null then
- Target.First := New_Node;
- else
- Target.Last.Next := New_Node;
- New_Node.Prev := Target.Last;
- end if;
- Target.Last := Source.Last;
- else
- -- Target list is empty?
- if Target.First = null then
- Target.First := New_Node;
- Target.Last := Source.Last;
- Target.First.Prev := null;
- -- We insert at the beginning of the list?
- elsif Before.Ptr = Target.First then
- Source.Last.Next := Target.First;
- Target.First.Prev := Source.Last;
- Target.First := New_Node;
- Target.First.Prev := null;
- else
- -- New order will be:
- -- [previous_node] [new_node] ... [source.last] [target.first]
- declare
- Previous_Node : Node_Access := Before.Ptr.Prev;
- begin
- Previous_Node.Next := New_Node;
- Before.Ptr.Prev := Source.Last;
- Source.Last.Next := Before.Ptr;
- New_Node.Prev := Previous_Node;
- end;
- end if;
- end if;
- Target.Size := Target.Size + Source.Size;
-
- Source.First := null;
- Source.Last := null;
- Source.Size := 0;
- end Splice;
-
- procedure Replace_Element (Container : in out List;
- Position : Cursor;
- New_Item : Element_Type) is
- begin
- if Position = No_Element then
- raise Constraint_Error;
- end if;
-
- if not Cursor_In_Container (Container, Position) then
- raise Program_Error;
- end if;
-
- Position.Ptr.Data := New_Item;
- end Replace_element;
-
- function Is_Empty (Container : List) return Boolean is
- begin
- return Container.Size = 0;
- end Is_Empty;
-
- function First (Container : List) return Cursor is
- begin
- if Container.Size = 0 then
- return Cursor'(Ptr => null, First_Item => null);
- end if;
-
- return Cursor'(Ptr => Container.First, First_Item => Container.First);
- end First;
-
- function Last (Container : List) return Cursor is
- begin
- if Container.Size = 0 then
- return Cursor'(Ptr => null, First_Item => null);
- end if;
-
- return Cursor'(Ptr => Container.Last, First_Item => Container.First);
- end Last;
-
- function Next (Position : Cursor) return Cursor is
- begin
- if Position.Ptr = null or else
- Position.Ptr.Next = null then
- return No_Element;
- end if;
- return Cursor'(Ptr => Position.Ptr.Next,
- First_Item => Position.First_Item);
- end Next;
-
- procedure Next (Position : in out Cursor) is
- begin
- Position := Next (Position);
- end Next;
-
- function Previous (Position : Cursor) return Cursor is
- begin
- if Position.Ptr = null or else Position.Ptr.Prev = null then
- return No_Element;
- end if;
- return Cursor'(Ptr => Position.Ptr.Prev,
- First_Item => Position.First_Item);
- end Previous;
-
- procedure Previous (Position : in out Cursor) is
- begin
- Position := Previous (Position);
- end Previous;
-
- function Element (Position : Cursor) return Element_Type is
- begin
- if Position = No_Element then
- raise Constraint_Error;
- end if;
- return Position.Ptr.Data;
- end Element;
-
- function Length (Container : List) return Count_Type is
- begin
- return Container.Size;
- end Length;
-
- procedure Move (Target : in out List; Source : in out List) is
- begin
- Clear (Target);
- if Source.Size = 0 then
- return;
- end if;
-
- Target.First := Source.First;
- Target.Last := Source.Last;
- Target.Size := Source.Size;
-
- -- No need to release Source's memory
- -- because all nodes are transferred to Target
- Source.Last := null;
- Source.First := null;
- Source.Size := 0;
- end Move;
-
- function Is_Valid (Position : Cursor) return Boolean is
- begin
- return Position.Ptr /= null;
- end Is_Valid;
-
- procedure Initialize (Object : in out List) is
- begin
- Object.Last := null;
- Object.First := null;
- Object.Size := 0;
- end Initialize;
-
- procedure Finalize (Object : in out List) is
- begin
- Clear (Object);
- end Finalize;
-
- procedure Adjust (Object : in out List) is
- Target_Last : Node_Access := null;
- Target_First : Node_Access := null;
- Current : Node_Access := Object.First;
- New_Node : Node_Access;
- begin
- while Current /= null loop
- New_Node := new Node'(Data => Current.Data,
- Next => null, Prev => Target_Last);
-
- if Target_Last = null then
- Target_Last := New_Node;
- Target_First := New_Node;
- else
- Target_Last.Next := New_Node;
- Target_Last := New_Node;
- end if;
-
- Current := Current.Next;
- end loop;
- Object.First := Target_First;
- Object.Last := Target_Last;
- end Adjust;
-
- procedure Query_Element
- (Position : Cursor;
- Process : Query_Proc) is
- begin
- if Position = No_Element then
- raise Constraint_Error;
- end if;
- Process.all (Position.Ptr.all.Data);
- end Query_Element;
-
- procedure Update_Element
- (Container : in out List;
- Position : Cursor;
- Process : Update_Proc) is
- begin
- if Position = No_Element then
- raise Constraint_Error;
- elsif Container.First /= Position.First_item then
- raise Program_Error;
- end if;
-
- Process.all (Position.Ptr.all.Data);
- end Update_Element;
-
- procedure Assign (Target : in out List;
- Source : List) is
- begin
- if Target.First = Source.First then
- return;
- end if;
-
- Target := Source;
- end Assign;
-
- function Copy (Source : List) return List is
- begin
- return Source; -- XXX is this enough or should we
- -- create a temporary copy also.
- end Copy;
-
- procedure Swap (Container : in out List;
- I, J : Cursor) is
- Temp : Element_Type;
- begin
- if I = No_Element or J = No_Element then
- raise Constraint_Error;
- elsif I.First_Item /= Container.First or
- J.First_Item /= Container.First then
- raise Program_Error;
- elsif I.Ptr = J.Ptr then
- return;
- end if;
-
- Temp := I.Ptr.Data;
- I.Ptr.Data := J.Ptr.Data;
- J.Ptr.Data := Temp;
- end Swap;
-
- procedure Swap_Links (Container : in out List;
- I, J : in Cursor) is
- I_Is_First : constant Boolean := I.Ptr = Container.First;
- I_Is_Last : constant Boolean := I.Ptr = Container.Last;
- J_Is_First : constant Boolean := J.Ptr = Container.First;
- J_Is_Last : constant Boolean := J.Ptr = Container.Last;
-
- Prev_Link, Next_Link : Node_Access;
- begin
- if I = No_Element or J = No_Element then
- raise Constraint_Error;
- elsif I.Ptr = J.Ptr then
- return;
- end if;
-
- Prev_Link := I.Ptr.Prev;
- Next_Link := I.Ptr.Next;
-
- if I.Ptr.Prev /= null then
- I.Ptr.Prev.Next := J.Ptr;
- end if;
- if I.Ptr.Next /= null then
- I.Ptr.Next := J.Ptr;
- end if;
- I.Ptr.Prev := J.Ptr.Prev;
- I.Ptr.Next := J.Ptr.Next;
-
- if J.Ptr.Prev /= null then
- J.Ptr.Prev.Next := I.Ptr;
- end if;
- if J.Ptr.Next /= null then
- J.Ptr.Next.Prev := I.Ptr;
- end if;
- J.Ptr.Prev := Prev_Link;
- J.Ptr.Next := Next_Link;
-
- if I_Is_First then
- Container.First := J.Ptr;
- end if;
- if I_Is_Last then
- Container.Last := J.Ptr;
- end if;
- if J_Is_First then
- Container.First := I.Ptr;
- end if;
- if J_Is_Last then
- Container.Last := I.Ptr;
- end if;
- end Swap_Links;
-
- procedure Iterate (Container : List; Process : Iterate_Proc) is
- Current : Node_Access := Container.First;
- begin
- loop
- exit when Current = null;
- Process.all (Cursor'(Current, Container.First));
- Current := Current.Next;
- end loop;
- end Iterate;
-
- procedure Reverse_Iterate (Container : List; Process : Iterate_Proc) is
- Current : Node_Access := Container.Last;
- begin
- loop
- exit when Current = null;
- Process.all (Cursor'(Current, Container.First));
- Current := Current.Prev;
- end loop;
- end Reverse_Iterate;
-
-end Hauki.Containers.Doubly_Linked_Lists;
-
R src/hauki-containers-doubly_linked_lists.ads => +0 -269
@@ 1,269 0,0 @@
---
--- Copyright (c) 2006-2008 Tero Koskinen <tero.koskinen@iki.fi>
---
--- Permission to use, copy, modify, and distribute this software for any
--- purpose with or without fee is hereby granted, provided that the above
--- copyright notice and this permission notice appear in all copies.
---
--- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
--- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
--- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
--- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
--- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
--- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
--- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---
-
-with Ada.Finalization;
-
-generic
- type Element_Type is private;
- with function "=" (Left, Right : Element_Type)
- return Boolean is <>;
-package Hauki.Containers.Doubly_Linked_Lists is
- -- pragma Preelaborate(Doubly_Linked_Lists);
-
- type Cursor is private;
-
- List_Empty : exception;
- Out_Of_Range : exception;
- Invalid_Cursor : exception;
-
- type List is tagged private;
- -- List is a Controlled type. You can safely copy it.
- -- Although, notice that if you have a list of pointers (access types),
- -- only the pointers are copied, not the objects they point at.
-
- Empty_List : constant List;
- -- A list with zero elements.
- -- For example, can be used for initialization.
-
- No_Element : constant Cursor;
-
- function "=" (Left, Right : List) return Boolean;
- -- Compares the lists.
- --
- -- Time: O(N)
-
- function Length (Container : List) return Count_Type;
- -- Return the size of the list.
- --
- -- Time: O(1)
-
- function Is_Empty (Container : List) return Boolean;
- -- Is the list empty?
- --
- -- Time: O(1)
-
- procedure Clear (Container : in out List);
- -- Remove all elements from the list.
- --
- -- Time: O(N)
-
- function Element (Position : Cursor) return Element_Type;
- -- Return element pointed by the iterator.
- --
- -- Time: O(1)
-
- procedure Replace_Element (Container : in out List;
- Position : Cursor;
- New_Item : Element_Type);
- -- Replace the element poited by the iterator with the given item.
- --
- -- Time: O(1)
-
- type Query_Proc is access procedure (Element : Element_Type);
-
- procedure Query_Element
- (Position : Cursor;
- Process : Query_Proc);
- -- Call the given procedure with the element pointed by the cursor.
- --
- -- Time: O(1)
-
- type Update_Proc is access procedure (Element : in out Element_Type);
-
- procedure Update_Element
- (Container : in out List;
- Position : Cursor;
- Process : Update_Proc);
- -- Call the given procedure with the element pointed by the cursor.
- -- The process is expected to modify the given element.
- --
- -- Time: O(1)
-
- procedure Assign (Target : in out List;
- Source : List);
- -- Assign the contents of the source to the Target.
- -- If Target and Source denote the same object,
- -- the procedure does nothing.
- --
- -- Time: O(N)
-
- function Copy (Source : List) return List;
- -- Returns a copy of Source.
- --
- -- Time: O(N)
-
- procedure Move (Target : in out List; Source : in out List);
- -- Move all elements from the Source list to the Target list.
- -- The Target list is cleared before move.
- --
- -- Time: O(1)
-
- procedure Insert (Container : in out List;
- Before : Cursor;
- New_Item : Element_Type;
- Count : Count_Type := 1);
- -- Insert an item before the cursor.
- --
- -- Time: O(1) or actually O(Count)
-
- procedure Insert (Container : in out List;
- Before : Cursor;
- New_Item : Element_Type;
- Position : out Cursor;
- Count : Count_Type := 1);
- -- Insert one or more items before the cursor.
- -- Set Position to point to the first element.
- --
- -- Time: O(1) or actually O(Count)
-
--- procedure Insert (Container : in out List;
--- Before : in Cursor;
--- Position : out Cursor;
--- Count : in Count_Type := 1);
-
- procedure Append (Container : in out List;
- New_Item : Element_Type;
- Count : Count_Type := 1);
- -- Append an element(s) at the end of the list.
- --
- -- Time: O(1)
-
- procedure Prepend (Container : in out List;
- New_Item : Element_Type;
- Count : Count_Type := 1);
- -- Prepend an element at the beginning of the list.
- --
- -- Time: O(1)
-
- procedure Delete (Container : in out List;
- Position : Cursor;
- Count : Count_Type := 1);
- -- Remove an elemenent pointed by the iterator.
- --
- -- Time: O(1)
-
- procedure Delete_First (Container : in out List);
- -- Remove the first element from the list.
- --
- -- Time: O(1)
-
- procedure Delete_Last (Container : in out List);
- -- Remove the last element from the list.
- --
- -- Time: O(1)
-
- procedure Swap (Container : in out List;
- I, J : Cursor);
- -- Swap elements pointed by I and J
- --
- -- Time: O(1)
-
- procedure Swap_Links (Container : in out List;
- I, J : in Cursor);
- -- Swap nodes I and J.
- --
- -- Time: O(1)
-
- procedure Splice (Target : in out List;
- Before : in Cursor;
- Source : in out List);
- -- Move elements from Source to Target and
- -- place them in front of element pointed by Before.
-
- function First (Container : List) return Cursor;
- -- Return an iterator to the first element of the list.
- --
- -- Time: O(1)
-
- function Last (Container : List) return Cursor;
- -- Return an iterator to the last element of the list.
- --
- -- Time: O(1)
-
- function Next (Position : Cursor) return Cursor;
- -- Move the iterator to point to the next element on the list.
- --
- -- Time: O(1)
-
- procedure Next (Position : in out Cursor);
- -- Move the iterator to point to the next element on the list.
- --
- -- Time: O(1)
-
- function Previous (Position : Cursor) return Cursor;
- -- Move the iterator to point to the previous element on the list.
- --
- -- Time: O(1)
-
- procedure Previous (Position : in out Cursor);
- -- Move the iterator to point to the previous element on the list.
- --
- -- Time: O(1)
-
- function Is_Valid (Position : Cursor) return Boolean;
- -- Is Cursor still valid or out of range?
- --
- -- Time: O(1)
-
- type Iterate_Proc is access procedure (Position : Cursor);
-
- procedure Iterate (Container : List; Process : Iterate_Proc);
- -- Iterate through the Container and call Process for each element.
-
- procedure Reverse_Iterate (Container : List; Process : Iterate_Proc);
- -- Iterate through the Container in reverse order
- -- and call Process for each element.
-
-private
- type Node;
- type Node_Access is access Node;
- type Cursor is record
- Ptr : Node_Access;
- First_Item : Node_Access;
- end record;
-
- function Cursor_In_Container (Container : List; Position : Cursor)
- return Boolean;
-
- function Create_Nodes (Count : Count_Type; New_Item : Element_Type)
- return Node_Access;
-
- procedure Remove (Ptr : Node_Access);
- -- A procedure to release memory pointed by Ptr.
-
- type Node is record
- Data : Element_Type;
- Next : Node_Access := null;
- Prev : Node_Access := null;
- end record;
-
- type List is new Ada.Finalization.Controlled with record
- First : Node_Access := null;
- Last : Node_Access := null;
- Size : Count_Type := 0;
- end record;
-
- procedure Initialize (Object : in out List);
- procedure Finalize (Object : in out List);
- procedure Adjust (Object : in out List);
-
- Empty_List : constant List :=
- (Ada.Finalization.Controlled with First => null,
- Last => null,
- Size => 0);
-
- No_Element : constant Cursor := (Ptr => null, First_Item => null);
-end Hauki.Containers.Doubly_Linked_Lists;
R src/hauki-containers.ads => +0 -23
@@ 1,23 0,0 @@
---
--- Copyright (c) 2008 Tero Koskinen <tero.koskinen@iki.fi>
---
--- Permission to use, copy, modify, and distribute this software for any
--- purpose with or without fee is hereby granted, provided that the above
--- copyright notice and this permission notice appear in all copies.
---
--- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
--- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
--- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
--- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
--- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
--- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
--- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---
-
-package Hauki.Containers is
- pragma Pure (Containers);
-
- type Hash_Type is mod 2**32;
-
- type Count_Type is range 0 .. 2**31-1;
-end Hauki.Containers;
R src/hauki.ads => +0 -19
@@ 1,19 0,0 @@
---
--- Copyright (c) 2006-2008 Tero Koskinen <tero.koskinen@iki.fi>
---
--- Permission to use, copy, modify, and distribute this software for any
--- purpose with or without fee is hereby granted, provided that the above
--- copyright notice and this permission notice appear in all copies.
---
--- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
--- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
--- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
--- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
--- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
--- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
--- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
---
-
-package Hauki is
- pragma Pure (Hauki);
-end Hauki;
M src/input.adb +9 -5
@@ 86,16 86,20 @@ package body Input is
-- Unbounded_String stream
procedure Open (Buffer : in out Unbounded_String_Stream;
- Data : Unbounded_String) is
+ Data : Hauki.Charbuf.Char_Buffer) is
begin
- for I in reverse Positive range 1 .. Length (Data) loop
+ Put_Line ("Open begin");
+ for I in reverse Long_Integer range 1 .. Length (Data) loop
+ -- Put_Line ("Append " & I'Img);
Append (Buffer.Buffer, Element (Data, I));
end loop;
+ Put_Line ("Open end");
end Open;
procedure Close (Buffer : in out Unbounded_String_Stream) is
begin
- Buffer.Buffer := Null_Unbounded_String;
+ -- Buffer.Buffer := Null_Unbounded_String;
+ null;
end Close;
procedure Get
@@ 109,7 113,7 @@ package body Input is
Head (File.Buffer, Length (File.Buffer) - 1);
Char := Data;
Status := True;
- -- Put_Line ("Source_Code.Get: " & Data);
+ Put_Line ("Source_Code.Get: " & Data);
if Char = Character'Val(10) then
File.Line_Number := File.Line_Number + 1;
end if;
@@ 125,7 129,7 @@ package body Input is
if Char = Character'Val(10) then
File.Line_Number := File.Line_Number - 1;
end if;
- -- Put_Line ("Source_Code.Put: " & Char);
+ Put_Line ("Source_Code.Put: " & Char);
Append (File.Buffer, Char);
end Put;
M src/input.ads +4 -3
@@ 16,11 16,12 @@
with Ada.Strings.Unbounded;
with Ada.Sequential_IO;
+with Hauki.Charbuf;
use Ada.Strings.Unbounded;
package Input is
-
+ use Hauki.Charbuf;
-- Abstract source code stream
type Source_Stream is abstract tagged limited record
@@ 67,7 68,7 @@ package Input is
type Unbounded_String_Stream is new Source_Stream with private;
procedure Open (Buffer : in out Unbounded_String_Stream;
- Data : Unbounded_String);
+ Data : Hauki.Charbuf.Char_Buffer);
procedure Close (Buffer : in out Unbounded_String_Stream);
@@ 94,7 95,7 @@ private
end record;
type Unbounded_String_Stream is new Source_Stream with record
- Buffer : Unbounded_String := Null_Unbounded_String;
+ Buffer : Hauki.Charbuf.Char_Buffer;
end record;
end Input;