Overview
| Comment: | s_expressions-generic_caches: implement Lockable.Descriptor interface on memory caches |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
660d5d43a435d000105540e8f5bca753 |
| User & Date: | nat on 2014-03-07 21:53:10 |
| Other Links: | manifest | tags |
Context
|
2014-03-08
| ||
| 14:11 | s_expressions-cache_tests: add a test for the new Lockable.Descriptor interface of cache objects check-in: 0faa8fc7d8 user: nat tags: trunk | |
|
2014-03-07
| ||
| 21:53 | s_expressions-generic_caches: implement Lockable.Descriptor interface on memory caches check-in: 660d5d43a4 user: nat tags: trunk | |
|
2014-03-06
| ||
| 17:23 | s_expressions-parsers-tests: add a test for the new Lockable interface of Subparser objects check-in: e1b283ce5a user: nat tags: trunk | |
Changes
Modified src/natools-s_expressions-generic_caches.adb from [3373c2a61e] to [18facc84e2].
| ︙ | ︙ | |||
219 220 221 222 223 224 225 |
N : Node_Access;
begin
if Cache.Exp.Is_Empty then
return Cursor'(others => <>);
else
N := Cache.Exp.Query.Data.Root;
pragma Assert (N /= null);
| | > | > > | | > > < < | > > | | < < < < < < < < < | > > | > > | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 |
N : Node_Access;
begin
if Cache.Exp.Is_Empty then
return Cursor'(others => <>);
else
N := Cache.Exp.Query.Data.Root;
pragma Assert (N /= null);
return Cursor'(Exp => Cache.Exp,
Position => N,
Opening => N.Kind = List_Node,
Stack => <>,
Locked => False);
end if;
end First;
--------------------------
-- Descriptor Interface --
--------------------------
overriding function Current_Event (Object : in Cursor)
return Events.Event is
begin
if Object.Position = null or Object.Locked then
return Events.End_Of_Input;
end if;
case Object.Position.Kind is
when Atom_Node =>
return Events.Add_Atom;
when List_Node =>
if Object.Opening then
return Events.Open_List;
else
return Events.Close_List;
end if;
end case;
end Current_Event;
overriding function Current_Atom (Object : in Cursor) return Atom is
begin
if Object.Position = null or else Object.Position.Kind /= Atom_Node
or else Object.Locked
then
raise Program_Error;
end if;
return Object.Position.Data.all;
end Current_Atom;
overriding function Current_Level (Object : in Cursor) return Natural is
begin
if Object.Locked then
return 0;
else
return Absolute_Level (Object)
- Lockable.Current_Level (Object.Stack);
end if;
end Current_Level;
overriding procedure Query_Atom
(Object : in Cursor;
Process : not null access procedure (Data : in Atom)) is
begin
if Object.Position = null or else Object.Position.Kind /= Atom_Node
or else Object.Locked
then
raise Program_Error;
end if;
Process.all (Object.Position.Data.all);
end Query_Atom;
overriding procedure Read_Atom
(Object : in Cursor;
Data : out Atom;
Length : out Count)
is
Transferred : Count;
begin
if Object.Position = null or else Object.Position.Kind /= Atom_Node
or else Object.Locked
then
raise Program_Error;
end if;
Length := Object.Position.Data'Length;
Transferred := Count'Min (Data'Length, Length);
Data (Data'First .. Data'First + Transferred - 1)
:= Object.Position.Data (Object.Position.Data'First
.. Object.Position.Data'First + Transferred - 1);
end Read_Atom;
overriding procedure Next
(Object : in out Cursor;
Event : out Events.Event) is
begin
if Object.Position = null or Object.Locked then
Event := Events.End_Of_Input;
return;
end if;
if Object.Opening then
pragma Assert (Object.Position.Kind = List_Node);
if Object.Position.Child = null then
|
| ︙ | ︙ | |||
342 343 344 345 346 347 348 349 350 |
Object.Position := Object.Position.Parent;
Object.Opening := False;
else
Object.Position := null;
end if;
Event := Object.Current_Event;
end Next;
| > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 |
Object.Position := Object.Position.Parent;
Object.Opening := False;
else
Object.Position := null;
end if;
Event := Object.Current_Event;
if Event = Events.Close_List
and then Object.Absolute_Level < Lockable.Current_Level (Object.Stack)
then
Event := Events.End_Of_Input;
Object.Locked := True;
end if;
end Next;
-----------------------------------
-- Lockable.Descriptor Interface --
-----------------------------------
function Absolute_Level (Object : Cursor) return Natural is
Result : Natural := 0;
N : Node_Access := Object.Position;
begin
if Object.Position /= null
and then Object.Position.Kind = List_Node
and then Object.Opening
then
Result := Result + 1;
end if;
while N /= null loop
Result := Result + 1;
N := N.Parent;
end loop;
return Natural'Max (Result, 1) - 1;
end Absolute_Level;
overriding procedure Lock
(Object : in out Cursor;
State : out Lockable.Lock_State) is
begin
Lockable.Push_Level (Object.Stack, Object.Absolute_Level, State);
end Lock;
overriding procedure Unlock
(Object : in out Cursor;
State : in out Lockable.Lock_State;
Finish : in Boolean := True)
is
Previous_Level : constant Natural
:= Lockable.Current_Level (Object.Stack);
begin
Lockable.Pop_Level (Object.Stack, State);
State := Lockable.Null_State;
Object.Locked := False;
if Finish then
declare
Event : Events.Event := Object.Current_Event;
begin
loop
case Event is
when Events.Add_Atom | Events.Open_List =>
null;
when Events.Close_List =>
exit when Object.Absolute_Level < Previous_Level;
when Events.Error | Events.End_Of_Input =>
exit;
end case;
Object.Next (Event);
end loop;
end;
end if;
Object.Locked
:= Object.Absolute_Level < Lockable.Current_Level (Object.Stack);
end Unlock;
end Natools.S_Expressions.Generic_Caches;
|
Modified src/natools-s_expressions-generic_caches.ads from [d6fece5551] to [f6638058cf].
| ︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | -- The intended usage is efficient caching of S-expressions in memory. For -- -- more flexible in-memory S-expression objects, -- -- see Natools.S_Expressions.Holders. -- ------------------------------------------------------------------------------ with System.Storage_Pools; with Natools.S_Expressions.Printers; private with Ada.Finalization; private with Ada.Unchecked_Deallocation; private with Natools.References; generic | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | -- The intended usage is efficient caching of S-expressions in memory. For -- -- more flexible in-memory S-expression objects, -- -- see Natools.S_Expressions.Holders. -- ------------------------------------------------------------------------------ with System.Storage_Pools; with Natools.S_Expressions.Lockable; with Natools.S_Expressions.Printers; private with Ada.Finalization; private with Ada.Unchecked_Deallocation; private with Natools.References; generic |
| ︙ | ︙ | |||
48 49 50 51 52 53 54 |
(Output : in out Reference; Data : in Atom);
overriding procedure Close_List (Output : in out Reference);
function Duplicate (Cache : Reference) return Reference;
-- Create a new copy of the S-expression held in Cache and return it
| | > > > > > > > > | 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 |
(Output : in out Reference; Data : in Atom);
overriding procedure Close_List (Output : in out Reference);
function Duplicate (Cache : Reference) return Reference;
-- Create a new copy of the S-expression held in Cache and return it
type Cursor is new Lockable.Descriptor with private;
overriding function Current_Event (Object : in Cursor) return Events.Event;
overriding function Current_Atom (Object : in Cursor) return Atom;
overriding function Current_Level (Object : in Cursor) return Natural;
overriding procedure Query_Atom
(Object : in Cursor;
Process : not null access procedure (Data : in Atom));
overriding procedure Read_Atom
(Object : in Cursor;
Data : out Atom;
Length : out Count);
overriding procedure Next
(Object : in out Cursor;
Event : out Events.Event);
overriding procedure Lock
(Object : in out Cursor;
State : out Lockable.Lock_State);
overriding procedure Unlock
(Object : in out Cursor;
State : in out Lockable.Lock_State;
Finish : in Boolean := True);
function First (Cache : Reference'Class) return Cursor;
-- Create a new Cursor pointing at the beginning of Cache
private
type Atom_Access is access Atom;
for Atom_Access'Storage_Pool use Atom_Pool;
|
| ︙ | ︙ | |||
127 128 129 130 131 132 133 |
type Reference is new Printers.Printer with record
Exp : Trees.Reference;
end record;
| | > > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 |
type Reference is new Printers.Printer with record
Exp : Trees.Reference;
end record;
type Cursor is new Lockable.Descriptor with record
Exp : Trees.Reference := Trees.Null_Reference;
Position : Node_Access := null;
Opening : Boolean := False;
Stack : Lockable.Lock_Stack;
Locked : Boolean := False;
end record;
function Absolute_Level (Object : Cursor) return Natural;
end Natools.S_Expressions.Generic_Caches;
|