Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | natools-references: add support of references to constant |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
8c650fd9275de495f21f5d9daada4e04 |
| User & Date: | nat 2014-04-12 16:19:43.632 |
Context
|
2014-04-13
| ||
| 17:17 | s_expressions-encodings: add base-64 conversions with custom representations of 62 and 63 check-in: a41d6ed173 user: nat tags: trunk | |
|
2014-04-12
| ||
| 16:19 | natools-references: add support of references to constant check-in: 8c650fd927 user: nat tags: trunk | |
|
2014-04-11
| ||
| 20:10 | tools/test.sh: test suite for tools check-in: 9347f4362d user: nat tags: trunk | |
Changes
Changes to src/natools-references.adb.
| ︙ | ︙ | |||
18 19 20 21 22 23 24 | package body Natools.References is --------------------------------- -- Low-level memory management -- --------------------------------- | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
package body Natools.References is
---------------------------------
-- Low-level memory management --
---------------------------------
overriding procedure Adjust (Object : in out Immutable_Reference) is
begin
if Object.Count /= null then
Object.Count.all := Object.Count.all + 1;
end if;
end Adjust;
overriding procedure Finalize (Object : in out Immutable_Reference) is
procedure Free is
new Ada.Unchecked_Deallocation (Held_Data, Data_Access);
procedure Free is
new Ada.Unchecked_Deallocation (Counter, Counter_Access);
begin
if Object.Count /= null then
Object.Count.all := Object.Count.all - 1;
|
| ︙ | ︙ | |||
53 54 55 56 57 58 59 |
-----------------------------------------
-- Object construction and destruction --
-----------------------------------------
function Create
(Constructor : not null access function return Held_Data)
| | | | | | | | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 |
-----------------------------------------
-- Object construction and destruction --
-----------------------------------------
function Create
(Constructor : not null access function return Held_Data)
return Immutable_Reference is
begin
return (Ada.Finalization.Controlled with
Data => new Held_Data'(Constructor.all),
Count => new Counter'(1));
end Create;
procedure Replace
(Ref : in out Immutable_Reference;
Constructor : not null access function return Held_Data) is
begin
Finalize (Ref);
Ref.Data := new Held_Data'(Constructor.all);
Ref.Count := new Counter'(1);
end Replace;
procedure Reset (Ref : in out Immutable_Reference) is
begin
Finalize (Ref);
end Reset;
function Is_Empty (Ref : Immutable_Reference) return Boolean is
begin
return Ref.Count = null;
end Is_Empty;
function "=" (Left, Right : Immutable_Reference) return Boolean is
begin
return Left.Data = Right.Data;
end "=";
----------------------
-- Dereferenciation --
----------------------
function Query (Ref : in Immutable_Reference) return Accessor is
begin
return Accessor'(Data => Ref.Data, Parent => Ref);
end Query;
function Update (Ref : in Reference) return Mutator is
begin
return Mutator'(Data => Ref.Data, Parent => Ref);
end Update;
procedure Query
(Ref : in Immutable_Reference;
Process : not null access procedure (Object : in Held_Data)) is
begin
Process.all (Ref.Data.all);
end Query;
procedure Update
|
| ︙ | ︙ |
Changes to src/natools-references.ads.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 | type Held_Data (<>) is limited private; Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; Data_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class; package Natools.References is pragma Preelaborate (References); | < < > > | | | | | < | < < < < | > > > > > > > > > | | | > > | | > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
type Held_Data (<>) is limited private;
Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;
Data_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;
package Natools.References is
pragma Preelaborate (References);
type Accessor (Data : not null access constant Held_Data) is
limited private;
type Mutator (Data : not null access Held_Data) is
limited private;
type Immutable_Reference is new Ada.Finalization.Controlled with private;
function Create
(Constructor : not null access function return Held_Data)
return Immutable_Reference;
-- Create a new held object and return a reference to it
procedure Replace
(Ref : in out Immutable_Reference;
Constructor : not null access function return Held_Data);
-- Replace the object held in Ref with a newly created object
procedure Reset (Ref : in out Immutable_Reference);
-- Empty Ref
function Is_Empty (Ref : Immutable_Reference) return Boolean;
-- Check whether Ref refers to an actual object
function "=" (Left, Right : Immutable_Reference) return Boolean;
-- Check whether Left and Right refer to the same object
function Query (Ref : in Immutable_Reference) return Accessor;
pragma Inline (Query);
-- Return a derefenciable constant access to the held object
procedure Query
(Ref : in Immutable_Reference;
Process : not null access procedure (Object : in Held_Data));
-- Call Process with the held object
Null_Immutable_Reference : constant Immutable_Reference;
type Reference is new Immutable_Reference with private;
function Update (Ref : in Reference) return Mutator;
pragma Inline (Update);
-- Return a ereferenciable mutable access to the held object
procedure Update
(Ref : in Reference;
Process : not null access procedure (Object : in out Held_Data));
-- Call Process with the held object
Null_Reference : constant Reference;
private
type Counter is new Natural;
type Counter_Access is access Counter;
for Counter_Access'Storage_Pool use Counter_Pool;
type Data_Access is access Held_Data;
for Data_Access'Storage_Pool use Data_Pool;
type Immutable_Reference is new Ada.Finalization.Controlled with record
Count : Counter_Access := null;
Data : Data_Access := null;
end record;
overriding procedure Adjust (Object : in out Immutable_Reference);
-- Increate reference counter
overriding procedure Finalize (Object : in out Immutable_Reference);
-- Decrease reference counter and release memory if needed
type Reference is new Immutable_Reference with null record;
type Accessor (Data : not null access constant Held_Data) is limited record
Parent : Immutable_Reference;
end record;
type Mutator (Data : not null access Held_Data) is limited record
Parent : Reference;
end record;
Null_Immutable_Reference : constant Immutable_Reference
:= (Ada.Finalization.Controlled with Count => null, Data => null);
Null_Reference : constant Reference
:= (Null_Immutable_Reference with null record);
end Natools.References;
|
Changes to src/natools-s_expressions-atom_buffers.adb.
| ︙ | ︙ | |||
139 140 141 142 143 144 145 |
function Create return Atom is
begin
return Null_Atom;
end Create;
begin
if Buffer.Ref.Is_Empty then
| > > | > > > | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 |
function Create return Atom is
begin
return Null_Atom;
end Create;
begin
if Buffer.Ref.Is_Empty then
declare
Tmp_Ref : constant Atom_Refs.Reference
:= Atom_Refs.Create (Create'Access);
begin
return Tmp_Ref.Query;
end;
else
return Buffer.Ref.Query;
end if;
end Raw_Query;
procedure Query
|
| ︙ | ︙ |